No puede seleccionar más de 25 temas Los temas deben comenzar con una letra o número, pueden incluir guiones ('-') y pueden tener hasta 35 caracteres de largo.

8576 líneas
295 KiB

  1. {***********************************************************
  2. glBitmap by Steffen Xonna aka Lossy eX (2003-2008)
  3. http://www.opengl24.de/index.php?cat=header&file=glbitmap
  4. modified by Delphi OpenGL Community (http://delphigl.com/) (2013)
  5. ------------------------------------------------------------
  6. The contents of this file are used with permission, subject to
  7. the Mozilla Public License Version 1.1 (the "License"); you may
  8. not use this file except in compliance with the License. You may
  9. obtain a copy of the License at
  10. http://www.mozilla.org/MPL/MPL-1.1.html
  11. ------------------------------------------------------------
  12. Version 3.0.0 unstable
  13. ------------------------------------------------------------
  14. History
  15. 20-11-2013
  16. - refactoring of the complete library
  17. 21-03-2010
  18. - The define GLB_DELPHI dosn't check versions anymore. If you say you are using delphi
  19. then it's your problem if that isn't true. This prevents the unit for incompatibility
  20. with newer versions of Delphi.
  21. - Problems with D2009+ resolved (Thanks noeska and all i forgot)
  22. - GetPixel isn't set if you are loading textures inside the constructor (Thanks Wilson)
  23. 10-08-2008
  24. - AddAlphaFromglBitmap used the custom pointer instead the imagedatapointer (Thanks Wilson)
  25. - Additional Datapointer for functioninterface now has the name CustomData
  26. 24-07-2008
  27. - AssigneAlphaToBitmap overwrites his own palette (Thanks Wilson)
  28. - If you load an texture from an file the property Filename will be set to the name of the file
  29. - Three new properties to attach custom data to the Texture objects
  30. - CustomName (free for use string)
  31. - CustomNameW (free for use widestring)
  32. - CustomDataPointer (free for use pointer to attach other objects or complex structures)
  33. 27-05-2008
  34. - RLE TGAs loaded much faster
  35. 26-05-2008
  36. - fixed some problem with reading RLE TGAs.
  37. 21-05-2008
  38. - function clone now only copys data if it's assigned and now it also copies the ID
  39. - it seems that lazarus dont like comments in comments.
  40. 01-05-2008
  41. - It's possible to set the id of the texture
  42. - define GLB_NO_NATIVE_GL deactivated by default
  43. 27-04-2008
  44. - Now supports the following libraries
  45. - SDL and SDL_image
  46. - libPNG
  47. - libJPEG
  48. - Linux compatibillity via free pascal compatibility (delphi sources optional)
  49. - BMPs now loaded manuel
  50. - Large restructuring
  51. - Property DataPtr now has the name Data
  52. - Functions are more flexible between RGB(A) and BGR(A). RGB can be saved as Bitmap and will be saved as BGR
  53. - Unused Depth removed
  54. - Function FreeData to freeing image data added
  55. 24-10-2007
  56. - ImageID flag of TGAs was ignored. (Thanks Zwoetzen)
  57. 15-11-2006
  58. - Function SetBorderColor implemented (only used by opengl if wrap is set to GL_CLAMP_TO_BORDER)
  59. - Function AddAlphaFromValue implemented to use an fixed Value as Alphachannel
  60. - Function ReadOpenGLExtension is now only intern
  61. 29-06-2006
  62. - pngimage now disabled by default like all other versions.
  63. 26-06-2006
  64. - Setting up an anisotropic filter of 0 isnt allowed by nvidia (Thanks Ogridi)
  65. 22-06-2006
  66. - Fixed some Problem with Delphi 5
  67. - Now uses the newest version of pngimage. Makes saving pngs much easier.
  68. 22-03-2006
  69. - Property IsCompressed and Size removed. Not really supported by Spec (Thanks Ogridi)
  70. 09-03-2006
  71. - Internal Format ifDepth8 added
  72. - function GrabScreen now supports all uncompressed formats
  73. 31-01-2006
  74. - AddAlphaFromglBitmap implemented
  75. 29-12-2005
  76. - LoadFromResource and LoadFromResourceId now needs an Instance and an ResourceType (for ID)
  77. 28-12-2005
  78. - Width, Height and Depth internal changed to TglBitmapPixelPosition.
  79. property Width, Height, Depth are still existing and new property Dimension are avail
  80. 11-12-2005
  81. - Added native OpenGL Support. Breaking the dglOpenGL "barrier".
  82. 19-10-2005
  83. - Added function GrabScreen to class TglBitmap2D
  84. 18-10-2005
  85. - Added support to Save images
  86. - Added function Clone to Clone Instance
  87. 11-10-2005
  88. - Functions now works with Cardinals for each channel. Up to 32 Bits per channel.
  89. Usefull for Future
  90. - Several speed optimizations
  91. 09-10-2005
  92. - Internal structure change. Loading of TGA, PNG and DDS improved.
  93. Data, format and size will now set directly with SetDataPtr.
  94. - AddFunc now works with all Types of Images and Formats
  95. - Some Funtions moved to Baseclass TglBitmap
  96. 06-10-2005
  97. - Added Support to decompress DXT3 and DXT5 compressed Images.
  98. - Added Mapping to convert data from one format into an other.
  99. 05-10-2005
  100. - Added method ConvertTo in Class TglBitmap2D. Method allows to convert every
  101. supported Input format (supported by GetPixel) into any uncompresed Format
  102. - Added Support to decompress DXT1 compressed Images.
  103. - SwapColors replaced by ConvertTo
  104. 04-10-2005
  105. - Added Support for compressed DDSs
  106. - Added new internal formats (DXT1, DXT3, DXT5)
  107. 29-09-2005
  108. - Parameter Components renamed to InternalFormat
  109. 23-09-2005
  110. - Some AllocMem replaced with GetMem (little speed change)
  111. - better exception handling. Better protection from memory leaks.
  112. 22-09-2005
  113. - Added support for Direct Draw Surfaces (.DDS) (uncompressed images only)
  114. - Added new internal formats (RGB8, RGBA8, RGBA4, RGB5A1, RGB10A2, R5G6B5)
  115. 07-09-2005
  116. - Added support for Grayscale textures
  117. - Added internal formats (Alpha, Luminance, LuminanceAlpha, BGR8, BGRA8)
  118. 10-07-2005
  119. - Added support for GL_VERSION_2_0
  120. - Added support for GL_EXT_texture_filter_anisotropic
  121. 04-07-2005
  122. - Function FillWithColor fills the Image with one Color
  123. - Function LoadNormalMap added
  124. 30-06-2005
  125. - ToNormalMap allows to Create an NormalMap from the Alphachannel
  126. - ToNormalMap now supports Sobel (nmSobel) function.
  127. 29-06-2005
  128. - support for RLE Compressed RGB TGAs added
  129. 28-06-2005
  130. - Class TglBitmapNormalMap added to support Normalmap generation
  131. - Added function ToNormalMap in class TglBitmap2D to genereate normal maps from textures.
  132. 3 Filters are supported. (4 Samples, 3x3 and 5x5)
  133. 16-06-2005
  134. - Method LoadCubeMapClass removed
  135. - LoadCubeMap returnvalue is now the Texture paramter. Such as LoadTextures
  136. - virtual abstract method GenTexture in class TglBitmap now is protected
  137. 12-06-2005
  138. - now support DescriptionFlag in LoadTga. Allows vertical flipped images to be loaded as normal
  139. 10-06-2005
  140. - little enhancement for IsPowerOfTwo
  141. - TglBitmap1D.GenTexture now tests NPOT Textures
  142. 06-06-2005
  143. - some little name changes. All properties or function with Texture in name are
  144. now without texture in name. We have allways texture so we dosn't name it.
  145. 03-06-2005
  146. - GenTexture now tests if texture is NPOT and NPOT-Texture are supported or
  147. TextureTarget is GL_TEXTURE_RECTANGLE. Else it raised an exception.
  148. 02-06-2005
  149. - added support for GL_ARB_texture_rectangle, GL_EXT_texture_rectangle and GL_NV_texture_rectangle
  150. 25-04-2005
  151. - Function Unbind added
  152. - call of SetFilter or SetTextureWrap if TextureID exists results in setting properties to opengl texture.
  153. 21-04-2005
  154. - class TglBitmapCubeMap added (allows to Create Cubemaps)
  155. 29-03-2005
  156. - Added Support for PNG Images. (http://pngdelphi.sourceforge.net/)
  157. To Enable png's use the define pngimage
  158. 22-03-2005
  159. - New Functioninterface added
  160. - Function GetPixel added
  161. 27-11-2004
  162. - Property BuildMipMaps renamed to MipMap
  163. 21-11-2004
  164. - property Name removed.
  165. - BuildMipMaps is now a set of 3 values. None, GluBuildMipmaps and SGIS_generate_mipmap
  166. 22-05-2004
  167. - property name added. Only used in glForms!
  168. 26-11-2003
  169. - property FreeDataAfterGenTexture is now available as default (default = true)
  170. - BuildMipmaps now implemented in TglBitmap1D (i've forgotten it)
  171. - function MoveMemory replaced with function Move (little speed change)
  172. - several calculations stored in variables (little speed change)
  173. 29-09-2003
  174. - property BuildMipsMaps added (default = true)
  175. if BuildMipMaps isn't set GenTextures uses glTexImage[12]D else it use gluBuild[12]dMipmaps
  176. - property FreeDataAfterGenTexture added (default = true)
  177. if FreeDataAfterGenTexture is set the texturedata were deleted after the texture was generated.
  178. - parameter DisableOtherTextureUnits of Bind removed
  179. - parameter FreeDataAfterGeneration of GenTextures removed
  180. 12-09-2003
  181. - TglBitmap dosn't delete data if class was destroyed (fixed)
  182. 09-09-2003
  183. - Bind now enables TextureUnits (by params)
  184. - GenTextures can leave data (by param)
  185. - LoadTextures now optimal
  186. 03-09-2003
  187. - Performance optimization in AddFunc
  188. - procedure Bind moved to subclasses
  189. - Added new Class TglBitmap1D to support real OpenGL 1D Textures
  190. 19-08-2003
  191. - Texturefilter and texturewrap now also as defaults
  192. Minfilter = GL_LINEAR_MIPMAP_LINEAR
  193. Magfilter = GL_LINEAR
  194. Wrap(str) = GL_CLAMP_TO_EDGE
  195. - Added new format tfCompressed to create a compressed texture.
  196. - propertys IsCompressed, TextureSize and IsResident added
  197. IsCompressed and TextureSize only contains data from level 0
  198. 18-08-2003
  199. - Added function AddFunc to add PerPixelEffects to Image
  200. - LoadFromFunc now based on AddFunc
  201. - Invert now based on AddFunc
  202. - SwapColors now based on AddFunc
  203. 16-08-2003
  204. - Added function FlipHorz
  205. 15-08-2003
  206. - Added function LaodFromFunc to create images with function
  207. - Added function FlipVert
  208. - Added internal format RGB(A) if GL_EXT_bgra or OpenGL 1.2 isn't supported
  209. 29-07-2003
  210. - Added Alphafunctions to calculate alpha per function
  211. - Added Alpha from ColorKey using alphafunctions
  212. 28-07-2003
  213. - First full functionally Version of glBitmap
  214. - Support for 24Bit and 32Bit TGA Pictures added
  215. 25-07-2003
  216. - begin of programming
  217. ***********************************************************}
  218. unit glBitmap;
  219. // Please uncomment the defines below to configure the glBitmap to your preferences.
  220. // If you have configured the unit you can uncomment the warning above.
  221. {$MESSAGE warn 'Hey. I''m the glBitmap.pas and i need to be configured. My master tell me your preferences! ;)'}
  222. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  223. // Preferences ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  224. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  225. // activate to enable build-in OpenGL support with statically linked methods
  226. // use dglOpenGL.pas if not enabled
  227. {.$DEFINE GLB_NATIVE_OGL_STATIC}
  228. // activate to enable build-in OpenGL support with dynamically linked methods
  229. // use dglOpenGL.pas if not enabled
  230. {.$DEFINE GLB_NATIVE_OGL_DYNAMIC}
  231. // activate to enable the support for SDL_surfaces
  232. {.$DEFINE GLB_SDL}
  233. // activate to enable the support for TBitmap from Delphi (not lazarus)
  234. {.$DEFINE GLB_DELPHI}
  235. // activate to enable the support for TLazIntfImage from Lazarus
  236. {.$DEFINE GLB_LAZARUS}
  237. // activate to enable the support of SDL_image to load files. (READ ONLY)
  238. // If you enable SDL_image all other libraries will be ignored!
  239. {.$DEFINE GLB_SDL_IMAGE}
  240. // activate to enable Lazarus TPortableNetworkGraphic support
  241. // if you enable this pngImage and libPNG will be ignored
  242. {.$DEFINE GLB_LAZ_PNG}
  243. // activate to enable png support with the unit pngimage -> http://pngdelphi.sourceforge.net/
  244. // if you enable pngimage the libPNG will be ignored
  245. {.$DEFINE GLB_PNGIMAGE}
  246. // activate to use the libPNG -> http://www.libpng.org/
  247. // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libpng
  248. {.$DEFINE GLB_LIB_PNG}
  249. // activate to enable Lazarus TJPEGImage support
  250. // if you enable this delphi jpegs and libJPEG will be ignored
  251. {.$DEFINE GLB_LAZ_JPEG}
  252. // if you enable delphi jpegs the libJPEG will be ignored
  253. {.$DEFINE GLB_DELPHI_JPEG}
  254. // activate to use the libJPEG -> http://www.ijg.org/
  255. // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libjpeg
  256. {.$DEFINE GLB_LIB_JPEG}
  257. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  258. // PRIVATE: do not change anything! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  259. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  260. // Delphi Versions
  261. {$IFDEF fpc}
  262. {$MODE Delphi}
  263. {$IFDEF CPUI386}
  264. {$DEFINE CPU386}
  265. {$ASMMODE INTEL}
  266. {$ENDIF}
  267. {$IFNDEF WINDOWS}
  268. {$linklib c}
  269. {$ENDIF}
  270. {$ENDIF}
  271. // Operation System
  272. {$IF DEFINED(WIN32) or DEFINED(WIN64) or DEFINED(WINDOWS)}
  273. {$DEFINE GLB_WIN}
  274. {$ELSEIF DEFINED(LINUX)}
  275. {$DEFINE GLB_LINUX}
  276. {$IFEND}
  277. // native OpenGL Support
  278. {$IF DEFINED(GLB_NATIVE_OGL_STATIC) OR DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
  279. {$DEFINE GLB_NATIVE_OGL}
  280. {$IFEND}
  281. // checking define combinations
  282. //SDL Image
  283. {$IFDEF GLB_SDL_IMAGE}
  284. {$IFNDEF GLB_SDL}
  285. {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
  286. {$DEFINE GLB_SDL}
  287. {$ENDIF}
  288. {$IFDEF GLB_LAZ_PNG}
  289. {$MESSAGE warn 'The Lazarus TPortableNetworkGraphics will be ignored because you are using SDL_image.'}
  290. {$undef GLB_LAZ_PNG}
  291. {$ENDIF}
  292. {$IFDEF GLB_PNGIMAGE}
  293. {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
  294. {$undef GLB_PNGIMAGE}
  295. {$ENDIF}
  296. {$IFDEF GLB_LAZ_JPEG}
  297. {$MESSAGE warn 'The Lazarus TJPEGImage will be ignored because you are using SDL_image.'}
  298. {$undef GLB_LAZ_JPEG}
  299. {$ENDIF}
  300. {$IFDEF GLB_DELPHI_JPEG}
  301. {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
  302. {$undef GLB_DELPHI_JPEG}
  303. {$ENDIF}
  304. {$IFDEF GLB_LIB_PNG}
  305. {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
  306. {$undef GLB_LIB_PNG}
  307. {$ENDIF}
  308. {$IFDEF GLB_LIB_JPEG}
  309. {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
  310. {$undef GLB_LIB_JPEG}
  311. {$ENDIF}
  312. {$DEFINE GLB_SUPPORT_PNG_READ}
  313. {$DEFINE GLB_SUPPORT_JPEG_READ}
  314. {$ENDIF}
  315. // Lazarus TPortableNetworkGraphic
  316. {$IFDEF GLB_LAZ_PNG}
  317. {$IFNDEF GLB_LAZARUS}
  318. {$MESSAGE warn 'Lazarus TPortableNetworkGraphic won''t work without Lazarus. Lazarus will be activated.'}
  319. {$DEFINE GLB_LAZARUS}
  320. {$ENDIF}
  321. {$IFDEF GLB_PNGIMAGE}
  322. {$MESSAGE warn 'The pngimage will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
  323. {$undef GLB_PNGIMAGE}
  324. {$ENDIF}
  325. {$IFDEF GLB_LIB_PNG}
  326. {$MESSAGE warn 'The library libPNG will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
  327. {$undef GLB_LIB_PNG}
  328. {$ENDIF}
  329. {$DEFINE GLB_SUPPORT_PNG_READ}
  330. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  331. {$ENDIF}
  332. // PNG Image
  333. {$IFDEF GLB_PNGIMAGE}
  334. {$IFDEF GLB_LIB_PNG}
  335. {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
  336. {$undef GLB_LIB_PNG}
  337. {$ENDIF}
  338. {$DEFINE GLB_SUPPORT_PNG_READ}
  339. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  340. {$ENDIF}
  341. // libPNG
  342. {$IFDEF GLB_LIB_PNG}
  343. {$DEFINE GLB_SUPPORT_PNG_READ}
  344. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  345. {$ENDIF}
  346. // Lazarus TJPEGImage
  347. {$IFDEF GLB_LAZ_JPEG}
  348. {$IFNDEF GLB_LAZARUS}
  349. {$MESSAGE warn 'Lazarus TJPEGImage won''t work without Lazarus. Lazarus will be activated.'}
  350. {$DEFINE GLB_LAZARUS}
  351. {$ENDIF}
  352. {$IFDEF GLB_DELPHI_JPEG}
  353. {$MESSAGE warn 'The Delphi JPEGImage will be ignored if you are using the Lazarus TJPEGImage.'}
  354. {$undef GLB_DELPHI_JPEG}
  355. {$ENDIF}
  356. {$IFDEF GLB_LIB_JPEG}
  357. {$MESSAGE warn 'The library libJPEG will be ignored if you are using the Lazarus TJPEGImage.'}
  358. {$undef GLB_LIB_JPEG}
  359. {$ENDIF}
  360. {$DEFINE GLB_SUPPORT_JPEG_READ}
  361. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  362. {$ENDIF}
  363. // JPEG Image
  364. {$IFDEF GLB_DELPHI_JPEG}
  365. {$IFDEF GLB_LIB_JPEG}
  366. {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
  367. {$undef GLB_LIB_JPEG}
  368. {$ENDIF}
  369. {$DEFINE GLB_SUPPORT_JPEG_READ}
  370. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  371. {$ENDIF}
  372. // libJPEG
  373. {$IFDEF GLB_LIB_JPEG}
  374. {$DEFINE GLB_SUPPORT_JPEG_READ}
  375. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  376. {$ENDIF}
  377. // native OpenGL
  378. {$IF DEFINED(GLB_NATIVE_OGL_STATIC) AND DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
  379. {$MESSAGE warn 'GLB_NATIVE_OGL_STATIC will be ignored because you enabled GLB_NATIVE_OGL_DYNAMIC'}
  380. {$IFEND}
  381. // general options
  382. {$EXTENDEDSYNTAX ON}
  383. {$LONGSTRINGS ON}
  384. {$ALIGN ON}
  385. {$IFNDEF FPC}
  386. {$OPTIMIZATION ON}
  387. {$ENDIF}
  388. interface
  389. uses
  390. {$IFNDEF GLB_NATIVE_OGL} dglOpenGL, {$ENDIF}
  391. {$IF DEFINED(GLB_WIN) AND
  392. (DEFINED(GLB_NATIVE_OGL) OR
  393. DEFINED(GLB_DELPHI))} windows, {$IFEND}
  394. {$IFDEF GLB_SDL} SDL, {$ENDIF}
  395. {$IFDEF GLB_LAZARUS} IntfGraphics, GraphType, Graphics, {$ENDIF}
  396. {$IFDEF GLB_DELPHI} Dialogs, Graphics, Types, {$ENDIF}
  397. {$IFDEF GLB_SDL_IMAGE} SDL_image, {$ENDIF}
  398. {$IFDEF GLB_PNGIMAGE} pngimage, {$ENDIF}
  399. {$IFDEF GLB_LIB_PNG} libPNG, {$ENDIF}
  400. {$IFDEF GLB_DELPHI_JPEG} JPEG, {$ENDIF}
  401. {$IFDEF GLB_LIB_JPEG} libJPEG, {$ENDIF}
  402. Classes, SysUtils;
  403. {$IFDEF GLB_NATIVE_OGL}
  404. const
  405. GL_TRUE = 1;
  406. GL_FALSE = 0;
  407. GL_ZERO = 0;
  408. GL_ONE = 1;
  409. GL_VERSION = $1F02;
  410. GL_EXTENSIONS = $1F03;
  411. GL_TEXTURE_1D = $0DE0;
  412. GL_TEXTURE_2D = $0DE1;
  413. GL_TEXTURE_RECTANGLE = $84F5;
  414. GL_NORMAL_MAP = $8511;
  415. GL_TEXTURE_CUBE_MAP = $8513;
  416. GL_REFLECTION_MAP = $8512;
  417. GL_TEXTURE_CUBE_MAP_POSITIVE_X = $8515;
  418. GL_TEXTURE_CUBE_MAP_NEGATIVE_X = $8516;
  419. GL_TEXTURE_CUBE_MAP_POSITIVE_Y = $8517;
  420. GL_TEXTURE_CUBE_MAP_NEGATIVE_Y = $8518;
  421. GL_TEXTURE_CUBE_MAP_POSITIVE_Z = $8519;
  422. GL_TEXTURE_CUBE_MAP_NEGATIVE_Z = $851A;
  423. GL_TEXTURE_WIDTH = $1000;
  424. GL_TEXTURE_HEIGHT = $1001;
  425. GL_TEXTURE_INTERNAL_FORMAT = $1003;
  426. GL_TEXTURE_SWIZZLE_RGBA = $8E46;
  427. GL_S = $2000;
  428. GL_T = $2001;
  429. GL_R = $2002;
  430. GL_Q = $2003;
  431. GL_TEXTURE_GEN_S = $0C60;
  432. GL_TEXTURE_GEN_T = $0C61;
  433. GL_TEXTURE_GEN_R = $0C62;
  434. GL_TEXTURE_GEN_Q = $0C63;
  435. GL_RED = $1903;
  436. GL_GREEN = $1904;
  437. GL_BLUE = $1905;
  438. GL_ALPHA = $1906;
  439. GL_ALPHA4 = $803B;
  440. GL_ALPHA8 = $803C;
  441. GL_ALPHA12 = $803D;
  442. GL_ALPHA16 = $803E;
  443. GL_LUMINANCE = $1909;
  444. GL_LUMINANCE4 = $803F;
  445. GL_LUMINANCE8 = $8040;
  446. GL_LUMINANCE12 = $8041;
  447. GL_LUMINANCE16 = $8042;
  448. GL_LUMINANCE_ALPHA = $190A;
  449. GL_LUMINANCE4_ALPHA4 = $8043;
  450. GL_LUMINANCE6_ALPHA2 = $8044;
  451. GL_LUMINANCE8_ALPHA8 = $8045;
  452. GL_LUMINANCE12_ALPHA4 = $8046;
  453. GL_LUMINANCE12_ALPHA12 = $8047;
  454. GL_LUMINANCE16_ALPHA16 = $8048;
  455. GL_RGB = $1907;
  456. GL_BGR = $80E0;
  457. GL_R3_G3_B2 = $2A10;
  458. GL_RGB4 = $804F;
  459. GL_RGB5 = $8050;
  460. GL_RGB565 = $8D62;
  461. GL_RGB8 = $8051;
  462. GL_RGB10 = $8052;
  463. GL_RGB12 = $8053;
  464. GL_RGB16 = $8054;
  465. GL_RGBA = $1908;
  466. GL_BGRA = $80E1;
  467. GL_RGBA2 = $8055;
  468. GL_RGBA4 = $8056;
  469. GL_RGB5_A1 = $8057;
  470. GL_RGBA8 = $8058;
  471. GL_RGB10_A2 = $8059;
  472. GL_RGBA12 = $805A;
  473. GL_RGBA16 = $805B;
  474. GL_DEPTH_COMPONENT = $1902;
  475. GL_DEPTH_COMPONENT16 = $81A5;
  476. GL_DEPTH_COMPONENT24 = $81A6;
  477. GL_DEPTH_COMPONENT32 = $81A7;
  478. GL_COMPRESSED_RGB = $84ED;
  479. GL_COMPRESSED_RGBA = $84EE;
  480. GL_COMPRESSED_RGB_S3TC_DXT1_EXT = $83F0;
  481. GL_COMPRESSED_RGBA_S3TC_DXT1_EXT = $83F1;
  482. GL_COMPRESSED_RGBA_S3TC_DXT3_EXT = $83F2;
  483. GL_COMPRESSED_RGBA_S3TC_DXT5_EXT = $83F3;
  484. GL_UNSIGNED_BYTE = $1401;
  485. GL_UNSIGNED_BYTE_3_3_2 = $8032;
  486. GL_UNSIGNED_BYTE_2_3_3_REV = $8362;
  487. GL_UNSIGNED_SHORT = $1403;
  488. GL_UNSIGNED_SHORT_5_6_5 = $8363;
  489. GL_UNSIGNED_SHORT_4_4_4_4 = $8033;
  490. GL_UNSIGNED_SHORT_5_5_5_1 = $8034;
  491. GL_UNSIGNED_SHORT_5_6_5_REV = $8364;
  492. GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;
  493. GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;
  494. GL_UNSIGNED_INT = $1405;
  495. GL_UNSIGNED_INT_8_8_8_8 = $8035;
  496. GL_UNSIGNED_INT_10_10_10_2 = $8036;
  497. GL_UNSIGNED_INT_8_8_8_8_REV = $8367;
  498. GL_UNSIGNED_INT_2_10_10_10_REV = $8368;
  499. { Texture Filter }
  500. GL_TEXTURE_MAG_FILTER = $2800;
  501. GL_TEXTURE_MIN_FILTER = $2801;
  502. GL_NEAREST = $2600;
  503. GL_NEAREST_MIPMAP_NEAREST = $2700;
  504. GL_NEAREST_MIPMAP_LINEAR = $2702;
  505. GL_LINEAR = $2601;
  506. GL_LINEAR_MIPMAP_NEAREST = $2701;
  507. GL_LINEAR_MIPMAP_LINEAR = $2703;
  508. { Texture Wrap }
  509. GL_TEXTURE_WRAP_S = $2802;
  510. GL_TEXTURE_WRAP_T = $2803;
  511. GL_TEXTURE_WRAP_R = $8072;
  512. GL_CLAMP = $2900;
  513. GL_REPEAT = $2901;
  514. GL_CLAMP_TO_EDGE = $812F;
  515. GL_CLAMP_TO_BORDER = $812D;
  516. GL_MIRRORED_REPEAT = $8370;
  517. { Other }
  518. GL_GENERATE_MIPMAP = $8191;
  519. GL_TEXTURE_BORDER_COLOR = $1004;
  520. GL_MAX_TEXTURE_SIZE = $0D33;
  521. GL_PACK_ALIGNMENT = $0D05;
  522. GL_UNPACK_ALIGNMENT = $0CF5;
  523. GL_TEXTURE_MAX_ANISOTROPY_EXT = $84FE;
  524. GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;
  525. GL_MAX_CUBE_MAP_TEXTURE_SIZE = $851C;
  526. GL_TEXTURE_GEN_MODE = $2500;
  527. {$IF DEFINED(GLB_WIN)}
  528. libglu = 'glu32.dll';
  529. libopengl = 'opengl32.dll';
  530. {$ELSEIF DEFINED(GLB_LINUX)}
  531. libglu = 'libGLU.so.1';
  532. libopengl = 'libGL.so.1';
  533. {$IFEND}
  534. type
  535. GLboolean = BYTEBOOL;
  536. GLint = Integer;
  537. GLsizei = Integer;
  538. GLuint = Cardinal;
  539. GLfloat = Single;
  540. GLenum = Cardinal;
  541. PGLvoid = Pointer;
  542. PGLboolean = ^GLboolean;
  543. PGLint = ^GLint;
  544. PGLuint = ^GLuint;
  545. PGLfloat = ^GLfloat;
  546. TglCompressedTexImage1D = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  547. TglCompressedTexImage2D = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; height: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  548. TglGetCompressedTexImage = procedure(target: GLenum; level: GLint; img: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  549. {$IF DEFINED(GLB_WIN)}
  550. TwglGetProcAddress = function (ProcName: PAnsiChar): Pointer; stdcall;
  551. {$ELSEIF DEFINED(GLB_LINUX)}
  552. TglXGetProcAddress = function(ProcName: PAnsiChar): Pointer; cdecl;
  553. TglXGetProcAddressARB = function(const name: PAnsiChar): pointer; cdecl;
  554. {$IFEND}
  555. {$IF DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
  556. TglEnable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  557. TglDisable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  558. TglGetString = function(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  559. TglGetIntegerv = procedure(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  560. TglTexParameteri = procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  561. TglTexParameteriv = procedure(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  562. TglTexParameterfv = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  563. TglGetTexParameteriv = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  564. TglGetTexParameterfv = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  565. TglGetTexLevelParameteriv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  566. TglGetTexLevelParameterfv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  567. TglTexGeni = procedure(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  568. TglGenTextures = procedure(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  569. TglBindTexture = procedure(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  570. TglDeleteTextures = procedure(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  571. TglAreTexturesResident = function(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  572. TglReadPixels = procedure(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  573. TglPixelStorei = procedure(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  574. TglTexImage1D = procedure(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  575. TglTexImage2D = procedure(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; height: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  576. TglGetTexImage = procedure(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  577. TgluBuild1DMipmaps = function(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  578. TgluBuild2DMipmaps = function(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  579. {$ELSEIF DEFINED(GLB_NATIVE_OGL_STATIC)}
  580. procedure glEnable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  581. procedure glDisable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  582. function glGetString(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  583. procedure glGetIntegerv(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  584. procedure glTexParameteri(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  585. procedure glTexParameteriv(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  586. procedure glTexParameterfv(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  587. procedure glGetTexParameteriv(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  588. procedure glGetTexParameterfv(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  589. procedure glGetTexLevelParameteriv(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  590. procedure glGetTexLevelParameterfv(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  591. procedure glTexGeni(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  592. procedure glGenTextures(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  593. procedure glBindTexture(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  594. procedure glDeleteTextures(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  595. function glAreTexturesResident(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  596. procedure glReadPixels(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  597. procedure glPixelStorei(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  598. procedure glTexImage1D(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  599. procedure glTexImage2D(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; height: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  600. procedure glGetTexImage(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  601. function gluBuild1DMipmaps(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
  602. function gluBuild2DMipmaps(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
  603. {$IFEND}
  604. var
  605. GL_VERSION_1_2,
  606. GL_VERSION_1_3,
  607. GL_VERSION_1_4,
  608. GL_VERSION_2_0,
  609. GL_VERSION_3_3,
  610. GL_SGIS_generate_mipmap,
  611. GL_ARB_texture_border_clamp,
  612. GL_ARB_texture_mirrored_repeat,
  613. GL_ARB_texture_rectangle,
  614. GL_ARB_texture_non_power_of_two,
  615. GL_ARB_texture_swizzle,
  616. GL_ARB_texture_cube_map,
  617. GL_IBM_texture_mirrored_repeat,
  618. GL_NV_texture_rectangle,
  619. GL_EXT_texture_edge_clamp,
  620. GL_EXT_texture_rectangle,
  621. GL_EXT_texture_swizzle,
  622. GL_EXT_texture_cube_map,
  623. GL_EXT_texture_filter_anisotropic: Boolean;
  624. glCompressedTexImage1D: TglCompressedTexImage1D;
  625. glCompressedTexImage2D: TglCompressedTexImage2D;
  626. glGetCompressedTexImage: TglGetCompressedTexImage;
  627. {$IF DEFINED(GLB_WIN)}
  628. wglGetProcAddress: TwglGetProcAddress;
  629. {$ELSEIF DEFINED(GLB_LINUX)}
  630. glXGetProcAddress: TglXGetProcAddress;
  631. glXGetProcAddressARB: TglXGetProcAddress;
  632. {$IFEND}
  633. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  634. glEnable: TglEnable;
  635. glDisable: TglDisable;
  636. glGetString: TglGetString;
  637. glGetIntegerv: TglGetIntegerv;
  638. glTexParameteri: TglTexParameteri;
  639. glTexParameteriv: TglTexParameteriv;
  640. glTexParameterfv: TglTexParameterfv;
  641. glGetTexParameteriv: TglGetTexParameteriv;
  642. glGetTexParameterfv: TglGetTexParameterfv;
  643. glGetTexLevelParameteriv: TglGetTexLevelParameteriv;
  644. glGetTexLevelParameterfv: TglGetTexLevelParameterfv;
  645. glTexGeni: TglTexGeni;
  646. glGenTextures: TglGenTextures;
  647. glBindTexture: TglBindTexture;
  648. glDeleteTextures: TglDeleteTextures;
  649. glAreTexturesResident: TglAreTexturesResident;
  650. glReadPixels: TglReadPixels;
  651. glPixelStorei: TglPixelStorei;
  652. glTexImage1D: TglTexImage1D;
  653. glTexImage2D: TglTexImage2D;
  654. glGetTexImage: TglGetTexImage;
  655. gluBuild1DMipmaps: TgluBuild1DMipmaps;
  656. gluBuild2DMipmaps: TgluBuild2DMipmaps;
  657. {$ENDIF}
  658. {$ENDIF}
  659. type
  660. ////////////////////////////////////////////////////////////////////////////////////////////////////
  661. TglBitmapFormat = (
  662. tfEmpty = 0, //must be smallest value!
  663. tfAlpha4,
  664. tfAlpha8,
  665. tfAlpha12,
  666. tfAlpha16,
  667. tfLuminance4,
  668. tfLuminance8,
  669. tfLuminance12,
  670. tfLuminance16,
  671. tfLuminance4Alpha4,
  672. tfLuminance6Alpha2,
  673. tfLuminance8Alpha8,
  674. tfLuminance12Alpha4,
  675. tfLuminance12Alpha12,
  676. tfLuminance16Alpha16,
  677. tfR3G3B2,
  678. tfRGB4,
  679. tfR5G6B5,
  680. tfRGB5,
  681. tfRGB8,
  682. tfRGB10,
  683. tfRGB12,
  684. tfRGB16,
  685. tfRGBA2,
  686. tfRGBA4,
  687. tfRGB5A1,
  688. tfRGBA8,
  689. tfRGB10A2,
  690. tfRGBA12,
  691. tfRGBA16,
  692. tfBGR4,
  693. tfB5G6R5,
  694. tfBGR5,
  695. tfBGR8,
  696. tfBGR10,
  697. tfBGR12,
  698. tfBGR16,
  699. tfBGRA2,
  700. tfBGRA4,
  701. tfBGR5A1,
  702. tfBGRA8,
  703. tfBGR10A2,
  704. tfBGRA12,
  705. tfBGRA16,
  706. tfDepth16,
  707. tfDepth24,
  708. tfDepth32,
  709. tfS3tcDtx1RGBA,
  710. tfS3tcDtx3RGBA,
  711. tfS3tcDtx5RGBA
  712. );
  713. TglBitmapFileType = (
  714. {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG, {$ENDIF}
  715. {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
  716. ftDDS,
  717. ftTGA,
  718. ftBMP);
  719. TglBitmapFileTypes = set of TglBitmapFileType;
  720. TglBitmapMipMap = (
  721. mmNone,
  722. mmMipmap,
  723. mmMipmapGlu);
  724. TglBitmapNormalMapFunc = (
  725. nm4Samples,
  726. nmSobel,
  727. nm3x3,
  728. nm5x5);
  729. ////////////////////////////////////////////////////////////////////////////////////////////////////
  730. EglBitmap = class(Exception);
  731. EglBitmapNotSupported = class(Exception);
  732. EglBitmapSizeToLarge = class(EglBitmap);
  733. EglBitmapNonPowerOfTwo = class(EglBitmap);
  734. EglBitmapUnsupportedFormat = class(EglBitmap)
  735. constructor Create(const aFormat: TglBitmapFormat); overload;
  736. constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;
  737. end;
  738. ////////////////////////////////////////////////////////////////////////////////////////////////////
  739. TglBitmapColorRec = packed record
  740. case Integer of
  741. 0: (r, g, b, a: Cardinal);
  742. 1: (arr: array[0..3] of Cardinal);
  743. end;
  744. TglBitmapPixelData = packed record
  745. Data, Range: TglBitmapColorRec;
  746. Format: TglBitmapFormat;
  747. end;
  748. PglBitmapPixelData = ^TglBitmapPixelData;
  749. ////////////////////////////////////////////////////////////////////////////////////////////////////
  750. TglBitmapPixelPositionFields = set of (ffX, ffY);
  751. TglBitmapPixelPosition = record
  752. Fields : TglBitmapPixelPositionFields;
  753. X : Word;
  754. Y : Word;
  755. end;
  756. TglBitmapFormatDescriptor = class(TObject)
  757. protected
  758. function GetIsCompressed: Boolean; virtual; abstract;
  759. function GetHasAlpha: Boolean; virtual; abstract;
  760. function GetglDataFormat: GLenum; virtual; abstract;
  761. function GetglFormat: GLenum; virtual; abstract;
  762. function GetglInternalFormat: GLenum; virtual; abstract;
  763. public
  764. property IsCompressed: Boolean read GetIsCompressed;
  765. property HasAlpha: Boolean read GetHasAlpha;
  766. property glFormat: GLenum read GetglFormat;
  767. property glInternalFormat: GLenum read GetglInternalFormat;
  768. property glDataFormat: GLenum read GetglDataFormat;
  769. end;
  770. ////////////////////////////////////////////////////////////////////////////////////////////////////
  771. TglBitmap = class;
  772. TglBitmapFunctionRec = record
  773. Sender: TglBitmap;
  774. Size: TglBitmapPixelPosition;
  775. Position: TglBitmapPixelPosition;
  776. Source: TglBitmapPixelData;
  777. Dest: TglBitmapPixelData;
  778. Args: Pointer;
  779. end;
  780. TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
  781. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  782. TglBitmap = class
  783. private
  784. function GetFormatDesc: TglBitmapFormatDescriptor;
  785. protected
  786. fID: GLuint;
  787. fTarget: GLuint;
  788. fAnisotropic: Integer;
  789. fDeleteTextureOnFree: Boolean;
  790. fFreeDataAfterGenTexture: Boolean;
  791. fData: PByte;
  792. fIsResident: Boolean;
  793. fBorderColor: array[0..3] of Single;
  794. fDimension: TglBitmapPixelPosition;
  795. fMipMap: TglBitmapMipMap;
  796. fFormat: TglBitmapFormat;
  797. // Mapping
  798. fPixelSize: Integer;
  799. fRowSize: Integer;
  800. // Filtering
  801. fFilterMin: GLenum;
  802. fFilterMag: GLenum;
  803. // TexturWarp
  804. fWrapS: GLenum;
  805. fWrapT: GLenum;
  806. fWrapR: GLenum;
  807. //Swizzle
  808. fSwizzle: array[0..3] of GLenum;
  809. // CustomData
  810. fFilename: String;
  811. fCustomName: String;
  812. fCustomNameW: WideString;
  813. fCustomData: Pointer;
  814. //Getter
  815. function GetWidth: Integer; virtual;
  816. function GetHeight: Integer; virtual;
  817. function GetFileWidth: Integer; virtual;
  818. function GetFileHeight: Integer; virtual;
  819. //Setter
  820. procedure SetCustomData(const aValue: Pointer);
  821. procedure SetCustomName(const aValue: String);
  822. procedure SetCustomNameW(const aValue: WideString);
  823. procedure SetDeleteTextureOnFree(const aValue: Boolean);
  824. procedure SetFormat(const aValue: TglBitmapFormat);
  825. procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
  826. procedure SetID(const aValue: Cardinal);
  827. procedure SetMipMap(const aValue: TglBitmapMipMap);
  828. procedure SetTarget(const aValue: Cardinal);
  829. procedure SetAnisotropic(const aValue: Integer);
  830. procedure CreateID;
  831. procedure SetupParameters(out aBuildWithGlu: Boolean);
  832. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  833. const aWidth: Integer = -1; const aHeight: Integer = -1); virtual; //be careful, aData could be freed by this method
  834. procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
  835. function FlipHorz: Boolean; virtual;
  836. function FlipVert: Boolean; virtual;
  837. property Width: Integer read GetWidth;
  838. property Height: Integer read GetHeight;
  839. property FileWidth: Integer read GetFileWidth;
  840. property FileHeight: Integer read GetFileHeight;
  841. public
  842. //Properties
  843. property ID: Cardinal read fID write SetID;
  844. property Target: Cardinal read fTarget write SetTarget;
  845. property Format: TglBitmapFormat read fFormat write SetFormat;
  846. property MipMap: TglBitmapMipMap read fMipMap write SetMipMap;
  847. property Anisotropic: Integer read fAnisotropic write SetAnisotropic;
  848. property FormatDesc: TglBitmapFormatDescriptor read GetFormatDesc;
  849. property Filename: String read fFilename;
  850. property CustomName: String read fCustomName write SetCustomName;
  851. property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
  852. property CustomData: Pointer read fCustomData write SetCustomData;
  853. property DeleteTextureOnFree: Boolean read fDeleteTextureOnFree write SetDeleteTextureOnFree;
  854. property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
  855. property Dimension: TglBitmapPixelPosition read fDimension;
  856. property Data: PByte read fData;
  857. property IsResident: Boolean read fIsResident;
  858. procedure AfterConstruction; override;
  859. procedure BeforeDestruction; override;
  860. procedure PrepareResType(var aResource: String; var aResType: PChar);
  861. //Load
  862. procedure LoadFromFile(const aFilename: String);
  863. procedure LoadFromStream(const aStream: TStream); virtual;
  864. procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  865. const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
  866. procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
  867. procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  868. //Save
  869. procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  870. procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
  871. //Convert
  872. function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
  873. function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  874. const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
  875. public
  876. //Alpha & Co
  877. {$IFDEF GLB_SDL}
  878. function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  879. function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  880. function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  881. function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
  882. const aArgs: Pointer = nil): Boolean;
  883. {$ENDIF}
  884. {$IFDEF GLB_DELPHI}
  885. function AssignToBitmap(const aBitmap: TBitmap): Boolean;
  886. function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  887. function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  888. function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
  889. const aArgs: Pointer = nil): Boolean;
  890. {$ENDIF}
  891. {$IFDEF GLB_LAZARUS}
  892. function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  893. function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  894. function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  895. function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil;
  896. const aArgs: Pointer = nil): Boolean;
  897. {$ENDIF}
  898. function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil;
  899. const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  900. function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  901. const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  902. function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
  903. function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  904. function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  905. function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  906. function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
  907. function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
  908. function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
  909. function AddAlphaFromValue(const aAlpha: Byte): Boolean;
  910. function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  911. function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  912. function RemoveAlpha: Boolean; virtual;
  913. public
  914. //Common
  915. function Clone: TglBitmap;
  916. function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
  917. procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
  918. procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  919. procedure FreeData;
  920. //ColorFill
  921. procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
  922. procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
  923. procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
  924. //TexParameters
  925. procedure SetFilter(const aMin, aMag: GLenum);
  926. procedure SetWrap(
  927. const S: GLenum = GL_CLAMP_TO_EDGE;
  928. const T: GLenum = GL_CLAMP_TO_EDGE;
  929. const R: GLenum = GL_CLAMP_TO_EDGE);
  930. procedure SetSwizzle(const r, g, b, a: GLenum);
  931. procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
  932. procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
  933. //Constructors
  934. constructor Create; overload;
  935. constructor Create(const aFileName: String); overload;
  936. constructor Create(const aStream: TStream); overload;
  937. constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat); overload;
  938. constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
  939. constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
  940. constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
  941. private
  942. {$IFDEF GLB_SUPPORT_PNG_READ} function LoadPNG(const aStream: TStream): Boolean; virtual; {$ENDIF}
  943. {$ifdef GLB_SUPPORT_PNG_WRITE} procedure SavePNG(const aStream: TStream); virtual; {$ENDIF}
  944. {$IFDEF GLB_SUPPORT_JPEG_READ} function LoadJPEG(const aStream: TStream): Boolean; virtual; {$ENDIF}
  945. {$IFDEF GLB_SUPPORT_JPEG_WRITE} procedure SaveJPEG(const aStream: TStream); virtual; {$ENDIF}
  946. function LoadBMP(const aStream: TStream): Boolean; virtual;
  947. procedure SaveBMP(const aStream: TStream); virtual;
  948. function LoadTGA(const aStream: TStream): Boolean; virtual;
  949. procedure SaveTGA(const aStream: TStream); virtual;
  950. function LoadDDS(const aStream: TStream): Boolean; virtual;
  951. procedure SaveDDS(const aStream: TStream); virtual;
  952. end;
  953. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  954. TglBitmap1D = class(TglBitmap)
  955. protected
  956. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  957. const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
  958. procedure UploadData(const aBuildWithGlu: Boolean);
  959. public
  960. property Width;
  961. procedure AfterConstruction; override;
  962. function FlipHorz: Boolean; override;
  963. procedure GenTexture(const aTestTextureSize: Boolean = true); override;
  964. end;
  965. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  966. TglBitmap2D = class(TglBitmap)
  967. protected
  968. fLines: array of PByte;
  969. function GetScanline(const aIndex: Integer): Pointer;
  970. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  971. const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
  972. procedure UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
  973. public
  974. property Width;
  975. property Height;
  976. property Scanline[const aIndex: Integer]: Pointer read GetScanline;
  977. procedure AfterConstruction; override;
  978. procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  979. procedure GetDataFromTexture;
  980. procedure GenTexture(const aTestTextureSize: Boolean = true); override;
  981. function FlipHorz: Boolean; override;
  982. function FlipVert: Boolean; override;
  983. procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
  984. const aScale: Single = 2; const aUseAlpha: Boolean = false);
  985. end;
  986. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  987. TglBitmapCubeMap = class(TglBitmap2D)
  988. protected
  989. fGenMode: Integer;
  990. procedure GenTexture(const aTestTextureSize: Boolean = true); reintroduce;
  991. public
  992. procedure AfterConstruction; override;
  993. procedure GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean = true);
  994. procedure Bind(const aEnableTexCoordsGen: Boolean = true; const aEnableTextureUnit: Boolean = true); reintroduce; virtual;
  995. procedure Unbind(const aDisableTexCoordsGen: Boolean = true; const aDisableTextureUnit: Boolean = true); reintroduce; virtual;
  996. end;
  997. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  998. TglBitmapNormalMap = class(TglBitmapCubeMap)
  999. public
  1000. procedure AfterConstruction; override;
  1001. procedure GenerateNormalMap(const aSize: Integer = 32; const aTestTextureSize: Boolean = true);
  1002. end;
  1003. const
  1004. NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
  1005. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1006. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1007. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1008. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1009. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1010. procedure glBitmapSetDefaultWrap(
  1011. const S: Cardinal = GL_CLAMP_TO_EDGE;
  1012. const T: Cardinal = GL_CLAMP_TO_EDGE;
  1013. const R: Cardinal = GL_CLAMP_TO_EDGE);
  1014. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1015. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1016. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1017. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1018. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  1019. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  1020. function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
  1021. function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
  1022. function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
  1023. var
  1024. glBitmapDefaultDeleteTextureOnFree: Boolean;
  1025. glBitmapDefaultFreeDataAfterGenTextures: Boolean;
  1026. glBitmapDefaultFormat: TglBitmapFormat;
  1027. glBitmapDefaultMipmap: TglBitmapMipMap;
  1028. glBitmapDefaultFilterMin: Cardinal;
  1029. glBitmapDefaultFilterMag: Cardinal;
  1030. glBitmapDefaultWrapS: Cardinal;
  1031. glBitmapDefaultWrapT: Cardinal;
  1032. glBitmapDefaultWrapR: Cardinal;
  1033. glDefaultSwizzle: array[0..3] of GLenum;
  1034. {$IFDEF GLB_DELPHI}
  1035. function CreateGrayPalette: HPALETTE;
  1036. {$ENDIF}
  1037. implementation
  1038. uses
  1039. Math, syncobjs, typinfo
  1040. {$IFDEF GLB_DELPHI}, Types{$ENDIF};
  1041. type
  1042. {$IFNDEF fpc}
  1043. QWord = System.UInt64;
  1044. PQWord = ^QWord;
  1045. PtrInt = Longint;
  1046. PtrUInt = DWord;
  1047. {$ENDIF}
  1048. ////////////////////////////////////////////////////////////////////////////////////////////////////
  1049. TShiftRec = packed record
  1050. case Integer of
  1051. 0: (r, g, b, a: Byte);
  1052. 1: (arr: array[0..3] of Byte);
  1053. end;
  1054. TFormatDescriptor = class(TglBitmapFormatDescriptor)
  1055. private
  1056. function GetRedMask: QWord;
  1057. function GetGreenMask: QWord;
  1058. function GetBlueMask: QWord;
  1059. function GetAlphaMask: QWord;
  1060. protected
  1061. fFormat: TglBitmapFormat;
  1062. fWithAlpha: TglBitmapFormat;
  1063. fWithoutAlpha: TglBitmapFormat;
  1064. fRGBInverted: TglBitmapFormat;
  1065. fUncompressed: TglBitmapFormat;
  1066. fPixelSize: Single;
  1067. fIsCompressed: Boolean;
  1068. fRange: TglBitmapColorRec;
  1069. fShift: TShiftRec;
  1070. fglFormat: GLenum;
  1071. fglInternalFormat: GLenum;
  1072. fglDataFormat: GLenum;
  1073. function GetIsCompressed: Boolean; override;
  1074. function GetHasAlpha: Boolean; override;
  1075. function GetglFormat: GLenum; override;
  1076. function GetglInternalFormat: GLenum; override;
  1077. function GetglDataFormat: GLenum; override;
  1078. function GetComponents: Integer; virtual;
  1079. public
  1080. property Format: TglBitmapFormat read fFormat;
  1081. property WithAlpha: TglBitmapFormat read fWithAlpha;
  1082. property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;
  1083. property RGBInverted: TglBitmapFormat read fRGBInverted;
  1084. property Components: Integer read GetComponents;
  1085. property PixelSize: Single read fPixelSize;
  1086. property Range: TglBitmapColorRec read fRange;
  1087. property Shift: TShiftRec read fShift;
  1088. property RedMask: QWord read GetRedMask;
  1089. property GreenMask: QWord read GetGreenMask;
  1090. property BlueMask: QWord read GetBlueMask;
  1091. property AlphaMask: QWord read GetAlphaMask;
  1092. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
  1093. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
  1094. function GetSize(const aSize: TglBitmapPixelPosition): Integer; overload; virtual;
  1095. function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
  1096. function CreateMappingData: Pointer; virtual;
  1097. procedure FreeMappingData(var aMappingData: Pointer); virtual;
  1098. function IsEmpty: Boolean; virtual;
  1099. function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean; virtual;
  1100. procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
  1101. constructor Create; virtual;
  1102. public
  1103. class procedure Init;
  1104. class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1105. class function GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1106. class procedure Clear;
  1107. class procedure Finalize;
  1108. end;
  1109. TFormatDescriptorClass = class of TFormatDescriptor;
  1110. TfdEmpty = class(TFormatDescriptor);
  1111. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1112. TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1113. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1114. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1115. constructor Create; override;
  1116. end;
  1117. TfdLuminance_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1118. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1119. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1120. constructor Create; override;
  1121. end;
  1122. TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1123. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1124. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1125. constructor Create; override;
  1126. end;
  1127. TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte
  1128. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1129. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1130. constructor Create; override;
  1131. end;
  1132. TfdRGB_UB3 = class(TFormatDescriptor) //3* unsigned byte
  1133. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1134. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1135. constructor Create; override;
  1136. end;
  1137. TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
  1138. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1139. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1140. constructor Create; override;
  1141. end;
  1142. TfdRGBA_UB4 = class(TfdRGB_UB3) //4* unsigned byte
  1143. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1144. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1145. constructor Create; override;
  1146. end;
  1147. TfdBGRA_UB4 = class(TfdBGR_UB3) //4* unsigned byte (inverse)
  1148. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1149. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1150. constructor Create; override;
  1151. end;
  1152. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1153. TfdAlpha_US1 = class(TFormatDescriptor) //1* unsigned short
  1154. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1155. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1156. constructor Create; override;
  1157. end;
  1158. TfdLuminance_US1 = class(TFormatDescriptor) //1* unsigned short
  1159. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1160. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1161. constructor Create; override;
  1162. end;
  1163. TfdUniversal_US1 = class(TFormatDescriptor) //1* unsigned short
  1164. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1165. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1166. constructor Create; override;
  1167. end;
  1168. TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short
  1169. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1170. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1171. constructor Create; override;
  1172. end;
  1173. TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short
  1174. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1175. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1176. constructor Create; override;
  1177. end;
  1178. TfdRGB_US3 = class(TFormatDescriptor) //3* unsigned short
  1179. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1180. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1181. constructor Create; override;
  1182. end;
  1183. TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)
  1184. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1185. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1186. constructor Create; override;
  1187. end;
  1188. TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
  1189. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1190. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1191. constructor Create; override;
  1192. end;
  1193. TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
  1194. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1195. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1196. constructor Create; override;
  1197. end;
  1198. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1199. TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int
  1200. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1201. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1202. constructor Create; override;
  1203. end;
  1204. TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int
  1205. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1206. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1207. constructor Create; override;
  1208. end;
  1209. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1210. TfdAlpha4 = class(TfdAlpha_UB1)
  1211. constructor Create; override;
  1212. end;
  1213. TfdAlpha8 = class(TfdAlpha_UB1)
  1214. constructor Create; override;
  1215. end;
  1216. TfdAlpha12 = class(TfdAlpha_US1)
  1217. constructor Create; override;
  1218. end;
  1219. TfdAlpha16 = class(TfdAlpha_US1)
  1220. constructor Create; override;
  1221. end;
  1222. TfdLuminance4 = class(TfdLuminance_UB1)
  1223. constructor Create; override;
  1224. end;
  1225. TfdLuminance8 = class(TfdLuminance_UB1)
  1226. constructor Create; override;
  1227. end;
  1228. TfdLuminance12 = class(TfdLuminance_US1)
  1229. constructor Create; override;
  1230. end;
  1231. TfdLuminance16 = class(TfdLuminance_US1)
  1232. constructor Create; override;
  1233. end;
  1234. TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
  1235. constructor Create; override;
  1236. end;
  1237. TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
  1238. constructor Create; override;
  1239. end;
  1240. TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
  1241. constructor Create; override;
  1242. end;
  1243. TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
  1244. constructor Create; override;
  1245. end;
  1246. TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)
  1247. constructor Create; override;
  1248. end;
  1249. TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
  1250. constructor Create; override;
  1251. end;
  1252. TfdR3G3B2 = class(TfdUniversal_UB1)
  1253. constructor Create; override;
  1254. end;
  1255. TfdRGB4 = class(TfdUniversal_US1)
  1256. constructor Create; override;
  1257. end;
  1258. TfdR5G6B5 = class(TfdUniversal_US1)
  1259. constructor Create; override;
  1260. end;
  1261. TfdRGB5 = class(TfdUniversal_US1)
  1262. constructor Create; override;
  1263. end;
  1264. TfdRGB8 = class(TfdRGB_UB3)
  1265. constructor Create; override;
  1266. end;
  1267. TfdRGB10 = class(TfdUniversal_UI1)
  1268. constructor Create; override;
  1269. end;
  1270. TfdRGB12 = class(TfdRGB_US3)
  1271. constructor Create; override;
  1272. end;
  1273. TfdRGB16 = class(TfdRGB_US3)
  1274. constructor Create; override;
  1275. end;
  1276. TfdRGBA2 = class(TfdRGBA_UB4)
  1277. constructor Create; override;
  1278. end;
  1279. TfdRGBA4 = class(TfdUniversal_US1)
  1280. constructor Create; override;
  1281. end;
  1282. TfdRGB5A1 = class(TfdUniversal_US1)
  1283. constructor Create; override;
  1284. end;
  1285. TfdRGBA8 = class(TfdRGBA_UB4)
  1286. constructor Create; override;
  1287. end;
  1288. TfdRGB10A2 = class(TfdUniversal_UI1)
  1289. constructor Create; override;
  1290. end;
  1291. TfdRGBA12 = class(TfdRGBA_US4)
  1292. constructor Create; override;
  1293. end;
  1294. TfdRGBA16 = class(TfdRGBA_US4)
  1295. constructor Create; override;
  1296. end;
  1297. TfdBGR4 = class(TfdUniversal_US1)
  1298. constructor Create; override;
  1299. end;
  1300. TfdB5G6R5 = class(TfdUniversal_US1)
  1301. constructor Create; override;
  1302. end;
  1303. TfdBGR5 = class(TfdUniversal_US1)
  1304. constructor Create; override;
  1305. end;
  1306. TfdBGR8 = class(TfdBGR_UB3)
  1307. constructor Create; override;
  1308. end;
  1309. TfdBGR10 = class(TfdUniversal_UI1)
  1310. constructor Create; override;
  1311. end;
  1312. TfdBGR12 = class(TfdBGR_US3)
  1313. constructor Create; override;
  1314. end;
  1315. TfdBGR16 = class(TfdBGR_US3)
  1316. constructor Create; override;
  1317. end;
  1318. TfdBGRA2 = class(TfdBGRA_UB4)
  1319. constructor Create; override;
  1320. end;
  1321. TfdBGRA4 = class(TfdUniversal_US1)
  1322. constructor Create; override;
  1323. end;
  1324. TfdBGR5A1 = class(TfdUniversal_US1)
  1325. constructor Create; override;
  1326. end;
  1327. TfdBGRA8 = class(TfdBGRA_UB4)
  1328. constructor Create; override;
  1329. end;
  1330. TfdBGR10A2 = class(TfdUniversal_UI1)
  1331. constructor Create; override;
  1332. end;
  1333. TfdBGRA12 = class(TfdBGRA_US4)
  1334. constructor Create; override;
  1335. end;
  1336. TfdBGRA16 = class(TfdBGRA_US4)
  1337. constructor Create; override;
  1338. end;
  1339. TfdDepth16 = class(TfdDepth_US1)
  1340. constructor Create; override;
  1341. end;
  1342. TfdDepth24 = class(TfdDepth_UI1)
  1343. constructor Create; override;
  1344. end;
  1345. TfdDepth32 = class(TfdDepth_UI1)
  1346. constructor Create; override;
  1347. end;
  1348. TfdS3tcDtx1RGBA = class(TFormatDescriptor)
  1349. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1350. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1351. constructor Create; override;
  1352. end;
  1353. TfdS3tcDtx3RGBA = class(TFormatDescriptor)
  1354. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1355. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1356. constructor Create; override;
  1357. end;
  1358. TfdS3tcDtx5RGBA = class(TFormatDescriptor)
  1359. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1360. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1361. constructor Create; override;
  1362. end;
  1363. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1364. TbmpBitfieldFormat = class(TFormatDescriptor)
  1365. private
  1366. procedure SetRedMask (const aValue: QWord);
  1367. procedure SetGreenMask(const aValue: QWord);
  1368. procedure SetBlueMask (const aValue: QWord);
  1369. procedure SetAlphaMask(const aValue: QWord);
  1370. procedure Update(aMask: QWord; out aRange: Cardinal; out aShift: Byte);
  1371. public
  1372. property RedMask: QWord read GetRedMask write SetRedMask;
  1373. property GreenMask: QWord read GetGreenMask write SetGreenMask;
  1374. property BlueMask: QWord read GetBlueMask write SetBlueMask;
  1375. property AlphaMask: QWord read GetAlphaMask write SetAlphaMask;
  1376. property PixelSize: Single read fPixelSize write fPixelSize;
  1377. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1378. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1379. end;
  1380. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1381. TbmpColorTableEnty = packed record
  1382. b, g, r, a: Byte;
  1383. end;
  1384. TbmpColorTable = array of TbmpColorTableEnty;
  1385. TbmpColorTableFormat = class(TFormatDescriptor)
  1386. private
  1387. fColorTable: TbmpColorTable;
  1388. public
  1389. property PixelSize: Single read fPixelSize write fPixelSize;
  1390. property ColorTable: TbmpColorTable read fColorTable write fColorTable;
  1391. property Range: TglBitmapColorRec read fRange write fRange;
  1392. property Shift: TShiftRec read fShift write fShift;
  1393. property Format: TglBitmapFormat read fFormat write fFormat;
  1394. procedure CreateColorTable;
  1395. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1396. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1397. destructor Destroy; override;
  1398. end;
  1399. const
  1400. LUMINANCE_WEIGHT_R = 0.30;
  1401. LUMINANCE_WEIGHT_G = 0.59;
  1402. LUMINANCE_WEIGHT_B = 0.11;
  1403. ALPHA_WEIGHT_R = 0.30;
  1404. ALPHA_WEIGHT_G = 0.59;
  1405. ALPHA_WEIGHT_B = 0.11;
  1406. DEPTH_WEIGHT_R = 0.333333333;
  1407. DEPTH_WEIGHT_G = 0.333333333;
  1408. DEPTH_WEIGHT_B = 0.333333333;
  1409. UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
  1410. FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
  1411. TfdEmpty,
  1412. TfdAlpha4,
  1413. TfdAlpha8,
  1414. TfdAlpha12,
  1415. TfdAlpha16,
  1416. TfdLuminance4,
  1417. TfdLuminance8,
  1418. TfdLuminance12,
  1419. TfdLuminance16,
  1420. TfdLuminance4Alpha4,
  1421. TfdLuminance6Alpha2,
  1422. TfdLuminance8Alpha8,
  1423. TfdLuminance12Alpha4,
  1424. TfdLuminance12Alpha12,
  1425. TfdLuminance16Alpha16,
  1426. TfdR3G3B2,
  1427. TfdRGB4,
  1428. TfdR5G6B5,
  1429. TfdRGB5,
  1430. TfdRGB8,
  1431. TfdRGB10,
  1432. TfdRGB12,
  1433. TfdRGB16,
  1434. TfdRGBA2,
  1435. TfdRGBA4,
  1436. TfdRGB5A1,
  1437. TfdRGBA8,
  1438. TfdRGB10A2,
  1439. TfdRGBA12,
  1440. TfdRGBA16,
  1441. TfdBGR4,
  1442. TfdB5G6R5,
  1443. TfdBGR5,
  1444. TfdBGR8,
  1445. TfdBGR10,
  1446. TfdBGR12,
  1447. TfdBGR16,
  1448. TfdBGRA2,
  1449. TfdBGRA4,
  1450. TfdBGR5A1,
  1451. TfdBGRA8,
  1452. TfdBGR10A2,
  1453. TfdBGRA12,
  1454. TfdBGRA16,
  1455. TfdDepth16,
  1456. TfdDepth24,
  1457. TfdDepth32,
  1458. TfdS3tcDtx1RGBA,
  1459. TfdS3tcDtx3RGBA,
  1460. TfdS3tcDtx5RGBA
  1461. );
  1462. var
  1463. FormatDescriptorCS: TCriticalSection;
  1464. FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
  1465. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1466. constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
  1467. begin
  1468. inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1469. end;
  1470. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1471. constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
  1472. begin
  1473. inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1474. end;
  1475. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1476. function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
  1477. begin
  1478. result.Fields := [];
  1479. if X >= 0 then
  1480. result.Fields := result.Fields + [ffX];
  1481. if Y >= 0 then
  1482. result.Fields := result.Fields + [ffY];
  1483. result.X := Max(0, X);
  1484. result.Y := Max(0, Y);
  1485. end;
  1486. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1487. function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
  1488. begin
  1489. result.r := r;
  1490. result.g := g;
  1491. result.b := b;
  1492. result.a := a;
  1493. end;
  1494. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1495. function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
  1496. var
  1497. i: Integer;
  1498. begin
  1499. result := false;
  1500. for i := 0 to high(r1.arr) do
  1501. if (r1.arr[i] <> r2.arr[i]) then
  1502. exit;
  1503. result := true;
  1504. end;
  1505. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1506. function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
  1507. begin
  1508. result.r := r;
  1509. result.g := g;
  1510. result.b := b;
  1511. result.a := a;
  1512. end;
  1513. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1514. function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
  1515. begin
  1516. result := [];
  1517. if (aFormat in [
  1518. //4 bbp
  1519. tfLuminance4,
  1520. //8bpp
  1521. tfR3G3B2, tfLuminance8,
  1522. //16bpp
  1523. tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
  1524. tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,
  1525. //24bpp
  1526. tfBGR8, tfRGB8,
  1527. //32bpp
  1528. tfRGB10, tfRGB10A2, tfRGBA8,
  1529. tfBGR10, tfBGR10A2, tfBGRA8]) then
  1530. result := result + [ftBMP];
  1531. if (aFormat in [
  1532. //8 bpp
  1533. tfLuminance8, tfAlpha8,
  1534. //16 bpp
  1535. tfLuminance16, tfLuminance8Alpha8,
  1536. tfRGB5, tfRGB5A1, tfRGBA4,
  1537. tfBGR5, tfBGR5A1, tfBGRA4,
  1538. //24 bpp
  1539. tfRGB8, tfBGR8,
  1540. //32 bpp
  1541. tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
  1542. result := result + [ftTGA];
  1543. if (aFormat in [
  1544. //8 bpp
  1545. tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,
  1546. tfR3G3B2, tfRGBA2, tfBGRA2,
  1547. //16 bpp
  1548. tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,
  1549. tfRGB4, tfR5G6B5, tfRGB5, tfRGBA4, tfRGB5A1,
  1550. tfBGR4, tfB5G6R5, tfBGR5, tfBGRA4, tfBGR5A1,
  1551. //24 bpp
  1552. tfRGB8, tfBGR8,
  1553. //32 bbp
  1554. tfLuminance16Alpha16,
  1555. tfRGBA8, tfRGB10A2,
  1556. tfBGRA8, tfBGR10A2,
  1557. //compressed
  1558. tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then
  1559. result := result + [ftDDS];
  1560. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  1561. if aFormat in [
  1562. tfAlpha8, tfLuminance8, tfLuminance8Alpha8,
  1563. tfRGB8, tfRGBA8,
  1564. tfBGR8, tfBGRA8] then
  1565. result := result + [ftPNG];
  1566. {$ENDIF}
  1567. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  1568. if aFormat in [tfAlpha8, tfLuminance8, tfRGB8, tfBGR8] then
  1569. result := result + [ftJPEG];
  1570. {$ENDIF}
  1571. end;
  1572. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1573. function IsPowerOfTwo(aNumber: Integer): Boolean;
  1574. begin
  1575. while (aNumber and 1) = 0 do
  1576. aNumber := aNumber shr 1;
  1577. result := aNumber = 1;
  1578. end;
  1579. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1580. function GetTopMostBit(aBitSet: QWord): Integer;
  1581. begin
  1582. result := 0;
  1583. while aBitSet > 0 do begin
  1584. inc(result);
  1585. aBitSet := aBitSet shr 1;
  1586. end;
  1587. end;
  1588. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1589. function CountSetBits(aBitSet: QWord): Integer;
  1590. begin
  1591. result := 0;
  1592. while aBitSet > 0 do begin
  1593. if (aBitSet and 1) = 1 then
  1594. inc(result);
  1595. aBitSet := aBitSet shr 1;
  1596. end;
  1597. end;
  1598. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1599. function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1600. begin
  1601. result := Trunc(
  1602. LUMINANCE_WEIGHT_R * aPixel.Data.r +
  1603. LUMINANCE_WEIGHT_G * aPixel.Data.g +
  1604. LUMINANCE_WEIGHT_B * aPixel.Data.b);
  1605. end;
  1606. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1607. function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1608. begin
  1609. result := Trunc(
  1610. DEPTH_WEIGHT_R * aPixel.Data.r +
  1611. DEPTH_WEIGHT_G * aPixel.Data.g +
  1612. DEPTH_WEIGHT_B * aPixel.Data.b);
  1613. end;
  1614. {$IFDEF GLB_NATIVE_OGL}
  1615. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1616. //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1617. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1618. var
  1619. GL_LibHandle: Pointer = nil;
  1620. function glbGetProcAddress(aProcName: PAnsiChar; aLibHandle: Pointer = nil; const aRaiseOnErr: Boolean = true): Pointer;
  1621. begin
  1622. if not Assigned(aLibHandle) then
  1623. aLibHandle := GL_LibHandle;
  1624. {$IF DEFINED(GLB_WIN)}
  1625. result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
  1626. if Assigned(result) then
  1627. exit;
  1628. if Assigned(wglGetProcAddress) then
  1629. result := wglGetProcAddress(aProcName);
  1630. {$ELSEIF DEFINED(GLB_LINUX)}
  1631. if Assigned(glXGetProcAddress) then begin
  1632. result := glXGetProcAddress(aProcName);
  1633. if Assigned(result) then
  1634. exit;
  1635. end;
  1636. if Assigned(glXGetProcAddressARB) then begin
  1637. result := glXGetProcAddressARB(aProcName);
  1638. if Assigned(result) then
  1639. exit;
  1640. end;
  1641. result := dlsym(aLibHandle, aProcName);
  1642. {$IFEND}
  1643. if not Assigned(result) and aRaiseOnErr then
  1644. raise EglBitmap.Create('unable to load procedure form library: ' + aProcName);
  1645. end;
  1646. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  1647. var
  1648. GLU_LibHandle: Pointer = nil;
  1649. OpenGLInitialized: Boolean;
  1650. InitOpenGLCS: TCriticalSection;
  1651. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1652. procedure glbInitOpenGL;
  1653. ////////////////////////////////////////////////////////////////////////////////
  1654. function glbLoadLibrary(const aName: PChar): Pointer;
  1655. begin
  1656. {$IF DEFINED(GLB_WIN)}
  1657. result := {%H-}Pointer(LoadLibrary(aName));
  1658. {$ELSEIF DEFINED(GLB_LINUX)}
  1659. result := dlopen(Name, RTLD_LAZY);
  1660. {$ELSE}
  1661. result := nil;
  1662. {$IFEND}
  1663. end;
  1664. ////////////////////////////////////////////////////////////////////////////////
  1665. function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
  1666. begin
  1667. result := false;
  1668. if not Assigned(aLibHandle) then
  1669. exit;
  1670. {$IF DEFINED(GLB_WIN)}
  1671. Result := FreeLibrary({%H-}HINST(aLibHandle));
  1672. {$ELSEIF DEFINED(GLB_LINUX)}
  1673. Result := dlclose(aLibHandle) = 0;
  1674. {$IFEND}
  1675. end;
  1676. begin
  1677. if Assigned(GL_LibHandle) then
  1678. glbFreeLibrary(GL_LibHandle);
  1679. if Assigned(GLU_LibHandle) then
  1680. glbFreeLibrary(GLU_LibHandle);
  1681. GL_LibHandle := glbLoadLibrary(libopengl);
  1682. if not Assigned(GL_LibHandle) then
  1683. raise EglBitmap.Create('unable to load library: ' + libopengl);
  1684. GLU_LibHandle := glbLoadLibrary(libglu);
  1685. if not Assigned(GLU_LibHandle) then
  1686. raise EglBitmap.Create('unable to load library: ' + libglu);
  1687. {$IF DEFINED(GLB_WIN)}
  1688. wglGetProcAddress := glbGetProcAddress('wglGetProcAddress');
  1689. {$ELSEIF DEFINED(GLB_LINUX)}
  1690. glXGetProcAddress := glbGetProcAddress('glXGetProcAddress');
  1691. glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB');
  1692. {$IFEND}
  1693. glEnable := glbGetProcAddress('glEnable');
  1694. glDisable := glbGetProcAddress('glDisable');
  1695. glGetString := glbGetProcAddress('glGetString');
  1696. glGetIntegerv := glbGetProcAddress('glGetIntegerv');
  1697. glTexParameteri := glbGetProcAddress('glTexParameteri');
  1698. glTexParameteriv := glbGetProcAddress('glTexParameteriv');
  1699. glTexParameterfv := glbGetProcAddress('glTexParameterfv');
  1700. glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
  1701. glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
  1702. glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
  1703. glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
  1704. glTexGeni := glbGetProcAddress('glTexGeni');
  1705. glGenTextures := glbGetProcAddress('glGenTextures');
  1706. glBindTexture := glbGetProcAddress('glBindTexture');
  1707. glDeleteTextures := glbGetProcAddress('glDeleteTextures');
  1708. glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
  1709. glReadPixels := glbGetProcAddress('glReadPixels');
  1710. glPixelStorei := glbGetProcAddress('glPixelStorei');
  1711. glTexImage1D := glbGetProcAddress('glTexImage1D');
  1712. glTexImage2D := glbGetProcAddress('glTexImage2D');
  1713. glGetTexImage := glbGetProcAddress('glGetTexImage');
  1714. gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
  1715. gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
  1716. end;
  1717. {$ENDIF}
  1718. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1719. procedure glbReadOpenGLExtensions;
  1720. var
  1721. Buffer: AnsiString;
  1722. MajorVersion, MinorVersion: Integer;
  1723. ///////////////////////////////////////////////////////////////////////////////////////////
  1724. procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
  1725. var
  1726. Separator: Integer;
  1727. begin
  1728. aMinor := 0;
  1729. aMajor := 0;
  1730. Separator := Pos(AnsiString('.'), aBuffer);
  1731. if (Separator > 1) and (Separator < Length(aBuffer)) and
  1732. (aBuffer[Separator - 1] in ['0'..'9']) and
  1733. (aBuffer[Separator + 1] in ['0'..'9']) then begin
  1734. Dec(Separator);
  1735. while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
  1736. Dec(Separator);
  1737. Delete(aBuffer, 1, Separator);
  1738. Separator := Pos(AnsiString('.'), aBuffer) + 1;
  1739. while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
  1740. Inc(Separator);
  1741. Delete(aBuffer, Separator, 255);
  1742. Separator := Pos(AnsiString('.'), aBuffer);
  1743. aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
  1744. aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
  1745. end;
  1746. end;
  1747. ///////////////////////////////////////////////////////////////////////////////////////////
  1748. function CheckExtension(const Extension: AnsiString): Boolean;
  1749. var
  1750. ExtPos: Integer;
  1751. begin
  1752. ExtPos := Pos(Extension, Buffer);
  1753. result := ExtPos > 0;
  1754. if result then
  1755. result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
  1756. end;
  1757. ///////////////////////////////////////////////////////////////////////////////////////////
  1758. function CheckVersion(const aMajor, aMinor: Integer): Boolean;
  1759. begin
  1760. result := (MajorVersion > aMajor) or ((MajorVersion = aMajor) and (MinorVersion >= aMinor));
  1761. end;
  1762. begin
  1763. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  1764. InitOpenGLCS.Enter;
  1765. try
  1766. if not OpenGLInitialized then begin
  1767. glbInitOpenGL;
  1768. OpenGLInitialized := true;
  1769. end;
  1770. finally
  1771. InitOpenGLCS.Leave;
  1772. end;
  1773. {$ENDIF}
  1774. // Version
  1775. Buffer := glGetString(GL_VERSION);
  1776. TrimVersionString(Buffer, MajorVersion, MinorVersion);
  1777. GL_VERSION_1_2 := CheckVersion(1, 2);
  1778. GL_VERSION_1_3 := CheckVersion(1, 3);
  1779. GL_VERSION_1_4 := CheckVersion(1, 4);
  1780. GL_VERSION_2_0 := CheckVersion(2, 0);
  1781. GL_VERSION_3_3 := CheckVersion(3, 3);
  1782. // Extensions
  1783. Buffer := glGetString(GL_EXTENSIONS);
  1784. GL_ARB_texture_border_clamp := CheckExtension('GL_ARB_texture_border_clamp');
  1785. GL_ARB_texture_non_power_of_two := CheckExtension('GL_ARB_texture_non_power_of_two');
  1786. GL_ARB_texture_swizzle := CheckExtension('GL_ARB_texture_swizzle');
  1787. GL_ARB_texture_cube_map := CheckExtension('GL_ARB_texture_cube_map');
  1788. GL_ARB_texture_rectangle := CheckExtension('GL_ARB_texture_rectangle');
  1789. GL_ARB_texture_mirrored_repeat := CheckExtension('GL_ARB_texture_mirrored_repeat');
  1790. GL_EXT_texture_edge_clamp := CheckExtension('GL_EXT_texture_edge_clamp');
  1791. GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
  1792. GL_EXT_texture_rectangle := CheckExtension('GL_EXT_texture_rectangle');
  1793. GL_EXT_texture_swizzle := CheckExtension('GL_EXT_texture_swizzle');
  1794. GL_EXT_texture_cube_map := CheckExtension('GL_EXT_texture_cube_map');
  1795. GL_NV_texture_rectangle := CheckExtension('GL_NV_texture_rectangle');
  1796. GL_IBM_texture_mirrored_repeat := CheckExtension('GL_IBM_texture_mirrored_repeat');
  1797. GL_SGIS_generate_mipmap := CheckExtension('GL_SGIS_generate_mipmap');
  1798. if GL_VERSION_1_3 then begin
  1799. glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1D');
  1800. glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2D');
  1801. glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
  1802. end else begin
  1803. glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1DARB', nil, false);
  1804. glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2DARB', nil, false);
  1805. glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB', nil, false);
  1806. end;
  1807. end;
  1808. {$ENDIF}
  1809. {$IFDEF GLB_SDL_IMAGE}
  1810. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1811. // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1812. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1813. function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
  1814. begin
  1815. result := TStream(context^.unknown.data1).Seek(offset, whence);
  1816. end;
  1817. function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
  1818. begin
  1819. result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
  1820. end;
  1821. function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
  1822. begin
  1823. result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
  1824. end;
  1825. function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
  1826. begin
  1827. result := 0;
  1828. end;
  1829. function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
  1830. begin
  1831. result := SDL_AllocRW;
  1832. if result = nil then
  1833. raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
  1834. result^.seek := glBitmapRWseek;
  1835. result^.read := glBitmapRWread;
  1836. result^.write := glBitmapRWwrite;
  1837. result^.close := glBitmapRWclose;
  1838. result^.unknown.data1 := Stream;
  1839. end;
  1840. {$ENDIF}
  1841. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1842. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1843. begin
  1844. glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
  1845. end;
  1846. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1847. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1848. begin
  1849. glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
  1850. end;
  1851. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1852. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1853. begin
  1854. glBitmapDefaultMipmap := aValue;
  1855. end;
  1856. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1857. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1858. begin
  1859. glBitmapDefaultFormat := aFormat;
  1860. end;
  1861. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1862. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1863. begin
  1864. glBitmapDefaultFilterMin := aMin;
  1865. glBitmapDefaultFilterMag := aMag;
  1866. end;
  1867. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1868. procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
  1869. begin
  1870. glBitmapDefaultWrapS := S;
  1871. glBitmapDefaultWrapT := T;
  1872. glBitmapDefaultWrapR := R;
  1873. end;
  1874. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1875. procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
  1876. begin
  1877. glDefaultSwizzle[0] := r;
  1878. glDefaultSwizzle[1] := g;
  1879. glDefaultSwizzle[2] := b;
  1880. glDefaultSwizzle[3] := a;
  1881. end;
  1882. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1883. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1884. begin
  1885. result := glBitmapDefaultDeleteTextureOnFree;
  1886. end;
  1887. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1888. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1889. begin
  1890. result := glBitmapDefaultFreeDataAfterGenTextures;
  1891. end;
  1892. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1893. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1894. begin
  1895. result := glBitmapDefaultMipmap;
  1896. end;
  1897. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1898. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1899. begin
  1900. result := glBitmapDefaultFormat;
  1901. end;
  1902. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1903. procedure glBitmapGetDefaultFilter(var aMin, aMag: GLenum);
  1904. begin
  1905. aMin := glBitmapDefaultFilterMin;
  1906. aMag := glBitmapDefaultFilterMag;
  1907. end;
  1908. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1909. procedure glBitmapGetDefaultTextureWrap(var S, T, R: GLenum);
  1910. begin
  1911. S := glBitmapDefaultWrapS;
  1912. T := glBitmapDefaultWrapT;
  1913. R := glBitmapDefaultWrapR;
  1914. end;
  1915. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1916. procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
  1917. begin
  1918. r := glDefaultSwizzle[0];
  1919. g := glDefaultSwizzle[1];
  1920. b := glDefaultSwizzle[2];
  1921. a := glDefaultSwizzle[3];
  1922. end;
  1923. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1924. //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1925. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1926. function TFormatDescriptor.GetRedMask: QWord;
  1927. begin
  1928. result := fRange.r shl fShift.r;
  1929. end;
  1930. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1931. function TFormatDescriptor.GetGreenMask: QWord;
  1932. begin
  1933. result := fRange.g shl fShift.g;
  1934. end;
  1935. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1936. function TFormatDescriptor.GetBlueMask: QWord;
  1937. begin
  1938. result := fRange.b shl fShift.b;
  1939. end;
  1940. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1941. function TFormatDescriptor.GetAlphaMask: QWord;
  1942. begin
  1943. result := fRange.a shl fShift.a;
  1944. end;
  1945. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1946. function TFormatDescriptor.GetIsCompressed: Boolean;
  1947. begin
  1948. result := fIsCompressed;
  1949. end;
  1950. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1951. function TFormatDescriptor.GetHasAlpha: Boolean;
  1952. begin
  1953. result := (fRange.a > 0);
  1954. end;
  1955. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1956. function TFormatDescriptor.GetglFormat: GLenum;
  1957. begin
  1958. result := fglFormat;
  1959. end;
  1960. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1961. function TFormatDescriptor.GetglInternalFormat: GLenum;
  1962. begin
  1963. result := fglInternalFormat;
  1964. end;
  1965. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1966. function TFormatDescriptor.GetglDataFormat: GLenum;
  1967. begin
  1968. result := fglDataFormat;
  1969. end;
  1970. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1971. function TFormatDescriptor.GetComponents: Integer;
  1972. var
  1973. i: Integer;
  1974. begin
  1975. result := 0;
  1976. for i := 0 to 3 do
  1977. if (fRange.arr[i] > 0) then
  1978. inc(result);
  1979. end;
  1980. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1981. function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
  1982. var
  1983. w, h: Integer;
  1984. begin
  1985. if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
  1986. w := Max(1, aSize.X);
  1987. h := Max(1, aSize.Y);
  1988. result := GetSize(w, h);
  1989. end else
  1990. result := 0;
  1991. end;
  1992. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1993. function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
  1994. begin
  1995. result := 0;
  1996. if (aWidth <= 0) or (aHeight <= 0) then
  1997. exit;
  1998. result := Ceil(aWidth * aHeight * fPixelSize);
  1999. end;
  2000. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2001. function TFormatDescriptor.CreateMappingData: Pointer;
  2002. begin
  2003. result := nil;
  2004. end;
  2005. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2006. procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
  2007. begin
  2008. //DUMMY
  2009. end;
  2010. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2011. function TFormatDescriptor.IsEmpty: Boolean;
  2012. begin
  2013. result := (fFormat = tfEmpty);
  2014. end;
  2015. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2016. function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean;
  2017. begin
  2018. result := false;
  2019. if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
  2020. raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
  2021. if (aRedMask <> RedMask) then
  2022. exit;
  2023. if (aGreenMask <> GreenMask) then
  2024. exit;
  2025. if (aBlueMask <> BlueMask) then
  2026. exit;
  2027. if (aAlphaMask <> AlphaMask) then
  2028. exit;
  2029. result := true;
  2030. end;
  2031. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2032. procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
  2033. begin
  2034. FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
  2035. aPixel.Data := fRange;
  2036. aPixel.Range := fRange;
  2037. aPixel.Format := fFormat;
  2038. end;
  2039. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2040. constructor TFormatDescriptor.Create;
  2041. begin
  2042. inherited Create;
  2043. fFormat := tfEmpty;
  2044. fWithAlpha := tfEmpty;
  2045. fWithoutAlpha := tfEmpty;
  2046. fRGBInverted := tfEmpty;
  2047. fUncompressed := tfEmpty;
  2048. fPixelSize := 0.0;
  2049. fIsCompressed := false;
  2050. fglFormat := 0;
  2051. fglInternalFormat := 0;
  2052. fglDataFormat := 0;
  2053. FillChar(fRange, 0, SizeOf(fRange));
  2054. FillChar(fShift, 0, SizeOf(fShift));
  2055. end;
  2056. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2057. //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2058. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2059. procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2060. begin
  2061. aData^ := aPixel.Data.a;
  2062. inc(aData);
  2063. end;
  2064. procedure TfdAlpha_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2065. begin
  2066. aPixel.Data.r := 0;
  2067. aPixel.Data.g := 0;
  2068. aPixel.Data.b := 0;
  2069. aPixel.Data.a := aData^;
  2070. inc(aData);
  2071. end;
  2072. constructor TfdAlpha_UB1.Create;
  2073. begin
  2074. inherited Create;
  2075. fPixelSize := 1.0;
  2076. fRange.a := $FF;
  2077. fglFormat := GL_ALPHA;
  2078. fglDataFormat := GL_UNSIGNED_BYTE;
  2079. end;
  2080. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2081. //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2082. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2083. procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2084. begin
  2085. aData^ := LuminanceWeight(aPixel);
  2086. inc(aData);
  2087. end;
  2088. procedure TfdLuminance_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2089. begin
  2090. aPixel.Data.r := aData^;
  2091. aPixel.Data.g := aData^;
  2092. aPixel.Data.b := aData^;
  2093. aPixel.Data.a := 0;
  2094. inc(aData);
  2095. end;
  2096. constructor TfdLuminance_UB1.Create;
  2097. begin
  2098. inherited Create;
  2099. fPixelSize := 1.0;
  2100. fRange.r := $FF;
  2101. fRange.g := $FF;
  2102. fRange.b := $FF;
  2103. fglFormat := GL_LUMINANCE;
  2104. fglDataFormat := GL_UNSIGNED_BYTE;
  2105. end;
  2106. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2107. //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2108. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2109. procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2110. var
  2111. i: Integer;
  2112. begin
  2113. aData^ := 0;
  2114. for i := 0 to 3 do
  2115. if (fRange.arr[i] > 0) then
  2116. aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2117. inc(aData);
  2118. end;
  2119. procedure TfdUniversal_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2120. var
  2121. i: Integer;
  2122. begin
  2123. for i := 0 to 3 do
  2124. aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
  2125. inc(aData);
  2126. end;
  2127. constructor TfdUniversal_UB1.Create;
  2128. begin
  2129. inherited Create;
  2130. fPixelSize := 1.0;
  2131. end;
  2132. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2133. //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2134. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2135. procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2136. begin
  2137. inherited Map(aPixel, aData, aMapData);
  2138. aData^ := aPixel.Data.a;
  2139. inc(aData);
  2140. end;
  2141. procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2142. begin
  2143. inherited Unmap(aData, aPixel, aMapData);
  2144. aPixel.Data.a := aData^;
  2145. inc(aData);
  2146. end;
  2147. constructor TfdLuminanceAlpha_UB2.Create;
  2148. begin
  2149. inherited Create;
  2150. fPixelSize := 2.0;
  2151. fRange.a := $FF;
  2152. fShift.a := 8;
  2153. fglFormat := GL_LUMINANCE_ALPHA;
  2154. fglDataFormat := GL_UNSIGNED_BYTE;
  2155. end;
  2156. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2157. //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2158. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2159. procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2160. begin
  2161. aData^ := aPixel.Data.r;
  2162. inc(aData);
  2163. aData^ := aPixel.Data.g;
  2164. inc(aData);
  2165. aData^ := aPixel.Data.b;
  2166. inc(aData);
  2167. end;
  2168. procedure TfdRGB_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2169. begin
  2170. aPixel.Data.r := aData^;
  2171. inc(aData);
  2172. aPixel.Data.g := aData^;
  2173. inc(aData);
  2174. aPixel.Data.b := aData^;
  2175. inc(aData);
  2176. aPixel.Data.a := 0;
  2177. end;
  2178. constructor TfdRGB_UB3.Create;
  2179. begin
  2180. inherited Create;
  2181. fPixelSize := 3.0;
  2182. fRange.r := $FF;
  2183. fRange.g := $FF;
  2184. fRange.b := $FF;
  2185. fShift.r := 0;
  2186. fShift.g := 8;
  2187. fShift.b := 16;
  2188. fglFormat := GL_RGB;
  2189. fglDataFormat := GL_UNSIGNED_BYTE;
  2190. end;
  2191. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2192. //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2193. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2194. procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2195. begin
  2196. aData^ := aPixel.Data.b;
  2197. inc(aData);
  2198. aData^ := aPixel.Data.g;
  2199. inc(aData);
  2200. aData^ := aPixel.Data.r;
  2201. inc(aData);
  2202. end;
  2203. procedure TfdBGR_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2204. begin
  2205. aPixel.Data.b := aData^;
  2206. inc(aData);
  2207. aPixel.Data.g := aData^;
  2208. inc(aData);
  2209. aPixel.Data.r := aData^;
  2210. inc(aData);
  2211. aPixel.Data.a := 0;
  2212. end;
  2213. constructor TfdBGR_UB3.Create;
  2214. begin
  2215. fPixelSize := 3.0;
  2216. fRange.r := $FF;
  2217. fRange.g := $FF;
  2218. fRange.b := $FF;
  2219. fShift.r := 16;
  2220. fShift.g := 8;
  2221. fShift.b := 0;
  2222. fglFormat := GL_BGR;
  2223. fglDataFormat := GL_UNSIGNED_BYTE;
  2224. end;
  2225. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2226. //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2227. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2228. procedure TfdRGBA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2229. begin
  2230. inherited Map(aPixel, aData, aMapData);
  2231. aData^ := aPixel.Data.a;
  2232. inc(aData);
  2233. end;
  2234. procedure TfdRGBA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2235. begin
  2236. inherited Unmap(aData, aPixel, aMapData);
  2237. aPixel.Data.a := aData^;
  2238. inc(aData);
  2239. end;
  2240. constructor TfdRGBA_UB4.Create;
  2241. begin
  2242. inherited Create;
  2243. fPixelSize := 4.0;
  2244. fRange.a := $FF;
  2245. fShift.a := 24;
  2246. fglFormat := GL_RGBA;
  2247. fglDataFormat := GL_UNSIGNED_BYTE;
  2248. end;
  2249. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2250. //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2251. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2252. procedure TfdBGRA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2253. begin
  2254. inherited Map(aPixel, aData, aMapData);
  2255. aData^ := aPixel.Data.a;
  2256. inc(aData);
  2257. end;
  2258. procedure TfdBGRA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2259. begin
  2260. inherited Unmap(aData, aPixel, aMapData);
  2261. aPixel.Data.a := aData^;
  2262. inc(aData);
  2263. end;
  2264. constructor TfdBGRA_UB4.Create;
  2265. begin
  2266. inherited Create;
  2267. fPixelSize := 4.0;
  2268. fRange.a := $FF;
  2269. fShift.a := 24;
  2270. fglFormat := GL_BGRA;
  2271. fglDataFormat := GL_UNSIGNED_BYTE;
  2272. end;
  2273. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2274. //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2275. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2276. procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2277. begin
  2278. PWord(aData)^ := aPixel.Data.a;
  2279. inc(aData, 2);
  2280. end;
  2281. procedure TfdAlpha_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2282. begin
  2283. aPixel.Data.r := 0;
  2284. aPixel.Data.g := 0;
  2285. aPixel.Data.b := 0;
  2286. aPixel.Data.a := PWord(aData)^;
  2287. inc(aData, 2);
  2288. end;
  2289. constructor TfdAlpha_US1.Create;
  2290. begin
  2291. inherited Create;
  2292. fPixelSize := 2.0;
  2293. fRange.a := $FFFF;
  2294. fglFormat := GL_ALPHA;
  2295. fglDataFormat := GL_UNSIGNED_SHORT;
  2296. end;
  2297. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2298. //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2299. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2300. procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2301. begin
  2302. PWord(aData)^ := LuminanceWeight(aPixel);
  2303. inc(aData, 2);
  2304. end;
  2305. procedure TfdLuminance_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2306. begin
  2307. aPixel.Data.r := PWord(aData)^;
  2308. aPixel.Data.g := PWord(aData)^;
  2309. aPixel.Data.b := PWord(aData)^;
  2310. aPixel.Data.a := 0;
  2311. inc(aData, 2);
  2312. end;
  2313. constructor TfdLuminance_US1.Create;
  2314. begin
  2315. inherited Create;
  2316. fPixelSize := 2.0;
  2317. fRange.r := $FFFF;
  2318. fRange.g := $FFFF;
  2319. fRange.b := $FFFF;
  2320. fglFormat := GL_LUMINANCE;
  2321. fglDataFormat := GL_UNSIGNED_SHORT;
  2322. end;
  2323. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2324. //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2325. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2326. procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2327. var
  2328. i: Integer;
  2329. begin
  2330. PWord(aData)^ := 0;
  2331. for i := 0 to 3 do
  2332. if (fRange.arr[i] > 0) then
  2333. PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2334. inc(aData, 2);
  2335. end;
  2336. procedure TfdUniversal_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2337. var
  2338. i: Integer;
  2339. begin
  2340. for i := 0 to 3 do
  2341. aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
  2342. inc(aData, 2);
  2343. end;
  2344. constructor TfdUniversal_US1.Create;
  2345. begin
  2346. inherited Create;
  2347. fPixelSize := 2.0;
  2348. end;
  2349. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2350. //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2351. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2352. procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2353. begin
  2354. PWord(aData)^ := DepthWeight(aPixel);
  2355. inc(aData, 2);
  2356. end;
  2357. procedure TfdDepth_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2358. begin
  2359. aPixel.Data.r := PWord(aData)^;
  2360. aPixel.Data.g := PWord(aData)^;
  2361. aPixel.Data.b := PWord(aData)^;
  2362. aPixel.Data.a := 0;
  2363. inc(aData, 2);
  2364. end;
  2365. constructor TfdDepth_US1.Create;
  2366. begin
  2367. inherited Create;
  2368. fPixelSize := 2.0;
  2369. fRange.r := $FFFF;
  2370. fRange.g := $FFFF;
  2371. fRange.b := $FFFF;
  2372. fglFormat := GL_DEPTH_COMPONENT;
  2373. fglDataFormat := GL_UNSIGNED_SHORT;
  2374. end;
  2375. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2376. //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2377. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2378. procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2379. begin
  2380. inherited Map(aPixel, aData, aMapData);
  2381. PWord(aData)^ := aPixel.Data.a;
  2382. inc(aData, 2);
  2383. end;
  2384. procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2385. begin
  2386. inherited Unmap(aData, aPixel, aMapData);
  2387. aPixel.Data.a := PWord(aData)^;
  2388. inc(aData, 2);
  2389. end;
  2390. constructor TfdLuminanceAlpha_US2.Create;
  2391. begin
  2392. inherited Create;
  2393. fPixelSize := 4.0;
  2394. fRange.a := $FFFF;
  2395. fShift.a := 16;
  2396. fglFormat := GL_LUMINANCE_ALPHA;
  2397. fglDataFormat := GL_UNSIGNED_SHORT;
  2398. end;
  2399. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2400. //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2401. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2402. procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2403. begin
  2404. PWord(aData)^ := aPixel.Data.r;
  2405. inc(aData, 2);
  2406. PWord(aData)^ := aPixel.Data.g;
  2407. inc(aData, 2);
  2408. PWord(aData)^ := aPixel.Data.b;
  2409. inc(aData, 2);
  2410. end;
  2411. procedure TfdRGB_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2412. begin
  2413. aPixel.Data.r := PWord(aData)^;
  2414. inc(aData, 2);
  2415. aPixel.Data.g := PWord(aData)^;
  2416. inc(aData, 2);
  2417. aPixel.Data.b := PWord(aData)^;
  2418. inc(aData, 2);
  2419. aPixel.Data.a := 0;
  2420. end;
  2421. constructor TfdRGB_US3.Create;
  2422. begin
  2423. inherited Create;
  2424. fPixelSize := 6.0;
  2425. fRange.r := $FFFF;
  2426. fRange.g := $FFFF;
  2427. fRange.b := $FFFF;
  2428. fShift.r := 0;
  2429. fShift.g := 16;
  2430. fShift.b := 32;
  2431. fglFormat := GL_RGB;
  2432. fglDataFormat := GL_UNSIGNED_SHORT;
  2433. end;
  2434. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2435. //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2436. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2437. procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2438. begin
  2439. PWord(aData)^ := aPixel.Data.b;
  2440. inc(aData, 2);
  2441. PWord(aData)^ := aPixel.Data.g;
  2442. inc(aData, 2);
  2443. PWord(aData)^ := aPixel.Data.r;
  2444. inc(aData, 2);
  2445. end;
  2446. procedure TfdBGR_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2447. begin
  2448. aPixel.Data.b := PWord(aData)^;
  2449. inc(aData, 2);
  2450. aPixel.Data.g := PWord(aData)^;
  2451. inc(aData, 2);
  2452. aPixel.Data.r := PWord(aData)^;
  2453. inc(aData, 2);
  2454. aPixel.Data.a := 0;
  2455. end;
  2456. constructor TfdBGR_US3.Create;
  2457. begin
  2458. inherited Create;
  2459. fPixelSize := 6.0;
  2460. fRange.r := $FFFF;
  2461. fRange.g := $FFFF;
  2462. fRange.b := $FFFF;
  2463. fShift.r := 32;
  2464. fShift.g := 16;
  2465. fShift.b := 0;
  2466. fglFormat := GL_BGR;
  2467. fglDataFormat := GL_UNSIGNED_SHORT;
  2468. end;
  2469. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2470. //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2471. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2472. procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2473. begin
  2474. inherited Map(aPixel, aData, aMapData);
  2475. PWord(aData)^ := aPixel.Data.a;
  2476. inc(aData, 2);
  2477. end;
  2478. procedure TfdRGBA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2479. begin
  2480. inherited Unmap(aData, aPixel, aMapData);
  2481. aPixel.Data.a := PWord(aData)^;
  2482. inc(aData, 2);
  2483. end;
  2484. constructor TfdRGBA_US4.Create;
  2485. begin
  2486. inherited Create;
  2487. fPixelSize := 8.0;
  2488. fRange.a := $FFFF;
  2489. fShift.a := 48;
  2490. fglFormat := GL_RGBA;
  2491. fglDataFormat := GL_UNSIGNED_SHORT;
  2492. end;
  2493. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2494. //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2495. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2496. procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2497. begin
  2498. inherited Map(aPixel, aData, aMapData);
  2499. PWord(aData)^ := aPixel.Data.a;
  2500. inc(aData, 2);
  2501. end;
  2502. procedure TfdBGRA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2503. begin
  2504. inherited Unmap(aData, aPixel, aMapData);
  2505. aPixel.Data.a := PWord(aData)^;
  2506. inc(aData, 2);
  2507. end;
  2508. constructor TfdBGRA_US4.Create;
  2509. begin
  2510. inherited Create;
  2511. fPixelSize := 8.0;
  2512. fRange.a := $FFFF;
  2513. fShift.a := 48;
  2514. fglFormat := GL_BGRA;
  2515. fglDataFormat := GL_UNSIGNED_SHORT;
  2516. end;
  2517. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2518. //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2519. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2520. procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2521. var
  2522. i: Integer;
  2523. begin
  2524. PCardinal(aData)^ := 0;
  2525. for i := 0 to 3 do
  2526. if (fRange.arr[i] > 0) then
  2527. PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2528. inc(aData, 4);
  2529. end;
  2530. procedure TfdUniversal_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2531. var
  2532. i: Integer;
  2533. begin
  2534. for i := 0 to 3 do
  2535. aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
  2536. inc(aData, 2);
  2537. end;
  2538. constructor TfdUniversal_UI1.Create;
  2539. begin
  2540. inherited Create;
  2541. fPixelSize := 4.0;
  2542. end;
  2543. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2544. //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2545. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2546. procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2547. begin
  2548. PCardinal(aData)^ := DepthWeight(aPixel);
  2549. inc(aData, 4);
  2550. end;
  2551. procedure TfdDepth_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2552. begin
  2553. aPixel.Data.r := PCardinal(aData)^;
  2554. aPixel.Data.g := PCardinal(aData)^;
  2555. aPixel.Data.b := PCardinal(aData)^;
  2556. aPixel.Data.a := 0;
  2557. inc(aData, 4);
  2558. end;
  2559. constructor TfdDepth_UI1.Create;
  2560. begin
  2561. inherited Create;
  2562. fPixelSize := 4.0;
  2563. fRange.r := $FFFFFFFF;
  2564. fRange.g := $FFFFFFFF;
  2565. fRange.b := $FFFFFFFF;
  2566. fglFormat := GL_DEPTH_COMPONENT;
  2567. fglDataFormat := GL_UNSIGNED_INT;
  2568. end;
  2569. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2570. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2571. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2572. constructor TfdAlpha4.Create;
  2573. begin
  2574. inherited Create;
  2575. fFormat := tfAlpha4;
  2576. fWithAlpha := tfAlpha4;
  2577. fglInternalFormat := GL_ALPHA4;
  2578. end;
  2579. constructor TfdAlpha8.Create;
  2580. begin
  2581. inherited Create;
  2582. fFormat := tfAlpha8;
  2583. fWithAlpha := tfAlpha8;
  2584. fglInternalFormat := GL_ALPHA8;
  2585. end;
  2586. constructor TfdAlpha12.Create;
  2587. begin
  2588. inherited Create;
  2589. fFormat := tfAlpha12;
  2590. fWithAlpha := tfAlpha12;
  2591. fglInternalFormat := GL_ALPHA12;
  2592. end;
  2593. constructor TfdAlpha16.Create;
  2594. begin
  2595. inherited Create;
  2596. fFormat := tfAlpha16;
  2597. fWithAlpha := tfAlpha16;
  2598. fglInternalFormat := GL_ALPHA16;
  2599. end;
  2600. constructor TfdLuminance4.Create;
  2601. begin
  2602. inherited Create;
  2603. fFormat := tfLuminance4;
  2604. fWithAlpha := tfLuminance4Alpha4;
  2605. fWithoutAlpha := tfLuminance4;
  2606. fglInternalFormat := GL_LUMINANCE4;
  2607. end;
  2608. constructor TfdLuminance8.Create;
  2609. begin
  2610. inherited Create;
  2611. fFormat := tfLuminance8;
  2612. fWithAlpha := tfLuminance8Alpha8;
  2613. fWithoutAlpha := tfLuminance8;
  2614. fglInternalFormat := GL_LUMINANCE8;
  2615. end;
  2616. constructor TfdLuminance12.Create;
  2617. begin
  2618. inherited Create;
  2619. fFormat := tfLuminance12;
  2620. fWithAlpha := tfLuminance12Alpha12;
  2621. fWithoutAlpha := tfLuminance12;
  2622. fglInternalFormat := GL_LUMINANCE12;
  2623. end;
  2624. constructor TfdLuminance16.Create;
  2625. begin
  2626. inherited Create;
  2627. fFormat := tfLuminance16;
  2628. fWithAlpha := tfLuminance16Alpha16;
  2629. fWithoutAlpha := tfLuminance16;
  2630. fglInternalFormat := GL_LUMINANCE16;
  2631. end;
  2632. constructor TfdLuminance4Alpha4.Create;
  2633. begin
  2634. inherited Create;
  2635. fFormat := tfLuminance4Alpha4;
  2636. fWithAlpha := tfLuminance4Alpha4;
  2637. fWithoutAlpha := tfLuminance4;
  2638. fglInternalFormat := GL_LUMINANCE4_ALPHA4;
  2639. end;
  2640. constructor TfdLuminance6Alpha2.Create;
  2641. begin
  2642. inherited Create;
  2643. fFormat := tfLuminance6Alpha2;
  2644. fWithAlpha := tfLuminance6Alpha2;
  2645. fWithoutAlpha := tfLuminance8;
  2646. fglInternalFormat := GL_LUMINANCE6_ALPHA2;
  2647. end;
  2648. constructor TfdLuminance8Alpha8.Create;
  2649. begin
  2650. inherited Create;
  2651. fFormat := tfLuminance8Alpha8;
  2652. fWithAlpha := tfLuminance8Alpha8;
  2653. fWithoutAlpha := tfLuminance8;
  2654. fglInternalFormat := GL_LUMINANCE8_ALPHA8;
  2655. end;
  2656. constructor TfdLuminance12Alpha4.Create;
  2657. begin
  2658. inherited Create;
  2659. fFormat := tfLuminance12Alpha4;
  2660. fWithAlpha := tfLuminance12Alpha4;
  2661. fWithoutAlpha := tfLuminance12;
  2662. fglInternalFormat := GL_LUMINANCE12_ALPHA4;
  2663. end;
  2664. constructor TfdLuminance12Alpha12.Create;
  2665. begin
  2666. inherited Create;
  2667. fFormat := tfLuminance12Alpha12;
  2668. fWithAlpha := tfLuminance12Alpha12;
  2669. fWithoutAlpha := tfLuminance12;
  2670. fglInternalFormat := GL_LUMINANCE12_ALPHA12;
  2671. end;
  2672. constructor TfdLuminance16Alpha16.Create;
  2673. begin
  2674. inherited Create;
  2675. fFormat := tfLuminance16Alpha16;
  2676. fWithAlpha := tfLuminance16Alpha16;
  2677. fWithoutAlpha := tfLuminance16;
  2678. fglInternalFormat := GL_LUMINANCE16_ALPHA16;
  2679. end;
  2680. constructor TfdR3G3B2.Create;
  2681. begin
  2682. inherited Create;
  2683. fFormat := tfR3G3B2;
  2684. fWithAlpha := tfRGBA2;
  2685. fWithoutAlpha := tfR3G3B2;
  2686. fRange.r := $7;
  2687. fRange.g := $7;
  2688. fRange.b := $3;
  2689. fShift.r := 0;
  2690. fShift.g := 3;
  2691. fShift.b := 6;
  2692. fglFormat := GL_RGB;
  2693. fglInternalFormat := GL_R3_G3_B2;
  2694. fglDataFormat := GL_UNSIGNED_BYTE_2_3_3_REV;
  2695. end;
  2696. constructor TfdRGB4.Create;
  2697. begin
  2698. inherited Create;
  2699. fFormat := tfRGB4;
  2700. fWithAlpha := tfRGBA4;
  2701. fWithoutAlpha := tfRGB4;
  2702. fRGBInverted := tfBGR4;
  2703. fRange.r := $F;
  2704. fRange.g := $F;
  2705. fRange.b := $F;
  2706. fShift.r := 0;
  2707. fShift.g := 4;
  2708. fShift.b := 8;
  2709. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2710. fglInternalFormat := GL_RGB4;
  2711. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2712. end;
  2713. constructor TfdR5G6B5.Create;
  2714. begin
  2715. inherited Create;
  2716. fFormat := tfR5G6B5;
  2717. fWithAlpha := tfRGBA4;
  2718. fWithoutAlpha := tfR5G6B5;
  2719. fRGBInverted := tfB5G6R5;
  2720. fRange.r := $1F;
  2721. fRange.g := $3F;
  2722. fRange.b := $1F;
  2723. fShift.r := 0;
  2724. fShift.g := 5;
  2725. fShift.b := 11;
  2726. fglFormat := GL_RGB;
  2727. fglInternalFormat := GL_RGB565;
  2728. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5_REV;
  2729. end;
  2730. constructor TfdRGB5.Create;
  2731. begin
  2732. inherited Create;
  2733. fFormat := tfRGB5;
  2734. fWithAlpha := tfRGB5A1;
  2735. fWithoutAlpha := tfRGB5;
  2736. fRGBInverted := tfBGR5;
  2737. fRange.r := $1F;
  2738. fRange.g := $1F;
  2739. fRange.b := $1F;
  2740. fShift.r := 0;
  2741. fShift.g := 5;
  2742. fShift.b := 10;
  2743. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2744. fglInternalFormat := GL_RGB5;
  2745. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2746. end;
  2747. constructor TfdRGB8.Create;
  2748. begin
  2749. inherited Create;
  2750. fFormat := tfRGB8;
  2751. fWithAlpha := tfRGBA8;
  2752. fWithoutAlpha := tfRGB8;
  2753. fRGBInverted := tfBGR8;
  2754. fglInternalFormat := GL_RGB8;
  2755. end;
  2756. constructor TfdRGB10.Create;
  2757. begin
  2758. inherited Create;
  2759. fFormat := tfRGB10;
  2760. fWithAlpha := tfRGB10A2;
  2761. fWithoutAlpha := tfRGB10;
  2762. fRGBInverted := tfBGR10;
  2763. fRange.r := $3FF;
  2764. fRange.g := $3FF;
  2765. fRange.b := $3FF;
  2766. fShift.r := 0;
  2767. fShift.g := 10;
  2768. fShift.b := 20;
  2769. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2770. fglInternalFormat := GL_RGB10;
  2771. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2772. end;
  2773. constructor TfdRGB12.Create;
  2774. begin
  2775. inherited Create;
  2776. fFormat := tfRGB12;
  2777. fWithAlpha := tfRGBA12;
  2778. fWithoutAlpha := tfRGB12;
  2779. fRGBInverted := tfBGR12;
  2780. fglInternalFormat := GL_RGB12;
  2781. end;
  2782. constructor TfdRGB16.Create;
  2783. begin
  2784. inherited Create;
  2785. fFormat := tfRGB16;
  2786. fWithAlpha := tfRGBA16;
  2787. fWithoutAlpha := tfRGB16;
  2788. fRGBInverted := tfBGR16;
  2789. fglInternalFormat := GL_RGB16;
  2790. end;
  2791. constructor TfdRGBA2.Create;
  2792. begin
  2793. inherited Create;
  2794. fFormat := tfRGBA2;
  2795. fWithAlpha := tfRGBA2;
  2796. fWithoutAlpha := tfR3G3B2;
  2797. fRGBInverted := tfBGRA2;
  2798. fglInternalFormat := GL_RGBA2;
  2799. end;
  2800. constructor TfdRGBA4.Create;
  2801. begin
  2802. inherited Create;
  2803. fFormat := tfRGBA4;
  2804. fWithAlpha := tfRGBA4;
  2805. fWithoutAlpha := tfRGB4;
  2806. fRGBInverted := tfBGRA4;
  2807. fRange.r := $F;
  2808. fRange.g := $F;
  2809. fRange.b := $F;
  2810. fRange.a := $F;
  2811. fShift.r := 0;
  2812. fShift.g := 4;
  2813. fShift.b := 8;
  2814. fShift.a := 12;
  2815. fglFormat := GL_RGBA;
  2816. fglInternalFormat := GL_RGBA4;
  2817. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2818. end;
  2819. constructor TfdRGB5A1.Create;
  2820. begin
  2821. inherited Create;
  2822. fFormat := tfRGB5A1;
  2823. fWithAlpha := tfRGB5A1;
  2824. fWithoutAlpha := tfRGB5;
  2825. fRGBInverted := tfBGR5A1;
  2826. fRange.r := $1F;
  2827. fRange.g := $1F;
  2828. fRange.b := $1F;
  2829. fRange.a := $01;
  2830. fShift.r := 0;
  2831. fShift.g := 5;
  2832. fShift.b := 10;
  2833. fShift.a := 15;
  2834. fglFormat := GL_RGBA;
  2835. fglInternalFormat := GL_RGB5_A1;
  2836. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2837. end;
  2838. constructor TfdRGBA8.Create;
  2839. begin
  2840. inherited Create;
  2841. fFormat := tfRGBA8;
  2842. fWithAlpha := tfRGBA8;
  2843. fWithoutAlpha := tfRGB8;
  2844. fRGBInverted := tfBGRA8;
  2845. fglInternalFormat := GL_RGBA8;
  2846. end;
  2847. constructor TfdRGB10A2.Create;
  2848. begin
  2849. inherited Create;
  2850. fFormat := tfRGB10A2;
  2851. fWithAlpha := tfRGB10A2;
  2852. fWithoutAlpha := tfRGB10;
  2853. fRGBInverted := tfBGR10A2;
  2854. fRange.r := $3FF;
  2855. fRange.g := $3FF;
  2856. fRange.b := $3FF;
  2857. fRange.a := $003;
  2858. fShift.r := 0;
  2859. fShift.g := 10;
  2860. fShift.b := 20;
  2861. fShift.a := 30;
  2862. fglFormat := GL_RGBA;
  2863. fglInternalFormat := GL_RGB10_A2;
  2864. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2865. end;
  2866. constructor TfdRGBA12.Create;
  2867. begin
  2868. inherited Create;
  2869. fFormat := tfRGBA12;
  2870. fWithAlpha := tfRGBA12;
  2871. fWithoutAlpha := tfRGB12;
  2872. fRGBInverted := tfBGRA12;
  2873. fglInternalFormat := GL_RGBA12;
  2874. end;
  2875. constructor TfdRGBA16.Create;
  2876. begin
  2877. inherited Create;
  2878. fFormat := tfRGBA16;
  2879. fWithAlpha := tfRGBA16;
  2880. fWithoutAlpha := tfRGB16;
  2881. fRGBInverted := tfBGRA16;
  2882. fglInternalFormat := GL_RGBA16;
  2883. end;
  2884. constructor TfdBGR4.Create;
  2885. begin
  2886. inherited Create;
  2887. fPixelSize := 2.0;
  2888. fFormat := tfBGR4;
  2889. fWithAlpha := tfBGRA4;
  2890. fWithoutAlpha := tfBGR4;
  2891. fRGBInverted := tfRGB4;
  2892. fRange.r := $F;
  2893. fRange.g := $F;
  2894. fRange.b := $F;
  2895. fRange.a := $0;
  2896. fShift.r := 8;
  2897. fShift.g := 4;
  2898. fShift.b := 0;
  2899. fShift.a := 0;
  2900. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2901. fglInternalFormat := GL_RGB4;
  2902. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2903. end;
  2904. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2905. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2906. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2907. constructor TfdB5G6R5.Create;
  2908. begin
  2909. inherited Create;
  2910. fFormat := tfB5G6R5;
  2911. fWithAlpha := tfBGRA4;
  2912. fWithoutAlpha := tfB5G6R5;
  2913. fRGBInverted := tfR5G6B5;
  2914. fRange.r := $1F;
  2915. fRange.g := $3F;
  2916. fRange.b := $1F;
  2917. fShift.r := 11;
  2918. fShift.g := 5;
  2919. fShift.b := 0;
  2920. fglFormat := GL_RGB; //B5G6R5 is only possible as R5G6B5 -> use reverted dataformat
  2921. fglInternalFormat := GL_RGB8;
  2922. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5;
  2923. end;
  2924. constructor TfdBGR5.Create;
  2925. begin
  2926. inherited Create;
  2927. fPixelSize := 2.0;
  2928. fFormat := tfBGR5;
  2929. fWithAlpha := tfBGR5A1;
  2930. fWithoutAlpha := tfBGR5;
  2931. fRGBInverted := tfRGB5;
  2932. fRange.r := $1F;
  2933. fRange.g := $1F;
  2934. fRange.b := $1F;
  2935. fRange.a := $00;
  2936. fShift.r := 10;
  2937. fShift.g := 5;
  2938. fShift.b := 0;
  2939. fShift.a := 0;
  2940. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2941. fglInternalFormat := GL_RGB5;
  2942. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2943. end;
  2944. constructor TfdBGR8.Create;
  2945. begin
  2946. inherited Create;
  2947. fFormat := tfBGR8;
  2948. fWithAlpha := tfBGRA8;
  2949. fWithoutAlpha := tfBGR8;
  2950. fRGBInverted := tfRGB8;
  2951. fglInternalFormat := GL_RGB8;
  2952. end;
  2953. constructor TfdBGR10.Create;
  2954. begin
  2955. inherited Create;
  2956. fFormat := tfBGR10;
  2957. fWithAlpha := tfBGR10A2;
  2958. fWithoutAlpha := tfBGR10;
  2959. fRGBInverted := tfRGB10;
  2960. fRange.r := $3FF;
  2961. fRange.g := $3FF;
  2962. fRange.b := $3FF;
  2963. fRange.a := $000;
  2964. fShift.r := 20;
  2965. fShift.g := 10;
  2966. fShift.b := 0;
  2967. fShift.a := 0;
  2968. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2969. fglInternalFormat := GL_RGB10;
  2970. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2971. end;
  2972. constructor TfdBGR12.Create;
  2973. begin
  2974. inherited Create;
  2975. fFormat := tfBGR12;
  2976. fWithAlpha := tfBGRA12;
  2977. fWithoutAlpha := tfBGR12;
  2978. fRGBInverted := tfRGB12;
  2979. fglInternalFormat := GL_RGB12;
  2980. end;
  2981. constructor TfdBGR16.Create;
  2982. begin
  2983. inherited Create;
  2984. fFormat := tfBGR16;
  2985. fWithAlpha := tfBGRA16;
  2986. fWithoutAlpha := tfBGR16;
  2987. fRGBInverted := tfRGB16;
  2988. fglInternalFormat := GL_RGB16;
  2989. end;
  2990. constructor TfdBGRA2.Create;
  2991. begin
  2992. inherited Create;
  2993. fFormat := tfBGRA2;
  2994. fWithAlpha := tfBGRA4;
  2995. fWithoutAlpha := tfBGR4;
  2996. fRGBInverted := tfRGBA2;
  2997. fglInternalFormat := GL_RGBA2;
  2998. end;
  2999. constructor TfdBGRA4.Create;
  3000. begin
  3001. inherited Create;
  3002. fFormat := tfBGRA4;
  3003. fWithAlpha := tfBGRA4;
  3004. fWithoutAlpha := tfBGR4;
  3005. fRGBInverted := tfRGBA4;
  3006. fRange.r := $F;
  3007. fRange.g := $F;
  3008. fRange.b := $F;
  3009. fRange.a := $F;
  3010. fShift.r := 8;
  3011. fShift.g := 4;
  3012. fShift.b := 0;
  3013. fShift.a := 12;
  3014. fglFormat := GL_BGRA;
  3015. fglInternalFormat := GL_RGBA4;
  3016. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  3017. end;
  3018. constructor TfdBGR5A1.Create;
  3019. begin
  3020. inherited Create;
  3021. fFormat := tfBGR5A1;
  3022. fWithAlpha := tfBGR5A1;
  3023. fWithoutAlpha := tfBGR5;
  3024. fRGBInverted := tfRGB5A1;
  3025. fRange.r := $1F;
  3026. fRange.g := $1F;
  3027. fRange.b := $1F;
  3028. fRange.a := $01;
  3029. fShift.r := 10;
  3030. fShift.g := 5;
  3031. fShift.b := 0;
  3032. fShift.a := 15;
  3033. fglFormat := GL_BGRA;
  3034. fglInternalFormat := GL_RGB5_A1;
  3035. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  3036. end;
  3037. constructor TfdBGRA8.Create;
  3038. begin
  3039. inherited Create;
  3040. fFormat := tfBGRA8;
  3041. fWithAlpha := tfBGRA8;
  3042. fWithoutAlpha := tfBGR8;
  3043. fRGBInverted := tfRGBA8;
  3044. fglInternalFormat := GL_RGBA8;
  3045. end;
  3046. constructor TfdBGR10A2.Create;
  3047. begin
  3048. inherited Create;
  3049. fFormat := tfBGR10A2;
  3050. fWithAlpha := tfBGR10A2;
  3051. fWithoutAlpha := tfBGR10;
  3052. fRGBInverted := tfRGB10A2;
  3053. fRange.r := $3FF;
  3054. fRange.g := $3FF;
  3055. fRange.b := $3FF;
  3056. fRange.a := $003;
  3057. fShift.r := 20;
  3058. fShift.g := 10;
  3059. fShift.b := 0;
  3060. fShift.a := 30;
  3061. fglFormat := GL_BGRA;
  3062. fglInternalFormat := GL_RGB10_A2;
  3063. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3064. end;
  3065. constructor TfdBGRA12.Create;
  3066. begin
  3067. inherited Create;
  3068. fFormat := tfBGRA12;
  3069. fWithAlpha := tfBGRA12;
  3070. fWithoutAlpha := tfBGR12;
  3071. fRGBInverted := tfRGBA12;
  3072. fglInternalFormat := GL_RGBA12;
  3073. end;
  3074. constructor TfdBGRA16.Create;
  3075. begin
  3076. inherited Create;
  3077. fFormat := tfBGRA16;
  3078. fWithAlpha := tfBGRA16;
  3079. fWithoutAlpha := tfBGR16;
  3080. fRGBInverted := tfRGBA16;
  3081. fglInternalFormat := GL_RGBA16;
  3082. end;
  3083. constructor TfdDepth16.Create;
  3084. begin
  3085. inherited Create;
  3086. fFormat := tfDepth16;
  3087. fWithAlpha := tfEmpty;
  3088. fWithoutAlpha := tfDepth16;
  3089. fglInternalFormat := GL_DEPTH_COMPONENT16;
  3090. end;
  3091. constructor TfdDepth24.Create;
  3092. begin
  3093. inherited Create;
  3094. fFormat := tfDepth24;
  3095. fWithAlpha := tfEmpty;
  3096. fWithoutAlpha := tfDepth24;
  3097. fglInternalFormat := GL_DEPTH_COMPONENT24;
  3098. end;
  3099. constructor TfdDepth32.Create;
  3100. begin
  3101. inherited Create;
  3102. fFormat := tfDepth32;
  3103. fWithAlpha := tfEmpty;
  3104. fWithoutAlpha := tfDepth32;
  3105. fglInternalFormat := GL_DEPTH_COMPONENT32;
  3106. end;
  3107. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3108. //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3109. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3110. procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3111. begin
  3112. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3113. end;
  3114. procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3115. begin
  3116. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3117. end;
  3118. constructor TfdS3tcDtx1RGBA.Create;
  3119. begin
  3120. inherited Create;
  3121. fFormat := tfS3tcDtx1RGBA;
  3122. fWithAlpha := tfS3tcDtx1RGBA;
  3123. fUncompressed := tfRGB5A1;
  3124. fPixelSize := 0.5;
  3125. fIsCompressed := true;
  3126. fglFormat := GL_COMPRESSED_RGBA;
  3127. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
  3128. fglDataFormat := GL_UNSIGNED_BYTE;
  3129. end;
  3130. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3131. //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3132. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3133. procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3134. begin
  3135. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3136. end;
  3137. procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3138. begin
  3139. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3140. end;
  3141. constructor TfdS3tcDtx3RGBA.Create;
  3142. begin
  3143. inherited Create;
  3144. fFormat := tfS3tcDtx3RGBA;
  3145. fWithAlpha := tfS3tcDtx3RGBA;
  3146. fUncompressed := tfRGBA8;
  3147. fPixelSize := 1.0;
  3148. fIsCompressed := true;
  3149. fglFormat := GL_COMPRESSED_RGBA;
  3150. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
  3151. fglDataFormat := GL_UNSIGNED_BYTE;
  3152. end;
  3153. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3154. //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3155. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3156. procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3157. begin
  3158. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3159. end;
  3160. procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3161. begin
  3162. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3163. end;
  3164. constructor TfdS3tcDtx5RGBA.Create;
  3165. begin
  3166. inherited Create;
  3167. fFormat := tfS3tcDtx3RGBA;
  3168. fWithAlpha := tfS3tcDtx3RGBA;
  3169. fUncompressed := tfRGBA8;
  3170. fPixelSize := 1.0;
  3171. fIsCompressed := true;
  3172. fglFormat := GL_COMPRESSED_RGBA;
  3173. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
  3174. fglDataFormat := GL_UNSIGNED_BYTE;
  3175. end;
  3176. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3177. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3178. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3179. class procedure TFormatDescriptor.Init;
  3180. begin
  3181. if not Assigned(FormatDescriptorCS) then
  3182. FormatDescriptorCS := TCriticalSection.Create;
  3183. end;
  3184. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3185. class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3186. begin
  3187. FormatDescriptorCS.Enter;
  3188. try
  3189. result := FormatDescriptors[aFormat];
  3190. if not Assigned(result) then begin
  3191. result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
  3192. FormatDescriptors[aFormat] := result;
  3193. end;
  3194. finally
  3195. FormatDescriptorCS.Leave;
  3196. end;
  3197. end;
  3198. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3199. class function TFormatDescriptor.GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3200. begin
  3201. result := Get(Get(aFormat).WithAlpha);
  3202. end;
  3203. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3204. class procedure TFormatDescriptor.Clear;
  3205. var
  3206. f: TglBitmapFormat;
  3207. begin
  3208. FormatDescriptorCS.Enter;
  3209. try
  3210. for f := low(FormatDescriptors) to high(FormatDescriptors) do
  3211. FreeAndNil(FormatDescriptors[f]);
  3212. finally
  3213. FormatDescriptorCS.Leave;
  3214. end;
  3215. end;
  3216. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3217. class procedure TFormatDescriptor.Finalize;
  3218. begin
  3219. Clear;
  3220. FreeAndNil(FormatDescriptorCS);
  3221. end;
  3222. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3223. //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3224. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3225. procedure TbmpBitfieldFormat.SetRedMask(const aValue: QWord);
  3226. begin
  3227. Update(aValue, fRange.r, fShift.r);
  3228. end;
  3229. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3230. procedure TbmpBitfieldFormat.SetGreenMask(const aValue: QWord);
  3231. begin
  3232. Update(aValue, fRange.g, fShift.g);
  3233. end;
  3234. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3235. procedure TbmpBitfieldFormat.SetBlueMask(const aValue: QWord);
  3236. begin
  3237. Update(aValue, fRange.b, fShift.b);
  3238. end;
  3239. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3240. procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: QWord);
  3241. begin
  3242. Update(aValue, fRange.a, fShift.a);
  3243. end;
  3244. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3245. procedure TbmpBitfieldFormat.Update(aMask: QWord; out aRange: Cardinal; out
  3246. aShift: Byte);
  3247. begin
  3248. aShift := 0;
  3249. aRange := 0;
  3250. if (aMask = 0) then
  3251. exit;
  3252. while (aMask > 0) and ((aMask and 1) = 0) do begin
  3253. inc(aShift);
  3254. aMask := aMask shr 1;
  3255. end;
  3256. aRange := 1;
  3257. while (aMask > 0) do begin
  3258. aRange := aRange shl 1;
  3259. aMask := aMask shr 1;
  3260. end;
  3261. dec(aRange);
  3262. fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
  3263. end;
  3264. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3265. procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3266. var
  3267. data: QWord;
  3268. s: Integer;
  3269. begin
  3270. data :=
  3271. ((aPixel.Data.r and fRange.r) shl fShift.r) or
  3272. ((aPixel.Data.g and fRange.g) shl fShift.g) or
  3273. ((aPixel.Data.b and fRange.b) shl fShift.b) or
  3274. ((aPixel.Data.a and fRange.a) shl fShift.a);
  3275. s := Round(fPixelSize);
  3276. case s of
  3277. 1: aData^ := data;
  3278. 2: PWord(aData)^ := data;
  3279. 4: PCardinal(aData)^ := data;
  3280. 8: PQWord(aData)^ := data;
  3281. else
  3282. raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
  3283. end;
  3284. inc(aData, s);
  3285. end;
  3286. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3287. procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3288. var
  3289. data: QWord;
  3290. s, i: Integer;
  3291. begin
  3292. s := Round(fPixelSize);
  3293. case s of
  3294. 1: data := aData^;
  3295. 2: data := PWord(aData)^;
  3296. 4: data := PCardinal(aData)^;
  3297. 8: data := PQWord(aData)^;
  3298. else
  3299. raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
  3300. end;
  3301. for i := 0 to 3 do
  3302. aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
  3303. inc(aData, s);
  3304. end;
  3305. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3306. //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3307. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3308. procedure TbmpColorTableFormat.CreateColorTable;
  3309. var
  3310. i: Integer;
  3311. begin
  3312. if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
  3313. raise EglBitmap.Create(UNSUPPORTED_FORMAT);
  3314. if (Format = tfLuminance4) then
  3315. SetLength(fColorTable, 16)
  3316. else
  3317. SetLength(fColorTable, 256);
  3318. case Format of
  3319. tfLuminance4: begin
  3320. for i := 0 to High(fColorTable) do begin
  3321. fColorTable[i].r := 16 * i;
  3322. fColorTable[i].g := 16 * i;
  3323. fColorTable[i].b := 16 * i;
  3324. fColorTable[i].a := 0;
  3325. end;
  3326. end;
  3327. tfLuminance8: begin
  3328. for i := 0 to High(fColorTable) do begin
  3329. fColorTable[i].r := i;
  3330. fColorTable[i].g := i;
  3331. fColorTable[i].b := i;
  3332. fColorTable[i].a := 0;
  3333. end;
  3334. end;
  3335. tfR3G3B2: begin
  3336. for i := 0 to High(fColorTable) do begin
  3337. fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
  3338. fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
  3339. fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
  3340. fColorTable[i].a := 0;
  3341. end;
  3342. end;
  3343. end;
  3344. end;
  3345. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3346. procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3347. var
  3348. d: Byte;
  3349. begin
  3350. if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
  3351. raise EglBitmap.Create(UNSUPPORTED_FORMAT);
  3352. case Format of
  3353. tfLuminance4: begin
  3354. if (aMapData = nil) then
  3355. aData^ := 0;
  3356. d := LuminanceWeight(aPixel) and Range.r;
  3357. aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData)));
  3358. inc(PByte(aMapData), 4);
  3359. if ({%H-}PtrUInt(aMapData) >= 8) then begin
  3360. inc(aData);
  3361. aMapData := nil;
  3362. end;
  3363. end;
  3364. tfLuminance8: begin
  3365. aData^ := LuminanceWeight(aPixel) and Range.r;
  3366. inc(aData);
  3367. end;
  3368. tfR3G3B2: begin
  3369. aData^ := Round(
  3370. ((aPixel.Data.r and Range.r) shl Shift.r) or
  3371. ((aPixel.Data.g and Range.g) shl Shift.g) or
  3372. ((aPixel.Data.b and Range.b) shl Shift.b));
  3373. inc(aData);
  3374. end;
  3375. end;
  3376. end;
  3377. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3378. procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3379. var
  3380. idx: QWord;
  3381. s: Integer;
  3382. bits: Byte;
  3383. f: Single;
  3384. begin
  3385. s := Trunc(fPixelSize);
  3386. f := fPixelSize - s;
  3387. bits := Round(8 * f);
  3388. case s of
  3389. 0: idx := (aData^ shr (8 - bits - {%H-}PtrInt(aMapData))) and ((1 shl bits) - 1);
  3390. 1: idx := aData^;
  3391. 2: idx := PWord(aData)^;
  3392. 4: idx := PCardinal(aData)^;
  3393. 8: idx := PQWord(aData)^;
  3394. else
  3395. raise EglBitmap.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
  3396. end;
  3397. if (idx >= Length(fColorTable)) then
  3398. raise EglBitmap.CreateFmt('invalid color index: %d', [idx]);
  3399. with fColorTable[idx] do begin
  3400. aPixel.Data.r := r;
  3401. aPixel.Data.g := g;
  3402. aPixel.Data.b := b;
  3403. aPixel.Data.a := a;
  3404. end;
  3405. inc(PByte(aMapData), bits);
  3406. if ({%H-}PtrUInt(aMapData) >= 8) then begin
  3407. inc(aData, 1);
  3408. dec(PByte(aMapData), 8);
  3409. end;
  3410. inc(aData, s);
  3411. end;
  3412. destructor TbmpColorTableFormat.Destroy;
  3413. begin
  3414. SetLength(fColorTable, 0);
  3415. inherited Destroy;
  3416. end;
  3417. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3418. //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3419. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3420. procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
  3421. var
  3422. i: Integer;
  3423. begin
  3424. for i := 0 to 3 do begin
  3425. if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
  3426. if (aSourceFD.Range.arr[i] > 0) then
  3427. aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
  3428. else
  3429. aPixel.Data.arr[i] := aDestFD.Range.arr[i];
  3430. end;
  3431. end;
  3432. end;
  3433. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3434. procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
  3435. begin
  3436. with aFuncRec do begin
  3437. if (Source.Range.r > 0) then
  3438. Dest.Data.r := Source.Data.r;
  3439. if (Source.Range.g > 0) then
  3440. Dest.Data.g := Source.Data.g;
  3441. if (Source.Range.b > 0) then
  3442. Dest.Data.b := Source.Data.b;
  3443. if (Source.Range.a > 0) then
  3444. Dest.Data.a := Source.Data.a;
  3445. end;
  3446. end;
  3447. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3448. procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3449. var
  3450. i: Integer;
  3451. begin
  3452. with aFuncRec do begin
  3453. for i := 0 to 3 do
  3454. if (Source.Range.arr[i] > 0) then
  3455. Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
  3456. end;
  3457. end;
  3458. type
  3459. TShiftData = packed record
  3460. case Integer of
  3461. 0: (r, g, b, a: SmallInt);
  3462. 1: (arr: array[0..3] of SmallInt);
  3463. end;
  3464. PShiftData = ^TShiftData;
  3465. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3466. procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3467. var
  3468. i: Integer;
  3469. begin
  3470. with aFuncRec do
  3471. for i := 0 to 3 do
  3472. if (Source.Range.arr[i] > 0) then
  3473. Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
  3474. end;
  3475. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3476. procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
  3477. begin
  3478. with aFuncRec do begin
  3479. Dest.Data := Source.Data;
  3480. if ({%H-}PtrUInt(Args) and $1 > 0) then begin
  3481. Dest.Data.r := Dest.Data.r xor Dest.Range.r;
  3482. Dest.Data.g := Dest.Data.g xor Dest.Range.g;
  3483. Dest.Data.b := Dest.Data.b xor Dest.Range.b;
  3484. end;
  3485. if ({%H-}PtrUInt(Args) and $2 > 0) then begin
  3486. Dest.Data.a := Dest.Data.a xor Dest.Range.a;
  3487. end;
  3488. end;
  3489. end;
  3490. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3491. procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
  3492. var
  3493. i: Integer;
  3494. begin
  3495. with aFuncRec do begin
  3496. for i := 0 to 3 do
  3497. Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
  3498. end;
  3499. end;
  3500. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3501. procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3502. var
  3503. Temp: Single;
  3504. begin
  3505. with FuncRec do begin
  3506. if (FuncRec.Args = nil) then begin //source has no alpha
  3507. Temp :=
  3508. Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
  3509. Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
  3510. Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
  3511. Dest.Data.a := Round(Dest.Range.a * Temp);
  3512. end else
  3513. Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
  3514. end;
  3515. end;
  3516. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3517. procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3518. type
  3519. PglBitmapPixelData = ^TglBitmapPixelData;
  3520. begin
  3521. with FuncRec do begin
  3522. Dest.Data.r := Source.Data.r;
  3523. Dest.Data.g := Source.Data.g;
  3524. Dest.Data.b := Source.Data.b;
  3525. with PglBitmapPixelData(Args)^ do
  3526. if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
  3527. (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
  3528. (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
  3529. Dest.Data.a := 0
  3530. else
  3531. Dest.Data.a := Dest.Range.a;
  3532. end;
  3533. end;
  3534. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3535. procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3536. begin
  3537. with FuncRec do begin
  3538. Dest.Data.r := Source.Data.r;
  3539. Dest.Data.g := Source.Data.g;
  3540. Dest.Data.b := Source.Data.b;
  3541. Dest.Data.a := PCardinal(Args)^;
  3542. end;
  3543. end;
  3544. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3545. procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
  3546. type
  3547. PRGBPix = ^TRGBPix;
  3548. TRGBPix = array [0..2] of byte;
  3549. var
  3550. Temp: Byte;
  3551. begin
  3552. while aWidth > 0 do begin
  3553. Temp := PRGBPix(aData)^[0];
  3554. PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
  3555. PRGBPix(aData)^[2] := Temp;
  3556. if aHasAlpha then
  3557. Inc(aData, 4)
  3558. else
  3559. Inc(aData, 3);
  3560. dec(aWidth);
  3561. end;
  3562. end;
  3563. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3564. //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3565. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3566. function TglBitmap.GetFormatDesc: TglBitmapFormatDescriptor;
  3567. begin
  3568. result := TFormatDescriptor.Get(Format);
  3569. end;
  3570. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3571. function TglBitmap.GetWidth: Integer;
  3572. begin
  3573. if (ffX in fDimension.Fields) then
  3574. result := fDimension.X
  3575. else
  3576. result := -1;
  3577. end;
  3578. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3579. function TglBitmap.GetHeight: Integer;
  3580. begin
  3581. if (ffY in fDimension.Fields) then
  3582. result := fDimension.Y
  3583. else
  3584. result := -1;
  3585. end;
  3586. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3587. function TglBitmap.GetFileWidth: Integer;
  3588. begin
  3589. result := Max(1, Width);
  3590. end;
  3591. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3592. function TglBitmap.GetFileHeight: Integer;
  3593. begin
  3594. result := Max(1, Height);
  3595. end;
  3596. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3597. procedure TglBitmap.SetCustomData(const aValue: Pointer);
  3598. begin
  3599. if fCustomData = aValue then
  3600. exit;
  3601. fCustomData := aValue;
  3602. end;
  3603. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3604. procedure TglBitmap.SetCustomName(const aValue: String);
  3605. begin
  3606. if fCustomName = aValue then
  3607. exit;
  3608. fCustomName := aValue;
  3609. end;
  3610. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3611. procedure TglBitmap.SetCustomNameW(const aValue: WideString);
  3612. begin
  3613. if fCustomNameW = aValue then
  3614. exit;
  3615. fCustomNameW := aValue;
  3616. end;
  3617. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3618. procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
  3619. begin
  3620. if fDeleteTextureOnFree = aValue then
  3621. exit;
  3622. fDeleteTextureOnFree := aValue;
  3623. end;
  3624. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3625. procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
  3626. begin
  3627. if fFormat = aValue then
  3628. exit;
  3629. if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
  3630. raise EglBitmapUnsupportedFormat.Create(Format);
  3631. SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
  3632. end;
  3633. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3634. procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
  3635. begin
  3636. if fFreeDataAfterGenTexture = aValue then
  3637. exit;
  3638. fFreeDataAfterGenTexture := aValue;
  3639. end;
  3640. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3641. procedure TglBitmap.SetID(const aValue: Cardinal);
  3642. begin
  3643. if fID = aValue then
  3644. exit;
  3645. fID := aValue;
  3646. end;
  3647. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3648. procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
  3649. begin
  3650. if fMipMap = aValue then
  3651. exit;
  3652. fMipMap := aValue;
  3653. end;
  3654. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3655. procedure TglBitmap.SetTarget(const aValue: Cardinal);
  3656. begin
  3657. if fTarget = aValue then
  3658. exit;
  3659. fTarget := aValue;
  3660. end;
  3661. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3662. procedure TglBitmap.SetAnisotropic(const aValue: Integer);
  3663. var
  3664. MaxAnisotropic: Integer;
  3665. begin
  3666. fAnisotropic := aValue;
  3667. if (ID > 0) then begin
  3668. if GL_EXT_texture_filter_anisotropic then begin
  3669. if fAnisotropic > 0 then begin
  3670. Bind(false);
  3671. glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
  3672. if aValue > MaxAnisotropic then
  3673. fAnisotropic := MaxAnisotropic;
  3674. glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
  3675. end;
  3676. end else begin
  3677. fAnisotropic := 0;
  3678. end;
  3679. end;
  3680. end;
  3681. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3682. procedure TglBitmap.CreateID;
  3683. begin
  3684. if (ID <> 0) then
  3685. glDeleteTextures(1, @fID);
  3686. glGenTextures(1, @fID);
  3687. Bind(false);
  3688. end;
  3689. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3690. procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
  3691. begin
  3692. // Set Up Parameters
  3693. SetWrap(fWrapS, fWrapT, fWrapR);
  3694. SetFilter(fFilterMin, fFilterMag);
  3695. SetAnisotropic(fAnisotropic);
  3696. SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
  3697. if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  3698. SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  3699. // Mip Maps Generation Mode
  3700. aBuildWithGlu := false;
  3701. if (MipMap = mmMipmap) then begin
  3702. if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
  3703. glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
  3704. else
  3705. aBuildWithGlu := true;
  3706. end else if (MipMap = mmMipmapGlu) then
  3707. aBuildWithGlu := true;
  3708. end;
  3709. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3710. procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  3711. const aWidth: Integer; const aHeight: Integer);
  3712. var
  3713. s: Single;
  3714. begin
  3715. if (Data <> aData) then begin
  3716. if (Assigned(Data)) then
  3717. FreeMem(Data);
  3718. fData := aData;
  3719. end;
  3720. if not Assigned(fData) then begin
  3721. fPixelSize := 0;
  3722. fRowSize := 0;
  3723. end else begin
  3724. FillChar(fDimension, SizeOf(fDimension), 0);
  3725. if aWidth <> -1 then begin
  3726. fDimension.Fields := fDimension.Fields + [ffX];
  3727. fDimension.X := aWidth;
  3728. end;
  3729. if aHeight <> -1 then begin
  3730. fDimension.Fields := fDimension.Fields + [ffY];
  3731. fDimension.Y := aHeight;
  3732. end;
  3733. s := TFormatDescriptor.Get(aFormat).PixelSize;
  3734. fFormat := aFormat;
  3735. fPixelSize := Ceil(s);
  3736. fRowSize := Ceil(s * aWidth);
  3737. end;
  3738. end;
  3739. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3740. function TglBitmap.FlipHorz: Boolean;
  3741. begin
  3742. result := false;
  3743. end;
  3744. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3745. function TglBitmap.FlipVert: Boolean;
  3746. begin
  3747. result := false;
  3748. end;
  3749. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3750. //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3751. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3752. procedure TglBitmap.AfterConstruction;
  3753. begin
  3754. inherited AfterConstruction;
  3755. fID := 0;
  3756. fTarget := 0;
  3757. fIsResident := false;
  3758. fFormat := glBitmapGetDefaultFormat;
  3759. fMipMap := glBitmapDefaultMipmap;
  3760. fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
  3761. fDeleteTextureOnFree := glBitmapGetDefaultDeleteTextureOnFree;
  3762. glBitmapGetDefaultFilter (fFilterMin, fFilterMag);
  3763. glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
  3764. glBitmapGetDefaultSwizzle (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  3765. end;
  3766. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3767. procedure TglBitmap.BeforeDestruction;
  3768. var
  3769. NewData: PByte;
  3770. begin
  3771. NewData := nil;
  3772. SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
  3773. if (fID > 0) and fDeleteTextureOnFree then
  3774. glDeleteTextures(1, @fID);
  3775. inherited BeforeDestruction;
  3776. end;
  3777. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3778. procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
  3779. var
  3780. TempPos: Integer;
  3781. begin
  3782. if not Assigned(aResType) then begin
  3783. TempPos := Pos('.', aResource);
  3784. aResType := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
  3785. aResource := UpperCase(Copy(aResource, 0, TempPos -1));
  3786. end;
  3787. end;
  3788. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3789. procedure TglBitmap.LoadFromFile(const aFilename: String);
  3790. var
  3791. fs: TFileStream;
  3792. begin
  3793. if not FileExists(aFilename) then
  3794. raise EglBitmap.Create('file does not exist: ' + aFilename);
  3795. fFilename := aFilename;
  3796. fs := TFileStream.Create(fFilename, fmOpenRead);
  3797. try
  3798. fs.Position := 0;
  3799. LoadFromStream(fs);
  3800. finally
  3801. fs.Free;
  3802. end;
  3803. end;
  3804. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3805. procedure TglBitmap.LoadFromStream(const aStream: TStream);
  3806. begin
  3807. {$IFDEF GLB_SUPPORT_PNG_READ}
  3808. if not LoadPNG(aStream) then
  3809. {$ENDIF}
  3810. {$IFDEF GLB_SUPPORT_JPEG_READ}
  3811. if not LoadJPEG(aStream) then
  3812. {$ENDIF}
  3813. if not LoadDDS(aStream) then
  3814. if not LoadTGA(aStream) then
  3815. if not LoadBMP(aStream) then
  3816. raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
  3817. end;
  3818. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3819. procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  3820. const aFormat: TglBitmapFormat; const aArgs: Pointer);
  3821. var
  3822. tmpData: PByte;
  3823. size: Integer;
  3824. begin
  3825. size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  3826. GetMem(tmpData, size);
  3827. try
  3828. FillChar(tmpData^, size, #$FF);
  3829. SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  3830. except
  3831. if Assigned(tmpData) then
  3832. FreeMem(tmpData);
  3833. raise;
  3834. end;
  3835. AddFunc(Self, aFunc, false, Format, aArgs);
  3836. end;
  3837. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3838. procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
  3839. var
  3840. rs: TResourceStream;
  3841. begin
  3842. PrepareResType(aResource, aResType);
  3843. rs := TResourceStream.Create(aInstance, aResource, aResType);
  3844. try
  3845. LoadFromStream(rs);
  3846. finally
  3847. rs.Free;
  3848. end;
  3849. end;
  3850. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3851. procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  3852. var
  3853. rs: TResourceStream;
  3854. begin
  3855. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  3856. try
  3857. LoadFromStream(rs);
  3858. finally
  3859. rs.Free;
  3860. end;
  3861. end;
  3862. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3863. procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  3864. var
  3865. fs: TFileStream;
  3866. begin
  3867. fs := TFileStream.Create(aFileName, fmCreate);
  3868. try
  3869. fs.Position := 0;
  3870. SaveToStream(fs, aFileType);
  3871. finally
  3872. fs.Free;
  3873. end;
  3874. end;
  3875. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3876. procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
  3877. begin
  3878. case aFileType of
  3879. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  3880. ftPNG: SavePNG(aStream);
  3881. {$ENDIF}
  3882. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  3883. ftJPEG: SaveJPEG(aStream);
  3884. {$ENDIF}
  3885. ftDDS: SaveDDS(aStream);
  3886. ftTGA: SaveTGA(aStream);
  3887. ftBMP: SaveBMP(aStream);
  3888. end;
  3889. end;
  3890. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3891. function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
  3892. begin
  3893. result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
  3894. end;
  3895. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3896. function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  3897. const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
  3898. var
  3899. DestData, TmpData, SourceData: pByte;
  3900. TempHeight, TempWidth: Integer;
  3901. SourceFD, DestFD: TFormatDescriptor;
  3902. SourceMD, DestMD: Pointer;
  3903. FuncRec: TglBitmapFunctionRec;
  3904. begin
  3905. Assert(Assigned(Data));
  3906. Assert(Assigned(aSource));
  3907. Assert(Assigned(aSource.Data));
  3908. result := false;
  3909. if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
  3910. SourceFD := TFormatDescriptor.Get(aSource.Format);
  3911. DestFD := TFormatDescriptor.Get(aFormat);
  3912. if (SourceFD.IsCompressed) then
  3913. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
  3914. if (DestFD.IsCompressed) then
  3915. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
  3916. // inkompatible Formats so CreateTemp
  3917. if (SourceFD.PixelSize <> DestFD.PixelSize) then
  3918. aCreateTemp := true;
  3919. // Values
  3920. TempHeight := Max(1, aSource.Height);
  3921. TempWidth := Max(1, aSource.Width);
  3922. FuncRec.Sender := Self;
  3923. FuncRec.Args := aArgs;
  3924. TmpData := nil;
  3925. if aCreateTemp then begin
  3926. GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
  3927. DestData := TmpData;
  3928. end else
  3929. DestData := Data;
  3930. try
  3931. SourceFD.PreparePixel(FuncRec.Source);
  3932. DestFD.PreparePixel (FuncRec.Dest);
  3933. SourceMD := SourceFD.CreateMappingData;
  3934. DestMD := DestFD.CreateMappingData;
  3935. FuncRec.Size := aSource.Dimension;
  3936. FuncRec.Position.Fields := FuncRec.Size.Fields;
  3937. try
  3938. SourceData := aSource.Data;
  3939. FuncRec.Position.Y := 0;
  3940. while FuncRec.Position.Y < TempHeight do begin
  3941. FuncRec.Position.X := 0;
  3942. while FuncRec.Position.X < TempWidth do begin
  3943. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  3944. aFunc(FuncRec);
  3945. DestFD.Map(FuncRec.Dest, DestData, DestMD);
  3946. inc(FuncRec.Position.X);
  3947. end;
  3948. inc(FuncRec.Position.Y);
  3949. end;
  3950. // Updating Image or InternalFormat
  3951. if aCreateTemp then
  3952. SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method
  3953. else if (aFormat <> fFormat) then
  3954. Format := aFormat;
  3955. result := true;
  3956. finally
  3957. SourceFD.FreeMappingData(SourceMD);
  3958. DestFD.FreeMappingData(DestMD);
  3959. end;
  3960. except
  3961. if aCreateTemp and Assigned(TmpData) then
  3962. FreeMem(TmpData);
  3963. raise;
  3964. end;
  3965. end;
  3966. end;
  3967. {$IFDEF GLB_SDL}
  3968. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3969. function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  3970. var
  3971. Row, RowSize: Integer;
  3972. SourceData, TmpData: PByte;
  3973. TempDepth: Integer;
  3974. FormatDesc: TFormatDescriptor;
  3975. function GetRowPointer(Row: Integer): pByte;
  3976. begin
  3977. result := aSurface.pixels;
  3978. Inc(result, Row * RowSize);
  3979. end;
  3980. begin
  3981. result := false;
  3982. FormatDesc := TFormatDescriptor.Get(Format);
  3983. if FormatDesc.IsCompressed then
  3984. raise EglBitmapUnsupportedFormat.Create(Format);
  3985. if Assigned(Data) then begin
  3986. case Trunc(FormatDesc.PixelSize) of
  3987. 1: TempDepth := 8;
  3988. 2: TempDepth := 16;
  3989. 3: TempDepth := 24;
  3990. 4: TempDepth := 32;
  3991. else
  3992. raise EglBitmapUnsupportedFormat.Create(Format);
  3993. end;
  3994. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
  3995. FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
  3996. SourceData := Data;
  3997. RowSize := FormatDesc.GetSize(FileWidth, 1);
  3998. for Row := 0 to FileHeight-1 do begin
  3999. TmpData := GetRowPointer(Row);
  4000. if Assigned(TmpData) then begin
  4001. Move(SourceData^, TmpData^, RowSize);
  4002. inc(SourceData, RowSize);
  4003. end;
  4004. end;
  4005. result := true;
  4006. end;
  4007. end;
  4008. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4009. function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  4010. var
  4011. pSource, pData, pTempData: PByte;
  4012. Row, RowSize, TempWidth, TempHeight: Integer;
  4013. IntFormat: TglBitmapFormat;
  4014. FormatDesc: TFormatDescriptor;
  4015. function GetRowPointer(Row: Integer): pByte;
  4016. begin
  4017. result := aSurface^.pixels;
  4018. Inc(result, Row * RowSize);
  4019. end;
  4020. begin
  4021. result := false;
  4022. if (Assigned(aSurface)) then begin
  4023. with aSurface^.format^ do begin
  4024. for IntFormat := High(TglBitmapFormat) to Low(TglBitmapFormat) do begin
  4025. FormatDesc := TFormatDescriptor.Get(IntFormat);
  4026. if (FormatDesc.MaskMatch(RMask, GMask, BMask, AMask)) then
  4027. break;
  4028. end;
  4029. if (IntFormat = tfEmpty) then
  4030. raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
  4031. end;
  4032. TempWidth := aSurface^.w;
  4033. TempHeight := aSurface^.h;
  4034. RowSize := FormatDesc.GetSize(TempWidth, 1);
  4035. GetMem(pData, TempHeight * RowSize);
  4036. try
  4037. pTempData := pData;
  4038. for Row := 0 to TempHeight -1 do begin
  4039. pSource := GetRowPointer(Row);
  4040. if (Assigned(pSource)) then begin
  4041. Move(pSource^, pTempData^, RowSize);
  4042. Inc(pTempData, RowSize);
  4043. end;
  4044. end;
  4045. SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  4046. result := true;
  4047. except
  4048. if Assigned(pData) then
  4049. FreeMem(pData);
  4050. raise;
  4051. end;
  4052. end;
  4053. end;
  4054. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4055. function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  4056. var
  4057. Row, Col, AlphaInterleave: Integer;
  4058. pSource, pDest: PByte;
  4059. function GetRowPointer(Row: Integer): pByte;
  4060. begin
  4061. result := aSurface.pixels;
  4062. Inc(result, Row * Width);
  4063. end;
  4064. begin
  4065. result := false;
  4066. if Assigned(Data) then begin
  4067. if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
  4068. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
  4069. AlphaInterleave := 0;
  4070. case Format of
  4071. tfLuminance8Alpha8:
  4072. AlphaInterleave := 1;
  4073. tfBGRA8, tfRGBA8:
  4074. AlphaInterleave := 3;
  4075. end;
  4076. pSource := Data;
  4077. for Row := 0 to Height -1 do begin
  4078. pDest := GetRowPointer(Row);
  4079. if Assigned(pDest) then begin
  4080. for Col := 0 to Width -1 do begin
  4081. Inc(pSource, AlphaInterleave);
  4082. pDest^ := pSource^;
  4083. Inc(pDest);
  4084. Inc(pSource);
  4085. end;
  4086. end;
  4087. end;
  4088. result := true;
  4089. end;
  4090. end;
  4091. end;
  4092. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4093. function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  4094. var
  4095. bmp: TglBitmap2D;
  4096. begin
  4097. bmp := TglBitmap2D.Create;
  4098. try
  4099. bmp.AssignFromSurface(aSurface);
  4100. result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
  4101. finally
  4102. bmp.Free;
  4103. end;
  4104. end;
  4105. {$ENDIF}
  4106. {$IFDEF GLB_DELPHI}
  4107. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4108. function CreateGrayPalette: HPALETTE;
  4109. var
  4110. Idx: Integer;
  4111. Pal: PLogPalette;
  4112. begin
  4113. GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
  4114. Pal.palVersion := $300;
  4115. Pal.palNumEntries := 256;
  4116. for Idx := 0 to Pal.palNumEntries - 1 do begin
  4117. Pal.palPalEntry[Idx].peRed := Idx;
  4118. Pal.palPalEntry[Idx].peGreen := Idx;
  4119. Pal.palPalEntry[Idx].peBlue := Idx;
  4120. Pal.palPalEntry[Idx].peFlags := 0;
  4121. end;
  4122. Result := CreatePalette(Pal^);
  4123. FreeMem(Pal);
  4124. end;
  4125. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4126. function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
  4127. var
  4128. Row: Integer;
  4129. pSource, pData: PByte;
  4130. begin
  4131. result := false;
  4132. if Assigned(Data) then begin
  4133. if Assigned(aBitmap) then begin
  4134. aBitmap.Width := Width;
  4135. aBitmap.Height := Height;
  4136. case Format of
  4137. tfAlpha8, tfLuminance8: begin
  4138. aBitmap.PixelFormat := pf8bit;
  4139. aBitmap.Palette := CreateGrayPalette;
  4140. end;
  4141. tfRGB5A1:
  4142. aBitmap.PixelFormat := pf15bit;
  4143. tfR5G6B5:
  4144. aBitmap.PixelFormat := pf16bit;
  4145. tfRGB8, tfBGR8:
  4146. aBitmap.PixelFormat := pf24bit;
  4147. tfRGBA8, tfBGRA8:
  4148. aBitmap.PixelFormat := pf32bit;
  4149. else
  4150. raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
  4151. end;
  4152. pSource := Data;
  4153. for Row := 0 to FileHeight -1 do begin
  4154. pData := aBitmap.Scanline[Row];
  4155. Move(pSource^, pData^, fRowSize);
  4156. Inc(pSource, fRowSize);
  4157. if (Format in [tfRGB8, tfRGBA8]) then // swap RGB(A) to BGR(A)
  4158. SwapRGB(pData, FileWidth, Format = tfRGBA8);
  4159. end;
  4160. result := true;
  4161. end;
  4162. end;
  4163. end;
  4164. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4165. function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  4166. var
  4167. pSource, pData, pTempData: PByte;
  4168. Row, RowSize, TempWidth, TempHeight: Integer;
  4169. IntFormat: TglBitmapFormat;
  4170. begin
  4171. result := false;
  4172. if (Assigned(aBitmap)) then begin
  4173. case aBitmap.PixelFormat of
  4174. pf8bit:
  4175. IntFormat := tfLuminance8;
  4176. pf15bit:
  4177. IntFormat := tfRGB5A1;
  4178. pf16bit:
  4179. IntFormat := tfR5G6B5;
  4180. pf24bit:
  4181. IntFormat := tfBGR8;
  4182. pf32bit:
  4183. IntFormat := tfBGRA8;
  4184. else
  4185. raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
  4186. end;
  4187. TempWidth := aBitmap.Width;
  4188. TempHeight := aBitmap.Height;
  4189. RowSize := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
  4190. GetMem(pData, TempHeight * RowSize);
  4191. try
  4192. pTempData := pData;
  4193. for Row := 0 to TempHeight -1 do begin
  4194. pSource := aBitmap.Scanline[Row];
  4195. if (Assigned(pSource)) then begin
  4196. Move(pSource^, pTempData^, RowSize);
  4197. Inc(pTempData, RowSize);
  4198. end;
  4199. end;
  4200. SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  4201. result := true;
  4202. except
  4203. if Assigned(pData) then
  4204. FreeMem(pData);
  4205. raise;
  4206. end;
  4207. end;
  4208. end;
  4209. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4210. function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  4211. var
  4212. Row, Col, AlphaInterleave: Integer;
  4213. pSource, pDest: PByte;
  4214. begin
  4215. result := false;
  4216. if Assigned(Data) then begin
  4217. if (Format in [tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8]) then begin
  4218. if Assigned(aBitmap) then begin
  4219. aBitmap.PixelFormat := pf8bit;
  4220. aBitmap.Palette := CreateGrayPalette;
  4221. aBitmap.Width := Width;
  4222. aBitmap.Height := Height;
  4223. case Format of
  4224. tfLuminance8Alpha8:
  4225. AlphaInterleave := 1;
  4226. tfRGBA8, tfBGRA8:
  4227. AlphaInterleave := 3;
  4228. else
  4229. AlphaInterleave := 0;
  4230. end;
  4231. // Copy Data
  4232. pSource := Data;
  4233. for Row := 0 to Height -1 do begin
  4234. pDest := aBitmap.Scanline[Row];
  4235. if Assigned(pDest) then begin
  4236. for Col := 0 to Width -1 do begin
  4237. Inc(pSource, AlphaInterleave);
  4238. pDest^ := pSource^;
  4239. Inc(pDest);
  4240. Inc(pSource);
  4241. end;
  4242. end;
  4243. end;
  4244. result := true;
  4245. end;
  4246. end;
  4247. end;
  4248. end;
  4249. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4250. function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4251. var
  4252. tex: TglBitmap2D;
  4253. begin
  4254. tex := TglBitmap2D.Create;
  4255. try
  4256. tex.AssignFromBitmap(ABitmap);
  4257. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4258. finally
  4259. tex.Free;
  4260. end;
  4261. end;
  4262. {$ENDIF}
  4263. {$IFDEF GLB_LAZARUS}
  4264. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4265. function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4266. var
  4267. rid: TRawImageDescription;
  4268. FormatDesc: TFormatDescriptor;
  4269. begin
  4270. result := false;
  4271. if not Assigned(aImage) or (Format = tfEmpty) then
  4272. exit;
  4273. FormatDesc := TFormatDescriptor.Get(Format);
  4274. if FormatDesc.IsCompressed then
  4275. exit;
  4276. FillChar(rid{%H-}, SizeOf(rid), 0);
  4277. if (Format in [
  4278. tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
  4279. tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
  4280. tfLuminance4Alpha4, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16]) then
  4281. rid.Format := ricfGray
  4282. else
  4283. rid.Format := ricfRGBA;
  4284. rid.Width := Width;
  4285. rid.Height := Height;
  4286. rid.Depth := CountSetBits(FormatDesc.RedMask or FormatDesc.GreenMask or FormatDesc.BlueMask or FormatDesc.AlphaMask);
  4287. rid.BitOrder := riboBitsInOrder;
  4288. rid.ByteOrder := riboLSBFirst;
  4289. rid.LineOrder := riloTopToBottom;
  4290. rid.LineEnd := rileTight;
  4291. rid.BitsPerPixel := Round(8 * FormatDesc.PixelSize);
  4292. rid.RedPrec := CountSetBits(FormatDesc.Range.r);
  4293. rid.GreenPrec := CountSetBits(FormatDesc.Range.g);
  4294. rid.BluePrec := CountSetBits(FormatDesc.Range.b);
  4295. rid.AlphaPrec := CountSetBits(FormatDesc.Range.a);
  4296. rid.RedShift := FormatDesc.Shift.r;
  4297. rid.GreenShift := FormatDesc.Shift.g;
  4298. rid.BlueShift := FormatDesc.Shift.b;
  4299. rid.AlphaShift := FormatDesc.Shift.a;
  4300. rid.MaskBitsPerPixel := 0;
  4301. rid.PaletteColorCount := 0;
  4302. aImage.DataDescription := rid;
  4303. aImage.CreateData;
  4304. Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
  4305. result := true;
  4306. end;
  4307. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4308. function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4309. var
  4310. f: TglBitmapFormat;
  4311. FormatDesc: TFormatDescriptor;
  4312. ImageData: PByte;
  4313. ImageSize: Integer;
  4314. begin
  4315. result := false;
  4316. if not Assigned(aImage) then
  4317. exit;
  4318. for f := High(f) downto Low(f) do begin
  4319. FormatDesc := TFormatDescriptor.Get(f);
  4320. with aImage.DataDescription do
  4321. if FormatDesc.MaskMatch(
  4322. (QWord(1 shl RedPrec )-1) shl RedShift,
  4323. (QWord(1 shl GreenPrec)-1) shl GreenShift,
  4324. (QWord(1 shl BluePrec )-1) shl BlueShift,
  4325. (QWord(1 shl AlphaPrec)-1) shl AlphaShift) then
  4326. break;
  4327. end;
  4328. if (f = tfEmpty) then
  4329. exit;
  4330. ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
  4331. ImageData := GetMem(ImageSize);
  4332. try
  4333. Move(aImage.PixelData^, ImageData^, (aImage.Width * aImage.Height * aImage.DataDescription.BitsPerPixel) shr 3);
  4334. SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method
  4335. except
  4336. if Assigned(ImageData) then
  4337. FreeMem(ImageData);
  4338. raise;
  4339. end;
  4340. result := true;
  4341. end;
  4342. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4343. function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4344. var
  4345. rid: TRawImageDescription;
  4346. FormatDesc: TFormatDescriptor;
  4347. Pixel: TglBitmapPixelData;
  4348. x, y: Integer;
  4349. srcMD: Pointer;
  4350. src, dst: PByte;
  4351. begin
  4352. result := false;
  4353. if not Assigned(aImage) or (Format = tfEmpty) then
  4354. exit;
  4355. FormatDesc := TFormatDescriptor.Get(Format);
  4356. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  4357. exit;
  4358. FillChar(rid{%H-}, SizeOf(rid), 0);
  4359. rid.Format := ricfGray;
  4360. rid.Width := Width;
  4361. rid.Height := Height;
  4362. rid.Depth := CountSetBits(FormatDesc.Range.a);
  4363. rid.BitOrder := riboBitsInOrder;
  4364. rid.ByteOrder := riboLSBFirst;
  4365. rid.LineOrder := riloTopToBottom;
  4366. rid.LineEnd := rileTight;
  4367. rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
  4368. rid.RedPrec := CountSetBits(FormatDesc.Range.a);
  4369. rid.GreenPrec := 0;
  4370. rid.BluePrec := 0;
  4371. rid.AlphaPrec := 0;
  4372. rid.RedShift := 0;
  4373. rid.GreenShift := 0;
  4374. rid.BlueShift := 0;
  4375. rid.AlphaShift := 0;
  4376. rid.MaskBitsPerPixel := 0;
  4377. rid.PaletteColorCount := 0;
  4378. aImage.DataDescription := rid;
  4379. aImage.CreateData;
  4380. srcMD := FormatDesc.CreateMappingData;
  4381. try
  4382. FormatDesc.PreparePixel(Pixel);
  4383. src := Data;
  4384. dst := aImage.PixelData;
  4385. for y := 0 to Height-1 do
  4386. for x := 0 to Width-1 do begin
  4387. FormatDesc.Unmap(src, Pixel, srcMD);
  4388. case rid.BitsPerPixel of
  4389. 8: begin
  4390. dst^ := Pixel.Data.a;
  4391. inc(dst);
  4392. end;
  4393. 16: begin
  4394. PWord(dst)^ := Pixel.Data.a;
  4395. inc(dst, 2);
  4396. end;
  4397. 24: begin
  4398. PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
  4399. PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
  4400. PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
  4401. inc(dst, 3);
  4402. end;
  4403. 32: begin
  4404. PCardinal(dst)^ := Pixel.Data.a;
  4405. inc(dst, 4);
  4406. end;
  4407. else
  4408. raise EglBitmapUnsupportedFormat.Create(Format);
  4409. end;
  4410. end;
  4411. finally
  4412. FormatDesc.FreeMappingData(srcMD);
  4413. end;
  4414. result := true;
  4415. end;
  4416. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4417. function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4418. var
  4419. tex: TglBitmap2D;
  4420. begin
  4421. tex := TglBitmap2D.Create;
  4422. try
  4423. tex.AssignFromLazIntfImage(aImage);
  4424. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4425. finally
  4426. tex.Free;
  4427. end;
  4428. end;
  4429. {$ENDIF}
  4430. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4431. function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
  4432. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4433. var
  4434. rs: TResourceStream;
  4435. begin
  4436. PrepareResType(aResource, aResType);
  4437. rs := TResourceStream.Create(aInstance, aResource, aResType);
  4438. try
  4439. result := AddAlphaFromStream(rs, aFunc, aArgs);
  4440. finally
  4441. rs.Free;
  4442. end;
  4443. end;
  4444. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4445. function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  4446. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4447. var
  4448. rs: TResourceStream;
  4449. begin
  4450. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  4451. try
  4452. result := AddAlphaFromStream(rs, aFunc, aArgs);
  4453. finally
  4454. rs.Free;
  4455. end;
  4456. end;
  4457. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4458. function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4459. begin
  4460. if TFormatDescriptor.Get(Format).IsCompressed then
  4461. raise EglBitmapUnsupportedFormat.Create(Format);
  4462. result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
  4463. end;
  4464. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4465. function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4466. var
  4467. FS: TFileStream;
  4468. begin
  4469. FS := TFileStream.Create(aFileName, fmOpenRead);
  4470. try
  4471. result := AddAlphaFromStream(FS, aFunc, aArgs);
  4472. finally
  4473. FS.Free;
  4474. end;
  4475. end;
  4476. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4477. function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4478. var
  4479. tex: TglBitmap2D;
  4480. begin
  4481. tex := TglBitmap2D.Create(aStream);
  4482. try
  4483. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4484. finally
  4485. tex.Free;
  4486. end;
  4487. end;
  4488. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4489. function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4490. var
  4491. DestData, DestData2, SourceData: pByte;
  4492. TempHeight, TempWidth: Integer;
  4493. SourceFD, DestFD: TFormatDescriptor;
  4494. SourceMD, DestMD, DestMD2: Pointer;
  4495. FuncRec: TglBitmapFunctionRec;
  4496. begin
  4497. result := false;
  4498. Assert(Assigned(Data));
  4499. Assert(Assigned(aBitmap));
  4500. Assert(Assigned(aBitmap.Data));
  4501. if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
  4502. result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
  4503. SourceFD := TFormatDescriptor.Get(aBitmap.Format);
  4504. DestFD := TFormatDescriptor.Get(Format);
  4505. if not Assigned(aFunc) then begin
  4506. aFunc := glBitmapAlphaFunc;
  4507. FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
  4508. end else
  4509. FuncRec.Args := aArgs;
  4510. // Values
  4511. TempHeight := aBitmap.FileHeight;
  4512. TempWidth := aBitmap.FileWidth;
  4513. FuncRec.Sender := Self;
  4514. FuncRec.Size := Dimension;
  4515. FuncRec.Position.Fields := FuncRec.Size.Fields;
  4516. DestData := Data;
  4517. DestData2 := Data;
  4518. SourceData := aBitmap.Data;
  4519. // Mapping
  4520. SourceFD.PreparePixel(FuncRec.Source);
  4521. DestFD.PreparePixel (FuncRec.Dest);
  4522. SourceMD := SourceFD.CreateMappingData;
  4523. DestMD := DestFD.CreateMappingData;
  4524. DestMD2 := DestFD.CreateMappingData;
  4525. try
  4526. FuncRec.Position.Y := 0;
  4527. while FuncRec.Position.Y < TempHeight do begin
  4528. FuncRec.Position.X := 0;
  4529. while FuncRec.Position.X < TempWidth do begin
  4530. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  4531. DestFD.Unmap (DestData, FuncRec.Dest, DestMD);
  4532. aFunc(FuncRec);
  4533. DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
  4534. inc(FuncRec.Position.X);
  4535. end;
  4536. inc(FuncRec.Position.Y);
  4537. end;
  4538. finally
  4539. SourceFD.FreeMappingData(SourceMD);
  4540. DestFD.FreeMappingData(DestMD);
  4541. DestFD.FreeMappingData(DestMD2);
  4542. end;
  4543. end;
  4544. end;
  4545. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4546. function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
  4547. begin
  4548. result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
  4549. end;
  4550. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4551. function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
  4552. var
  4553. PixelData: TglBitmapPixelData;
  4554. begin
  4555. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4556. result := AddAlphaFromColorKeyFloat(
  4557. aRed / PixelData.Range.r,
  4558. aGreen / PixelData.Range.g,
  4559. aBlue / PixelData.Range.b,
  4560. aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
  4561. end;
  4562. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4563. function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
  4564. var
  4565. values: array[0..2] of Single;
  4566. tmp: Cardinal;
  4567. i: Integer;
  4568. PixelData: TglBitmapPixelData;
  4569. begin
  4570. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4571. with PixelData do begin
  4572. values[0] := aRed;
  4573. values[1] := aGreen;
  4574. values[2] := aBlue;
  4575. for i := 0 to 2 do begin
  4576. tmp := Trunc(Range.arr[i] * aDeviation);
  4577. Data.arr[i] := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
  4578. Range.arr[i] := Max(0, Trunc(Range.arr[i] * values[i] - tmp));
  4579. end;
  4580. Data.a := 0;
  4581. Range.a := 0;
  4582. end;
  4583. result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
  4584. end;
  4585. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4586. function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
  4587. begin
  4588. result := AddAlphaFromValueFloat(aAlpha / $FF);
  4589. end;
  4590. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4591. function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  4592. var
  4593. PixelData: TglBitmapPixelData;
  4594. begin
  4595. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4596. result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
  4597. end;
  4598. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4599. function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  4600. var
  4601. PixelData: TglBitmapPixelData;
  4602. begin
  4603. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4604. with PixelData do
  4605. Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
  4606. result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
  4607. end;
  4608. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4609. function TglBitmap.RemoveAlpha: Boolean;
  4610. var
  4611. FormatDesc: TFormatDescriptor;
  4612. begin
  4613. result := false;
  4614. FormatDesc := TFormatDescriptor.Get(Format);
  4615. if Assigned(Data) then begin
  4616. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  4617. raise EglBitmapUnsupportedFormat.Create(Format);
  4618. result := ConvertTo(FormatDesc.WithoutAlpha);
  4619. end;
  4620. end;
  4621. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4622. function TglBitmap.Clone: TglBitmap;
  4623. var
  4624. Temp: TglBitmap;
  4625. TempPtr: PByte;
  4626. Size: Integer;
  4627. begin
  4628. result := nil;
  4629. Temp := (ClassType.Create as TglBitmap);
  4630. try
  4631. // copy texture data if assigned
  4632. if Assigned(Data) then begin
  4633. Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
  4634. GetMem(TempPtr, Size);
  4635. try
  4636. Move(Data^, TempPtr^, Size);
  4637. Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
  4638. except
  4639. if Assigned(TempPtr) then
  4640. FreeMem(TempPtr);
  4641. raise;
  4642. end;
  4643. end else begin
  4644. TempPtr := nil;
  4645. Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
  4646. end;
  4647. // copy properties
  4648. Temp.fID := ID;
  4649. Temp.fTarget := Target;
  4650. Temp.fFormat := Format;
  4651. Temp.fMipMap := MipMap;
  4652. Temp.fAnisotropic := Anisotropic;
  4653. Temp.fBorderColor := fBorderColor;
  4654. Temp.fDeleteTextureOnFree := DeleteTextureOnFree;
  4655. Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
  4656. Temp.fFilterMin := fFilterMin;
  4657. Temp.fFilterMag := fFilterMag;
  4658. Temp.fWrapS := fWrapS;
  4659. Temp.fWrapT := fWrapT;
  4660. Temp.fWrapR := fWrapR;
  4661. Temp.fFilename := fFilename;
  4662. Temp.fCustomName := fCustomName;
  4663. Temp.fCustomNameW := fCustomNameW;
  4664. Temp.fCustomData := fCustomData;
  4665. result := Temp;
  4666. except
  4667. FreeAndNil(Temp);
  4668. raise;
  4669. end;
  4670. end;
  4671. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4672. function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
  4673. var
  4674. SourceFD, DestFD: TFormatDescriptor;
  4675. SourcePD, DestPD: TglBitmapPixelData;
  4676. ShiftData: TShiftData;
  4677. function CanCopyDirect: Boolean;
  4678. begin
  4679. result :=
  4680. ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  4681. ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  4682. ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  4683. ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  4684. end;
  4685. function CanShift: Boolean;
  4686. begin
  4687. result :=
  4688. ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  4689. ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  4690. ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  4691. ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  4692. end;
  4693. function GetShift(aSource, aDest: Cardinal) : ShortInt;
  4694. begin
  4695. result := 0;
  4696. while (aSource > aDest) and (aSource > 0) do begin
  4697. inc(result);
  4698. aSource := aSource shr 1;
  4699. end;
  4700. end;
  4701. begin
  4702. if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
  4703. SourceFD := TFormatDescriptor.Get(Format);
  4704. DestFD := TFormatDescriptor.Get(aFormat);
  4705. SourceFD.PreparePixel(SourcePD);
  4706. DestFD.PreparePixel (DestPD);
  4707. if CanCopyDirect then
  4708. result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
  4709. else if CanShift then begin
  4710. ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
  4711. ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
  4712. ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
  4713. ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
  4714. result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
  4715. end else
  4716. result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
  4717. end else
  4718. result := true;
  4719. end;
  4720. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4721. procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
  4722. begin
  4723. if aUseRGB or aUseAlpha then
  4724. AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
  4725. ((Byte(aUseAlpha) and 1) shl 1) or
  4726. (Byte(aUseRGB) and 1) ));
  4727. end;
  4728. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4729. procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  4730. begin
  4731. fBorderColor[0] := aRed;
  4732. fBorderColor[1] := aGreen;
  4733. fBorderColor[2] := aBlue;
  4734. fBorderColor[3] := aAlpha;
  4735. if (ID > 0) then begin
  4736. Bind(false);
  4737. glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
  4738. end;
  4739. end;
  4740. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4741. procedure TglBitmap.FreeData;
  4742. var
  4743. TempPtr: PByte;
  4744. begin
  4745. TempPtr := nil;
  4746. SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method
  4747. end;
  4748. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4749. procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
  4750. const aAlpha: Byte);
  4751. begin
  4752. FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
  4753. end;
  4754. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4755. procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
  4756. var
  4757. PixelData: TglBitmapPixelData;
  4758. begin
  4759. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4760. FillWithColorFloat(
  4761. aRed / PixelData.Range.r,
  4762. aGreen / PixelData.Range.g,
  4763. aBlue / PixelData.Range.b,
  4764. aAlpha / PixelData.Range.a);
  4765. end;
  4766. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4767. procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
  4768. var
  4769. PixelData: TglBitmapPixelData;
  4770. begin
  4771. TFormatDescriptor.Get(Format).PreparePixel(PixelData);
  4772. with PixelData do begin
  4773. Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
  4774. Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
  4775. Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
  4776. Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
  4777. end;
  4778. AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
  4779. end;
  4780. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4781. procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
  4782. begin
  4783. //check MIN filter
  4784. case aMin of
  4785. GL_NEAREST:
  4786. fFilterMin := GL_NEAREST;
  4787. GL_LINEAR:
  4788. fFilterMin := GL_LINEAR;
  4789. GL_NEAREST_MIPMAP_NEAREST:
  4790. fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
  4791. GL_LINEAR_MIPMAP_NEAREST:
  4792. fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
  4793. GL_NEAREST_MIPMAP_LINEAR:
  4794. fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
  4795. GL_LINEAR_MIPMAP_LINEAR:
  4796. fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
  4797. else
  4798. raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
  4799. end;
  4800. //check MAG filter
  4801. case aMag of
  4802. GL_NEAREST:
  4803. fFilterMag := GL_NEAREST;
  4804. GL_LINEAR:
  4805. fFilterMag := GL_LINEAR;
  4806. else
  4807. raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
  4808. end;
  4809. //apply filter
  4810. if (ID > 0) then begin
  4811. Bind(false);
  4812. glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
  4813. if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
  4814. case fFilterMin of
  4815. GL_NEAREST, GL_LINEAR:
  4816. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  4817. GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
  4818. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
  4819. GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
  4820. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
  4821. end;
  4822. end else
  4823. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  4824. end;
  4825. end;
  4826. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4827. procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
  4828. procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
  4829. begin
  4830. case aValue of
  4831. GL_CLAMP:
  4832. aTarget := GL_CLAMP;
  4833. GL_REPEAT:
  4834. aTarget := GL_REPEAT;
  4835. GL_CLAMP_TO_EDGE: begin
  4836. if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
  4837. aTarget := GL_CLAMP_TO_EDGE
  4838. else
  4839. aTarget := GL_CLAMP;
  4840. end;
  4841. GL_CLAMP_TO_BORDER: begin
  4842. if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
  4843. aTarget := GL_CLAMP_TO_BORDER
  4844. else
  4845. aTarget := GL_CLAMP;
  4846. end;
  4847. GL_MIRRORED_REPEAT: begin
  4848. if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
  4849. aTarget := GL_MIRRORED_REPEAT
  4850. else
  4851. raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
  4852. end;
  4853. else
  4854. raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
  4855. end;
  4856. end;
  4857. begin
  4858. CheckAndSetWrap(S, fWrapS);
  4859. CheckAndSetWrap(T, fWrapT);
  4860. CheckAndSetWrap(R, fWrapR);
  4861. if (ID > 0) then begin
  4862. Bind(false);
  4863. glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
  4864. glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
  4865. glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
  4866. end;
  4867. end;
  4868. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4869. procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
  4870. procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
  4871. begin
  4872. if (aValue = GL_ZERO) or (aValue = GL_ONE) or (aValue = GL_ALPHA) or
  4873. (aValue = GL_RED) or (aValue = GL_GREEN) or (aValue = GL_BLUE) then
  4874. fSwizzle[aIndex] := aValue
  4875. else
  4876. raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
  4877. end;
  4878. begin
  4879. if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  4880. raise EglBitmapNotSupported.Create('texture swizzle is not supported');
  4881. CheckAndSetValue(r, 0);
  4882. CheckAndSetValue(g, 1);
  4883. CheckAndSetValue(b, 2);
  4884. CheckAndSetValue(a, 3);
  4885. if (ID > 0) then begin
  4886. Bind(false);
  4887. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, @fSwizzle[0]);
  4888. end;
  4889. end;
  4890. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4891. procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
  4892. begin
  4893. if aEnableTextureUnit then
  4894. glEnable(Target);
  4895. if (ID > 0) then
  4896. glBindTexture(Target, ID);
  4897. end;
  4898. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4899. procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
  4900. begin
  4901. if aDisableTextureUnit then
  4902. glDisable(Target);
  4903. glBindTexture(Target, 0);
  4904. end;
  4905. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4906. constructor TglBitmap.Create;
  4907. begin
  4908. if (ClassType = TglBitmap) then
  4909. raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
  4910. {$IFDEF GLB_NATIVE_OGL}
  4911. glbReadOpenGLExtensions;
  4912. {$ENDIF}
  4913. inherited Create;
  4914. end;
  4915. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4916. constructor TglBitmap.Create(const aFileName: String);
  4917. begin
  4918. Create;
  4919. LoadFromFile(aFileName);
  4920. end;
  4921. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4922. constructor TglBitmap.Create(const aStream: TStream);
  4923. begin
  4924. Create;
  4925. LoadFromStream(aStream);
  4926. end;
  4927. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4928. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat);
  4929. var
  4930. Image: PByte;
  4931. ImageSize: Integer;
  4932. begin
  4933. Create;
  4934. ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  4935. GetMem(Image, ImageSize);
  4936. try
  4937. FillChar(Image^, ImageSize, #$FF);
  4938. SetDataPointer(Image, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  4939. except
  4940. if Assigned(Image) then
  4941. FreeMem(Image);
  4942. raise;
  4943. end;
  4944. end;
  4945. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4946. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat;
  4947. const aFunc: TglBitmapFunction; const aArgs: Pointer);
  4948. begin
  4949. Create;
  4950. LoadFromFunc(aSize, aFunc, aFormat, aArgs);
  4951. end;
  4952. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4953. constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
  4954. begin
  4955. Create;
  4956. LoadFromResource(aInstance, aResource, aResType);
  4957. end;
  4958. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4959. constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  4960. begin
  4961. Create;
  4962. LoadFromResourceID(aInstance, aResourceID, aResType);
  4963. end;
  4964. {$IFDEF GLB_SUPPORT_PNG_READ}
  4965. {$IF DEFINED(GLB_LAZ_PNG)}
  4966. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4967. //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4968. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4969. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  4970. const
  4971. MAGIC_LEN = 8;
  4972. PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
  4973. var
  4974. png: TPortableNetworkGraphic;
  4975. intf: TLazIntfImage;
  4976. StreamPos: Int64;
  4977. magic: String[MAGIC_LEN];
  4978. begin
  4979. result := true;
  4980. StreamPos := aStream.Position;
  4981. SetLength(magic, MAGIC_LEN);
  4982. aStream.Read(magic[1], MAGIC_LEN);
  4983. aStream.Position := StreamPos;
  4984. if (magic <> PNG_MAGIC) then begin
  4985. result := false;
  4986. exit;
  4987. end;
  4988. png := TPortableNetworkGraphic.Create;
  4989. try try
  4990. png.LoadFromStream(aStream);
  4991. intf := png.CreateIntfImage;
  4992. try try
  4993. AssignFromLazIntfImage(intf);
  4994. except
  4995. result := false;
  4996. aStream.Position := StreamPos;
  4997. exit;
  4998. end;
  4999. finally
  5000. intf.Free;
  5001. end;
  5002. except
  5003. result := false;
  5004. aStream.Position := StreamPos;
  5005. exit;
  5006. end;
  5007. finally
  5008. png.Free;
  5009. end;
  5010. end;
  5011. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
  5012. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5013. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5014. var
  5015. Surface: PSDL_Surface;
  5016. RWops: PSDL_RWops;
  5017. begin
  5018. result := false;
  5019. RWops := glBitmapCreateRWops(aStream);
  5020. try
  5021. if IMG_isPNG(RWops) > 0 then begin
  5022. Surface := IMG_LoadPNG_RW(RWops);
  5023. try
  5024. AssignFromSurface(Surface);
  5025. result := true;
  5026. finally
  5027. SDL_FreeSurface(Surface);
  5028. end;
  5029. end;
  5030. finally
  5031. SDL_FreeRW(RWops);
  5032. end;
  5033. end;
  5034. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  5035. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5036. procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  5037. begin
  5038. TStream(png_get_io_ptr(png)).Read(buffer^, size);
  5039. end;
  5040. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5041. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5042. var
  5043. StreamPos: Int64;
  5044. signature: array [0..7] of byte;
  5045. png: png_structp;
  5046. png_info: png_infop;
  5047. TempHeight, TempWidth: Integer;
  5048. Format: TglBitmapFormat;
  5049. png_data: pByte;
  5050. png_rows: array of pByte;
  5051. Row, LineSize: Integer;
  5052. begin
  5053. result := false;
  5054. if not init_libPNG then
  5055. raise Exception.Create('LoadPNG - unable to initialize libPNG.');
  5056. try
  5057. // signature
  5058. StreamPos := aStream.Position;
  5059. aStream.Read(signature{%H-}, 8);
  5060. aStream.Position := StreamPos;
  5061. if png_check_sig(@signature, 8) <> 0 then begin
  5062. // png read struct
  5063. png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  5064. if png = nil then
  5065. raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
  5066. // png info
  5067. png_info := png_create_info_struct(png);
  5068. if png_info = nil then begin
  5069. png_destroy_read_struct(@png, nil, nil);
  5070. raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
  5071. end;
  5072. // set read callback
  5073. png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
  5074. // read informations
  5075. png_read_info(png, png_info);
  5076. // size
  5077. TempHeight := png_get_image_height(png, png_info);
  5078. TempWidth := png_get_image_width(png, png_info);
  5079. // format
  5080. case png_get_color_type(png, png_info) of
  5081. PNG_COLOR_TYPE_GRAY:
  5082. Format := tfLuminance8;
  5083. PNG_COLOR_TYPE_GRAY_ALPHA:
  5084. Format := tfLuminance8Alpha8;
  5085. PNG_COLOR_TYPE_RGB:
  5086. Format := tfRGB8;
  5087. PNG_COLOR_TYPE_RGB_ALPHA:
  5088. Format := tfRGBA8;
  5089. else
  5090. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5091. end;
  5092. // cut upper 8 bit from 16 bit formats
  5093. if png_get_bit_depth(png, png_info) > 8 then
  5094. png_set_strip_16(png);
  5095. // expand bitdepth smaller than 8
  5096. if png_get_bit_depth(png, png_info) < 8 then
  5097. png_set_expand(png);
  5098. // allocating mem for scanlines
  5099. LineSize := png_get_rowbytes(png, png_info);
  5100. GetMem(png_data, TempHeight * LineSize);
  5101. try
  5102. SetLength(png_rows, TempHeight);
  5103. for Row := Low(png_rows) to High(png_rows) do begin
  5104. png_rows[Row] := png_data;
  5105. Inc(png_rows[Row], Row * LineSize);
  5106. end;
  5107. // read complete image into scanlines
  5108. png_read_image(png, @png_rows[0]);
  5109. // read end
  5110. png_read_end(png, png_info);
  5111. // destroy read struct
  5112. png_destroy_read_struct(@png, @png_info, nil);
  5113. SetLength(png_rows, 0);
  5114. // set new data
  5115. SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
  5116. result := true;
  5117. except
  5118. if Assigned(png_data) then
  5119. FreeMem(png_data);
  5120. raise;
  5121. end;
  5122. end;
  5123. finally
  5124. quit_libPNG;
  5125. end;
  5126. end;
  5127. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  5128. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5129. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5130. var
  5131. StreamPos: Int64;
  5132. Png: TPNGObject;
  5133. Header: String[8];
  5134. Row, Col, PixSize, LineSize: Integer;
  5135. NewImage, pSource, pDest, pAlpha: pByte;
  5136. PngFormat: TglBitmapFormat;
  5137. FormatDesc: TFormatDescriptor;
  5138. const
  5139. PngHeader: String[8] = #137#80#78#71#13#10#26#10;
  5140. begin
  5141. result := false;
  5142. StreamPos := aStream.Position;
  5143. aStream.Read(Header[0], SizeOf(Header));
  5144. aStream.Position := StreamPos;
  5145. {Test if the header matches}
  5146. if Header = PngHeader then begin
  5147. Png := TPNGObject.Create;
  5148. try
  5149. Png.LoadFromStream(aStream);
  5150. case Png.Header.ColorType of
  5151. COLOR_GRAYSCALE:
  5152. PngFormat := tfLuminance8;
  5153. COLOR_GRAYSCALEALPHA:
  5154. PngFormat := tfLuminance8Alpha8;
  5155. COLOR_RGB:
  5156. PngFormat := tfBGR8;
  5157. COLOR_RGBALPHA:
  5158. PngFormat := tfBGRA8;
  5159. else
  5160. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5161. end;
  5162. FormatDesc := TFormatDescriptor.Get(PngFormat);
  5163. PixSize := Round(FormatDesc.PixelSize);
  5164. LineSize := FormatDesc.GetSize(Png.Header.Width, 1);
  5165. GetMem(NewImage, LineSize * Integer(Png.Header.Height));
  5166. try
  5167. pDest := NewImage;
  5168. case Png.Header.ColorType of
  5169. COLOR_RGB, COLOR_GRAYSCALE:
  5170. begin
  5171. for Row := 0 to Png.Height -1 do begin
  5172. Move (Png.Scanline[Row]^, pDest^, LineSize);
  5173. Inc(pDest, LineSize);
  5174. end;
  5175. end;
  5176. COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
  5177. begin
  5178. PixSize := PixSize -1;
  5179. for Row := 0 to Png.Height -1 do begin
  5180. pSource := Png.Scanline[Row];
  5181. pAlpha := pByte(Png.AlphaScanline[Row]);
  5182. for Col := 0 to Png.Width -1 do begin
  5183. Move (pSource^, pDest^, PixSize);
  5184. Inc(pSource, PixSize);
  5185. Inc(pDest, PixSize);
  5186. pDest^ := pAlpha^;
  5187. inc(pAlpha);
  5188. Inc(pDest);
  5189. end;
  5190. end;
  5191. end;
  5192. else
  5193. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5194. end;
  5195. SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
  5196. result := true;
  5197. except
  5198. if Assigned(NewImage) then
  5199. FreeMem(NewImage);
  5200. raise;
  5201. end;
  5202. finally
  5203. Png.Free;
  5204. end;
  5205. end;
  5206. end;
  5207. {$IFEND}
  5208. {$ENDIF}
  5209. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  5210. {$IFDEF GLB_LIB_PNG}
  5211. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5212. procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  5213. begin
  5214. TStream(png_get_io_ptr(png)).Write(buffer^, size);
  5215. end;
  5216. {$ENDIF}
  5217. {$IF DEFINED(GLB_LAZ_PNG)}
  5218. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5219. procedure TglBitmap.SavePNG(const aStream: TStream);
  5220. var
  5221. png: TPortableNetworkGraphic;
  5222. intf: TLazIntfImage;
  5223. raw: TRawImage;
  5224. begin
  5225. png := TPortableNetworkGraphic.Create;
  5226. intf := TLazIntfImage.Create(0, 0);
  5227. try
  5228. if not AssignToLazIntfImage(intf) then
  5229. raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
  5230. intf.GetRawImage(raw);
  5231. png.LoadFromRawImage(raw, false);
  5232. png.SaveToStream(aStream);
  5233. finally
  5234. png.Free;
  5235. intf.Free;
  5236. end;
  5237. end;
  5238. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  5239. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5240. procedure TglBitmap.SavePNG(const aStream: TStream);
  5241. var
  5242. png: png_structp;
  5243. png_info: png_infop;
  5244. png_rows: array of pByte;
  5245. LineSize: Integer;
  5246. ColorType: Integer;
  5247. Row: Integer;
  5248. FormatDesc: TFormatDescriptor;
  5249. begin
  5250. if not (ftPNG in FormatGetSupportedFiles(Format)) then
  5251. raise EglBitmapUnsupportedFormat.Create(Format);
  5252. if not init_libPNG then
  5253. raise Exception.Create('unable to initialize libPNG.');
  5254. try
  5255. case Format of
  5256. tfAlpha8, tfLuminance8:
  5257. ColorType := PNG_COLOR_TYPE_GRAY;
  5258. tfLuminance8Alpha8:
  5259. ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
  5260. tfBGR8, tfRGB8:
  5261. ColorType := PNG_COLOR_TYPE_RGB;
  5262. tfBGRA8, tfRGBA8:
  5263. ColorType := PNG_COLOR_TYPE_RGBA;
  5264. else
  5265. raise EglBitmapUnsupportedFormat.Create(Format);
  5266. end;
  5267. FormatDesc := TFormatDescriptor.Get(Format);
  5268. LineSize := FormatDesc.GetSize(Width, 1);
  5269. // creating array for scanline
  5270. SetLength(png_rows, Height);
  5271. try
  5272. for Row := 0 to Height - 1 do begin
  5273. png_rows[Row] := Data;
  5274. Inc(png_rows[Row], Row * LineSize)
  5275. end;
  5276. // write struct
  5277. png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  5278. if png = nil then
  5279. raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
  5280. // create png info
  5281. png_info := png_create_info_struct(png);
  5282. if png_info = nil then begin
  5283. png_destroy_write_struct(@png, nil);
  5284. raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
  5285. end;
  5286. // set read callback
  5287. png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
  5288. // set compression
  5289. png_set_compression_level(png, 6);
  5290. if Format in [tfBGR8, tfBGRA8] then
  5291. png_set_bgr(png);
  5292. png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
  5293. png_write_info(png, png_info);
  5294. png_write_image(png, @png_rows[0]);
  5295. png_write_end(png, png_info);
  5296. png_destroy_write_struct(@png, @png_info);
  5297. finally
  5298. SetLength(png_rows, 0);
  5299. end;
  5300. finally
  5301. quit_libPNG;
  5302. end;
  5303. end;
  5304. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  5305. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5306. procedure TglBitmap.SavePNG(const aStream: TStream);
  5307. var
  5308. Png: TPNGObject;
  5309. pSource, pDest: pByte;
  5310. X, Y, PixSize: Integer;
  5311. ColorType: Cardinal;
  5312. Alpha: Boolean;
  5313. pTemp: pByte;
  5314. Temp: Byte;
  5315. begin
  5316. if not (ftPNG in FormatGetSupportedFiles (Format)) then
  5317. raise EglBitmapUnsupportedFormat.Create(Format);
  5318. case Format of
  5319. tfAlpha8, tfLuminance8: begin
  5320. ColorType := COLOR_GRAYSCALE;
  5321. PixSize := 1;
  5322. Alpha := false;
  5323. end;
  5324. tfLuminance8Alpha8: begin
  5325. ColorType := COLOR_GRAYSCALEALPHA;
  5326. PixSize := 1;
  5327. Alpha := true;
  5328. end;
  5329. tfBGR8, tfRGB8: begin
  5330. ColorType := COLOR_RGB;
  5331. PixSize := 3;
  5332. Alpha := false;
  5333. end;
  5334. tfBGRA8, tfRGBA8: begin
  5335. ColorType := COLOR_RGBALPHA;
  5336. PixSize := 3;
  5337. Alpha := true
  5338. end;
  5339. else
  5340. raise EglBitmapUnsupportedFormat.Create(Format);
  5341. end;
  5342. Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
  5343. try
  5344. // Copy ImageData
  5345. pSource := Data;
  5346. for Y := 0 to Height -1 do begin
  5347. pDest := png.ScanLine[Y];
  5348. for X := 0 to Width -1 do begin
  5349. Move(pSource^, pDest^, PixSize);
  5350. Inc(pDest, PixSize);
  5351. Inc(pSource, PixSize);
  5352. if Alpha then begin
  5353. png.AlphaScanline[Y]^[X] := pSource^;
  5354. Inc(pSource);
  5355. end;
  5356. end;
  5357. // convert RGB line to BGR
  5358. if Format in [tfRGB8, tfRGBA8] then begin
  5359. pTemp := png.ScanLine[Y];
  5360. for X := 0 to Width -1 do begin
  5361. Temp := pByteArray(pTemp)^[0];
  5362. pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
  5363. pByteArray(pTemp)^[2] := Temp;
  5364. Inc(pTemp, 3);
  5365. end;
  5366. end;
  5367. end;
  5368. // Save to Stream
  5369. Png.CompressionLevel := 6;
  5370. Png.SaveToStream(aStream);
  5371. finally
  5372. FreeAndNil(Png);
  5373. end;
  5374. end;
  5375. {$IFEND}
  5376. {$ENDIF}
  5377. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5378. //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5379. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5380. {$IFDEF GLB_LIB_JPEG}
  5381. type
  5382. glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
  5383. glBitmap_libJPEG_source_mgr = record
  5384. pub: jpeg_source_mgr;
  5385. SrcStream: TStream;
  5386. SrcBuffer: array [1..4096] of byte;
  5387. end;
  5388. glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
  5389. glBitmap_libJPEG_dest_mgr = record
  5390. pub: jpeg_destination_mgr;
  5391. DestStream: TStream;
  5392. DestBuffer: array [1..4096] of byte;
  5393. end;
  5394. procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
  5395. begin
  5396. //DUMMY
  5397. end;
  5398. procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
  5399. begin
  5400. //DUMMY
  5401. end;
  5402. procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
  5403. begin
  5404. //DUMMY
  5405. end;
  5406. procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
  5407. begin
  5408. //DUMMY
  5409. end;
  5410. procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
  5411. begin
  5412. //DUMMY
  5413. end;
  5414. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5415. function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
  5416. var
  5417. src: glBitmap_libJPEG_source_mgr_ptr;
  5418. bytes: integer;
  5419. begin
  5420. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  5421. bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
  5422. if (bytes <= 0) then begin
  5423. src^.SrcBuffer[1] := $FF;
  5424. src^.SrcBuffer[2] := JPEG_EOI;
  5425. bytes := 2;
  5426. end;
  5427. src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
  5428. src^.pub.bytes_in_buffer := bytes;
  5429. result := true;
  5430. end;
  5431. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5432. procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
  5433. var
  5434. src: glBitmap_libJPEG_source_mgr_ptr;
  5435. begin
  5436. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  5437. if num_bytes > 0 then begin
  5438. // wanted byte isn't in buffer so set stream position and read buffer
  5439. if num_bytes > src^.pub.bytes_in_buffer then begin
  5440. src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
  5441. src^.pub.fill_input_buffer(cinfo);
  5442. end else begin
  5443. // wanted byte is in buffer so only skip
  5444. inc(src^.pub.next_input_byte, num_bytes);
  5445. dec(src^.pub.bytes_in_buffer, num_bytes);
  5446. end;
  5447. end;
  5448. end;
  5449. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5450. function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
  5451. var
  5452. dest: glBitmap_libJPEG_dest_mgr_ptr;
  5453. begin
  5454. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  5455. if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
  5456. // write complete buffer
  5457. dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
  5458. // reset buffer
  5459. dest^.pub.next_output_byte := @dest^.DestBuffer[1];
  5460. dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
  5461. end;
  5462. result := true;
  5463. end;
  5464. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5465. procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
  5466. var
  5467. Idx: Integer;
  5468. dest: glBitmap_libJPEG_dest_mgr_ptr;
  5469. begin
  5470. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  5471. for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
  5472. // check for endblock
  5473. if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
  5474. // write endblock
  5475. dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
  5476. // leave
  5477. break;
  5478. end else
  5479. dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
  5480. end;
  5481. end;
  5482. {$ENDIF}
  5483. {$IFDEF GLB_SUPPORT_JPEG_READ}
  5484. {$IF DEFINED(GLB_LAZ_JPEG)}
  5485. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5486. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5487. const
  5488. MAGIC_LEN = 2;
  5489. JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
  5490. var
  5491. jpeg: TJPEGImage;
  5492. intf: TLazIntfImage;
  5493. StreamPos: Int64;
  5494. magic: String[MAGIC_LEN];
  5495. begin
  5496. result := true;
  5497. StreamPos := aStream.Position;
  5498. SetLength(magic, MAGIC_LEN);
  5499. aStream.Read(magic[1], MAGIC_LEN);
  5500. aStream.Position := StreamPos;
  5501. if (magic <> JPEG_MAGIC) then begin
  5502. result := false;
  5503. exit;
  5504. end;
  5505. jpeg := TJPEGImage.Create;
  5506. try try
  5507. jpeg.LoadFromStream(aStream);
  5508. intf := TLazIntfImage.Create(0, 0);
  5509. try try
  5510. intf.LoadFromBitmap(jpeg.BitmapHandle, jpeg.MaskHandle);
  5511. AssignFromLazIntfImage(intf);
  5512. except
  5513. result := false;
  5514. aStream.Position := StreamPos;
  5515. exit;
  5516. end;
  5517. finally
  5518. intf.Free;
  5519. end;
  5520. except
  5521. result := false;
  5522. aStream.Position := StreamPos;
  5523. exit;
  5524. end;
  5525. finally
  5526. jpeg.Free;
  5527. end;
  5528. end;
  5529. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
  5530. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5531. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5532. var
  5533. Surface: PSDL_Surface;
  5534. RWops: PSDL_RWops;
  5535. begin
  5536. result := false;
  5537. RWops := glBitmapCreateRWops(aStream);
  5538. try
  5539. if IMG_isJPG(RWops) > 0 then begin
  5540. Surface := IMG_LoadJPG_RW(RWops);
  5541. try
  5542. AssignFromSurface(Surface);
  5543. result := true;
  5544. finally
  5545. SDL_FreeSurface(Surface);
  5546. end;
  5547. end;
  5548. finally
  5549. SDL_FreeRW(RWops);
  5550. end;
  5551. end;
  5552. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  5553. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5554. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5555. var
  5556. StreamPos: Int64;
  5557. Temp: array[0..1]of Byte;
  5558. jpeg: jpeg_decompress_struct;
  5559. jpeg_err: jpeg_error_mgr;
  5560. IntFormat: TglBitmapFormat;
  5561. pImage: pByte;
  5562. TempHeight, TempWidth: Integer;
  5563. pTemp: pByte;
  5564. Row: Integer;
  5565. FormatDesc: TFormatDescriptor;
  5566. begin
  5567. result := false;
  5568. if not init_libJPEG then
  5569. raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
  5570. try
  5571. // reading first two bytes to test file and set cursor back to begin
  5572. StreamPos := aStream.Position;
  5573. aStream.Read({%H-}Temp[0], 2);
  5574. aStream.Position := StreamPos;
  5575. // if Bitmap then read file.
  5576. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  5577. FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
  5578. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  5579. // error managment
  5580. jpeg.err := jpeg_std_error(@jpeg_err);
  5581. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  5582. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  5583. // decompression struct
  5584. jpeg_create_decompress(@jpeg);
  5585. // allocation space for streaming methods
  5586. jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
  5587. // seeting up custom functions
  5588. with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
  5589. pub.init_source := glBitmap_libJPEG_init_source;
  5590. pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
  5591. pub.skip_input_data := glBitmap_libJPEG_skip_input_data;
  5592. pub.resync_to_restart := jpeg_resync_to_restart; // use default method
  5593. pub.term_source := glBitmap_libJPEG_term_source;
  5594. pub.bytes_in_buffer := 0; // forces fill_input_buffer on first read
  5595. pub.next_input_byte := nil; // until buffer loaded
  5596. SrcStream := aStream;
  5597. end;
  5598. // set global decoding state
  5599. jpeg.global_state := DSTATE_START;
  5600. // read header of jpeg
  5601. jpeg_read_header(@jpeg, false);
  5602. // setting output parameter
  5603. case jpeg.jpeg_color_space of
  5604. JCS_GRAYSCALE:
  5605. begin
  5606. jpeg.out_color_space := JCS_GRAYSCALE;
  5607. IntFormat := tfLuminance8;
  5608. end;
  5609. else
  5610. jpeg.out_color_space := JCS_RGB;
  5611. IntFormat := tfRGB8;
  5612. end;
  5613. // reading image
  5614. jpeg_start_decompress(@jpeg);
  5615. TempHeight := jpeg.output_height;
  5616. TempWidth := jpeg.output_width;
  5617. FormatDesc := TFormatDescriptor.Get(IntFormat);
  5618. // creating new image
  5619. GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
  5620. try
  5621. pTemp := pImage;
  5622. for Row := 0 to TempHeight -1 do begin
  5623. jpeg_read_scanlines(@jpeg, @pTemp, 1);
  5624. Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
  5625. end;
  5626. // finish decompression
  5627. jpeg_finish_decompress(@jpeg);
  5628. // destroy decompression
  5629. jpeg_destroy_decompress(@jpeg);
  5630. SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  5631. result := true;
  5632. except
  5633. if Assigned(pImage) then
  5634. FreeMem(pImage);
  5635. raise;
  5636. end;
  5637. end;
  5638. finally
  5639. quit_libJPEG;
  5640. end;
  5641. end;
  5642. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  5643. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5644. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5645. var
  5646. bmp: TBitmap;
  5647. jpg: TJPEGImage;
  5648. StreamPos: Int64;
  5649. Temp: array[0..1]of Byte;
  5650. begin
  5651. result := false;
  5652. // reading first two bytes to test file and set cursor back to begin
  5653. StreamPos := aStream.Position;
  5654. aStream.Read(Temp[0], 2);
  5655. aStream.Position := StreamPos;
  5656. // if Bitmap then read file.
  5657. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  5658. bmp := TBitmap.Create;
  5659. try
  5660. jpg := TJPEGImage.Create;
  5661. try
  5662. jpg.LoadFromStream(aStream);
  5663. bmp.Assign(jpg);
  5664. result := AssignFromBitmap(bmp);
  5665. finally
  5666. jpg.Free;
  5667. end;
  5668. finally
  5669. bmp.Free;
  5670. end;
  5671. end;
  5672. end;
  5673. {$IFEND}
  5674. {$ENDIF}
  5675. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  5676. {$IF DEFINED(GLB_LAZ_JPEG)}
  5677. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5678. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  5679. var
  5680. jpeg: TJPEGImage;
  5681. intf: TLazIntfImage;
  5682. raw: TRawImage;
  5683. begin
  5684. jpeg := TJPEGImage.Create;
  5685. intf := TLazIntfImage.Create(0, 0);
  5686. try
  5687. if not AssignToLazIntfImage(intf) then
  5688. raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
  5689. intf.GetRawImage(raw);
  5690. jpeg.LoadFromRawImage(raw, false);
  5691. jpeg.SaveToStream(aStream);
  5692. finally
  5693. intf.Free;
  5694. jpeg.Free;
  5695. end;
  5696. end;
  5697. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  5698. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5699. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  5700. var
  5701. jpeg: jpeg_compress_struct;
  5702. jpeg_err: jpeg_error_mgr;
  5703. Row: Integer;
  5704. pTemp, pTemp2: pByte;
  5705. procedure CopyRow(pDest, pSource: pByte);
  5706. var
  5707. X: Integer;
  5708. begin
  5709. for X := 0 to Width - 1 do begin
  5710. pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
  5711. pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
  5712. pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
  5713. Inc(pDest, 3);
  5714. Inc(pSource, 3);
  5715. end;
  5716. end;
  5717. begin
  5718. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  5719. raise EglBitmapUnsupportedFormat.Create(Format);
  5720. if not init_libJPEG then
  5721. raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
  5722. try
  5723. FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
  5724. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  5725. // error managment
  5726. jpeg.err := jpeg_std_error(@jpeg_err);
  5727. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  5728. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  5729. // compression struct
  5730. jpeg_create_compress(@jpeg);
  5731. // allocation space for streaming methods
  5732. jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
  5733. // seeting up custom functions
  5734. with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
  5735. pub.init_destination := glBitmap_libJPEG_init_destination;
  5736. pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
  5737. pub.term_destination := glBitmap_libJPEG_term_destination;
  5738. pub.next_output_byte := @DestBuffer[1];
  5739. pub.free_in_buffer := Length(DestBuffer);
  5740. DestStream := aStream;
  5741. end;
  5742. // very important state
  5743. jpeg.global_state := CSTATE_START;
  5744. jpeg.image_width := Width;
  5745. jpeg.image_height := Height;
  5746. case Format of
  5747. tfAlpha8, tfLuminance8: begin
  5748. jpeg.input_components := 1;
  5749. jpeg.in_color_space := JCS_GRAYSCALE;
  5750. end;
  5751. tfRGB8, tfBGR8: begin
  5752. jpeg.input_components := 3;
  5753. jpeg.in_color_space := JCS_RGB;
  5754. end;
  5755. end;
  5756. jpeg_set_defaults(@jpeg);
  5757. jpeg_set_quality(@jpeg, 95, true);
  5758. jpeg_start_compress(@jpeg, true);
  5759. pTemp := Data;
  5760. if Format = tfBGR8 then
  5761. GetMem(pTemp2, fRowSize)
  5762. else
  5763. pTemp2 := pTemp;
  5764. try
  5765. for Row := 0 to jpeg.image_height -1 do begin
  5766. // prepare row
  5767. if Format = tfBGR8 then
  5768. CopyRow(pTemp2, pTemp)
  5769. else
  5770. pTemp2 := pTemp;
  5771. // write row
  5772. jpeg_write_scanlines(@jpeg, @pTemp2, 1);
  5773. inc(pTemp, fRowSize);
  5774. end;
  5775. finally
  5776. // free memory
  5777. if Format = tfBGR8 then
  5778. FreeMem(pTemp2);
  5779. end;
  5780. jpeg_finish_compress(@jpeg);
  5781. jpeg_destroy_compress(@jpeg);
  5782. finally
  5783. quit_libJPEG;
  5784. end;
  5785. end;
  5786. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  5787. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5788. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  5789. var
  5790. Bmp: TBitmap;
  5791. Jpg: TJPEGImage;
  5792. begin
  5793. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  5794. raise EglBitmapUnsupportedFormat.Create(Format);
  5795. Bmp := TBitmap.Create;
  5796. try
  5797. Jpg := TJPEGImage.Create;
  5798. try
  5799. AssignToBitmap(Bmp);
  5800. if (Format in [tfAlpha8, tfLuminance8]) then begin
  5801. Jpg.Grayscale := true;
  5802. Jpg.PixelFormat := jf8Bit;
  5803. end;
  5804. Jpg.Assign(Bmp);
  5805. Jpg.SaveToStream(aStream);
  5806. finally
  5807. FreeAndNil(Jpg);
  5808. end;
  5809. finally
  5810. FreeAndNil(Bmp);
  5811. end;
  5812. end;
  5813. {$IFEND}
  5814. {$ENDIF}
  5815. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5816. //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5817. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5818. const
  5819. BMP_MAGIC = $4D42;
  5820. BMP_COMP_RGB = 0;
  5821. BMP_COMP_RLE8 = 1;
  5822. BMP_COMP_RLE4 = 2;
  5823. BMP_COMP_BITFIELDS = 3;
  5824. type
  5825. TBMPHeader = packed record
  5826. bfType: Word;
  5827. bfSize: Cardinal;
  5828. bfReserved1: Word;
  5829. bfReserved2: Word;
  5830. bfOffBits: Cardinal;
  5831. end;
  5832. TBMPInfo = packed record
  5833. biSize: Cardinal;
  5834. biWidth: Longint;
  5835. biHeight: Longint;
  5836. biPlanes: Word;
  5837. biBitCount: Word;
  5838. biCompression: Cardinal;
  5839. biSizeImage: Cardinal;
  5840. biXPelsPerMeter: Longint;
  5841. biYPelsPerMeter: Longint;
  5842. biClrUsed: Cardinal;
  5843. biClrImportant: Cardinal;
  5844. end;
  5845. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5846. function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
  5847. //////////////////////////////////////////////////////////////////////////////////////////////////
  5848. function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapColorRec): TglBitmapFormat;
  5849. begin
  5850. result := tfEmpty;
  5851. aStream.Read(aInfo{%H-}, SizeOf(aInfo));
  5852. FillChar(aMask{%H-}, SizeOf(aMask), 0);
  5853. //Read Compression
  5854. case aInfo.biCompression of
  5855. BMP_COMP_RLE4,
  5856. BMP_COMP_RLE8: begin
  5857. raise EglBitmap.Create('RLE compression is not supported');
  5858. end;
  5859. BMP_COMP_BITFIELDS: begin
  5860. if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
  5861. aStream.Read(aMask.r, SizeOf(aMask.r));
  5862. aStream.Read(aMask.g, SizeOf(aMask.g));
  5863. aStream.Read(aMask.b, SizeOf(aMask.b));
  5864. aStream.Read(aMask.a, SizeOf(aMask.a));
  5865. end else
  5866. raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
  5867. end;
  5868. end;
  5869. //get suitable format
  5870. case aInfo.biBitCount of
  5871. 8: result := tfLuminance8;
  5872. 16: result := tfBGR5;
  5873. 24: result := tfBGR8;
  5874. 32: result := tfBGRA8;
  5875. end;
  5876. end;
  5877. function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
  5878. var
  5879. i, c: Integer;
  5880. ColorTable: TbmpColorTable;
  5881. begin
  5882. result := nil;
  5883. if (aInfo.biBitCount >= 16) then
  5884. exit;
  5885. aFormat := tfLuminance8;
  5886. c := aInfo.biClrUsed;
  5887. if (c = 0) then
  5888. c := 1 shl aInfo.biBitCount;
  5889. SetLength(ColorTable, c);
  5890. for i := 0 to c-1 do begin
  5891. aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
  5892. if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
  5893. aFormat := tfRGB8;
  5894. end;
  5895. result := TbmpColorTableFormat.Create;
  5896. result.PixelSize := aInfo.biBitCount / 8;
  5897. result.ColorTable := ColorTable;
  5898. result.Range := glBitmapColorRec($FF, $FF, $FF, $00);
  5899. end;
  5900. //////////////////////////////////////////////////////////////////////////////////////////////////
  5901. function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
  5902. const aInfo: TBMPInfo): TbmpBitfieldFormat;
  5903. var
  5904. TmpFormat: TglBitmapFormat;
  5905. FormatDesc: TFormatDescriptor;
  5906. begin
  5907. result := nil;
  5908. if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
  5909. for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  5910. FormatDesc := TFormatDescriptor.Get(TmpFormat);
  5911. if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
  5912. aFormat := FormatDesc.Format;
  5913. exit;
  5914. end;
  5915. end;
  5916. if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
  5917. aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
  5918. if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
  5919. aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
  5920. result := TbmpBitfieldFormat.Create;
  5921. result.PixelSize := aInfo.biBitCount / 8;
  5922. result.RedMask := aMask.r;
  5923. result.GreenMask := aMask.g;
  5924. result.BlueMask := aMask.b;
  5925. result.AlphaMask := aMask.a;
  5926. end;
  5927. end;
  5928. var
  5929. //simple types
  5930. StartPos: Int64;
  5931. ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
  5932. PaddingBuff: Cardinal;
  5933. LineBuf, ImageData, TmpData: PByte;
  5934. SourceMD, DestMD: Pointer;
  5935. BmpFormat: TglBitmapFormat;
  5936. //records
  5937. Mask: TglBitmapColorRec;
  5938. Header: TBMPHeader;
  5939. Info: TBMPInfo;
  5940. //classes
  5941. SpecialFormat: TFormatDescriptor;
  5942. FormatDesc: TFormatDescriptor;
  5943. //////////////////////////////////////////////////////////////////////////////////////////////////
  5944. procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
  5945. var
  5946. i: Integer;
  5947. Pixel: TglBitmapPixelData;
  5948. begin
  5949. aStream.Read(aLineBuf^, rbLineSize);
  5950. SpecialFormat.PreparePixel(Pixel);
  5951. for i := 0 to Info.biWidth-1 do begin
  5952. SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
  5953. glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
  5954. FormatDesc.Map(Pixel, aData, DestMD);
  5955. end;
  5956. end;
  5957. begin
  5958. result := false;
  5959. BmpFormat := tfEmpty;
  5960. SpecialFormat := nil;
  5961. LineBuf := nil;
  5962. SourceMD := nil;
  5963. DestMD := nil;
  5964. // Header
  5965. StartPos := aStream.Position;
  5966. aStream.Read(Header{%H-}, SizeOf(Header));
  5967. if Header.bfType = BMP_MAGIC then begin
  5968. try try
  5969. BmpFormat := ReadInfo(Info, Mask);
  5970. SpecialFormat := ReadColorTable(BmpFormat, Info);
  5971. if not Assigned(SpecialFormat) then
  5972. SpecialFormat := CheckBitfields(BmpFormat, Mask, Info);
  5973. aStream.Position := StartPos + Header.bfOffBits;
  5974. if (BmpFormat <> tfEmpty) then begin
  5975. FormatDesc := TFormatDescriptor.Get(BmpFormat);
  5976. rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
  5977. wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
  5978. Padding := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
  5979. //get Memory
  5980. DestMD := FormatDesc.CreateMappingData;
  5981. ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
  5982. GetMem(ImageData, ImageSize);
  5983. if Assigned(SpecialFormat) then begin
  5984. GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
  5985. SourceMD := SpecialFormat.CreateMappingData;
  5986. end;
  5987. //read Data
  5988. try try
  5989. FillChar(ImageData^, ImageSize, $FF);
  5990. TmpData := ImageData;
  5991. if (Info.biHeight > 0) then
  5992. Inc(TmpData, wbLineSize * (Info.biHeight-1));
  5993. for i := 0 to Abs(Info.biHeight)-1 do begin
  5994. if Assigned(SpecialFormat) then
  5995. SpecialFormatReadLine(TmpData, LineBuf) //if is special format read and convert data
  5996. else
  5997. aStream.Read(TmpData^, wbLineSize); //else only read data
  5998. if (Info.biHeight > 0) then
  5999. dec(TmpData, wbLineSize)
  6000. else
  6001. inc(TmpData, wbLineSize);
  6002. aStream.Read(PaddingBuff{%H-}, Padding);
  6003. end;
  6004. SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
  6005. result := true;
  6006. finally
  6007. if Assigned(LineBuf) then
  6008. FreeMem(LineBuf);
  6009. if Assigned(SourceMD) then
  6010. SpecialFormat.FreeMappingData(SourceMD);
  6011. FormatDesc.FreeMappingData(DestMD);
  6012. end;
  6013. except
  6014. if Assigned(ImageData) then
  6015. FreeMem(ImageData);
  6016. raise;
  6017. end;
  6018. end else
  6019. raise EglBitmap.Create('LoadBMP - No suitable format found');
  6020. except
  6021. aStream.Position := StartPos;
  6022. raise;
  6023. end;
  6024. finally
  6025. FreeAndNil(SpecialFormat);
  6026. end;
  6027. end
  6028. else aStream.Position := StartPos;
  6029. end;
  6030. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6031. procedure TglBitmap.SaveBMP(const aStream: TStream);
  6032. var
  6033. Header: TBMPHeader;
  6034. Info: TBMPInfo;
  6035. Converter: TFormatDescriptor;
  6036. FormatDesc: TFormatDescriptor;
  6037. SourceFD, DestFD: Pointer;
  6038. pData, srcData, dstData, ConvertBuffer: pByte;
  6039. Pixel: TglBitmapPixelData;
  6040. ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
  6041. RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
  6042. PaddingBuff: Cardinal;
  6043. function GetLineWidth : Integer;
  6044. begin
  6045. result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
  6046. end;
  6047. begin
  6048. if not (ftBMP in FormatGetSupportedFiles(Format)) then
  6049. raise EglBitmapUnsupportedFormat.Create(Format);
  6050. Converter := nil;
  6051. FormatDesc := TFormatDescriptor.Get(Format);
  6052. ImageSize := FormatDesc.GetSize(Dimension);
  6053. FillChar(Header{%H-}, SizeOf(Header), 0);
  6054. Header.bfType := BMP_MAGIC;
  6055. Header.bfSize := SizeOf(Header) + SizeOf(Info) + ImageSize;
  6056. Header.bfReserved1 := 0;
  6057. Header.bfReserved2 := 0;
  6058. Header.bfOffBits := SizeOf(Header) + SizeOf(Info);
  6059. FillChar(Info{%H-}, SizeOf(Info), 0);
  6060. Info.biSize := SizeOf(Info);
  6061. Info.biWidth := Width;
  6062. Info.biHeight := Height;
  6063. Info.biPlanes := 1;
  6064. Info.biCompression := BMP_COMP_RGB;
  6065. Info.biSizeImage := ImageSize;
  6066. try
  6067. case Format of
  6068. tfLuminance4: begin
  6069. Info.biBitCount := 4;
  6070. Header.bfSize := Header.bfSize + 16 * SizeOf(Cardinal);
  6071. Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
  6072. Converter := TbmpColorTableFormat.Create;
  6073. with (Converter as TbmpColorTableFormat) do begin
  6074. PixelSize := 0.5;
  6075. Format := Format;
  6076. Range := glBitmapColorRec($F, $F, $F, $0);
  6077. CreateColorTable;
  6078. end;
  6079. end;
  6080. tfR3G3B2, tfLuminance8: begin
  6081. Info.biBitCount := 8;
  6082. Header.bfSize := Header.bfSize + 256 * SizeOf(Cardinal);
  6083. Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
  6084. Converter := TbmpColorTableFormat.Create;
  6085. with (Converter as TbmpColorTableFormat) do begin
  6086. PixelSize := 1;
  6087. Format := Format;
  6088. if (Format = tfR3G3B2) then begin
  6089. Range := glBitmapColorRec($7, $7, $3, $0);
  6090. Shift := glBitmapShiftRec(0, 3, 6, 0);
  6091. end else
  6092. Range := glBitmapColorRec($FF, $FF, $FF, $0);
  6093. CreateColorTable;
  6094. end;
  6095. end;
  6096. tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
  6097. tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin
  6098. Info.biBitCount := 16;
  6099. Info.biCompression := BMP_COMP_BITFIELDS;
  6100. end;
  6101. tfBGR8, tfRGB8: begin
  6102. Info.biBitCount := 24;
  6103. if (Format = tfRGB8) then
  6104. Converter := TfdBGR8.Create; //use BGR8 Format Descriptor to Swap RGB Values
  6105. end;
  6106. tfRGB10, tfRGB10A2, tfRGBA8,
  6107. tfBGR10, tfBGR10A2, tfBGRA8: begin
  6108. Info.biBitCount := 32;
  6109. Info.biCompression := BMP_COMP_BITFIELDS;
  6110. end;
  6111. else
  6112. raise EglBitmapUnsupportedFormat.Create(Format);
  6113. end;
  6114. Info.biXPelsPerMeter := 2835;
  6115. Info.biYPelsPerMeter := 2835;
  6116. // prepare bitmasks
  6117. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  6118. Header.bfSize := Header.bfSize + 4 * SizeOf(Cardinal);
  6119. Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
  6120. RedMask := FormatDesc.RedMask;
  6121. GreenMask := FormatDesc.GreenMask;
  6122. BlueMask := FormatDesc.BlueMask;
  6123. AlphaMask := FormatDesc.AlphaMask;
  6124. end;
  6125. // headers
  6126. aStream.Write(Header, SizeOf(Header));
  6127. aStream.Write(Info, SizeOf(Info));
  6128. // colortable
  6129. if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
  6130. with (Converter as TbmpColorTableFormat) do
  6131. aStream.Write(ColorTable[0].b,
  6132. SizeOf(TbmpColorTableEnty) * Length(ColorTable));
  6133. // bitmasks
  6134. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  6135. aStream.Write(RedMask, SizeOf(Cardinal));
  6136. aStream.Write(GreenMask, SizeOf(Cardinal));
  6137. aStream.Write(BlueMask, SizeOf(Cardinal));
  6138. aStream.Write(AlphaMask, SizeOf(Cardinal));
  6139. end;
  6140. // image data
  6141. rbLineSize := Round(Info.biWidth * FormatDesc.PixelSize);
  6142. wbLineSize := Round(Info.biWidth * Info.biBitCount / 8);
  6143. Padding := GetLineWidth - wbLineSize;
  6144. PaddingBuff := 0;
  6145. pData := Data;
  6146. inc(pData, (Height-1) * rbLineSize);
  6147. // prepare row buffer. But only for RGB because RGBA supports color masks
  6148. // so it's possible to change color within the image.
  6149. if Assigned(Converter) then begin
  6150. FormatDesc.PreparePixel(Pixel);
  6151. GetMem(ConvertBuffer, wbLineSize);
  6152. SourceFD := FormatDesc.CreateMappingData;
  6153. DestFD := Converter.CreateMappingData;
  6154. end else
  6155. ConvertBuffer := nil;
  6156. try
  6157. for LineIdx := 0 to Height - 1 do begin
  6158. // preparing row
  6159. if Assigned(Converter) then begin
  6160. srcData := pData;
  6161. dstData := ConvertBuffer;
  6162. for PixelIdx := 0 to Info.biWidth-1 do begin
  6163. FormatDesc.Unmap(srcData, Pixel, SourceFD);
  6164. glBitmapConvertPixel(Pixel, FormatDesc, Converter);
  6165. Converter.Map(Pixel, dstData, DestFD);
  6166. end;
  6167. aStream.Write(ConvertBuffer^, wbLineSize);
  6168. end else begin
  6169. aStream.Write(pData^, rbLineSize);
  6170. end;
  6171. dec(pData, rbLineSize);
  6172. if (Padding > 0) then
  6173. aStream.Write(PaddingBuff, Padding);
  6174. end;
  6175. finally
  6176. // destroy row buffer
  6177. if Assigned(ConvertBuffer) then begin
  6178. FormatDesc.FreeMappingData(SourceFD);
  6179. Converter.FreeMappingData(DestFD);
  6180. FreeMem(ConvertBuffer);
  6181. end;
  6182. end;
  6183. finally
  6184. if Assigned(Converter) then
  6185. Converter.Free;
  6186. end;
  6187. end;
  6188. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6189. //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6190. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6191. type
  6192. TTGAHeader = packed record
  6193. ImageID: Byte;
  6194. ColorMapType: Byte;
  6195. ImageType: Byte;
  6196. //ColorMapSpec: Array[0..4] of Byte;
  6197. ColorMapStart: Word;
  6198. ColorMapLength: Word;
  6199. ColorMapEntrySize: Byte;
  6200. OrigX: Word;
  6201. OrigY: Word;
  6202. Width: Word;
  6203. Height: Word;
  6204. Bpp: Byte;
  6205. ImageDesc: Byte;
  6206. end;
  6207. const
  6208. TGA_UNCOMPRESSED_RGB = 2;
  6209. TGA_UNCOMPRESSED_GRAY = 3;
  6210. TGA_COMPRESSED_RGB = 10;
  6211. TGA_COMPRESSED_GRAY = 11;
  6212. TGA_NONE_COLOR_TABLE = 0;
  6213. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6214. function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
  6215. var
  6216. Header: TTGAHeader;
  6217. ImageData: System.PByte;
  6218. StartPosition: Int64;
  6219. PixelSize, LineSize: Integer;
  6220. tgaFormat: TglBitmapFormat;
  6221. FormatDesc: TFormatDescriptor;
  6222. Counter: packed record
  6223. X, Y: packed record
  6224. low, high, dir: Integer;
  6225. end;
  6226. end;
  6227. const
  6228. CACHE_SIZE = $4000;
  6229. ////////////////////////////////////////////////////////////////////////////////////////
  6230. procedure ReadUncompressed;
  6231. var
  6232. i, j: Integer;
  6233. buf, tmp1, tmp2: System.PByte;
  6234. begin
  6235. buf := nil;
  6236. if (Counter.X.dir < 0) then
  6237. GetMem(buf, LineSize);
  6238. try
  6239. while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
  6240. tmp1 := ImageData;
  6241. inc(tmp1, (Counter.Y.low * LineSize)); //pointer to LineStart
  6242. if (Counter.X.dir < 0) then begin //flip X
  6243. aStream.Read(buf^, LineSize);
  6244. tmp2 := buf;
  6245. inc(tmp2, LineSize - PixelSize); //pointer to last pixel in line
  6246. for i := 0 to Header.Width-1 do begin //for all pixels in line
  6247. for j := 0 to PixelSize-1 do begin //for all bytes in pixel
  6248. tmp1^ := tmp2^;
  6249. inc(tmp1);
  6250. inc(tmp2);
  6251. end;
  6252. dec(tmp2, 2*PixelSize); //move 2 backwards, because j-loop moved 1 forward
  6253. end;
  6254. end else
  6255. aStream.Read(tmp1^, LineSize);
  6256. inc(Counter.Y.low, Counter.Y.dir); //move to next line index
  6257. end;
  6258. finally
  6259. if Assigned(buf) then
  6260. FreeMem(buf);
  6261. end;
  6262. end;
  6263. ////////////////////////////////////////////////////////////////////////////////////////
  6264. procedure ReadCompressed;
  6265. /////////////////////////////////////////////////////////////////
  6266. var
  6267. TmpData: System.PByte;
  6268. LinePixelsRead: Integer;
  6269. procedure CheckLine;
  6270. begin
  6271. if (LinePixelsRead >= Header.Width) then begin
  6272. LinePixelsRead := 0;
  6273. inc(Counter.Y.low, Counter.Y.dir); //next line index
  6274. TmpData := ImageData;
  6275. inc(TmpData, Counter.Y.low * LineSize); //set line
  6276. if (Counter.X.dir < 0) then //if x flipped then
  6277. inc(TmpData, LineSize - PixelSize); //set last pixel
  6278. end;
  6279. end;
  6280. /////////////////////////////////////////////////////////////////
  6281. var
  6282. Cache: PByte;
  6283. CacheSize, CachePos: Integer;
  6284. procedure CachedRead(out Buffer; Count: Integer);
  6285. var
  6286. BytesRead: Integer;
  6287. begin
  6288. if (CachePos + Count > CacheSize) then begin
  6289. //if buffer overflow save non read bytes
  6290. BytesRead := 0;
  6291. if (CacheSize - CachePos > 0) then begin
  6292. BytesRead := CacheSize - CachePos;
  6293. Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
  6294. inc(CachePos, BytesRead);
  6295. end;
  6296. //load cache from file
  6297. CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
  6298. aStream.Read(Cache^, CacheSize);
  6299. CachePos := 0;
  6300. //read rest of requested bytes
  6301. if (Count - BytesRead > 0) then begin
  6302. Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
  6303. inc(CachePos, Count - BytesRead);
  6304. end;
  6305. end else begin
  6306. //if no buffer overflow just read the data
  6307. Move(PByteArray(Cache)^[CachePos], Buffer, Count);
  6308. inc(CachePos, Count);
  6309. end;
  6310. end;
  6311. procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
  6312. begin
  6313. case PixelSize of
  6314. 1: begin
  6315. aBuffer^ := aData^;
  6316. inc(aBuffer, Counter.X.dir);
  6317. end;
  6318. 2: begin
  6319. PWord(aBuffer)^ := PWord(aData)^;
  6320. inc(aBuffer, 2 * Counter.X.dir);
  6321. end;
  6322. 3: begin
  6323. PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
  6324. PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
  6325. PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
  6326. inc(aBuffer, 3 * Counter.X.dir);
  6327. end;
  6328. 4: begin
  6329. PCardinal(aBuffer)^ := PCardinal(aData)^;
  6330. inc(aBuffer, 4 * Counter.X.dir);
  6331. end;
  6332. end;
  6333. end;
  6334. var
  6335. TotalPixelsToRead, TotalPixelsRead: Integer;
  6336. Temp: Byte;
  6337. buf: array [0..3] of Byte; //1 pixel is max 32bit long
  6338. PixelRepeat: Boolean;
  6339. PixelsToRead, PixelCount: Integer;
  6340. begin
  6341. CacheSize := 0;
  6342. CachePos := 0;
  6343. TotalPixelsToRead := Header.Width * Header.Height;
  6344. TotalPixelsRead := 0;
  6345. LinePixelsRead := 0;
  6346. GetMem(Cache, CACHE_SIZE);
  6347. try
  6348. TmpData := ImageData;
  6349. inc(TmpData, Counter.Y.low * LineSize); //set line
  6350. if (Counter.X.dir < 0) then //if x flipped then
  6351. inc(TmpData, LineSize - PixelSize); //set last pixel
  6352. repeat
  6353. //read CommandByte
  6354. CachedRead(Temp, 1);
  6355. PixelRepeat := (Temp and $80) > 0;
  6356. PixelsToRead := (Temp and $7F) + 1;
  6357. inc(TotalPixelsRead, PixelsToRead);
  6358. if PixelRepeat then
  6359. CachedRead(buf[0], PixelSize);
  6360. while (PixelsToRead > 0) do begin
  6361. CheckLine;
  6362. PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
  6363. while (PixelCount > 0) do begin
  6364. if not PixelRepeat then
  6365. CachedRead(buf[0], PixelSize);
  6366. PixelToBuffer(@buf[0], TmpData);
  6367. inc(LinePixelsRead);
  6368. dec(PixelsToRead);
  6369. dec(PixelCount);
  6370. end;
  6371. end;
  6372. until (TotalPixelsRead >= TotalPixelsToRead);
  6373. finally
  6374. FreeMem(Cache);
  6375. end;
  6376. end;
  6377. function IsGrayFormat: Boolean;
  6378. begin
  6379. result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
  6380. end;
  6381. begin
  6382. result := false;
  6383. // reading header to test file and set cursor back to begin
  6384. StartPosition := aStream.Position;
  6385. aStream.Read(Header{%H-}, SizeOf(Header));
  6386. // no colormapped files
  6387. if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
  6388. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
  6389. begin
  6390. try
  6391. if Header.ImageID <> 0 then // skip image ID
  6392. aStream.Position := aStream.Position + Header.ImageID;
  6393. tgaFormat := tfEmpty;
  6394. case Header.Bpp of
  6395. 8: if IsGrayFormat then case (Header.ImageDesc and $F) of
  6396. 0: tgaFormat := tfLuminance8;
  6397. 8: tgaFormat := tfAlpha8;
  6398. end;
  6399. 16: if IsGrayFormat then case (Header.ImageDesc and $F) of
  6400. 0: tgaFormat := tfLuminance16;
  6401. 8: tgaFormat := tfLuminance8Alpha8;
  6402. end else case (Header.ImageDesc and $F) of
  6403. 0: tgaFormat := tfBGR5;
  6404. 1: tgaFormat := tfBGR5A1;
  6405. 4: tgaFormat := tfBGRA4;
  6406. end;
  6407. 24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  6408. 0: tgaFormat := tfBGR8;
  6409. end;
  6410. 32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  6411. 2: tgaFormat := tfBGR10A2;
  6412. 8: tgaFormat := tfBGRA8;
  6413. end;
  6414. end;
  6415. if (tgaFormat = tfEmpty) then
  6416. raise EglBitmap.Create('LoadTga - unsupported format');
  6417. FormatDesc := TFormatDescriptor.Get(tgaFormat);
  6418. PixelSize := FormatDesc.GetSize(1, 1);
  6419. LineSize := FormatDesc.GetSize(Header.Width, 1);
  6420. GetMem(ImageData, LineSize * Header.Height);
  6421. try
  6422. //column direction
  6423. if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
  6424. Counter.X.low := Header.Height-1;;
  6425. Counter.X.high := 0;
  6426. Counter.X.dir := -1;
  6427. end else begin
  6428. Counter.X.low := 0;
  6429. Counter.X.high := Header.Height-1;
  6430. Counter.X.dir := 1;
  6431. end;
  6432. // Row direction
  6433. if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
  6434. Counter.Y.low := 0;
  6435. Counter.Y.high := Header.Height-1;
  6436. Counter.Y.dir := 1;
  6437. end else begin
  6438. Counter.Y.low := Header.Height-1;;
  6439. Counter.Y.high := 0;
  6440. Counter.Y.dir := -1;
  6441. end;
  6442. // Read Image
  6443. case Header.ImageType of
  6444. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
  6445. ReadUncompressed;
  6446. TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
  6447. ReadCompressed;
  6448. end;
  6449. SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
  6450. result := true;
  6451. except
  6452. if Assigned(ImageData) then
  6453. FreeMem(ImageData);
  6454. raise;
  6455. end;
  6456. finally
  6457. aStream.Position := StartPosition;
  6458. end;
  6459. end
  6460. else aStream.Position := StartPosition;
  6461. end;
  6462. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6463. procedure TglBitmap.SaveTGA(const aStream: TStream);
  6464. var
  6465. Header: TTGAHeader;
  6466. LineSize, Size, x, y: Integer;
  6467. Pixel: TglBitmapPixelData;
  6468. LineBuf, SourceData, DestData: PByte;
  6469. SourceMD, DestMD: Pointer;
  6470. FormatDesc: TFormatDescriptor;
  6471. Converter: TFormatDescriptor;
  6472. begin
  6473. if not (ftTGA in FormatGetSupportedFiles(Format)) then
  6474. raise EglBitmapUnsupportedFormat.Create(Format);
  6475. //prepare header
  6476. FillChar(Header{%H-}, SizeOf(Header), 0);
  6477. //set ImageType
  6478. if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
  6479. tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
  6480. Header.ImageType := TGA_UNCOMPRESSED_GRAY
  6481. else
  6482. Header.ImageType := TGA_UNCOMPRESSED_RGB;
  6483. //set BitsPerPixel
  6484. if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
  6485. Header.Bpp := 8
  6486. else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
  6487. tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
  6488. Header.Bpp := 16
  6489. else if (Format in [tfBGR8, tfRGB8]) then
  6490. Header.Bpp := 24
  6491. else
  6492. Header.Bpp := 32;
  6493. //set AlphaBitCount
  6494. case Format of
  6495. tfRGB5A1, tfBGR5A1:
  6496. Header.ImageDesc := 1 and $F;
  6497. tfRGB10A2, tfBGR10A2:
  6498. Header.ImageDesc := 2 and $F;
  6499. tfRGBA4, tfBGRA4:
  6500. Header.ImageDesc := 4 and $F;
  6501. tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
  6502. Header.ImageDesc := 8 and $F;
  6503. end;
  6504. Header.Width := Width;
  6505. Header.Height := Height;
  6506. Header.ImageDesc := Header.ImageDesc or $20; //flip y
  6507. aStream.Write(Header, SizeOf(Header));
  6508. // convert RGB(A) to BGR(A)
  6509. Converter := nil;
  6510. FormatDesc := TFormatDescriptor.Get(Format);
  6511. Size := FormatDesc.GetSize(Dimension);
  6512. if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
  6513. if (FormatDesc.RGBInverted = tfEmpty) then
  6514. raise EglBitmap.Create('inverted RGB format is empty');
  6515. Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
  6516. if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
  6517. (Converter.PixelSize <> FormatDesc.PixelSize) then
  6518. raise EglBitmap.Create('invalid inverted RGB format');
  6519. end;
  6520. if Assigned(Converter) then begin
  6521. LineSize := FormatDesc.GetSize(Width, 1);
  6522. GetMem(LineBuf, LineSize);
  6523. SourceMD := FormatDesc.CreateMappingData;
  6524. DestMD := Converter.CreateMappingData;
  6525. try
  6526. SourceData := Data;
  6527. for y := 0 to Height-1 do begin
  6528. DestData := LineBuf;
  6529. for x := 0 to Width-1 do begin
  6530. FormatDesc.Unmap(SourceData, Pixel, SourceMD);
  6531. Converter.Map(Pixel, DestData, DestMD);
  6532. end;
  6533. aStream.Write(LineBuf^, LineSize);
  6534. end;
  6535. finally
  6536. FreeMem(LineBuf);
  6537. FormatDesc.FreeMappingData(SourceMD);
  6538. FormatDesc.FreeMappingData(DestMD);
  6539. end;
  6540. end else
  6541. aStream.Write(Data^, Size);
  6542. end;
  6543. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6544. //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6545. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6546. const
  6547. DDS_MAGIC: Cardinal = $20534444;
  6548. // DDS_header.dwFlags
  6549. DDSD_CAPS = $00000001;
  6550. DDSD_HEIGHT = $00000002;
  6551. DDSD_WIDTH = $00000004;
  6552. DDSD_PIXELFORMAT = $00001000;
  6553. // DDS_header.sPixelFormat.dwFlags
  6554. DDPF_ALPHAPIXELS = $00000001;
  6555. DDPF_ALPHA = $00000002;
  6556. DDPF_FOURCC = $00000004;
  6557. DDPF_RGB = $00000040;
  6558. DDPF_LUMINANCE = $00020000;
  6559. // DDS_header.sCaps.dwCaps1
  6560. DDSCAPS_TEXTURE = $00001000;
  6561. // DDS_header.sCaps.dwCaps2
  6562. DDSCAPS2_CUBEMAP = $00000200;
  6563. D3DFMT_DXT1 = $31545844;
  6564. D3DFMT_DXT3 = $33545844;
  6565. D3DFMT_DXT5 = $35545844;
  6566. type
  6567. TDDSPixelFormat = packed record
  6568. dwSize: Cardinal;
  6569. dwFlags: Cardinal;
  6570. dwFourCC: Cardinal;
  6571. dwRGBBitCount: Cardinal;
  6572. dwRBitMask: Cardinal;
  6573. dwGBitMask: Cardinal;
  6574. dwBBitMask: Cardinal;
  6575. dwABitMask: Cardinal;
  6576. end;
  6577. TDDSCaps = packed record
  6578. dwCaps1: Cardinal;
  6579. dwCaps2: Cardinal;
  6580. dwDDSX: Cardinal;
  6581. dwReserved: Cardinal;
  6582. end;
  6583. TDDSHeader = packed record
  6584. dwSize: Cardinal;
  6585. dwFlags: Cardinal;
  6586. dwHeight: Cardinal;
  6587. dwWidth: Cardinal;
  6588. dwPitchOrLinearSize: Cardinal;
  6589. dwDepth: Cardinal;
  6590. dwMipMapCount: Cardinal;
  6591. dwReserved: array[0..10] of Cardinal;
  6592. PixelFormat: TDDSPixelFormat;
  6593. Caps: TDDSCaps;
  6594. dwReserved2: Cardinal;
  6595. end;
  6596. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6597. function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
  6598. var
  6599. Header: TDDSHeader;
  6600. Converter: TbmpBitfieldFormat;
  6601. function GetDDSFormat: TglBitmapFormat;
  6602. var
  6603. fd: TFormatDescriptor;
  6604. i: Integer;
  6605. Range: TglBitmapColorRec;
  6606. match: Boolean;
  6607. begin
  6608. result := tfEmpty;
  6609. with Header.PixelFormat do begin
  6610. // Compresses
  6611. if ((dwFlags and DDPF_FOURCC) > 0) then begin
  6612. case Header.PixelFormat.dwFourCC of
  6613. D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
  6614. D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
  6615. D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
  6616. end;
  6617. end else if ((Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin
  6618. //find matching format
  6619. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  6620. fd := TFormatDescriptor.Get(result);
  6621. if fd.MaskMatch(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask) and
  6622. (8 * fd.PixelSize = dwRGBBitCount) then
  6623. exit;
  6624. end;
  6625. //find format with same Range
  6626. Range.r := dwRBitMask;
  6627. Range.g := dwGBitMask;
  6628. Range.b := dwBBitMask;
  6629. Range.a := dwABitMask;
  6630. for i := 0 to 3 do begin
  6631. while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do
  6632. Range.arr[i] := Range.arr[i] shr 1;
  6633. end;
  6634. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  6635. fd := TFormatDescriptor.Get(result);
  6636. match := true;
  6637. for i := 0 to 3 do
  6638. if (fd.Range.arr[i] <> Range.arr[i]) then begin
  6639. match := false;
  6640. break;
  6641. end;
  6642. if match then
  6643. break;
  6644. end;
  6645. //no format with same range found -> use default
  6646. if (result = tfEmpty) then begin
  6647. if (dwABitMask > 0) then
  6648. result := tfBGRA8
  6649. else
  6650. result := tfBGR8;
  6651. end;
  6652. Converter := TbmpBitfieldFormat.Create;
  6653. Converter.RedMask := dwRBitMask;
  6654. Converter.GreenMask := dwGBitMask;
  6655. Converter.BlueMask := dwBBitMask;
  6656. Converter.AlphaMask := dwABitMask;
  6657. Converter.PixelSize := dwRGBBitCount / 8;
  6658. end;
  6659. end;
  6660. end;
  6661. var
  6662. StreamPos: Int64;
  6663. x, y, LineSize, RowSize, Magic: Cardinal;
  6664. NewImage, TmpData, RowData, SrcData: System.PByte;
  6665. SourceMD, DestMD: Pointer;
  6666. Pixel: TglBitmapPixelData;
  6667. ddsFormat: TglBitmapFormat;
  6668. FormatDesc: TFormatDescriptor;
  6669. begin
  6670. result := false;
  6671. Converter := nil;
  6672. StreamPos := aStream.Position;
  6673. // Magic
  6674. aStream.Read(Magic{%H-}, sizeof(Magic));
  6675. if (Magic <> DDS_MAGIC) then begin
  6676. aStream.Position := StreamPos;
  6677. exit;
  6678. end;
  6679. //Header
  6680. aStream.Read(Header{%H-}, sizeof(Header));
  6681. if (Header.dwSize <> SizeOf(Header)) or
  6682. ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
  6683. (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
  6684. begin
  6685. aStream.Position := StreamPos;
  6686. exit;
  6687. end;
  6688. if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
  6689. raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
  6690. ddsFormat := GetDDSFormat;
  6691. try
  6692. if (ddsFormat = tfEmpty) then
  6693. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  6694. FormatDesc := TFormatDescriptor.Get(ddsFormat);
  6695. LineSize := Trunc(Header.dwWidth * FormatDesc.PixelSize);
  6696. GetMem(NewImage, Header.dwHeight * LineSize);
  6697. try
  6698. TmpData := NewImage;
  6699. //Converter needed
  6700. if Assigned(Converter) then begin
  6701. RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
  6702. GetMem(RowData, RowSize);
  6703. SourceMD := Converter.CreateMappingData;
  6704. DestMD := FormatDesc.CreateMappingData;
  6705. try
  6706. for y := 0 to Header.dwHeight-1 do begin
  6707. TmpData := NewImage;
  6708. inc(TmpData, y * LineSize);
  6709. SrcData := RowData;
  6710. aStream.Read(SrcData^, RowSize);
  6711. for x := 0 to Header.dwWidth-1 do begin
  6712. Converter.Unmap(SrcData, Pixel, SourceMD);
  6713. glBitmapConvertPixel(Pixel, Converter, FormatDesc);
  6714. FormatDesc.Map(Pixel, TmpData, DestMD);
  6715. end;
  6716. end;
  6717. finally
  6718. Converter.FreeMappingData(SourceMD);
  6719. FormatDesc.FreeMappingData(DestMD);
  6720. FreeMem(RowData);
  6721. end;
  6722. end else
  6723. // Compressed
  6724. if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
  6725. RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
  6726. for Y := 0 to Header.dwHeight-1 do begin
  6727. aStream.Read(TmpData^, RowSize);
  6728. Inc(TmpData, LineSize);
  6729. end;
  6730. end else
  6731. // Uncompressed
  6732. if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
  6733. RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
  6734. for Y := 0 to Header.dwHeight-1 do begin
  6735. aStream.Read(TmpData^, RowSize);
  6736. Inc(TmpData, LineSize);
  6737. end;
  6738. end else
  6739. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  6740. SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
  6741. result := true;
  6742. except
  6743. if Assigned(NewImage) then
  6744. FreeMem(NewImage);
  6745. raise;
  6746. end;
  6747. finally
  6748. FreeAndNil(Converter);
  6749. end;
  6750. end;
  6751. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6752. procedure TglBitmap.SaveDDS(const aStream: TStream);
  6753. var
  6754. Header: TDDSHeader;
  6755. FormatDesc: TFormatDescriptor;
  6756. begin
  6757. if not (ftDDS in FormatGetSupportedFiles(Format)) then
  6758. raise EglBitmapUnsupportedFormat.Create(Format);
  6759. FormatDesc := TFormatDescriptor.Get(Format);
  6760. // Generell
  6761. FillChar(Header{%H-}, SizeOf(Header), 0);
  6762. Header.dwSize := SizeOf(Header);
  6763. Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
  6764. Header.dwWidth := Max(1, Width);
  6765. Header.dwHeight := Max(1, Height);
  6766. // Caps
  6767. Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
  6768. // Pixelformat
  6769. Header.PixelFormat.dwSize := sizeof(Header);
  6770. if (FormatDesc.IsCompressed) then begin
  6771. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
  6772. case Format of
  6773. tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
  6774. tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
  6775. tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
  6776. end;
  6777. end else if (Format in [tfAlpha8, tfAlpha16]) then begin
  6778. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHA;
  6779. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6780. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6781. end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
  6782. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
  6783. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6784. Header.PixelFormat.dwRBitMask := FormatDesc.RedMask;
  6785. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6786. end else begin
  6787. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
  6788. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6789. Header.PixelFormat.dwRBitMask := FormatDesc.RedMask;
  6790. Header.PixelFormat.dwGBitMask := FormatDesc.GreenMask;
  6791. Header.PixelFormat.dwBBitMask := FormatDesc.BlueMask;
  6792. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6793. end;
  6794. if (FormatDesc.HasAlpha) then
  6795. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
  6796. aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
  6797. aStream.Write(Header, SizeOf(Header));
  6798. aStream.Write(Data^, FormatDesc.GetSize(Dimension));
  6799. end;
  6800. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6801. //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6802. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6803. procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  6804. const aWidth: Integer; const aHeight: Integer);
  6805. var
  6806. pTemp: pByte;
  6807. Size: Integer;
  6808. begin
  6809. if (aHeight > 1) then begin
  6810. Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
  6811. GetMem(pTemp, Size);
  6812. try
  6813. Move(aData^, pTemp^, Size);
  6814. FreeMem(aData);
  6815. aData := nil;
  6816. except
  6817. FreeMem(pTemp);
  6818. raise;
  6819. end;
  6820. end else
  6821. pTemp := aData;
  6822. inherited SetDataPointer(pTemp, aFormat, aWidth);
  6823. end;
  6824. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6825. function TglBitmap1D.FlipHorz: Boolean;
  6826. var
  6827. Col: Integer;
  6828. pTempDest, pDest, pSource: PByte;
  6829. begin
  6830. result := inherited FlipHorz;
  6831. if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
  6832. pSource := Data;
  6833. GetMem(pDest, fRowSize);
  6834. try
  6835. pTempDest := pDest;
  6836. Inc(pTempDest, fRowSize);
  6837. for Col := 0 to Width-1 do begin
  6838. dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
  6839. Move(pSource^, pTempDest^, fPixelSize);
  6840. Inc(pSource, fPixelSize);
  6841. end;
  6842. SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
  6843. result := true;
  6844. except
  6845. if Assigned(pDest) then
  6846. FreeMem(pDest);
  6847. raise;
  6848. end;
  6849. end;
  6850. end;
  6851. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6852. procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
  6853. var
  6854. FormatDesc: TFormatDescriptor;
  6855. begin
  6856. // Upload data
  6857. FormatDesc := TFormatDescriptor.Get(Format);
  6858. if FormatDesc.IsCompressed then begin
  6859. if not Assigned(glCompressedTexImage1D) then
  6860. raise EglBitmap.Create('compressed formats not supported by video adapter');
  6861. glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
  6862. end else if aBuildWithGlu then
  6863. gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  6864. else
  6865. glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  6866. // Free Data
  6867. if (FreeDataAfterGenTexture) then
  6868. FreeData;
  6869. end;
  6870. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6871. procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
  6872. var
  6873. BuildWithGlu, TexRec: Boolean;
  6874. TexSize: Integer;
  6875. begin
  6876. if Assigned(Data) then begin
  6877. // Check Texture Size
  6878. if (aTestTextureSize) then begin
  6879. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  6880. if (Width > TexSize) then
  6881. raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  6882. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
  6883. (Target = GL_TEXTURE_RECTANGLE);
  6884. if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  6885. raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  6886. end;
  6887. CreateId;
  6888. SetupParameters(BuildWithGlu);
  6889. UploadData(BuildWithGlu);
  6890. glAreTexturesResident(1, @fID, @fIsResident);
  6891. end;
  6892. end;
  6893. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6894. procedure TglBitmap1D.AfterConstruction;
  6895. begin
  6896. inherited;
  6897. Target := GL_TEXTURE_1D;
  6898. end;
  6899. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6900. //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6901. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6902. function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
  6903. begin
  6904. if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
  6905. result := fLines[aIndex]
  6906. else
  6907. result := nil;
  6908. end;
  6909. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6910. procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  6911. const aWidth: Integer; const aHeight: Integer);
  6912. var
  6913. Idx, LineWidth: Integer;
  6914. begin
  6915. inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
  6916. if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
  6917. // Assigning Data
  6918. if Assigned(Data) then begin
  6919. SetLength(fLines, GetHeight);
  6920. LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
  6921. for Idx := 0 to GetHeight-1 do begin
  6922. fLines[Idx] := Data;
  6923. Inc(fLines[Idx], Idx * LineWidth);
  6924. end;
  6925. end
  6926. else SetLength(fLines, 0);
  6927. end else begin
  6928. SetLength(fLines, 0);
  6929. end;
  6930. end;
  6931. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6932. procedure TglBitmap2D.UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
  6933. var
  6934. FormatDesc: TFormatDescriptor;
  6935. begin
  6936. glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
  6937. FormatDesc := TFormatDescriptor.Get(Format);
  6938. if FormatDesc.IsCompressed then begin
  6939. if not Assigned(glCompressedTexImage2D) then
  6940. raise EglBitmap.Create('compressed formats not supported by video adapter');
  6941. glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
  6942. end else if aBuildWithGlu then begin
  6943. gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
  6944. FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  6945. end else begin
  6946. glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
  6947. FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  6948. end;
  6949. // Freigeben
  6950. if (FreeDataAfterGenTexture) then
  6951. FreeData;
  6952. end;
  6953. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6954. procedure TglBitmap2D.AfterConstruction;
  6955. begin
  6956. inherited;
  6957. Target := GL_TEXTURE_2D;
  6958. end;
  6959. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6960. procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  6961. var
  6962. Temp: pByte;
  6963. Size, w, h: Integer;
  6964. FormatDesc: TFormatDescriptor;
  6965. begin
  6966. FormatDesc := TFormatDescriptor.Get(aFormat);
  6967. if FormatDesc.IsCompressed then
  6968. raise EglBitmapUnsupportedFormat.Create(aFormat);
  6969. w := aRight - aLeft;
  6970. h := aBottom - aTop;
  6971. Size := FormatDesc.GetSize(w, h);
  6972. GetMem(Temp, Size);
  6973. try
  6974. glPixelStorei(GL_PACK_ALIGNMENT, 1);
  6975. glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  6976. SetDataPointer(Temp, aFormat, w, h); //be careful, Data could be freed by this method
  6977. FlipVert;
  6978. except
  6979. if Assigned(Temp) then
  6980. FreeMem(Temp);
  6981. raise;
  6982. end;
  6983. end;
  6984. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6985. procedure TglBitmap2D.GetDataFromTexture;
  6986. var
  6987. Temp: PByte;
  6988. TempWidth, TempHeight: Integer;
  6989. TempIntFormat: Cardinal;
  6990. IntFormat, f: TglBitmapFormat;
  6991. FormatDesc: TFormatDescriptor;
  6992. begin
  6993. Bind;
  6994. // Request Data
  6995. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH, @TempWidth);
  6996. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT, @TempHeight);
  6997. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
  6998. IntFormat := tfEmpty;
  6999. for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
  7000. FormatDesc := TFormatDescriptor.Get(f);
  7001. if (FormatDesc.glInternalFormat = TempIntFormat) then begin
  7002. IntFormat := FormatDesc.Format;
  7003. break;
  7004. end;
  7005. end;
  7006. // Getting data from OpenGL
  7007. FormatDesc := TFormatDescriptor.Get(IntFormat);
  7008. GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
  7009. try
  7010. if FormatDesc.IsCompressed then begin
  7011. if not Assigned(glGetCompressedTexImage) then
  7012. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7013. glGetCompressedTexImage(Target, 0, Temp)
  7014. end else
  7015. glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  7016. SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  7017. except
  7018. if Assigned(Temp) then
  7019. FreeMem(Temp);
  7020. raise;
  7021. end;
  7022. end;
  7023. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7024. procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
  7025. var
  7026. BuildWithGlu, PotTex, TexRec: Boolean;
  7027. TexSize: Integer;
  7028. begin
  7029. if Assigned(Data) then begin
  7030. // Check Texture Size
  7031. if (aTestTextureSize) then begin
  7032. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  7033. if ((Height > TexSize) or (Width > TexSize)) then
  7034. raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  7035. PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
  7036. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
  7037. if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  7038. raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7039. end;
  7040. CreateId;
  7041. SetupParameters(BuildWithGlu);
  7042. UploadData(Target, BuildWithGlu);
  7043. glAreTexturesResident(1, @fID, @fIsResident);
  7044. end;
  7045. end;
  7046. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7047. function TglBitmap2D.FlipHorz: Boolean;
  7048. var
  7049. Col, Row: Integer;
  7050. TempDestData, DestData, SourceData: PByte;
  7051. ImgSize: Integer;
  7052. begin
  7053. result := inherited FlipHorz;
  7054. if Assigned(Data) then begin
  7055. SourceData := Data;
  7056. ImgSize := Height * fRowSize;
  7057. GetMem(DestData, ImgSize);
  7058. try
  7059. TempDestData := DestData;
  7060. Dec(TempDestData, fRowSize + fPixelSize);
  7061. for Row := 0 to Height -1 do begin
  7062. Inc(TempDestData, fRowSize * 2);
  7063. for Col := 0 to Width -1 do begin
  7064. Move(SourceData^, TempDestData^, fPixelSize);
  7065. Inc(SourceData, fPixelSize);
  7066. Dec(TempDestData, fPixelSize);
  7067. end;
  7068. end;
  7069. SetDataPointer(DestData, Format); //be careful, Data could be freed by this method
  7070. result := true;
  7071. except
  7072. if Assigned(DestData) then
  7073. FreeMem(DestData);
  7074. raise;
  7075. end;
  7076. end;
  7077. end;
  7078. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7079. function TglBitmap2D.FlipVert: Boolean;
  7080. var
  7081. Row: Integer;
  7082. TempDestData, DestData, SourceData: PByte;
  7083. begin
  7084. result := inherited FlipVert;
  7085. if Assigned(Data) then begin
  7086. SourceData := Data;
  7087. GetMem(DestData, Height * fRowSize);
  7088. try
  7089. TempDestData := DestData;
  7090. Inc(TempDestData, Width * (Height -1) * fPixelSize);
  7091. for Row := 0 to Height -1 do begin
  7092. Move(SourceData^, TempDestData^, fRowSize);
  7093. Dec(TempDestData, fRowSize);
  7094. Inc(SourceData, fRowSize);
  7095. end;
  7096. SetDataPointer(DestData, Format); //be careful, Data could be freed by this method
  7097. result := true;
  7098. except
  7099. if Assigned(DestData) then
  7100. FreeMem(DestData);
  7101. raise;
  7102. end;
  7103. end;
  7104. end;
  7105. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7106. //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7107. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7108. type
  7109. TMatrixItem = record
  7110. X, Y: Integer;
  7111. W: Single;
  7112. end;
  7113. PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
  7114. TglBitmapToNormalMapRec = Record
  7115. Scale: Single;
  7116. Heights: array of Single;
  7117. MatrixU : array of TMatrixItem;
  7118. MatrixV : array of TMatrixItem;
  7119. end;
  7120. const
  7121. ONE_OVER_255 = 1 / 255;
  7122. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7123. procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
  7124. var
  7125. Val: Single;
  7126. begin
  7127. with FuncRec do begin
  7128. Val :=
  7129. Source.Data.r * LUMINANCE_WEIGHT_R +
  7130. Source.Data.g * LUMINANCE_WEIGHT_G +
  7131. Source.Data.b * LUMINANCE_WEIGHT_B;
  7132. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
  7133. end;
  7134. end;
  7135. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7136. procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  7137. begin
  7138. with FuncRec do
  7139. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
  7140. end;
  7141. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7142. procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
  7143. type
  7144. TVec = Array[0..2] of Single;
  7145. var
  7146. Idx: Integer;
  7147. du, dv: Double;
  7148. Len: Single;
  7149. Vec: TVec;
  7150. function GetHeight(X, Y: Integer): Single;
  7151. begin
  7152. with FuncRec do begin
  7153. X := Max(0, Min(Size.X -1, X));
  7154. Y := Max(0, Min(Size.Y -1, Y));
  7155. result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
  7156. end;
  7157. end;
  7158. begin
  7159. with FuncRec do begin
  7160. with PglBitmapToNormalMapRec(Args)^ do begin
  7161. du := 0;
  7162. for Idx := Low(MatrixU) to High(MatrixU) do
  7163. du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
  7164. dv := 0;
  7165. for Idx := Low(MatrixU) to High(MatrixU) do
  7166. dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
  7167. Vec[0] := -du * Scale;
  7168. Vec[1] := -dv * Scale;
  7169. Vec[2] := 1;
  7170. end;
  7171. // Normalize
  7172. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  7173. if Len <> 0 then begin
  7174. Vec[0] := Vec[0] * Len;
  7175. Vec[1] := Vec[1] * Len;
  7176. Vec[2] := Vec[2] * Len;
  7177. end;
  7178. // Farbe zuweisem
  7179. Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
  7180. Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
  7181. Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
  7182. end;
  7183. end;
  7184. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7185. procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
  7186. var
  7187. Rec: TglBitmapToNormalMapRec;
  7188. procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
  7189. begin
  7190. if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
  7191. Matrix[Index].X := X;
  7192. Matrix[Index].Y := Y;
  7193. Matrix[Index].W := W;
  7194. end;
  7195. end;
  7196. begin
  7197. if TFormatDescriptor.Get(Format).IsCompressed then
  7198. raise EglBitmapUnsupportedFormat.Create(Format);
  7199. if aScale > 100 then
  7200. Rec.Scale := 100
  7201. else if aScale < -100 then
  7202. Rec.Scale := -100
  7203. else
  7204. Rec.Scale := aScale;
  7205. SetLength(Rec.Heights, Width * Height);
  7206. try
  7207. case aFunc of
  7208. nm4Samples: begin
  7209. SetLength(Rec.MatrixU, 2);
  7210. SetEntry(Rec.MatrixU, 0, -1, 0, -0.5);
  7211. SetEntry(Rec.MatrixU, 1, 1, 0, 0.5);
  7212. SetLength(Rec.MatrixV, 2);
  7213. SetEntry(Rec.MatrixV, 0, 0, 1, 0.5);
  7214. SetEntry(Rec.MatrixV, 1, 0, -1, -0.5);
  7215. end;
  7216. nmSobel: begin
  7217. SetLength(Rec.MatrixU, 6);
  7218. SetEntry(Rec.MatrixU, 0, -1, 1, -1.0);
  7219. SetEntry(Rec.MatrixU, 1, -1, 0, -2.0);
  7220. SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
  7221. SetEntry(Rec.MatrixU, 3, 1, 1, 1.0);
  7222. SetEntry(Rec.MatrixU, 4, 1, 0, 2.0);
  7223. SetEntry(Rec.MatrixU, 5, 1, -1, 1.0);
  7224. SetLength(Rec.MatrixV, 6);
  7225. SetEntry(Rec.MatrixV, 0, -1, 1, 1.0);
  7226. SetEntry(Rec.MatrixV, 1, 0, 1, 2.0);
  7227. SetEntry(Rec.MatrixV, 2, 1, 1, 1.0);
  7228. SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
  7229. SetEntry(Rec.MatrixV, 4, 0, -1, -2.0);
  7230. SetEntry(Rec.MatrixV, 5, 1, -1, -1.0);
  7231. end;
  7232. nm3x3: begin
  7233. SetLength(Rec.MatrixU, 6);
  7234. SetEntry(Rec.MatrixU, 0, -1, 1, -1/6);
  7235. SetEntry(Rec.MatrixU, 1, -1, 0, -1/6);
  7236. SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
  7237. SetEntry(Rec.MatrixU, 3, 1, 1, 1/6);
  7238. SetEntry(Rec.MatrixU, 4, 1, 0, 1/6);
  7239. SetEntry(Rec.MatrixU, 5, 1, -1, 1/6);
  7240. SetLength(Rec.MatrixV, 6);
  7241. SetEntry(Rec.MatrixV, 0, -1, 1, 1/6);
  7242. SetEntry(Rec.MatrixV, 1, 0, 1, 1/6);
  7243. SetEntry(Rec.MatrixV, 2, 1, 1, 1/6);
  7244. SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
  7245. SetEntry(Rec.MatrixV, 4, 0, -1, -1/6);
  7246. SetEntry(Rec.MatrixV, 5, 1, -1, -1/6);
  7247. end;
  7248. nm5x5: begin
  7249. SetLength(Rec.MatrixU, 20);
  7250. SetEntry(Rec.MatrixU, 0, -2, 2, -1 / 16);
  7251. SetEntry(Rec.MatrixU, 1, -1, 2, -1 / 10);
  7252. SetEntry(Rec.MatrixU, 2, 1, 2, 1 / 10);
  7253. SetEntry(Rec.MatrixU, 3, 2, 2, 1 / 16);
  7254. SetEntry(Rec.MatrixU, 4, -2, 1, -1 / 10);
  7255. SetEntry(Rec.MatrixU, 5, -1, 1, -1 / 8);
  7256. SetEntry(Rec.MatrixU, 6, 1, 1, 1 / 8);
  7257. SetEntry(Rec.MatrixU, 7, 2, 1, 1 / 10);
  7258. SetEntry(Rec.MatrixU, 8, -2, 0, -1 / 2.8);
  7259. SetEntry(Rec.MatrixU, 9, -1, 0, -0.5);
  7260. SetEntry(Rec.MatrixU, 10, 1, 0, 0.5);
  7261. SetEntry(Rec.MatrixU, 11, 2, 0, 1 / 2.8);
  7262. SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
  7263. SetEntry(Rec.MatrixU, 13, -1, -1, -1 / 8);
  7264. SetEntry(Rec.MatrixU, 14, 1, -1, 1 / 8);
  7265. SetEntry(Rec.MatrixU, 15, 2, -1, 1 / 10);
  7266. SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
  7267. SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
  7268. SetEntry(Rec.MatrixU, 18, 1, -2, 1 / 10);
  7269. SetEntry(Rec.MatrixU, 19, 2, -2, 1 / 16);
  7270. SetLength(Rec.MatrixV, 20);
  7271. SetEntry(Rec.MatrixV, 0, -2, 2, 1 / 16);
  7272. SetEntry(Rec.MatrixV, 1, -1, 2, 1 / 10);
  7273. SetEntry(Rec.MatrixV, 2, 0, 2, 0.25);
  7274. SetEntry(Rec.MatrixV, 3, 1, 2, 1 / 10);
  7275. SetEntry(Rec.MatrixV, 4, 2, 2, 1 / 16);
  7276. SetEntry(Rec.MatrixV, 5, -2, 1, 1 / 10);
  7277. SetEntry(Rec.MatrixV, 6, -1, 1, 1 / 8);
  7278. SetEntry(Rec.MatrixV, 7, 0, 1, 0.5);
  7279. SetEntry(Rec.MatrixV, 8, 1, 1, 1 / 8);
  7280. SetEntry(Rec.MatrixV, 9, 2, 1, 1 / 16);
  7281. SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
  7282. SetEntry(Rec.MatrixV, 11, -1, -1, -1 / 8);
  7283. SetEntry(Rec.MatrixV, 12, 0, -1, -0.5);
  7284. SetEntry(Rec.MatrixV, 13, 1, -1, -1 / 8);
  7285. SetEntry(Rec.MatrixV, 14, 2, -1, -1 / 10);
  7286. SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
  7287. SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
  7288. SetEntry(Rec.MatrixV, 17, 0, -2, -0.25);
  7289. SetEntry(Rec.MatrixV, 18, 1, -2, -1 / 10);
  7290. SetEntry(Rec.MatrixV, 19, 2, -2, -1 / 16);
  7291. end;
  7292. end;
  7293. // Daten Sammeln
  7294. if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
  7295. AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
  7296. else
  7297. AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
  7298. AddFunc(glBitmapToNormalMapFunc, false, @Rec);
  7299. finally
  7300. SetLength(Rec.Heights, 0);
  7301. end;
  7302. end;
  7303. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7304. //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7305. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7306. procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);
  7307. begin
  7308. Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
  7309. end;
  7310. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7311. procedure TglBitmapCubeMap.AfterConstruction;
  7312. begin
  7313. inherited;
  7314. if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
  7315. raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
  7316. SetWrap;
  7317. Target := GL_TEXTURE_CUBE_MAP;
  7318. fGenMode := GL_REFLECTION_MAP;
  7319. end;
  7320. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7321. procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);
  7322. var
  7323. BuildWithGlu: Boolean;
  7324. TexSize: Integer;
  7325. begin
  7326. if (aTestTextureSize) then begin
  7327. glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
  7328. if (Height > TexSize) or (Width > TexSize) then
  7329. raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
  7330. if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
  7331. raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
  7332. end;
  7333. if (ID = 0) then
  7334. CreateID;
  7335. SetupParameters(BuildWithGlu);
  7336. UploadData(aCubeTarget, BuildWithGlu);
  7337. end;
  7338. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7339. procedure TglBitmapCubeMap.Bind(const aEnableTexCoordsGen: Boolean; const aEnableTextureUnit: Boolean);
  7340. begin
  7341. inherited Bind (aEnableTextureUnit);
  7342. if aEnableTexCoordsGen then begin
  7343. glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
  7344. glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
  7345. glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
  7346. glEnable(GL_TEXTURE_GEN_S);
  7347. glEnable(GL_TEXTURE_GEN_T);
  7348. glEnable(GL_TEXTURE_GEN_R);
  7349. end;
  7350. end;
  7351. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7352. procedure TglBitmapCubeMap.Unbind(const aDisableTexCoordsGen: Boolean; const aDisableTextureUnit: Boolean);
  7353. begin
  7354. inherited Unbind(aDisableTextureUnit);
  7355. if aDisableTexCoordsGen then begin
  7356. glDisable(GL_TEXTURE_GEN_S);
  7357. glDisable(GL_TEXTURE_GEN_T);
  7358. glDisable(GL_TEXTURE_GEN_R);
  7359. end;
  7360. end;
  7361. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7362. //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7363. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7364. type
  7365. TVec = Array[0..2] of Single;
  7366. TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7367. PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
  7368. TglBitmapNormalMapRec = record
  7369. HalfSize : Integer;
  7370. Func: TglBitmapNormalMapGetVectorFunc;
  7371. end;
  7372. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7373. procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7374. begin
  7375. aVec[0] := aHalfSize;
  7376. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7377. aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
  7378. end;
  7379. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7380. procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7381. begin
  7382. aVec[0] := - aHalfSize;
  7383. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7384. aVec[2] := aPosition.X + 0.5 - aHalfSize;
  7385. end;
  7386. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7387. procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7388. begin
  7389. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7390. aVec[1] := aHalfSize;
  7391. aVec[2] := aPosition.Y + 0.5 - aHalfSize;
  7392. end;
  7393. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7394. procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7395. begin
  7396. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7397. aVec[1] := - aHalfSize;
  7398. aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
  7399. end;
  7400. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7401. procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7402. begin
  7403. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7404. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7405. aVec[2] := aHalfSize;
  7406. end;
  7407. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7408. procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7409. begin
  7410. aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
  7411. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7412. aVec[2] := - aHalfSize;
  7413. end;
  7414. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7415. procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
  7416. var
  7417. i: Integer;
  7418. Vec: TVec;
  7419. Len: Single;
  7420. begin
  7421. with FuncRec do begin
  7422. with PglBitmapNormalMapRec(Args)^ do begin
  7423. Func(Vec, Position, HalfSize);
  7424. // Normalize
  7425. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  7426. if Len <> 0 then begin
  7427. Vec[0] := Vec[0] * Len;
  7428. Vec[1] := Vec[1] * Len;
  7429. Vec[2] := Vec[2] * Len;
  7430. end;
  7431. // Scale Vector and AddVectro
  7432. Vec[0] := Vec[0] * 0.5 + 0.5;
  7433. Vec[1] := Vec[1] * 0.5 + 0.5;
  7434. Vec[2] := Vec[2] * 0.5 + 0.5;
  7435. end;
  7436. // Set Color
  7437. for i := 0 to 2 do
  7438. Dest.Data.arr[i] := Round(Vec[i] * 255);
  7439. end;
  7440. end;
  7441. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7442. procedure TglBitmapNormalMap.AfterConstruction;
  7443. begin
  7444. inherited;
  7445. fGenMode := GL_NORMAL_MAP;
  7446. end;
  7447. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7448. procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);
  7449. var
  7450. Rec: TglBitmapNormalMapRec;
  7451. SizeRec: TglBitmapPixelPosition;
  7452. begin
  7453. Rec.HalfSize := aSize div 2;
  7454. FreeDataAfterGenTexture := false;
  7455. SizeRec.Fields := [ffX, ffY];
  7456. SizeRec.X := aSize;
  7457. SizeRec.Y := aSize;
  7458. // Positive X
  7459. Rec.Func := glBitmapNormalMapPosX;
  7460. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7461. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);
  7462. // Negative X
  7463. Rec.Func := glBitmapNormalMapNegX;
  7464. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7465. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);
  7466. // Positive Y
  7467. Rec.Func := glBitmapNormalMapPosY;
  7468. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7469. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);
  7470. // Negative Y
  7471. Rec.Func := glBitmapNormalMapNegY;
  7472. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7473. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);
  7474. // Positive Z
  7475. Rec.Func := glBitmapNormalMapPosZ;
  7476. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7477. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);
  7478. // Negative Z
  7479. Rec.Func := glBitmapNormalMapNegZ;
  7480. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7481. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);
  7482. end;
  7483. initialization
  7484. glBitmapSetDefaultFormat (tfEmpty);
  7485. glBitmapSetDefaultMipmap (mmMipmap);
  7486. glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
  7487. glBitmapSetDefaultWrap (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
  7488. glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
  7489. glBitmapSetDefaultFreeDataAfterGenTexture(true);
  7490. glBitmapSetDefaultDeleteTextureOnFree (true);
  7491. TFormatDescriptor.Init;
  7492. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  7493. OpenGLInitialized := false;
  7494. InitOpenGLCS := TCriticalSection.Create;
  7495. {$ENDIF}
  7496. finalization
  7497. TFormatDescriptor.Finalize;
  7498. {$IFDEF GLB_NATIVE_OGL}
  7499. if Assigned(GL_LibHandle) then
  7500. glbFreeLibrary(GL_LibHandle);
  7501. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  7502. if Assigned(GLU_LibHandle) then
  7503. glbFreeLibrary(GLU_LibHandle);
  7504. FreeAndNil(InitOpenGLCS);
  7505. {$ENDIF}
  7506. {$ENDIF}
  7507. end.