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

8574 lines
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)} windows, {$IFEND}
  393. {$IFDEF GLB_SDL} SDL, {$ENDIF}
  394. {$IFDEF GLB_LAZARUS} IntfGraphics, GraphType, Graphics, {$ENDIF}
  395. {$IFDEF GLB_DELPHI} Dialogs, Graphics, {$ENDIF}
  396. {$IFDEF GLB_SDL_IMAGE} SDL_image, {$ENDIF}
  397. {$IFDEF GLB_PNGIMAGE} pngimage, {$ENDIF}
  398. {$IFDEF GLB_LIB_PNG} libPNG, {$ENDIF}
  399. {$IFDEF GLB_DELPHI_JPEG} JPEG, {$ENDIF}
  400. {$IFDEF GLB_LIB_JPEG} libJPEG, {$ENDIF}
  401. Classes, SysUtils;
  402. {$IFDEF GLB_NATIVE_OGL}
  403. const
  404. GL_TRUE = 1;
  405. GL_FALSE = 0;
  406. GL_ZERO = 0;
  407. GL_ONE = 1;
  408. GL_VERSION = $1F02;
  409. GL_EXTENSIONS = $1F03;
  410. GL_TEXTURE_1D = $0DE0;
  411. GL_TEXTURE_2D = $0DE1;
  412. GL_TEXTURE_RECTANGLE = $84F5;
  413. GL_NORMAL_MAP = $8511;
  414. GL_TEXTURE_CUBE_MAP = $8513;
  415. GL_REFLECTION_MAP = $8512;
  416. GL_TEXTURE_CUBE_MAP_POSITIVE_X = $8515;
  417. GL_TEXTURE_CUBE_MAP_NEGATIVE_X = $8516;
  418. GL_TEXTURE_CUBE_MAP_POSITIVE_Y = $8517;
  419. GL_TEXTURE_CUBE_MAP_NEGATIVE_Y = $8518;
  420. GL_TEXTURE_CUBE_MAP_POSITIVE_Z = $8519;
  421. GL_TEXTURE_CUBE_MAP_NEGATIVE_Z = $851A;
  422. GL_TEXTURE_WIDTH = $1000;
  423. GL_TEXTURE_HEIGHT = $1001;
  424. GL_TEXTURE_INTERNAL_FORMAT = $1003;
  425. GL_TEXTURE_SWIZZLE_RGBA = $8E46;
  426. GL_S = $2000;
  427. GL_T = $2001;
  428. GL_R = $2002;
  429. GL_Q = $2003;
  430. GL_TEXTURE_GEN_S = $0C60;
  431. GL_TEXTURE_GEN_T = $0C61;
  432. GL_TEXTURE_GEN_R = $0C62;
  433. GL_TEXTURE_GEN_Q = $0C63;
  434. GL_RED = $1903;
  435. GL_GREEN = $1904;
  436. GL_BLUE = $1905;
  437. GL_ALPHA = $1906;
  438. GL_ALPHA4 = $803B;
  439. GL_ALPHA8 = $803C;
  440. GL_ALPHA12 = $803D;
  441. GL_ALPHA16 = $803E;
  442. GL_LUMINANCE = $1909;
  443. GL_LUMINANCE4 = $803F;
  444. GL_LUMINANCE8 = $8040;
  445. GL_LUMINANCE12 = $8041;
  446. GL_LUMINANCE16 = $8042;
  447. GL_LUMINANCE_ALPHA = $190A;
  448. GL_LUMINANCE4_ALPHA4 = $8043;
  449. GL_LUMINANCE6_ALPHA2 = $8044;
  450. GL_LUMINANCE8_ALPHA8 = $8045;
  451. GL_LUMINANCE12_ALPHA4 = $8046;
  452. GL_LUMINANCE12_ALPHA12 = $8047;
  453. GL_LUMINANCE16_ALPHA16 = $8048;
  454. GL_RGB = $1907;
  455. GL_BGR = $80E0;
  456. GL_R3_G3_B2 = $2A10;
  457. GL_RGB4 = $804F;
  458. GL_RGB5 = $8050;
  459. GL_RGB565 = $8D62;
  460. GL_RGB8 = $8051;
  461. GL_RGB10 = $8052;
  462. GL_RGB12 = $8053;
  463. GL_RGB16 = $8054;
  464. GL_RGBA = $1908;
  465. GL_BGRA = $80E1;
  466. GL_RGBA2 = $8055;
  467. GL_RGBA4 = $8056;
  468. GL_RGB5_A1 = $8057;
  469. GL_RGBA8 = $8058;
  470. GL_RGB10_A2 = $8059;
  471. GL_RGBA12 = $805A;
  472. GL_RGBA16 = $805B;
  473. GL_DEPTH_COMPONENT = $1902;
  474. GL_DEPTH_COMPONENT16 = $81A5;
  475. GL_DEPTH_COMPONENT24 = $81A6;
  476. GL_DEPTH_COMPONENT32 = $81A7;
  477. GL_COMPRESSED_RGB = $84ED;
  478. GL_COMPRESSED_RGBA = $84EE;
  479. GL_COMPRESSED_RGB_S3TC_DXT1_EXT = $83F0;
  480. GL_COMPRESSED_RGBA_S3TC_DXT1_EXT = $83F1;
  481. GL_COMPRESSED_RGBA_S3TC_DXT3_EXT = $83F2;
  482. GL_COMPRESSED_RGBA_S3TC_DXT5_EXT = $83F3;
  483. GL_UNSIGNED_BYTE = $1401;
  484. GL_UNSIGNED_BYTE_3_3_2 = $8032;
  485. GL_UNSIGNED_BYTE_2_3_3_REV = $8362;
  486. GL_UNSIGNED_SHORT = $1403;
  487. GL_UNSIGNED_SHORT_5_6_5 = $8363;
  488. GL_UNSIGNED_SHORT_4_4_4_4 = $8033;
  489. GL_UNSIGNED_SHORT_5_5_5_1 = $8034;
  490. GL_UNSIGNED_SHORT_5_6_5_REV = $8364;
  491. GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;
  492. GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;
  493. GL_UNSIGNED_INT = $1405;
  494. GL_UNSIGNED_INT_8_8_8_8 = $8035;
  495. GL_UNSIGNED_INT_10_10_10_2 = $8036;
  496. GL_UNSIGNED_INT_8_8_8_8_REV = $8367;
  497. GL_UNSIGNED_INT_2_10_10_10_REV = $8368;
  498. { Texture Filter }
  499. GL_TEXTURE_MAG_FILTER = $2800;
  500. GL_TEXTURE_MIN_FILTER = $2801;
  501. GL_NEAREST = $2600;
  502. GL_NEAREST_MIPMAP_NEAREST = $2700;
  503. GL_NEAREST_MIPMAP_LINEAR = $2702;
  504. GL_LINEAR = $2601;
  505. GL_LINEAR_MIPMAP_NEAREST = $2701;
  506. GL_LINEAR_MIPMAP_LINEAR = $2703;
  507. { Texture Wrap }
  508. GL_TEXTURE_WRAP_S = $2802;
  509. GL_TEXTURE_WRAP_T = $2803;
  510. GL_TEXTURE_WRAP_R = $8072;
  511. GL_CLAMP = $2900;
  512. GL_REPEAT = $2901;
  513. GL_CLAMP_TO_EDGE = $812F;
  514. GL_CLAMP_TO_BORDER = $812D;
  515. GL_MIRRORED_REPEAT = $8370;
  516. { Other }
  517. GL_GENERATE_MIPMAP = $8191;
  518. GL_TEXTURE_BORDER_COLOR = $1004;
  519. GL_MAX_TEXTURE_SIZE = $0D33;
  520. GL_PACK_ALIGNMENT = $0D05;
  521. GL_UNPACK_ALIGNMENT = $0CF5;
  522. GL_TEXTURE_MAX_ANISOTROPY_EXT = $84FE;
  523. GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;
  524. GL_MAX_CUBE_MAP_TEXTURE_SIZE = $851C;
  525. GL_TEXTURE_GEN_MODE = $2500;
  526. {$IF DEFINED(GLB_WIN)}
  527. libglu = 'glu32.dll';
  528. libopengl = 'opengl32.dll';
  529. {$ELSEIF DEFINED(GLB_LINUX)}
  530. libglu = 'libGLU.so.1';
  531. libopengl = 'libGL.so.1';
  532. {$IFEND}
  533. type
  534. GLboolean = BYTEBOOL;
  535. GLint = Integer;
  536. GLsizei = Integer;
  537. GLuint = Cardinal;
  538. GLfloat = Single;
  539. GLenum = Cardinal;
  540. PGLvoid = Pointer;
  541. PGLboolean = ^GLboolean;
  542. PGLint = ^GLint;
  543. PGLuint = ^GLuint;
  544. PGLfloat = ^GLfloat;
  545. TglCompressedTexImage1D = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  546. TglCompressedTexImage2D = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; height: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  547. TglGetCompressedTexImage = procedure(target: GLenum; level: GLint; img: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  548. {$IF DEFINED(GLB_WIN)}
  549. TwglGetProcAddress = function (ProcName: PAnsiChar): Pointer; stdcall;
  550. {$ELSEIF DEFINED(GLB_LINUX)}
  551. TglXGetProcAddress = function(ProcName: PAnsiChar): Pointer; cdecl;
  552. TglXGetProcAddressARB = function(const name: PAnsiChar): pointer; cdecl;
  553. {$IFEND}
  554. {$IF DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
  555. TglEnable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  556. TglDisable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  557. TglGetString = function(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  558. TglGetIntegerv = procedure(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  559. TglTexParameteri = procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  560. TglTexParameteriv = procedure(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  561. TglTexParameterfv = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  562. TglGetTexParameteriv = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  563. TglGetTexParameterfv = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  564. TglGetTexLevelParameteriv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  565. TglGetTexLevelParameterfv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  566. TglTexGeni = procedure(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  567. TglGenTextures = procedure(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  568. TglBindTexture = procedure(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  569. TglDeleteTextures = procedure(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  570. TglAreTexturesResident = function(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  571. TglReadPixels = procedure(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  572. TglPixelStorei = procedure(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  573. TglTexImage1D = procedure(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  574. TglTexImage2D = procedure(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; height: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  575. TglGetTexImage = procedure(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  576. TgluBuild1DMipmaps = function(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  577. TgluBuild2DMipmaps = function(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  578. {$ELSEIF DEFINED(GLB_NATIVE_OGL_STATIC)}
  579. procedure glEnable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  580. procedure glDisable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  581. function glGetString(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  582. procedure glGetIntegerv(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  583. procedure glTexParameteri(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  584. procedure glTexParameteriv(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  585. procedure glTexParameterfv(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  586. procedure glGetTexParameteriv(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  587. procedure glGetTexParameterfv(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  588. procedure glGetTexLevelParameteriv(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  589. procedure glGetTexLevelParameterfv(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  590. procedure glTexGeni(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  591. procedure glGenTextures(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  592. procedure glBindTexture(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  593. procedure glDeleteTextures(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  594. function glAreTexturesResident(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  595. procedure glReadPixels(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  596. procedure glPixelStorei(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  597. procedure glTexImage1D(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  598. procedure glTexImage2D(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; height: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  599. procedure glGetTexImage(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  600. function gluBuild1DMipmaps(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
  601. function gluBuild2DMipmaps(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
  602. {$IFEND}
  603. var
  604. GL_VERSION_1_2,
  605. GL_VERSION_1_3,
  606. GL_VERSION_1_4,
  607. GL_VERSION_2_0,
  608. GL_VERSION_3_3,
  609. GL_SGIS_generate_mipmap,
  610. GL_ARB_texture_border_clamp,
  611. GL_ARB_texture_mirrored_repeat,
  612. GL_ARB_texture_rectangle,
  613. GL_ARB_texture_non_power_of_two,
  614. GL_ARB_texture_swizzle,
  615. GL_ARB_texture_cube_map,
  616. GL_IBM_texture_mirrored_repeat,
  617. GL_NV_texture_rectangle,
  618. GL_EXT_texture_edge_clamp,
  619. GL_EXT_texture_rectangle,
  620. GL_EXT_texture_swizzle,
  621. GL_EXT_texture_cube_map,
  622. GL_EXT_texture_filter_anisotropic: Boolean;
  623. glCompressedTexImage1D: TglCompressedTexImage1D;
  624. glCompressedTexImage2D: TglCompressedTexImage2D;
  625. glGetCompressedTexImage: TglGetCompressedTexImage;
  626. {$IF DEFINED(GLB_WIN)}
  627. wglGetProcAddress: TwglGetProcAddress;
  628. {$ELSEIF DEFINED(GLB_LINUX)}
  629. glXGetProcAddress: TglXGetProcAddress;
  630. glXGetProcAddressARB: TglXGetProcAddress;
  631. {$IFEND}
  632. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  633. glEnable: TglEnable;
  634. glDisable: TglDisable;
  635. glGetString: TglGetString;
  636. glGetIntegerv: TglGetIntegerv;
  637. glTexParameteri: TglTexParameteri;
  638. glTexParameteriv: TglTexParameteriv;
  639. glTexParameterfv: TglTexParameterfv;
  640. glGetTexParameteriv: TglGetTexParameteriv;
  641. glGetTexParameterfv: TglGetTexParameterfv;
  642. glGetTexLevelParameteriv: TglGetTexLevelParameteriv;
  643. glGetTexLevelParameterfv: TglGetTexLevelParameterfv;
  644. glTexGeni: TglTexGeni;
  645. glGenTextures: TglGenTextures;
  646. glBindTexture: TglBindTexture;
  647. glDeleteTextures: TglDeleteTextures;
  648. glAreTexturesResident: TglAreTexturesResident;
  649. glReadPixels: TglReadPixels;
  650. glPixelStorei: TglPixelStorei;
  651. glTexImage1D: TglTexImage1D;
  652. glTexImage2D: TglTexImage2D;
  653. glGetTexImage: TglGetTexImage;
  654. gluBuild1DMipmaps: TgluBuild1DMipmaps;
  655. gluBuild2DMipmaps: TgluBuild2DMipmaps;
  656. {$ENDIF}
  657. {$ENDIF}
  658. type
  659. ////////////////////////////////////////////////////////////////////////////////////////////////////
  660. TglBitmapFormat = (
  661. tfEmpty = 0, //must be smallest value!
  662. tfAlpha4,
  663. tfAlpha8,
  664. tfAlpha12,
  665. tfAlpha16,
  666. tfLuminance4,
  667. tfLuminance8,
  668. tfLuminance12,
  669. tfLuminance16,
  670. tfLuminance4Alpha4,
  671. tfLuminance6Alpha2,
  672. tfLuminance8Alpha8,
  673. tfLuminance12Alpha4,
  674. tfLuminance12Alpha12,
  675. tfLuminance16Alpha16,
  676. tfR3G3B2,
  677. tfRGB4,
  678. tfR5G6B5,
  679. tfRGB5,
  680. tfRGB8,
  681. tfRGB10,
  682. tfRGB12,
  683. tfRGB16,
  684. tfRGBA2,
  685. tfRGBA4,
  686. tfRGB5A1,
  687. tfRGBA8,
  688. tfRGB10A2,
  689. tfRGBA12,
  690. tfRGBA16,
  691. tfBGR4,
  692. tfB5G6R5,
  693. tfBGR5,
  694. tfBGR8,
  695. tfBGR10,
  696. tfBGR12,
  697. tfBGR16,
  698. tfBGRA2,
  699. tfBGRA4,
  700. tfBGR5A1,
  701. tfBGRA8,
  702. tfBGR10A2,
  703. tfBGRA12,
  704. tfBGRA16,
  705. tfDepth16,
  706. tfDepth24,
  707. tfDepth32,
  708. tfS3tcDtx1RGBA,
  709. tfS3tcDtx3RGBA,
  710. tfS3tcDtx5RGBA
  711. );
  712. TglBitmapFileType = (
  713. {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG, {$ENDIF}
  714. {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
  715. ftDDS,
  716. ftTGA,
  717. ftBMP);
  718. TglBitmapFileTypes = set of TglBitmapFileType;
  719. TglBitmapMipMap = (
  720. mmNone,
  721. mmMipmap,
  722. mmMipmapGlu);
  723. TglBitmapNormalMapFunc = (
  724. nm4Samples,
  725. nmSobel,
  726. nm3x3,
  727. nm5x5);
  728. ////////////////////////////////////////////////////////////////////////////////////////////////////
  729. EglBitmap = class(Exception);
  730. EglBitmapNotSupported = class(Exception);
  731. EglBitmapSizeToLarge = class(EglBitmap);
  732. EglBitmapNonPowerOfTwo = class(EglBitmap);
  733. EglBitmapUnsupportedFormat = class(EglBitmap)
  734. constructor Create(const aFormat: TglBitmapFormat); overload;
  735. constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;
  736. end;
  737. ////////////////////////////////////////////////////////////////////////////////////////////////////
  738. TglBitmapColorRec = packed record
  739. case Integer of
  740. 0: (r, g, b, a: Cardinal);
  741. 1: (arr: array[0..3] of Cardinal);
  742. end;
  743. TglBitmapPixelData = packed record
  744. Data, Range: TglBitmapColorRec;
  745. Format: TglBitmapFormat;
  746. end;
  747. PglBitmapPixelData = ^TglBitmapPixelData;
  748. ////////////////////////////////////////////////////////////////////////////////////////////////////
  749. TglBitmapPixelPositionFields = set of (ffX, ffY);
  750. TglBitmapPixelPosition = record
  751. Fields : TglBitmapPixelPositionFields;
  752. X : Word;
  753. Y : Word;
  754. end;
  755. TglBitmapFormatDescriptor = class(TObject)
  756. protected
  757. function GetIsCompressed: Boolean; virtual; abstract;
  758. function GetHasAlpha: Boolean; virtual; abstract;
  759. function GetglDataFormat: GLenum; virtual; abstract;
  760. function GetglFormat: GLenum; virtual; abstract;
  761. function GetglInternalFormat: GLenum; virtual; abstract;
  762. public
  763. property IsCompressed: Boolean read GetIsCompressed;
  764. property HasAlpha: Boolean read GetHasAlpha;
  765. property glFormat: GLenum read GetglFormat;
  766. property glInternalFormat: GLenum read GetglInternalFormat;
  767. property glDataFormat: GLenum read GetglDataFormat;
  768. end;
  769. ////////////////////////////////////////////////////////////////////////////////////////////////////
  770. TglBitmap = class;
  771. TglBitmapFunctionRec = record
  772. Sender: TglBitmap;
  773. Size: TglBitmapPixelPosition;
  774. Position: TglBitmapPixelPosition;
  775. Source: TglBitmapPixelData;
  776. Dest: TglBitmapPixelData;
  777. Args: Pointer;
  778. end;
  779. TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
  780. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  781. TglBitmap = class
  782. private
  783. function GetFormatDesc: TglBitmapFormatDescriptor;
  784. protected
  785. fID: GLuint;
  786. fTarget: GLuint;
  787. fAnisotropic: Integer;
  788. fDeleteTextureOnFree: Boolean;
  789. fFreeDataAfterGenTexture: Boolean;
  790. fData: PByte;
  791. fIsResident: Boolean;
  792. fBorderColor: array[0..3] of Single;
  793. fDimension: TglBitmapPixelPosition;
  794. fMipMap: TglBitmapMipMap;
  795. fFormat: TglBitmapFormat;
  796. // Mapping
  797. fPixelSize: Integer;
  798. fRowSize: Integer;
  799. // Filtering
  800. fFilterMin: GLenum;
  801. fFilterMag: GLenum;
  802. // TexturWarp
  803. fWrapS: GLenum;
  804. fWrapT: GLenum;
  805. fWrapR: GLenum;
  806. //Swizzle
  807. fSwizzle: array[0..3] of GLenum;
  808. // CustomData
  809. fFilename: String;
  810. fCustomName: String;
  811. fCustomNameW: WideString;
  812. fCustomData: Pointer;
  813. //Getter
  814. function GetWidth: Integer; virtual;
  815. function GetHeight: Integer; virtual;
  816. function GetFileWidth: Integer; virtual;
  817. function GetFileHeight: Integer; virtual;
  818. //Setter
  819. procedure SetCustomData(const aValue: Pointer);
  820. procedure SetCustomName(const aValue: String);
  821. procedure SetCustomNameW(const aValue: WideString);
  822. procedure SetDeleteTextureOnFree(const aValue: Boolean);
  823. procedure SetFormat(const aValue: TglBitmapFormat);
  824. procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
  825. procedure SetID(const aValue: Cardinal);
  826. procedure SetMipMap(const aValue: TglBitmapMipMap);
  827. procedure SetTarget(const aValue: Cardinal);
  828. procedure SetAnisotropic(const aValue: Integer);
  829. procedure CreateID;
  830. procedure SetupParameters(out aBuildWithGlu: Boolean);
  831. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  832. const aWidth: Integer = -1; const aHeight: Integer = -1); virtual; //be careful, aData could be freed by this method
  833. procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
  834. function FlipHorz: Boolean; virtual;
  835. function FlipVert: Boolean; virtual;
  836. property Width: Integer read GetWidth;
  837. property Height: Integer read GetHeight;
  838. property FileWidth: Integer read GetFileWidth;
  839. property FileHeight: Integer read GetFileHeight;
  840. public
  841. //Properties
  842. property ID: Cardinal read fID write SetID;
  843. property Target: Cardinal read fTarget write SetTarget;
  844. property Format: TglBitmapFormat read fFormat write SetFormat;
  845. property MipMap: TglBitmapMipMap read fMipMap write SetMipMap;
  846. property Anisotropic: Integer read fAnisotropic write SetAnisotropic;
  847. property FormatDesc: TglBitmapFormatDescriptor read GetFormatDesc;
  848. property Filename: String read fFilename;
  849. property CustomName: String read fCustomName write SetCustomName;
  850. property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
  851. property CustomData: Pointer read fCustomData write SetCustomData;
  852. property DeleteTextureOnFree: Boolean read fDeleteTextureOnFree write SetDeleteTextureOnFree;
  853. property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
  854. property Dimension: TglBitmapPixelPosition read fDimension;
  855. property Data: PByte read fData;
  856. property IsResident: Boolean read fIsResident;
  857. procedure AfterConstruction; override;
  858. procedure BeforeDestruction; override;
  859. procedure PrepareResType(var aResource: String; var aResType: PChar);
  860. //Load
  861. procedure LoadFromFile(const aFilename: String);
  862. procedure LoadFromStream(const aStream: TStream); virtual;
  863. procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  864. const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
  865. procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
  866. procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  867. //Save
  868. procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  869. procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
  870. //Convert
  871. function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
  872. function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  873. const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
  874. public
  875. //Alpha & Co
  876. {$IFDEF GLB_SDL}
  877. function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  878. function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  879. function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  880. function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
  881. const aArgs: Pointer = nil): Boolean;
  882. {$ENDIF}
  883. {$IFDEF GLB_DELPHI}
  884. function AssignToBitmap(const aBitmap: TBitmap): Boolean;
  885. function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  886. function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  887. function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
  888. const aArgs: Pointer = nil): Boolean;
  889. {$ENDIF}
  890. {$IFDEF GLB_LAZARUS}
  891. function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  892. function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  893. function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  894. function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil;
  895. const aArgs: Pointer = nil): Boolean;
  896. {$ENDIF}
  897. function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil;
  898. const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  899. function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  900. const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  901. function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
  902. function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  903. function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  904. function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  905. function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
  906. function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
  907. function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
  908. function AddAlphaFromValue(const aAlpha: Byte): Boolean;
  909. function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  910. function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  911. function RemoveAlpha: Boolean; virtual;
  912. public
  913. //Common
  914. function Clone: TglBitmap;
  915. function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
  916. procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
  917. procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  918. procedure FreeData;
  919. //ColorFill
  920. procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
  921. procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
  922. procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
  923. //TexParameters
  924. procedure SetFilter(const aMin, aMag: GLenum);
  925. procedure SetWrap(
  926. const S: GLenum = GL_CLAMP_TO_EDGE;
  927. const T: GLenum = GL_CLAMP_TO_EDGE;
  928. const R: GLenum = GL_CLAMP_TO_EDGE);
  929. procedure SetSwizzle(const r, g, b, a: GLenum);
  930. procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
  931. procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
  932. //Constructors
  933. constructor Create; overload;
  934. constructor Create(const aFileName: String); overload;
  935. constructor Create(const aStream: TStream); overload;
  936. constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat); overload;
  937. constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
  938. constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
  939. constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
  940. private
  941. {$IFDEF GLB_SUPPORT_PNG_READ} function LoadPNG(const aStream: TStream): Boolean; virtual; {$ENDIF}
  942. {$ifdef GLB_SUPPORT_PNG_WRITE} procedure SavePNG(const aStream: TStream); virtual; {$ENDIF}
  943. {$IFDEF GLB_SUPPORT_JPEG_READ} function LoadJPEG(const aStream: TStream): Boolean; virtual; {$ENDIF}
  944. {$IFDEF GLB_SUPPORT_JPEG_WRITE} procedure SaveJPEG(const aStream: TStream); virtual; {$ENDIF}
  945. function LoadBMP(const aStream: TStream): Boolean; virtual;
  946. procedure SaveBMP(const aStream: TStream); virtual;
  947. function LoadTGA(const aStream: TStream): Boolean; virtual;
  948. procedure SaveTGA(const aStream: TStream); virtual;
  949. function LoadDDS(const aStream: TStream): Boolean; virtual;
  950. procedure SaveDDS(const aStream: TStream); virtual;
  951. end;
  952. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  953. TglBitmap1D = class(TglBitmap)
  954. protected
  955. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  956. const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
  957. procedure UploadData(const aBuildWithGlu: Boolean);
  958. public
  959. property Width;
  960. procedure AfterConstruction; override;
  961. function FlipHorz: Boolean; override;
  962. procedure GenTexture(const aTestTextureSize: Boolean = true); override;
  963. end;
  964. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  965. TglBitmap2D = class(TglBitmap)
  966. protected
  967. fLines: array of PByte;
  968. function GetScanline(const aIndex: Integer): Pointer;
  969. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  970. const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
  971. procedure UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
  972. public
  973. property Width;
  974. property Height;
  975. property Scanline[const aIndex: Integer]: Pointer read GetScanline;
  976. procedure AfterConstruction; override;
  977. procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  978. procedure GetDataFromTexture;
  979. procedure GenTexture(const aTestTextureSize: Boolean = true); override;
  980. function FlipHorz: Boolean; override;
  981. function FlipVert: Boolean; override;
  982. procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
  983. const aScale: Single = 2; const aUseAlpha: Boolean = false);
  984. end;
  985. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  986. TglBitmapCubeMap = class(TglBitmap2D)
  987. protected
  988. fGenMode: Integer;
  989. procedure GenTexture(const aTestTextureSize: Boolean = true); reintroduce;
  990. public
  991. procedure AfterConstruction; override;
  992. procedure GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean = true);
  993. procedure Bind(const aEnableTexCoordsGen: Boolean = true; const aEnableTextureUnit: Boolean = true); reintroduce; virtual;
  994. procedure Unbind(const aDisableTexCoordsGen: Boolean = true; const aDisableTextureUnit: Boolean = true); reintroduce; virtual;
  995. end;
  996. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  997. TglBitmapNormalMap = class(TglBitmapCubeMap)
  998. public
  999. procedure AfterConstruction; override;
  1000. procedure GenerateNormalMap(const aSize: Integer = 32; const aTestTextureSize: Boolean = true);
  1001. end;
  1002. const
  1003. NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
  1004. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1005. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1006. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1007. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1008. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1009. procedure glBitmapSetDefaultWrap(
  1010. const S: Cardinal = GL_CLAMP_TO_EDGE;
  1011. const T: Cardinal = GL_CLAMP_TO_EDGE;
  1012. const R: Cardinal = GL_CLAMP_TO_EDGE);
  1013. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1014. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1015. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1016. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1017. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  1018. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  1019. function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
  1020. function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
  1021. function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
  1022. var
  1023. glBitmapDefaultDeleteTextureOnFree: Boolean;
  1024. glBitmapDefaultFreeDataAfterGenTextures: Boolean;
  1025. glBitmapDefaultFormat: TglBitmapFormat;
  1026. glBitmapDefaultMipmap: TglBitmapMipMap;
  1027. glBitmapDefaultFilterMin: Cardinal;
  1028. glBitmapDefaultFilterMag: Cardinal;
  1029. glBitmapDefaultWrapS: Cardinal;
  1030. glBitmapDefaultWrapT: Cardinal;
  1031. glBitmapDefaultWrapR: Cardinal;
  1032. glDefaultSwizzle: array[0..3] of GLenum;
  1033. {$IFDEF GLB_DELPHI}
  1034. function CreateGrayPalette: HPALETTE;
  1035. {$ENDIF}
  1036. implementation
  1037. uses
  1038. Math, syncobjs, typinfo;
  1039. type
  1040. {$IFNDEF fpc}
  1041. QWord = System.UInt64;
  1042. PQWord = ^QWord;
  1043. PtrInt = Longint;
  1044. PtrUInt = DWord;
  1045. {$ENDIF}
  1046. ////////////////////////////////////////////////////////////////////////////////////////////////////
  1047. TShiftRec = packed record
  1048. case Integer of
  1049. 0: (r, g, b, a: Byte);
  1050. 1: (arr: array[0..3] of Byte);
  1051. end;
  1052. TFormatDescriptor = class(TglBitmapFormatDescriptor)
  1053. private
  1054. function GetRedMask: QWord;
  1055. function GetGreenMask: QWord;
  1056. function GetBlueMask: QWord;
  1057. function GetAlphaMask: QWord;
  1058. protected
  1059. fFormat: TglBitmapFormat;
  1060. fWithAlpha: TglBitmapFormat;
  1061. fWithoutAlpha: TglBitmapFormat;
  1062. fRGBInverted: TglBitmapFormat;
  1063. fUncompressed: TglBitmapFormat;
  1064. fPixelSize: Single;
  1065. fIsCompressed: Boolean;
  1066. fRange: TglBitmapColorRec;
  1067. fShift: TShiftRec;
  1068. fglFormat: GLenum;
  1069. fglInternalFormat: GLenum;
  1070. fglDataFormat: GLenum;
  1071. function GetIsCompressed: Boolean; override;
  1072. function GetHasAlpha: Boolean; override;
  1073. function GetglFormat: GLenum; override;
  1074. function GetglInternalFormat: GLenum; override;
  1075. function GetglDataFormat: GLenum; override;
  1076. function GetComponents: Integer; virtual;
  1077. public
  1078. property Format: TglBitmapFormat read fFormat;
  1079. property WithAlpha: TglBitmapFormat read fWithAlpha;
  1080. property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;
  1081. property RGBInverted: TglBitmapFormat read fRGBInverted;
  1082. property Components: Integer read GetComponents;
  1083. property PixelSize: Single read fPixelSize;
  1084. property Range: TglBitmapColorRec read fRange;
  1085. property Shift: TShiftRec read fShift;
  1086. property RedMask: QWord read GetRedMask;
  1087. property GreenMask: QWord read GetGreenMask;
  1088. property BlueMask: QWord read GetBlueMask;
  1089. property AlphaMask: QWord read GetAlphaMask;
  1090. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
  1091. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
  1092. function GetSize(const aSize: TglBitmapPixelPosition): Integer; overload; virtual;
  1093. function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
  1094. function CreateMappingData: Pointer; virtual;
  1095. procedure FreeMappingData(var aMappingData: Pointer); virtual;
  1096. function IsEmpty: Boolean; virtual;
  1097. function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean; virtual;
  1098. procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
  1099. constructor Create; virtual;
  1100. public
  1101. class procedure Init;
  1102. class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1103. class function GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1104. class procedure Clear;
  1105. class procedure Finalize;
  1106. end;
  1107. TFormatDescriptorClass = class of TFormatDescriptor;
  1108. TfdEmpty = class(TFormatDescriptor);
  1109. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1110. TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1111. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1112. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1113. constructor Create; override;
  1114. end;
  1115. TfdLuminance_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1116. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1117. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1118. constructor Create; override;
  1119. end;
  1120. TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1121. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1122. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1123. constructor Create; override;
  1124. end;
  1125. TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte
  1126. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1127. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1128. constructor Create; override;
  1129. end;
  1130. TfdRGB_UB3 = class(TFormatDescriptor) //3* unsigned byte
  1131. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1132. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1133. constructor Create; override;
  1134. end;
  1135. TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
  1136. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1137. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1138. constructor Create; override;
  1139. end;
  1140. TfdRGBA_UB4 = class(TfdRGB_UB3) //4* unsigned byte
  1141. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1142. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1143. constructor Create; override;
  1144. end;
  1145. TfdBGRA_UB4 = class(TfdBGR_UB3) //4* unsigned byte (inverse)
  1146. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1147. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1148. constructor Create; override;
  1149. end;
  1150. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1151. TfdAlpha_US1 = class(TFormatDescriptor) //1* unsigned short
  1152. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1153. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1154. constructor Create; override;
  1155. end;
  1156. TfdLuminance_US1 = class(TFormatDescriptor) //1* unsigned short
  1157. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1158. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1159. constructor Create; override;
  1160. end;
  1161. TfdUniversal_US1 = class(TFormatDescriptor) //1* unsigned short
  1162. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1163. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1164. constructor Create; override;
  1165. end;
  1166. TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short
  1167. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1168. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1169. constructor Create; override;
  1170. end;
  1171. TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short
  1172. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1173. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1174. constructor Create; override;
  1175. end;
  1176. TfdRGB_US3 = class(TFormatDescriptor) //3* unsigned short
  1177. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1178. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1179. constructor Create; override;
  1180. end;
  1181. TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)
  1182. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1183. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1184. constructor Create; override;
  1185. end;
  1186. TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
  1187. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1188. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1189. constructor Create; override;
  1190. end;
  1191. TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
  1192. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1193. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1194. constructor Create; override;
  1195. end;
  1196. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1197. TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int
  1198. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1199. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1200. constructor Create; override;
  1201. end;
  1202. TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int
  1203. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1204. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1205. constructor Create; override;
  1206. end;
  1207. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1208. TfdAlpha4 = class(TfdAlpha_UB1)
  1209. constructor Create; override;
  1210. end;
  1211. TfdAlpha8 = class(TfdAlpha_UB1)
  1212. constructor Create; override;
  1213. end;
  1214. TfdAlpha12 = class(TfdAlpha_US1)
  1215. constructor Create; override;
  1216. end;
  1217. TfdAlpha16 = class(TfdAlpha_US1)
  1218. constructor Create; override;
  1219. end;
  1220. TfdLuminance4 = class(TfdLuminance_UB1)
  1221. constructor Create; override;
  1222. end;
  1223. TfdLuminance8 = class(TfdLuminance_UB1)
  1224. constructor Create; override;
  1225. end;
  1226. TfdLuminance12 = class(TfdLuminance_US1)
  1227. constructor Create; override;
  1228. end;
  1229. TfdLuminance16 = class(TfdLuminance_US1)
  1230. constructor Create; override;
  1231. end;
  1232. TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
  1233. constructor Create; override;
  1234. end;
  1235. TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
  1236. constructor Create; override;
  1237. end;
  1238. TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
  1239. constructor Create; override;
  1240. end;
  1241. TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
  1242. constructor Create; override;
  1243. end;
  1244. TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)
  1245. constructor Create; override;
  1246. end;
  1247. TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
  1248. constructor Create; override;
  1249. end;
  1250. TfdR3G3B2 = class(TfdUniversal_UB1)
  1251. constructor Create; override;
  1252. end;
  1253. TfdRGB4 = class(TfdUniversal_US1)
  1254. constructor Create; override;
  1255. end;
  1256. TfdR5G6B5 = class(TfdUniversal_US1)
  1257. constructor Create; override;
  1258. end;
  1259. TfdRGB5 = class(TfdUniversal_US1)
  1260. constructor Create; override;
  1261. end;
  1262. TfdRGB8 = class(TfdRGB_UB3)
  1263. constructor Create; override;
  1264. end;
  1265. TfdRGB10 = class(TfdUniversal_UI1)
  1266. constructor Create; override;
  1267. end;
  1268. TfdRGB12 = class(TfdRGB_US3)
  1269. constructor Create; override;
  1270. end;
  1271. TfdRGB16 = class(TfdRGB_US3)
  1272. constructor Create; override;
  1273. end;
  1274. TfdRGBA2 = class(TfdRGBA_UB4)
  1275. constructor Create; override;
  1276. end;
  1277. TfdRGBA4 = class(TfdUniversal_US1)
  1278. constructor Create; override;
  1279. end;
  1280. TfdRGB5A1 = class(TfdUniversal_US1)
  1281. constructor Create; override;
  1282. end;
  1283. TfdRGBA8 = class(TfdRGBA_UB4)
  1284. constructor Create; override;
  1285. end;
  1286. TfdRGB10A2 = class(TfdUniversal_UI1)
  1287. constructor Create; override;
  1288. end;
  1289. TfdRGBA12 = class(TfdRGBA_US4)
  1290. constructor Create; override;
  1291. end;
  1292. TfdRGBA16 = class(TfdRGBA_US4)
  1293. constructor Create; override;
  1294. end;
  1295. TfdBGR4 = class(TfdUniversal_US1)
  1296. constructor Create; override;
  1297. end;
  1298. TfdB5G6R5 = class(TfdUniversal_US1)
  1299. constructor Create; override;
  1300. end;
  1301. TfdBGR5 = class(TfdUniversal_US1)
  1302. constructor Create; override;
  1303. end;
  1304. TfdBGR8 = class(TfdBGR_UB3)
  1305. constructor Create; override;
  1306. end;
  1307. TfdBGR10 = class(TfdUniversal_UI1)
  1308. constructor Create; override;
  1309. end;
  1310. TfdBGR12 = class(TfdBGR_US3)
  1311. constructor Create; override;
  1312. end;
  1313. TfdBGR16 = class(TfdBGR_US3)
  1314. constructor Create; override;
  1315. end;
  1316. TfdBGRA2 = class(TfdBGRA_UB4)
  1317. constructor Create; override;
  1318. end;
  1319. TfdBGRA4 = class(TfdUniversal_US1)
  1320. constructor Create; override;
  1321. end;
  1322. TfdBGR5A1 = class(TfdUniversal_US1)
  1323. constructor Create; override;
  1324. end;
  1325. TfdBGRA8 = class(TfdBGRA_UB4)
  1326. constructor Create; override;
  1327. end;
  1328. TfdBGR10A2 = class(TfdUniversal_UI1)
  1329. constructor Create; override;
  1330. end;
  1331. TfdBGRA12 = class(TfdBGRA_US4)
  1332. constructor Create; override;
  1333. end;
  1334. TfdBGRA16 = class(TfdBGRA_US4)
  1335. constructor Create; override;
  1336. end;
  1337. TfdDepth16 = class(TfdDepth_US1)
  1338. constructor Create; override;
  1339. end;
  1340. TfdDepth24 = class(TfdDepth_UI1)
  1341. constructor Create; override;
  1342. end;
  1343. TfdDepth32 = class(TfdDepth_UI1)
  1344. constructor Create; override;
  1345. end;
  1346. TfdS3tcDtx1RGBA = class(TFormatDescriptor)
  1347. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1348. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1349. constructor Create; override;
  1350. end;
  1351. TfdS3tcDtx3RGBA = class(TFormatDescriptor)
  1352. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1353. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1354. constructor Create; override;
  1355. end;
  1356. TfdS3tcDtx5RGBA = class(TFormatDescriptor)
  1357. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1358. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1359. constructor Create; override;
  1360. end;
  1361. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1362. TbmpBitfieldFormat = class(TFormatDescriptor)
  1363. private
  1364. procedure SetRedMask (const aValue: QWord);
  1365. procedure SetGreenMask(const aValue: QWord);
  1366. procedure SetBlueMask (const aValue: QWord);
  1367. procedure SetAlphaMask(const aValue: QWord);
  1368. procedure Update(aMask: QWord; out aRange: Cardinal; out aShift: Byte);
  1369. public
  1370. property RedMask: QWord read GetRedMask write SetRedMask;
  1371. property GreenMask: QWord read GetGreenMask write SetGreenMask;
  1372. property BlueMask: QWord read GetBlueMask write SetBlueMask;
  1373. property AlphaMask: QWord read GetAlphaMask write SetAlphaMask;
  1374. property PixelSize: Single read fPixelSize write fPixelSize;
  1375. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1376. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1377. end;
  1378. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1379. TbmpColorTableEnty = packed record
  1380. b, g, r, a: Byte;
  1381. end;
  1382. TbmpColorTable = array of TbmpColorTableEnty;
  1383. TbmpColorTableFormat = class(TFormatDescriptor)
  1384. private
  1385. fColorTable: TbmpColorTable;
  1386. public
  1387. property PixelSize: Single read fPixelSize write fPixelSize;
  1388. property ColorTable: TbmpColorTable read fColorTable write fColorTable;
  1389. property Range: TglBitmapColorRec read fRange write fRange;
  1390. property Shift: TShiftRec read fShift write fShift;
  1391. property Format: TglBitmapFormat read fFormat write fFormat;
  1392. procedure CreateColorTable;
  1393. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1394. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1395. destructor Destroy; override;
  1396. end;
  1397. const
  1398. LUMINANCE_WEIGHT_R = 0.30;
  1399. LUMINANCE_WEIGHT_G = 0.59;
  1400. LUMINANCE_WEIGHT_B = 0.11;
  1401. ALPHA_WEIGHT_R = 0.30;
  1402. ALPHA_WEIGHT_G = 0.59;
  1403. ALPHA_WEIGHT_B = 0.11;
  1404. DEPTH_WEIGHT_R = 0.333333333;
  1405. DEPTH_WEIGHT_G = 0.333333333;
  1406. DEPTH_WEIGHT_B = 0.333333333;
  1407. UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
  1408. FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
  1409. TfdEmpty,
  1410. TfdAlpha4,
  1411. TfdAlpha8,
  1412. TfdAlpha12,
  1413. TfdAlpha16,
  1414. TfdLuminance4,
  1415. TfdLuminance8,
  1416. TfdLuminance12,
  1417. TfdLuminance16,
  1418. TfdLuminance4Alpha4,
  1419. TfdLuminance6Alpha2,
  1420. TfdLuminance8Alpha8,
  1421. TfdLuminance12Alpha4,
  1422. TfdLuminance12Alpha12,
  1423. TfdLuminance16Alpha16,
  1424. TfdR3G3B2,
  1425. TfdRGB4,
  1426. TfdR5G6B5,
  1427. TfdRGB5,
  1428. TfdRGB8,
  1429. TfdRGB10,
  1430. TfdRGB12,
  1431. TfdRGB16,
  1432. TfdRGBA2,
  1433. TfdRGBA4,
  1434. TfdRGB5A1,
  1435. TfdRGBA8,
  1436. TfdRGB10A2,
  1437. TfdRGBA12,
  1438. TfdRGBA16,
  1439. TfdBGR4,
  1440. TfdB5G6R5,
  1441. TfdBGR5,
  1442. TfdBGR8,
  1443. TfdBGR10,
  1444. TfdBGR12,
  1445. TfdBGR16,
  1446. TfdBGRA2,
  1447. TfdBGRA4,
  1448. TfdBGR5A1,
  1449. TfdBGRA8,
  1450. TfdBGR10A2,
  1451. TfdBGRA12,
  1452. TfdBGRA16,
  1453. TfdDepth16,
  1454. TfdDepth24,
  1455. TfdDepth32,
  1456. TfdS3tcDtx1RGBA,
  1457. TfdS3tcDtx3RGBA,
  1458. TfdS3tcDtx5RGBA
  1459. );
  1460. var
  1461. FormatDescriptorCS: TCriticalSection;
  1462. FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
  1463. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1464. constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
  1465. begin
  1466. inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1467. end;
  1468. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1469. constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
  1470. begin
  1471. inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1472. end;
  1473. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1474. function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
  1475. begin
  1476. result.Fields := [];
  1477. if X >= 0 then
  1478. result.Fields := result.Fields + [ffX];
  1479. if Y >= 0 then
  1480. result.Fields := result.Fields + [ffY];
  1481. result.X := Max(0, X);
  1482. result.Y := Max(0, Y);
  1483. end;
  1484. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1485. function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
  1486. begin
  1487. result.r := r;
  1488. result.g := g;
  1489. result.b := b;
  1490. result.a := a;
  1491. end;
  1492. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1493. function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
  1494. var
  1495. i: Integer;
  1496. begin
  1497. result := false;
  1498. for i := 0 to high(r1.arr) do
  1499. if (r1.arr[i] <> r2.arr[i]) then
  1500. exit;
  1501. result := true;
  1502. end;
  1503. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1504. function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
  1505. begin
  1506. result.r := r;
  1507. result.g := g;
  1508. result.b := b;
  1509. result.a := a;
  1510. end;
  1511. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1512. function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
  1513. begin
  1514. result := [];
  1515. if (aFormat in [
  1516. //4 bbp
  1517. tfLuminance4,
  1518. //8bpp
  1519. tfR3G3B2, tfLuminance8,
  1520. //16bpp
  1521. tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
  1522. tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,
  1523. //24bpp
  1524. tfBGR8, tfRGB8,
  1525. //32bpp
  1526. tfRGB10, tfRGB10A2, tfRGBA8,
  1527. tfBGR10, tfBGR10A2, tfBGRA8]) then
  1528. result := result + [ftBMP];
  1529. if (aFormat in [
  1530. //8 bpp
  1531. tfLuminance8, tfAlpha8,
  1532. //16 bpp
  1533. tfLuminance16, tfLuminance8Alpha8,
  1534. tfRGB5, tfRGB5A1, tfRGBA4,
  1535. tfBGR5, tfBGR5A1, tfBGRA4,
  1536. //24 bpp
  1537. tfRGB8, tfBGR8,
  1538. //32 bpp
  1539. tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
  1540. result := result + [ftTGA];
  1541. if (aFormat in [
  1542. //8 bpp
  1543. tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,
  1544. tfR3G3B2, tfRGBA2, tfBGRA2,
  1545. //16 bpp
  1546. tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,
  1547. tfRGB4, tfR5G6B5, tfRGB5, tfRGBA4, tfRGB5A1,
  1548. tfBGR4, tfB5G6R5, tfBGR5, tfBGRA4, tfBGR5A1,
  1549. //24 bpp
  1550. tfRGB8, tfBGR8,
  1551. //32 bbp
  1552. tfLuminance16Alpha16,
  1553. tfRGBA8, tfRGB10A2,
  1554. tfBGRA8, tfBGR10A2,
  1555. //compressed
  1556. tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then
  1557. result := result + [ftDDS];
  1558. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  1559. if aFormat in [
  1560. tfAlpha8, tfLuminance8, tfLuminance8Alpha8,
  1561. tfRGB8, tfRGBA8,
  1562. tfBGR8, tfBGRA8] then
  1563. result := result + [ftPNG];
  1564. {$ENDIF}
  1565. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  1566. if aFormat in [tfAlpha8, tfLuminance8, tfRGB8, tfBGR8] then
  1567. result := result + [ftJPEG];
  1568. {$ENDIF}
  1569. end;
  1570. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1571. function IsPowerOfTwo(aNumber: Integer): Boolean;
  1572. begin
  1573. while (aNumber and 1) = 0 do
  1574. aNumber := aNumber shr 1;
  1575. result := aNumber = 1;
  1576. end;
  1577. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1578. function GetTopMostBit(aBitSet: QWord): Integer;
  1579. begin
  1580. result := 0;
  1581. while aBitSet > 0 do begin
  1582. inc(result);
  1583. aBitSet := aBitSet shr 1;
  1584. end;
  1585. end;
  1586. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1587. function CountSetBits(aBitSet: QWord): Integer;
  1588. begin
  1589. result := 0;
  1590. while aBitSet > 0 do begin
  1591. if (aBitSet and 1) = 1 then
  1592. inc(result);
  1593. aBitSet := aBitSet shr 1;
  1594. end;
  1595. end;
  1596. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1597. function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1598. begin
  1599. result := Trunc(
  1600. LUMINANCE_WEIGHT_R * aPixel.Data.r +
  1601. LUMINANCE_WEIGHT_G * aPixel.Data.g +
  1602. LUMINANCE_WEIGHT_B * aPixel.Data.b);
  1603. end;
  1604. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1605. function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1606. begin
  1607. result := Trunc(
  1608. DEPTH_WEIGHT_R * aPixel.Data.r +
  1609. DEPTH_WEIGHT_G * aPixel.Data.g +
  1610. DEPTH_WEIGHT_B * aPixel.Data.b);
  1611. end;
  1612. {$IFDEF GLB_NATIVE_OGL}
  1613. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1614. //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1615. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1616. var
  1617. GL_LibHandle: Pointer = nil;
  1618. function glbGetProcAddress(aProcName: PAnsiChar; aLibHandle: Pointer = nil; const aRaiseOnErr: Boolean = true): Pointer;
  1619. begin
  1620. if not Assigned(aLibHandle) then
  1621. aLibHandle := GL_LibHandle;
  1622. {$IF DEFINED(GLB_WIN)}
  1623. result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
  1624. if Assigned(result) then
  1625. exit;
  1626. if Assigned(wglGetProcAddress) then
  1627. result := wglGetProcAddress(aProcName);
  1628. {$ELSEIF DEFINED(GLB_LINUX)}
  1629. if Assigned(glXGetProcAddress) then begin
  1630. result := glXGetProcAddress(aProcName);
  1631. if Assigned(result) then
  1632. exit;
  1633. end;
  1634. if Assigned(glXGetProcAddressARB) then begin
  1635. result := glXGetProcAddressARB(aProcName);
  1636. if Assigned(result) then
  1637. exit;
  1638. end;
  1639. result := dlsym(aLibHandle, aProcName);
  1640. {$IFEND}
  1641. if not Assigned(result) and aRaiseOnErr then
  1642. raise EglBitmap.Create('unable to load procedure form library: ' + aProcName);
  1643. end;
  1644. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  1645. var
  1646. GLU_LibHandle: Pointer = nil;
  1647. OpenGLInitialized: Boolean;
  1648. InitOpenGLCS: TCriticalSection;
  1649. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1650. procedure glbInitOpenGL;
  1651. ////////////////////////////////////////////////////////////////////////////////
  1652. function glbLoadLibrary(const aName: PChar): Pointer;
  1653. begin
  1654. {$IF DEFINED(GLB_WIN)}
  1655. result := {%H-}Pointer(LoadLibrary(aName));
  1656. {$ELSEIF DEFINED(GLB_LINUX)}
  1657. result := dlopen(Name, RTLD_LAZY);
  1658. {$ELSE}
  1659. result := nil;
  1660. {$IFEND}
  1661. end;
  1662. ////////////////////////////////////////////////////////////////////////////////
  1663. function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
  1664. begin
  1665. result := false;
  1666. if not Assigned(aLibHandle) then
  1667. exit;
  1668. {$IF DEFINED(GLB_WIN)}
  1669. Result := FreeLibrary({%H-}HINST(aLibHandle));
  1670. {$ELSEIF DEFINED(GLB_LINUX)}
  1671. Result := dlclose(aLibHandle) = 0;
  1672. {$IFEND}
  1673. end;
  1674. begin
  1675. if Assigned(GL_LibHandle) then
  1676. glbFreeLibrary(GL_LibHandle);
  1677. if Assigned(GLU_LibHandle) then
  1678. glbFreeLibrary(GLU_LibHandle);
  1679. GL_LibHandle := glbLoadLibrary(libopengl);
  1680. if not Assigned(GL_LibHandle) then
  1681. raise EglBitmap.Create('unable to load library: ' + libopengl);
  1682. GLU_LibHandle := glbLoadLibrary(libglu);
  1683. if not Assigned(GLU_LibHandle) then
  1684. raise EglBitmap.Create('unable to load library: ' + libglu);
  1685. {$IF DEFINED(GLB_WIN)}
  1686. wglGetProcAddress := glbGetProcAddress('wglGetProcAddress');
  1687. {$ELSEIF DEFINED(GLB_LINUX)}
  1688. glXGetProcAddress := glbGetProcAddress('glXGetProcAddress');
  1689. glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB');
  1690. {$IFEND}
  1691. glEnable := glbGetProcAddress('glEnable');
  1692. glDisable := glbGetProcAddress('glDisable');
  1693. glGetString := glbGetProcAddress('glGetString');
  1694. glGetIntegerv := glbGetProcAddress('glGetIntegerv');
  1695. glTexParameteri := glbGetProcAddress('glTexParameteri');
  1696. glTexParameteriv := glbGetProcAddress('glTexParameteriv');
  1697. glTexParameterfv := glbGetProcAddress('glTexParameterfv');
  1698. glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
  1699. glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
  1700. glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
  1701. glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
  1702. glTexGeni := glbGetProcAddress('glTexGeni');
  1703. glGenTextures := glbGetProcAddress('glGenTextures');
  1704. glBindTexture := glbGetProcAddress('glBindTexture');
  1705. glDeleteTextures := glbGetProcAddress('glDeleteTextures');
  1706. glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
  1707. glReadPixels := glbGetProcAddress('glReadPixels');
  1708. glPixelStorei := glbGetProcAddress('glPixelStorei');
  1709. glTexImage1D := glbGetProcAddress('glTexImage1D');
  1710. glTexImage2D := glbGetProcAddress('glTexImage2D');
  1711. glGetTexImage := glbGetProcAddress('glGetTexImage');
  1712. gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
  1713. gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
  1714. end;
  1715. {$ENDIF}
  1716. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1717. procedure glbReadOpenGLExtensions;
  1718. var
  1719. Buffer: AnsiString;
  1720. MajorVersion, MinorVersion: Integer;
  1721. ///////////////////////////////////////////////////////////////////////////////////////////
  1722. procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
  1723. var
  1724. Separator: Integer;
  1725. begin
  1726. aMinor := 0;
  1727. aMajor := 0;
  1728. Separator := Pos(AnsiString('.'), aBuffer);
  1729. if (Separator > 1) and (Separator < Length(aBuffer)) and
  1730. (aBuffer[Separator - 1] in ['0'..'9']) and
  1731. (aBuffer[Separator + 1] in ['0'..'9']) then begin
  1732. Dec(Separator);
  1733. while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
  1734. Dec(Separator);
  1735. Delete(aBuffer, 1, Separator);
  1736. Separator := Pos(AnsiString('.'), aBuffer) + 1;
  1737. while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
  1738. Inc(Separator);
  1739. Delete(aBuffer, Separator, 255);
  1740. Separator := Pos(AnsiString('.'), aBuffer);
  1741. aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
  1742. aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
  1743. end;
  1744. end;
  1745. ///////////////////////////////////////////////////////////////////////////////////////////
  1746. function CheckExtension(const Extension: AnsiString): Boolean;
  1747. var
  1748. ExtPos: Integer;
  1749. begin
  1750. ExtPos := Pos(Extension, Buffer);
  1751. result := ExtPos > 0;
  1752. if result then
  1753. result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
  1754. end;
  1755. ///////////////////////////////////////////////////////////////////////////////////////////
  1756. function CheckVersion(const aMajor, aMinor: Integer): Boolean;
  1757. begin
  1758. result := (MajorVersion > aMajor) or ((MajorVersion = aMajor) and (MinorVersion >= aMinor));
  1759. end;
  1760. begin
  1761. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  1762. InitOpenGLCS.Enter;
  1763. try
  1764. if not OpenGLInitialized then begin
  1765. glbInitOpenGL;
  1766. OpenGLInitialized := true;
  1767. end;
  1768. finally
  1769. InitOpenGLCS.Leave;
  1770. end;
  1771. {$ENDIF}
  1772. // Version
  1773. Buffer := glGetString(GL_VERSION);
  1774. TrimVersionString(Buffer, MajorVersion, MinorVersion);
  1775. GL_VERSION_1_2 := CheckVersion(1, 2);
  1776. GL_VERSION_1_3 := CheckVersion(1, 3);
  1777. GL_VERSION_1_4 := CheckVersion(1, 4);
  1778. GL_VERSION_2_0 := CheckVersion(2, 0);
  1779. GL_VERSION_3_3 := CheckVersion(3, 3);
  1780. // Extensions
  1781. Buffer := glGetString(GL_EXTENSIONS);
  1782. GL_ARB_texture_border_clamp := CheckExtension('GL_ARB_texture_border_clamp');
  1783. GL_ARB_texture_non_power_of_two := CheckExtension('GL_ARB_texture_non_power_of_two');
  1784. GL_ARB_texture_swizzle := CheckExtension('GL_ARB_texture_swizzle');
  1785. GL_ARB_texture_cube_map := CheckExtension('GL_ARB_texture_cube_map');
  1786. GL_ARB_texture_rectangle := CheckExtension('GL_ARB_texture_rectangle');
  1787. GL_ARB_texture_mirrored_repeat := CheckExtension('GL_ARB_texture_mirrored_repeat');
  1788. GL_EXT_texture_edge_clamp := CheckExtension('GL_EXT_texture_edge_clamp');
  1789. GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
  1790. GL_EXT_texture_rectangle := CheckExtension('GL_EXT_texture_rectangle');
  1791. GL_EXT_texture_swizzle := CheckExtension('GL_EXT_texture_swizzle');
  1792. GL_EXT_texture_cube_map := CheckExtension('GL_EXT_texture_cube_map');
  1793. GL_NV_texture_rectangle := CheckExtension('GL_NV_texture_rectangle');
  1794. GL_IBM_texture_mirrored_repeat := CheckExtension('GL_IBM_texture_mirrored_repeat');
  1795. GL_SGIS_generate_mipmap := CheckExtension('GL_SGIS_generate_mipmap');
  1796. if GL_VERSION_1_3 then begin
  1797. glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1D');
  1798. glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2D');
  1799. glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
  1800. end else begin
  1801. glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1DARB', nil, false);
  1802. glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2DARB', nil, false);
  1803. glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB', nil, false);
  1804. end;
  1805. end;
  1806. {$ENDIF}
  1807. {$IFDEF GLB_SDL_IMAGE}
  1808. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1809. // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1810. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1811. function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
  1812. begin
  1813. result := TStream(context^.unknown.data1).Seek(offset, whence);
  1814. end;
  1815. function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
  1816. begin
  1817. result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
  1818. end;
  1819. function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
  1820. begin
  1821. result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
  1822. end;
  1823. function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
  1824. begin
  1825. result := 0;
  1826. end;
  1827. function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
  1828. begin
  1829. result := SDL_AllocRW;
  1830. if result = nil then
  1831. raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
  1832. result^.seek := glBitmapRWseek;
  1833. result^.read := glBitmapRWread;
  1834. result^.write := glBitmapRWwrite;
  1835. result^.close := glBitmapRWclose;
  1836. result^.unknown.data1 := Stream;
  1837. end;
  1838. {$ENDIF}
  1839. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1840. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1841. begin
  1842. glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
  1843. end;
  1844. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1845. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1846. begin
  1847. glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
  1848. end;
  1849. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1850. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1851. begin
  1852. glBitmapDefaultMipmap := aValue;
  1853. end;
  1854. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1855. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1856. begin
  1857. glBitmapDefaultFormat := aFormat;
  1858. end;
  1859. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1860. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1861. begin
  1862. glBitmapDefaultFilterMin := aMin;
  1863. glBitmapDefaultFilterMag := aMag;
  1864. end;
  1865. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1866. procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
  1867. begin
  1868. glBitmapDefaultWrapS := S;
  1869. glBitmapDefaultWrapT := T;
  1870. glBitmapDefaultWrapR := R;
  1871. end;
  1872. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1873. procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
  1874. begin
  1875. glDefaultSwizzle[0] := r;
  1876. glDefaultSwizzle[1] := g;
  1877. glDefaultSwizzle[2] := b;
  1878. glDefaultSwizzle[3] := a;
  1879. end;
  1880. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1881. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1882. begin
  1883. result := glBitmapDefaultDeleteTextureOnFree;
  1884. end;
  1885. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1886. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1887. begin
  1888. result := glBitmapDefaultFreeDataAfterGenTextures;
  1889. end;
  1890. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1891. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1892. begin
  1893. result := glBitmapDefaultMipmap;
  1894. end;
  1895. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1896. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1897. begin
  1898. result := glBitmapDefaultFormat;
  1899. end;
  1900. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1901. procedure glBitmapGetDefaultFilter(var aMin, aMag: GLenum);
  1902. begin
  1903. aMin := glBitmapDefaultFilterMin;
  1904. aMag := glBitmapDefaultFilterMag;
  1905. end;
  1906. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1907. procedure glBitmapGetDefaultTextureWrap(var S, T, R: GLenum);
  1908. begin
  1909. S := glBitmapDefaultWrapS;
  1910. T := glBitmapDefaultWrapT;
  1911. R := glBitmapDefaultWrapR;
  1912. end;
  1913. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1914. procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
  1915. begin
  1916. r := glDefaultSwizzle[0];
  1917. g := glDefaultSwizzle[1];
  1918. b := glDefaultSwizzle[2];
  1919. a := glDefaultSwizzle[3];
  1920. end;
  1921. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1922. //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1923. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1924. function TFormatDescriptor.GetRedMask: QWord;
  1925. begin
  1926. result := fRange.r shl fShift.r;
  1927. end;
  1928. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1929. function TFormatDescriptor.GetGreenMask: QWord;
  1930. begin
  1931. result := fRange.g shl fShift.g;
  1932. end;
  1933. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1934. function TFormatDescriptor.GetBlueMask: QWord;
  1935. begin
  1936. result := fRange.b shl fShift.b;
  1937. end;
  1938. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1939. function TFormatDescriptor.GetAlphaMask: QWord;
  1940. begin
  1941. result := fRange.a shl fShift.a;
  1942. end;
  1943. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1944. function TFormatDescriptor.GetIsCompressed: Boolean;
  1945. begin
  1946. result := fIsCompressed;
  1947. end;
  1948. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1949. function TFormatDescriptor.GetHasAlpha: Boolean;
  1950. begin
  1951. result := (fRange.a > 0);
  1952. end;
  1953. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1954. function TFormatDescriptor.GetglFormat: GLenum;
  1955. begin
  1956. result := fglFormat;
  1957. end;
  1958. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1959. function TFormatDescriptor.GetglInternalFormat: GLenum;
  1960. begin
  1961. result := fglInternalFormat;
  1962. end;
  1963. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1964. function TFormatDescriptor.GetglDataFormat: GLenum;
  1965. begin
  1966. result := fglDataFormat;
  1967. end;
  1968. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1969. function TFormatDescriptor.GetComponents: Integer;
  1970. var
  1971. i: Integer;
  1972. begin
  1973. result := 0;
  1974. for i := 0 to 3 do
  1975. if (fRange.arr[i] > 0) then
  1976. inc(result);
  1977. end;
  1978. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1979. function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
  1980. var
  1981. w, h: Integer;
  1982. begin
  1983. if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
  1984. w := Max(1, aSize.X);
  1985. h := Max(1, aSize.Y);
  1986. result := GetSize(w, h);
  1987. end else
  1988. result := 0;
  1989. end;
  1990. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1991. function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
  1992. begin
  1993. result := 0;
  1994. if (aWidth <= 0) or (aHeight <= 0) then
  1995. exit;
  1996. result := Ceil(aWidth * aHeight * fPixelSize);
  1997. end;
  1998. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1999. function TFormatDescriptor.CreateMappingData: Pointer;
  2000. begin
  2001. result := nil;
  2002. end;
  2003. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2004. procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
  2005. begin
  2006. //DUMMY
  2007. end;
  2008. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2009. function TFormatDescriptor.IsEmpty: Boolean;
  2010. begin
  2011. result := (fFormat = tfEmpty);
  2012. end;
  2013. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2014. function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean;
  2015. begin
  2016. result := false;
  2017. if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
  2018. raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
  2019. if (aRedMask <> RedMask) then
  2020. exit;
  2021. if (aGreenMask <> GreenMask) then
  2022. exit;
  2023. if (aBlueMask <> BlueMask) then
  2024. exit;
  2025. if (aAlphaMask <> AlphaMask) then
  2026. exit;
  2027. result := true;
  2028. end;
  2029. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2030. procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
  2031. begin
  2032. FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
  2033. aPixel.Data := fRange;
  2034. aPixel.Range := fRange;
  2035. aPixel.Format := fFormat;
  2036. end;
  2037. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2038. constructor TFormatDescriptor.Create;
  2039. begin
  2040. inherited Create;
  2041. fFormat := tfEmpty;
  2042. fWithAlpha := tfEmpty;
  2043. fWithoutAlpha := tfEmpty;
  2044. fRGBInverted := tfEmpty;
  2045. fUncompressed := tfEmpty;
  2046. fPixelSize := 0.0;
  2047. fIsCompressed := false;
  2048. fglFormat := 0;
  2049. fglInternalFormat := 0;
  2050. fglDataFormat := 0;
  2051. FillChar(fRange, 0, SizeOf(fRange));
  2052. FillChar(fShift, 0, SizeOf(fShift));
  2053. end;
  2054. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2055. //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2056. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2057. procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2058. begin
  2059. aData^ := aPixel.Data.a;
  2060. inc(aData);
  2061. end;
  2062. procedure TfdAlpha_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2063. begin
  2064. aPixel.Data.r := 0;
  2065. aPixel.Data.g := 0;
  2066. aPixel.Data.b := 0;
  2067. aPixel.Data.a := aData^;
  2068. inc(aData);
  2069. end;
  2070. constructor TfdAlpha_UB1.Create;
  2071. begin
  2072. inherited Create;
  2073. fPixelSize := 1.0;
  2074. fRange.a := $FF;
  2075. fglFormat := GL_ALPHA;
  2076. fglDataFormat := GL_UNSIGNED_BYTE;
  2077. end;
  2078. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2079. //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2080. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2081. procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2082. begin
  2083. aData^ := LuminanceWeight(aPixel);
  2084. inc(aData);
  2085. end;
  2086. procedure TfdLuminance_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2087. begin
  2088. aPixel.Data.r := aData^;
  2089. aPixel.Data.g := aData^;
  2090. aPixel.Data.b := aData^;
  2091. aPixel.Data.a := 0;
  2092. inc(aData);
  2093. end;
  2094. constructor TfdLuminance_UB1.Create;
  2095. begin
  2096. inherited Create;
  2097. fPixelSize := 1.0;
  2098. fRange.r := $FF;
  2099. fRange.g := $FF;
  2100. fRange.b := $FF;
  2101. fglFormat := GL_LUMINANCE;
  2102. fglDataFormat := GL_UNSIGNED_BYTE;
  2103. end;
  2104. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2105. //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2106. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2107. procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2108. var
  2109. i: Integer;
  2110. begin
  2111. aData^ := 0;
  2112. for i := 0 to 3 do
  2113. if (fRange.arr[i] > 0) then
  2114. aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2115. inc(aData);
  2116. end;
  2117. procedure TfdUniversal_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2118. var
  2119. i: Integer;
  2120. begin
  2121. for i := 0 to 3 do
  2122. aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
  2123. inc(aData);
  2124. end;
  2125. constructor TfdUniversal_UB1.Create;
  2126. begin
  2127. inherited Create;
  2128. fPixelSize := 1.0;
  2129. end;
  2130. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2131. //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2132. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2133. procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2134. begin
  2135. inherited Map(aPixel, aData, aMapData);
  2136. aData^ := aPixel.Data.a;
  2137. inc(aData);
  2138. end;
  2139. procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2140. begin
  2141. inherited Unmap(aData, aPixel, aMapData);
  2142. aPixel.Data.a := aData^;
  2143. inc(aData);
  2144. end;
  2145. constructor TfdLuminanceAlpha_UB2.Create;
  2146. begin
  2147. inherited Create;
  2148. fPixelSize := 2.0;
  2149. fRange.a := $FF;
  2150. fShift.a := 8;
  2151. fglFormat := GL_LUMINANCE_ALPHA;
  2152. fglDataFormat := GL_UNSIGNED_BYTE;
  2153. end;
  2154. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2155. //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2156. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2157. procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2158. begin
  2159. aData^ := aPixel.Data.r;
  2160. inc(aData);
  2161. aData^ := aPixel.Data.g;
  2162. inc(aData);
  2163. aData^ := aPixel.Data.b;
  2164. inc(aData);
  2165. end;
  2166. procedure TfdRGB_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2167. begin
  2168. aPixel.Data.r := aData^;
  2169. inc(aData);
  2170. aPixel.Data.g := aData^;
  2171. inc(aData);
  2172. aPixel.Data.b := aData^;
  2173. inc(aData);
  2174. aPixel.Data.a := 0;
  2175. end;
  2176. constructor TfdRGB_UB3.Create;
  2177. begin
  2178. inherited Create;
  2179. fPixelSize := 3.0;
  2180. fRange.r := $FF;
  2181. fRange.g := $FF;
  2182. fRange.b := $FF;
  2183. fShift.r := 0;
  2184. fShift.g := 8;
  2185. fShift.b := 16;
  2186. fglFormat := GL_RGB;
  2187. fglDataFormat := GL_UNSIGNED_BYTE;
  2188. end;
  2189. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2190. //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2191. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2192. procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2193. begin
  2194. aData^ := aPixel.Data.b;
  2195. inc(aData);
  2196. aData^ := aPixel.Data.g;
  2197. inc(aData);
  2198. aData^ := aPixel.Data.r;
  2199. inc(aData);
  2200. end;
  2201. procedure TfdBGR_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2202. begin
  2203. aPixel.Data.b := aData^;
  2204. inc(aData);
  2205. aPixel.Data.g := aData^;
  2206. inc(aData);
  2207. aPixel.Data.r := aData^;
  2208. inc(aData);
  2209. aPixel.Data.a := 0;
  2210. end;
  2211. constructor TfdBGR_UB3.Create;
  2212. begin
  2213. fPixelSize := 3.0;
  2214. fRange.r := $FF;
  2215. fRange.g := $FF;
  2216. fRange.b := $FF;
  2217. fShift.r := 16;
  2218. fShift.g := 8;
  2219. fShift.b := 0;
  2220. fglFormat := GL_BGR;
  2221. fglDataFormat := GL_UNSIGNED_BYTE;
  2222. end;
  2223. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2224. //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2225. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2226. procedure TfdRGBA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2227. begin
  2228. inherited Map(aPixel, aData, aMapData);
  2229. aData^ := aPixel.Data.a;
  2230. inc(aData);
  2231. end;
  2232. procedure TfdRGBA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2233. begin
  2234. inherited Unmap(aData, aPixel, aMapData);
  2235. aPixel.Data.a := aData^;
  2236. inc(aData);
  2237. end;
  2238. constructor TfdRGBA_UB4.Create;
  2239. begin
  2240. inherited Create;
  2241. fPixelSize := 4.0;
  2242. fRange.a := $FF;
  2243. fShift.a := 24;
  2244. fglFormat := GL_RGBA;
  2245. fglDataFormat := GL_UNSIGNED_BYTE;
  2246. end;
  2247. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2248. //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2249. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2250. procedure TfdBGRA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2251. begin
  2252. inherited Map(aPixel, aData, aMapData);
  2253. aData^ := aPixel.Data.a;
  2254. inc(aData);
  2255. end;
  2256. procedure TfdBGRA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2257. begin
  2258. inherited Unmap(aData, aPixel, aMapData);
  2259. aPixel.Data.a := aData^;
  2260. inc(aData);
  2261. end;
  2262. constructor TfdBGRA_UB4.Create;
  2263. begin
  2264. inherited Create;
  2265. fPixelSize := 4.0;
  2266. fRange.a := $FF;
  2267. fShift.a := 24;
  2268. fglFormat := GL_BGRA;
  2269. fglDataFormat := GL_UNSIGNED_BYTE;
  2270. end;
  2271. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2272. //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2273. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2274. procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2275. begin
  2276. PWord(aData)^ := aPixel.Data.a;
  2277. inc(aData, 2);
  2278. end;
  2279. procedure TfdAlpha_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2280. begin
  2281. aPixel.Data.r := 0;
  2282. aPixel.Data.g := 0;
  2283. aPixel.Data.b := 0;
  2284. aPixel.Data.a := PWord(aData)^;
  2285. inc(aData, 2);
  2286. end;
  2287. constructor TfdAlpha_US1.Create;
  2288. begin
  2289. inherited Create;
  2290. fPixelSize := 2.0;
  2291. fRange.a := $FFFF;
  2292. fglFormat := GL_ALPHA;
  2293. fglDataFormat := GL_UNSIGNED_SHORT;
  2294. end;
  2295. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2296. //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2297. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2298. procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2299. begin
  2300. PWord(aData)^ := LuminanceWeight(aPixel);
  2301. inc(aData, 2);
  2302. end;
  2303. procedure TfdLuminance_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2304. begin
  2305. aPixel.Data.r := PWord(aData)^;
  2306. aPixel.Data.g := PWord(aData)^;
  2307. aPixel.Data.b := PWord(aData)^;
  2308. aPixel.Data.a := 0;
  2309. inc(aData, 2);
  2310. end;
  2311. constructor TfdLuminance_US1.Create;
  2312. begin
  2313. inherited Create;
  2314. fPixelSize := 2.0;
  2315. fRange.r := $FFFF;
  2316. fRange.g := $FFFF;
  2317. fRange.b := $FFFF;
  2318. fglFormat := GL_LUMINANCE;
  2319. fglDataFormat := GL_UNSIGNED_SHORT;
  2320. end;
  2321. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2322. //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2323. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2324. procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2325. var
  2326. i: Integer;
  2327. begin
  2328. PWord(aData)^ := 0;
  2329. for i := 0 to 3 do
  2330. if (fRange.arr[i] > 0) then
  2331. PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2332. inc(aData, 2);
  2333. end;
  2334. procedure TfdUniversal_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2335. var
  2336. i: Integer;
  2337. begin
  2338. for i := 0 to 3 do
  2339. aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
  2340. inc(aData, 2);
  2341. end;
  2342. constructor TfdUniversal_US1.Create;
  2343. begin
  2344. inherited Create;
  2345. fPixelSize := 2.0;
  2346. end;
  2347. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2348. //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2349. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2350. procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2351. begin
  2352. PWord(aData)^ := DepthWeight(aPixel);
  2353. inc(aData, 2);
  2354. end;
  2355. procedure TfdDepth_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2356. begin
  2357. aPixel.Data.r := PWord(aData)^;
  2358. aPixel.Data.g := PWord(aData)^;
  2359. aPixel.Data.b := PWord(aData)^;
  2360. aPixel.Data.a := 0;
  2361. inc(aData, 2);
  2362. end;
  2363. constructor TfdDepth_US1.Create;
  2364. begin
  2365. inherited Create;
  2366. fPixelSize := 2.0;
  2367. fRange.r := $FFFF;
  2368. fRange.g := $FFFF;
  2369. fRange.b := $FFFF;
  2370. fglFormat := GL_DEPTH_COMPONENT;
  2371. fglDataFormat := GL_UNSIGNED_SHORT;
  2372. end;
  2373. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2374. //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2375. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2376. procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2377. begin
  2378. inherited Map(aPixel, aData, aMapData);
  2379. PWord(aData)^ := aPixel.Data.a;
  2380. inc(aData, 2);
  2381. end;
  2382. procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2383. begin
  2384. inherited Unmap(aData, aPixel, aMapData);
  2385. aPixel.Data.a := PWord(aData)^;
  2386. inc(aData, 2);
  2387. end;
  2388. constructor TfdLuminanceAlpha_US2.Create;
  2389. begin
  2390. inherited Create;
  2391. fPixelSize := 4.0;
  2392. fRange.a := $FFFF;
  2393. fShift.a := 16;
  2394. fglFormat := GL_LUMINANCE_ALPHA;
  2395. fglDataFormat := GL_UNSIGNED_SHORT;
  2396. end;
  2397. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2398. //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2399. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2400. procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2401. begin
  2402. PWord(aData)^ := aPixel.Data.r;
  2403. inc(aData, 2);
  2404. PWord(aData)^ := aPixel.Data.g;
  2405. inc(aData, 2);
  2406. PWord(aData)^ := aPixel.Data.b;
  2407. inc(aData, 2);
  2408. end;
  2409. procedure TfdRGB_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2410. begin
  2411. aPixel.Data.r := PWord(aData)^;
  2412. inc(aData, 2);
  2413. aPixel.Data.g := PWord(aData)^;
  2414. inc(aData, 2);
  2415. aPixel.Data.b := PWord(aData)^;
  2416. inc(aData, 2);
  2417. aPixel.Data.a := 0;
  2418. end;
  2419. constructor TfdRGB_US3.Create;
  2420. begin
  2421. inherited Create;
  2422. fPixelSize := 6.0;
  2423. fRange.r := $FFFF;
  2424. fRange.g := $FFFF;
  2425. fRange.b := $FFFF;
  2426. fShift.r := 0;
  2427. fShift.g := 16;
  2428. fShift.b := 32;
  2429. fglFormat := GL_RGB;
  2430. fglDataFormat := GL_UNSIGNED_SHORT;
  2431. end;
  2432. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2433. //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2434. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2435. procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2436. begin
  2437. PWord(aData)^ := aPixel.Data.b;
  2438. inc(aData, 2);
  2439. PWord(aData)^ := aPixel.Data.g;
  2440. inc(aData, 2);
  2441. PWord(aData)^ := aPixel.Data.r;
  2442. inc(aData, 2);
  2443. end;
  2444. procedure TfdBGR_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2445. begin
  2446. aPixel.Data.b := PWord(aData)^;
  2447. inc(aData, 2);
  2448. aPixel.Data.g := PWord(aData)^;
  2449. inc(aData, 2);
  2450. aPixel.Data.r := PWord(aData)^;
  2451. inc(aData, 2);
  2452. aPixel.Data.a := 0;
  2453. end;
  2454. constructor TfdBGR_US3.Create;
  2455. begin
  2456. inherited Create;
  2457. fPixelSize := 6.0;
  2458. fRange.r := $FFFF;
  2459. fRange.g := $FFFF;
  2460. fRange.b := $FFFF;
  2461. fShift.r := 32;
  2462. fShift.g := 16;
  2463. fShift.b := 0;
  2464. fglFormat := GL_BGR;
  2465. fglDataFormat := GL_UNSIGNED_SHORT;
  2466. end;
  2467. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2468. //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2469. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2470. procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2471. begin
  2472. inherited Map(aPixel, aData, aMapData);
  2473. PWord(aData)^ := aPixel.Data.a;
  2474. inc(aData, 2);
  2475. end;
  2476. procedure TfdRGBA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2477. begin
  2478. inherited Unmap(aData, aPixel, aMapData);
  2479. aPixel.Data.a := PWord(aData)^;
  2480. inc(aData, 2);
  2481. end;
  2482. constructor TfdRGBA_US4.Create;
  2483. begin
  2484. inherited Create;
  2485. fPixelSize := 8.0;
  2486. fRange.a := $FFFF;
  2487. fShift.a := 48;
  2488. fglFormat := GL_RGBA;
  2489. fglDataFormat := GL_UNSIGNED_SHORT;
  2490. end;
  2491. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2492. //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2493. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2494. procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2495. begin
  2496. inherited Map(aPixel, aData, aMapData);
  2497. PWord(aData)^ := aPixel.Data.a;
  2498. inc(aData, 2);
  2499. end;
  2500. procedure TfdBGRA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2501. begin
  2502. inherited Unmap(aData, aPixel, aMapData);
  2503. aPixel.Data.a := PWord(aData)^;
  2504. inc(aData, 2);
  2505. end;
  2506. constructor TfdBGRA_US4.Create;
  2507. begin
  2508. inherited Create;
  2509. fPixelSize := 8.0;
  2510. fRange.a := $FFFF;
  2511. fShift.a := 48;
  2512. fglFormat := GL_BGRA;
  2513. fglDataFormat := GL_UNSIGNED_SHORT;
  2514. end;
  2515. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2516. //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2517. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2518. procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2519. var
  2520. i: Integer;
  2521. begin
  2522. PCardinal(aData)^ := 0;
  2523. for i := 0 to 3 do
  2524. if (fRange.arr[i] > 0) then
  2525. PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2526. inc(aData, 4);
  2527. end;
  2528. procedure TfdUniversal_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2529. var
  2530. i: Integer;
  2531. begin
  2532. for i := 0 to 3 do
  2533. aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
  2534. inc(aData, 2);
  2535. end;
  2536. constructor TfdUniversal_UI1.Create;
  2537. begin
  2538. inherited Create;
  2539. fPixelSize := 4.0;
  2540. end;
  2541. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2542. //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2543. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2544. procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2545. begin
  2546. PCardinal(aData)^ := DepthWeight(aPixel);
  2547. inc(aData, 4);
  2548. end;
  2549. procedure TfdDepth_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2550. begin
  2551. aPixel.Data.r := PCardinal(aData)^;
  2552. aPixel.Data.g := PCardinal(aData)^;
  2553. aPixel.Data.b := PCardinal(aData)^;
  2554. aPixel.Data.a := 0;
  2555. inc(aData, 4);
  2556. end;
  2557. constructor TfdDepth_UI1.Create;
  2558. begin
  2559. inherited Create;
  2560. fPixelSize := 4.0;
  2561. fRange.r := $FFFFFFFF;
  2562. fRange.g := $FFFFFFFF;
  2563. fRange.b := $FFFFFFFF;
  2564. fglFormat := GL_DEPTH_COMPONENT;
  2565. fglDataFormat := GL_UNSIGNED_INT;
  2566. end;
  2567. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2568. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2569. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2570. constructor TfdAlpha4.Create;
  2571. begin
  2572. inherited Create;
  2573. fFormat := tfAlpha4;
  2574. fWithAlpha := tfAlpha4;
  2575. fglInternalFormat := GL_ALPHA4;
  2576. end;
  2577. constructor TfdAlpha8.Create;
  2578. begin
  2579. inherited Create;
  2580. fFormat := tfAlpha8;
  2581. fWithAlpha := tfAlpha8;
  2582. fglInternalFormat := GL_ALPHA8;
  2583. end;
  2584. constructor TfdAlpha12.Create;
  2585. begin
  2586. inherited Create;
  2587. fFormat := tfAlpha12;
  2588. fWithAlpha := tfAlpha12;
  2589. fglInternalFormat := GL_ALPHA12;
  2590. end;
  2591. constructor TfdAlpha16.Create;
  2592. begin
  2593. inherited Create;
  2594. fFormat := tfAlpha16;
  2595. fWithAlpha := tfAlpha16;
  2596. fglInternalFormat := GL_ALPHA16;
  2597. end;
  2598. constructor TfdLuminance4.Create;
  2599. begin
  2600. inherited Create;
  2601. fFormat := tfLuminance4;
  2602. fWithAlpha := tfLuminance4Alpha4;
  2603. fWithoutAlpha := tfLuminance4;
  2604. fglInternalFormat := GL_LUMINANCE4;
  2605. end;
  2606. constructor TfdLuminance8.Create;
  2607. begin
  2608. inherited Create;
  2609. fFormat := tfLuminance8;
  2610. fWithAlpha := tfLuminance8Alpha8;
  2611. fWithoutAlpha := tfLuminance8;
  2612. fglInternalFormat := GL_LUMINANCE8;
  2613. end;
  2614. constructor TfdLuminance12.Create;
  2615. begin
  2616. inherited Create;
  2617. fFormat := tfLuminance12;
  2618. fWithAlpha := tfLuminance12Alpha12;
  2619. fWithoutAlpha := tfLuminance12;
  2620. fglInternalFormat := GL_LUMINANCE12;
  2621. end;
  2622. constructor TfdLuminance16.Create;
  2623. begin
  2624. inherited Create;
  2625. fFormat := tfLuminance16;
  2626. fWithAlpha := tfLuminance16Alpha16;
  2627. fWithoutAlpha := tfLuminance16;
  2628. fglInternalFormat := GL_LUMINANCE16;
  2629. end;
  2630. constructor TfdLuminance4Alpha4.Create;
  2631. begin
  2632. inherited Create;
  2633. fFormat := tfLuminance4Alpha4;
  2634. fWithAlpha := tfLuminance4Alpha4;
  2635. fWithoutAlpha := tfLuminance4;
  2636. fglInternalFormat := GL_LUMINANCE4_ALPHA4;
  2637. end;
  2638. constructor TfdLuminance6Alpha2.Create;
  2639. begin
  2640. inherited Create;
  2641. fFormat := tfLuminance6Alpha2;
  2642. fWithAlpha := tfLuminance6Alpha2;
  2643. fWithoutAlpha := tfLuminance8;
  2644. fglInternalFormat := GL_LUMINANCE6_ALPHA2;
  2645. end;
  2646. constructor TfdLuminance8Alpha8.Create;
  2647. begin
  2648. inherited Create;
  2649. fFormat := tfLuminance8Alpha8;
  2650. fWithAlpha := tfLuminance8Alpha8;
  2651. fWithoutAlpha := tfLuminance8;
  2652. fglInternalFormat := GL_LUMINANCE8_ALPHA8;
  2653. end;
  2654. constructor TfdLuminance12Alpha4.Create;
  2655. begin
  2656. inherited Create;
  2657. fFormat := tfLuminance12Alpha4;
  2658. fWithAlpha := tfLuminance12Alpha4;
  2659. fWithoutAlpha := tfLuminance12;
  2660. fglInternalFormat := GL_LUMINANCE12_ALPHA4;
  2661. end;
  2662. constructor TfdLuminance12Alpha12.Create;
  2663. begin
  2664. inherited Create;
  2665. fFormat := tfLuminance12Alpha12;
  2666. fWithAlpha := tfLuminance12Alpha12;
  2667. fWithoutAlpha := tfLuminance12;
  2668. fglInternalFormat := GL_LUMINANCE12_ALPHA12;
  2669. end;
  2670. constructor TfdLuminance16Alpha16.Create;
  2671. begin
  2672. inherited Create;
  2673. fFormat := tfLuminance16Alpha16;
  2674. fWithAlpha := tfLuminance16Alpha16;
  2675. fWithoutAlpha := tfLuminance16;
  2676. fglInternalFormat := GL_LUMINANCE16_ALPHA16;
  2677. end;
  2678. constructor TfdR3G3B2.Create;
  2679. begin
  2680. inherited Create;
  2681. fFormat := tfR3G3B2;
  2682. fWithAlpha := tfRGBA2;
  2683. fWithoutAlpha := tfR3G3B2;
  2684. fRange.r := $7;
  2685. fRange.g := $7;
  2686. fRange.b := $3;
  2687. fShift.r := 0;
  2688. fShift.g := 3;
  2689. fShift.b := 6;
  2690. fglFormat := GL_RGB;
  2691. fglInternalFormat := GL_R3_G3_B2;
  2692. fglDataFormat := GL_UNSIGNED_BYTE_2_3_3_REV;
  2693. end;
  2694. constructor TfdRGB4.Create;
  2695. begin
  2696. inherited Create;
  2697. fFormat := tfRGB4;
  2698. fWithAlpha := tfRGBA4;
  2699. fWithoutAlpha := tfRGB4;
  2700. fRGBInverted := tfBGR4;
  2701. fRange.r := $F;
  2702. fRange.g := $F;
  2703. fRange.b := $F;
  2704. fShift.r := 0;
  2705. fShift.g := 4;
  2706. fShift.b := 8;
  2707. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2708. fglInternalFormat := GL_RGB4;
  2709. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2710. end;
  2711. constructor TfdR5G6B5.Create;
  2712. begin
  2713. inherited Create;
  2714. fFormat := tfR5G6B5;
  2715. fWithAlpha := tfRGBA4;
  2716. fWithoutAlpha := tfR5G6B5;
  2717. fRGBInverted := tfB5G6R5;
  2718. fRange.r := $1F;
  2719. fRange.g := $3F;
  2720. fRange.b := $1F;
  2721. fShift.r := 0;
  2722. fShift.g := 5;
  2723. fShift.b := 11;
  2724. fglFormat := GL_RGB;
  2725. fglInternalFormat := GL_RGB565;
  2726. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5_REV;
  2727. end;
  2728. constructor TfdRGB5.Create;
  2729. begin
  2730. inherited Create;
  2731. fFormat := tfRGB5;
  2732. fWithAlpha := tfRGB5A1;
  2733. fWithoutAlpha := tfRGB5;
  2734. fRGBInverted := tfBGR5;
  2735. fRange.r := $1F;
  2736. fRange.g := $1F;
  2737. fRange.b := $1F;
  2738. fShift.r := 0;
  2739. fShift.g := 5;
  2740. fShift.b := 10;
  2741. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2742. fglInternalFormat := GL_RGB5;
  2743. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2744. end;
  2745. constructor TfdRGB8.Create;
  2746. begin
  2747. inherited Create;
  2748. fFormat := tfRGB8;
  2749. fWithAlpha := tfRGBA8;
  2750. fWithoutAlpha := tfRGB8;
  2751. fRGBInverted := tfBGR8;
  2752. fglInternalFormat := GL_RGB8;
  2753. end;
  2754. constructor TfdRGB10.Create;
  2755. begin
  2756. inherited Create;
  2757. fFormat := tfRGB10;
  2758. fWithAlpha := tfRGB10A2;
  2759. fWithoutAlpha := tfRGB10;
  2760. fRGBInverted := tfBGR10;
  2761. fRange.r := $3FF;
  2762. fRange.g := $3FF;
  2763. fRange.b := $3FF;
  2764. fShift.r := 0;
  2765. fShift.g := 10;
  2766. fShift.b := 20;
  2767. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2768. fglInternalFormat := GL_RGB10;
  2769. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2770. end;
  2771. constructor TfdRGB12.Create;
  2772. begin
  2773. inherited Create;
  2774. fFormat := tfRGB12;
  2775. fWithAlpha := tfRGBA12;
  2776. fWithoutAlpha := tfRGB12;
  2777. fRGBInverted := tfBGR12;
  2778. fglInternalFormat := GL_RGB12;
  2779. end;
  2780. constructor TfdRGB16.Create;
  2781. begin
  2782. inherited Create;
  2783. fFormat := tfRGB16;
  2784. fWithAlpha := tfRGBA16;
  2785. fWithoutAlpha := tfRGB16;
  2786. fRGBInverted := tfBGR16;
  2787. fglInternalFormat := GL_RGB16;
  2788. end;
  2789. constructor TfdRGBA2.Create;
  2790. begin
  2791. inherited Create;
  2792. fFormat := tfRGBA2;
  2793. fWithAlpha := tfRGBA2;
  2794. fWithoutAlpha := tfR3G3B2;
  2795. fRGBInverted := tfBGRA2;
  2796. fglInternalFormat := GL_RGBA2;
  2797. end;
  2798. constructor TfdRGBA4.Create;
  2799. begin
  2800. inherited Create;
  2801. fFormat := tfRGBA4;
  2802. fWithAlpha := tfRGBA4;
  2803. fWithoutAlpha := tfRGB4;
  2804. fRGBInverted := tfBGRA4;
  2805. fRange.r := $F;
  2806. fRange.g := $F;
  2807. fRange.b := $F;
  2808. fRange.a := $F;
  2809. fShift.r := 0;
  2810. fShift.g := 4;
  2811. fShift.b := 8;
  2812. fShift.a := 12;
  2813. fglFormat := GL_RGBA;
  2814. fglInternalFormat := GL_RGBA4;
  2815. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2816. end;
  2817. constructor TfdRGB5A1.Create;
  2818. begin
  2819. inherited Create;
  2820. fFormat := tfRGB5A1;
  2821. fWithAlpha := tfRGB5A1;
  2822. fWithoutAlpha := tfRGB5;
  2823. fRGBInverted := tfBGR5A1;
  2824. fRange.r := $1F;
  2825. fRange.g := $1F;
  2826. fRange.b := $1F;
  2827. fRange.a := $01;
  2828. fShift.r := 0;
  2829. fShift.g := 5;
  2830. fShift.b := 10;
  2831. fShift.a := 15;
  2832. fglFormat := GL_RGBA;
  2833. fglInternalFormat := GL_RGB5_A1;
  2834. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2835. end;
  2836. constructor TfdRGBA8.Create;
  2837. begin
  2838. inherited Create;
  2839. fFormat := tfRGBA8;
  2840. fWithAlpha := tfRGBA8;
  2841. fWithoutAlpha := tfRGB8;
  2842. fRGBInverted := tfBGRA8;
  2843. fglInternalFormat := GL_RGBA8;
  2844. end;
  2845. constructor TfdRGB10A2.Create;
  2846. begin
  2847. inherited Create;
  2848. fFormat := tfRGB10A2;
  2849. fWithAlpha := tfRGB10A2;
  2850. fWithoutAlpha := tfRGB10;
  2851. fRGBInverted := tfBGR10A2;
  2852. fRange.r := $3FF;
  2853. fRange.g := $3FF;
  2854. fRange.b := $3FF;
  2855. fRange.a := $003;
  2856. fShift.r := 0;
  2857. fShift.g := 10;
  2858. fShift.b := 20;
  2859. fShift.a := 30;
  2860. fglFormat := GL_RGBA;
  2861. fglInternalFormat := GL_RGB10_A2;
  2862. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2863. end;
  2864. constructor TfdRGBA12.Create;
  2865. begin
  2866. inherited Create;
  2867. fFormat := tfRGBA12;
  2868. fWithAlpha := tfRGBA12;
  2869. fWithoutAlpha := tfRGB12;
  2870. fRGBInverted := tfBGRA12;
  2871. fglInternalFormat := GL_RGBA12;
  2872. end;
  2873. constructor TfdRGBA16.Create;
  2874. begin
  2875. inherited Create;
  2876. fFormat := tfRGBA16;
  2877. fWithAlpha := tfRGBA16;
  2878. fWithoutAlpha := tfRGB16;
  2879. fRGBInverted := tfBGRA16;
  2880. fglInternalFormat := GL_RGBA16;
  2881. end;
  2882. constructor TfdBGR4.Create;
  2883. begin
  2884. inherited Create;
  2885. fPixelSize := 2.0;
  2886. fFormat := tfBGR4;
  2887. fWithAlpha := tfBGRA4;
  2888. fWithoutAlpha := tfBGR4;
  2889. fRGBInverted := tfRGB4;
  2890. fRange.r := $F;
  2891. fRange.g := $F;
  2892. fRange.b := $F;
  2893. fRange.a := $0;
  2894. fShift.r := 8;
  2895. fShift.g := 4;
  2896. fShift.b := 0;
  2897. fShift.a := 0;
  2898. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2899. fglInternalFormat := GL_RGB4;
  2900. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2901. end;
  2902. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2903. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2904. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2905. constructor TfdB5G6R5.Create;
  2906. begin
  2907. inherited Create;
  2908. fFormat := tfB5G6R5;
  2909. fWithAlpha := tfBGRA4;
  2910. fWithoutAlpha := tfB5G6R5;
  2911. fRGBInverted := tfR5G6B5;
  2912. fRange.r := $1F;
  2913. fRange.g := $3F;
  2914. fRange.b := $1F;
  2915. fShift.r := 11;
  2916. fShift.g := 5;
  2917. fShift.b := 0;
  2918. fglFormat := GL_RGB; //B5G6R5 is only possible as R5G6B5 -> use reverted dataformat
  2919. fglInternalFormat := GL_RGB8;
  2920. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5;
  2921. end;
  2922. constructor TfdBGR5.Create;
  2923. begin
  2924. inherited Create;
  2925. fPixelSize := 2.0;
  2926. fFormat := tfBGR5;
  2927. fWithAlpha := tfBGR5A1;
  2928. fWithoutAlpha := tfBGR5;
  2929. fRGBInverted := tfRGB5;
  2930. fRange.r := $1F;
  2931. fRange.g := $1F;
  2932. fRange.b := $1F;
  2933. fRange.a := $00;
  2934. fShift.r := 10;
  2935. fShift.g := 5;
  2936. fShift.b := 0;
  2937. fShift.a := 0;
  2938. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2939. fglInternalFormat := GL_RGB5;
  2940. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2941. end;
  2942. constructor TfdBGR8.Create;
  2943. begin
  2944. inherited Create;
  2945. fFormat := tfBGR8;
  2946. fWithAlpha := tfBGRA8;
  2947. fWithoutAlpha := tfBGR8;
  2948. fRGBInverted := tfRGB8;
  2949. fglInternalFormat := GL_RGB8;
  2950. end;
  2951. constructor TfdBGR10.Create;
  2952. begin
  2953. inherited Create;
  2954. fFormat := tfBGR10;
  2955. fWithAlpha := tfBGR10A2;
  2956. fWithoutAlpha := tfBGR10;
  2957. fRGBInverted := tfRGB10;
  2958. fRange.r := $3FF;
  2959. fRange.g := $3FF;
  2960. fRange.b := $3FF;
  2961. fRange.a := $000;
  2962. fShift.r := 20;
  2963. fShift.g := 10;
  2964. fShift.b := 0;
  2965. fShift.a := 0;
  2966. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2967. fglInternalFormat := GL_RGB10;
  2968. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2969. end;
  2970. constructor TfdBGR12.Create;
  2971. begin
  2972. inherited Create;
  2973. fFormat := tfBGR12;
  2974. fWithAlpha := tfBGRA12;
  2975. fWithoutAlpha := tfBGR12;
  2976. fRGBInverted := tfRGB12;
  2977. fglInternalFormat := GL_RGB12;
  2978. end;
  2979. constructor TfdBGR16.Create;
  2980. begin
  2981. inherited Create;
  2982. fFormat := tfBGR16;
  2983. fWithAlpha := tfBGRA16;
  2984. fWithoutAlpha := tfBGR16;
  2985. fRGBInverted := tfRGB16;
  2986. fglInternalFormat := GL_RGB16;
  2987. end;
  2988. constructor TfdBGRA2.Create;
  2989. begin
  2990. inherited Create;
  2991. fFormat := tfBGRA2;
  2992. fWithAlpha := tfBGRA4;
  2993. fWithoutAlpha := tfBGR4;
  2994. fRGBInverted := tfRGBA2;
  2995. fglInternalFormat := GL_RGBA2;
  2996. end;
  2997. constructor TfdBGRA4.Create;
  2998. begin
  2999. inherited Create;
  3000. fFormat := tfBGRA4;
  3001. fWithAlpha := tfBGRA4;
  3002. fWithoutAlpha := tfBGR4;
  3003. fRGBInverted := tfRGBA4;
  3004. fRange.r := $F;
  3005. fRange.g := $F;
  3006. fRange.b := $F;
  3007. fRange.a := $F;
  3008. fShift.r := 8;
  3009. fShift.g := 4;
  3010. fShift.b := 0;
  3011. fShift.a := 12;
  3012. fglFormat := GL_BGRA;
  3013. fglInternalFormat := GL_RGBA4;
  3014. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  3015. end;
  3016. constructor TfdBGR5A1.Create;
  3017. begin
  3018. inherited Create;
  3019. fFormat := tfBGR5A1;
  3020. fWithAlpha := tfBGR5A1;
  3021. fWithoutAlpha := tfBGR5;
  3022. fRGBInverted := tfRGB5A1;
  3023. fRange.r := $1F;
  3024. fRange.g := $1F;
  3025. fRange.b := $1F;
  3026. fRange.a := $01;
  3027. fShift.r := 10;
  3028. fShift.g := 5;
  3029. fShift.b := 0;
  3030. fShift.a := 15;
  3031. fglFormat := GL_BGRA;
  3032. fglInternalFormat := GL_RGB5_A1;
  3033. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  3034. end;
  3035. constructor TfdBGRA8.Create;
  3036. begin
  3037. inherited Create;
  3038. fFormat := tfBGRA8;
  3039. fWithAlpha := tfBGRA8;
  3040. fWithoutAlpha := tfBGR8;
  3041. fRGBInverted := tfRGBA8;
  3042. fglInternalFormat := GL_RGBA8;
  3043. end;
  3044. constructor TfdBGR10A2.Create;
  3045. begin
  3046. inherited Create;
  3047. fFormat := tfBGR10A2;
  3048. fWithAlpha := tfBGR10A2;
  3049. fWithoutAlpha := tfBGR10;
  3050. fRGBInverted := tfRGB10A2;
  3051. fRange.r := $3FF;
  3052. fRange.g := $3FF;
  3053. fRange.b := $3FF;
  3054. fRange.a := $003;
  3055. fShift.r := 20;
  3056. fShift.g := 10;
  3057. fShift.b := 0;
  3058. fShift.a := 30;
  3059. fglFormat := GL_BGRA;
  3060. fglInternalFormat := GL_RGB10_A2;
  3061. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3062. end;
  3063. constructor TfdBGRA12.Create;
  3064. begin
  3065. inherited Create;
  3066. fFormat := tfBGRA12;
  3067. fWithAlpha := tfBGRA12;
  3068. fWithoutAlpha := tfBGR12;
  3069. fRGBInverted := tfRGBA12;
  3070. fglInternalFormat := GL_RGBA12;
  3071. end;
  3072. constructor TfdBGRA16.Create;
  3073. begin
  3074. inherited Create;
  3075. fFormat := tfBGRA16;
  3076. fWithAlpha := tfBGRA16;
  3077. fWithoutAlpha := tfBGR16;
  3078. fRGBInverted := tfRGBA16;
  3079. fglInternalFormat := GL_RGBA16;
  3080. end;
  3081. constructor TfdDepth16.Create;
  3082. begin
  3083. inherited Create;
  3084. fFormat := tfDepth16;
  3085. fWithAlpha := tfEmpty;
  3086. fWithoutAlpha := tfDepth16;
  3087. fglInternalFormat := GL_DEPTH_COMPONENT16;
  3088. end;
  3089. constructor TfdDepth24.Create;
  3090. begin
  3091. inherited Create;
  3092. fFormat := tfDepth24;
  3093. fWithAlpha := tfEmpty;
  3094. fWithoutAlpha := tfDepth24;
  3095. fglInternalFormat := GL_DEPTH_COMPONENT24;
  3096. end;
  3097. constructor TfdDepth32.Create;
  3098. begin
  3099. inherited Create;
  3100. fFormat := tfDepth32;
  3101. fWithAlpha := tfEmpty;
  3102. fWithoutAlpha := tfDepth32;
  3103. fglInternalFormat := GL_DEPTH_COMPONENT32;
  3104. end;
  3105. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3106. //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3107. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3108. procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3109. begin
  3110. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3111. end;
  3112. procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3113. begin
  3114. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3115. end;
  3116. constructor TfdS3tcDtx1RGBA.Create;
  3117. begin
  3118. inherited Create;
  3119. fFormat := tfS3tcDtx1RGBA;
  3120. fWithAlpha := tfS3tcDtx1RGBA;
  3121. fUncompressed := tfRGB5A1;
  3122. fPixelSize := 0.5;
  3123. fIsCompressed := true;
  3124. fglFormat := GL_COMPRESSED_RGBA;
  3125. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
  3126. fglDataFormat := GL_UNSIGNED_BYTE;
  3127. end;
  3128. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3129. //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3130. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3131. procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3132. begin
  3133. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3134. end;
  3135. procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3136. begin
  3137. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3138. end;
  3139. constructor TfdS3tcDtx3RGBA.Create;
  3140. begin
  3141. inherited Create;
  3142. fFormat := tfS3tcDtx3RGBA;
  3143. fWithAlpha := tfS3tcDtx3RGBA;
  3144. fUncompressed := tfRGBA8;
  3145. fPixelSize := 1.0;
  3146. fIsCompressed := true;
  3147. fglFormat := GL_COMPRESSED_RGBA;
  3148. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
  3149. fglDataFormat := GL_UNSIGNED_BYTE;
  3150. end;
  3151. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3152. //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3153. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3154. procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3155. begin
  3156. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3157. end;
  3158. procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3159. begin
  3160. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3161. end;
  3162. constructor TfdS3tcDtx5RGBA.Create;
  3163. begin
  3164. inherited Create;
  3165. fFormat := tfS3tcDtx3RGBA;
  3166. fWithAlpha := tfS3tcDtx3RGBA;
  3167. fUncompressed := tfRGBA8;
  3168. fPixelSize := 1.0;
  3169. fIsCompressed := true;
  3170. fglFormat := GL_COMPRESSED_RGBA;
  3171. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
  3172. fglDataFormat := GL_UNSIGNED_BYTE;
  3173. end;
  3174. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3175. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3176. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3177. class procedure TFormatDescriptor.Init;
  3178. begin
  3179. if not Assigned(FormatDescriptorCS) then
  3180. FormatDescriptorCS := TCriticalSection.Create;
  3181. end;
  3182. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3183. class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3184. begin
  3185. FormatDescriptorCS.Enter;
  3186. try
  3187. result := FormatDescriptors[aFormat];
  3188. if not Assigned(result) then begin
  3189. result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
  3190. FormatDescriptors[aFormat] := result;
  3191. end;
  3192. finally
  3193. FormatDescriptorCS.Leave;
  3194. end;
  3195. end;
  3196. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3197. class function TFormatDescriptor.GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3198. begin
  3199. result := Get(Get(aFormat).WithAlpha);
  3200. end;
  3201. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3202. class procedure TFormatDescriptor.Clear;
  3203. var
  3204. f: TglBitmapFormat;
  3205. begin
  3206. FormatDescriptorCS.Enter;
  3207. try
  3208. for f := low(FormatDescriptors) to high(FormatDescriptors) do
  3209. FreeAndNil(FormatDescriptors[f]);
  3210. finally
  3211. FormatDescriptorCS.Leave;
  3212. end;
  3213. end;
  3214. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3215. class procedure TFormatDescriptor.Finalize;
  3216. begin
  3217. Clear;
  3218. FreeAndNil(FormatDescriptorCS);
  3219. end;
  3220. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3221. //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3222. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3223. procedure TbmpBitfieldFormat.SetRedMask(const aValue: QWord);
  3224. begin
  3225. Update(aValue, fRange.r, fShift.r);
  3226. end;
  3227. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3228. procedure TbmpBitfieldFormat.SetGreenMask(const aValue: QWord);
  3229. begin
  3230. Update(aValue, fRange.g, fShift.g);
  3231. end;
  3232. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3233. procedure TbmpBitfieldFormat.SetBlueMask(const aValue: QWord);
  3234. begin
  3235. Update(aValue, fRange.b, fShift.b);
  3236. end;
  3237. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3238. procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: QWord);
  3239. begin
  3240. Update(aValue, fRange.a, fShift.a);
  3241. end;
  3242. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3243. procedure TbmpBitfieldFormat.Update(aMask: QWord; out aRange: Cardinal; out
  3244. aShift: Byte);
  3245. begin
  3246. aShift := 0;
  3247. aRange := 0;
  3248. if (aMask = 0) then
  3249. exit;
  3250. while (aMask > 0) and ((aMask and 1) = 0) do begin
  3251. inc(aShift);
  3252. aMask := aMask shr 1;
  3253. end;
  3254. aRange := 1;
  3255. while (aMask > 0) do begin
  3256. aRange := aRange shl 1;
  3257. aMask := aMask shr 1;
  3258. end;
  3259. dec(aRange);
  3260. fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
  3261. end;
  3262. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3263. procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3264. var
  3265. data: QWord;
  3266. s: Integer;
  3267. begin
  3268. data :=
  3269. ((aPixel.Data.r and fRange.r) shl fShift.r) or
  3270. ((aPixel.Data.g and fRange.g) shl fShift.g) or
  3271. ((aPixel.Data.b and fRange.b) shl fShift.b) or
  3272. ((aPixel.Data.a and fRange.a) shl fShift.a);
  3273. s := Round(fPixelSize);
  3274. case s of
  3275. 1: aData^ := data;
  3276. 2: PWord(aData)^ := data;
  3277. 4: PCardinal(aData)^ := data;
  3278. 8: PQWord(aData)^ := data;
  3279. else
  3280. raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
  3281. end;
  3282. inc(aData, s);
  3283. end;
  3284. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3285. procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3286. var
  3287. data: QWord;
  3288. s, i: Integer;
  3289. begin
  3290. s := Round(fPixelSize);
  3291. case s of
  3292. 1: data := aData^;
  3293. 2: data := PWord(aData)^;
  3294. 4: data := PCardinal(aData)^;
  3295. 8: data := PQWord(aData)^;
  3296. else
  3297. raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
  3298. end;
  3299. for i := 0 to 3 do
  3300. aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
  3301. inc(aData, s);
  3302. end;
  3303. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3304. //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3305. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3306. procedure TbmpColorTableFormat.CreateColorTable;
  3307. var
  3308. i: Integer;
  3309. begin
  3310. if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
  3311. raise EglBitmap.Create(UNSUPPORTED_FORMAT);
  3312. if (Format = tfLuminance4) then
  3313. SetLength(fColorTable, 16)
  3314. else
  3315. SetLength(fColorTable, 256);
  3316. case Format of
  3317. tfLuminance4: begin
  3318. for i := 0 to High(fColorTable) do begin
  3319. fColorTable[i].r := 16 * i;
  3320. fColorTable[i].g := 16 * i;
  3321. fColorTable[i].b := 16 * i;
  3322. fColorTable[i].a := 0;
  3323. end;
  3324. end;
  3325. tfLuminance8: begin
  3326. for i := 0 to High(fColorTable) do begin
  3327. fColorTable[i].r := i;
  3328. fColorTable[i].g := i;
  3329. fColorTable[i].b := i;
  3330. fColorTable[i].a := 0;
  3331. end;
  3332. end;
  3333. tfR3G3B2: begin
  3334. for i := 0 to High(fColorTable) do begin
  3335. fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
  3336. fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
  3337. fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
  3338. fColorTable[i].a := 0;
  3339. end;
  3340. end;
  3341. end;
  3342. end;
  3343. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3344. procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3345. var
  3346. d: Byte;
  3347. begin
  3348. if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
  3349. raise EglBitmap.Create(UNSUPPORTED_FORMAT);
  3350. case Format of
  3351. tfLuminance4: begin
  3352. if (aMapData = nil) then
  3353. aData^ := 0;
  3354. d := LuminanceWeight(aPixel) and Range.r;
  3355. aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData)));
  3356. inc(PByte(aMapData), 4);
  3357. if ({%H-}PtrUInt(aMapData) >= 8) then begin
  3358. inc(aData);
  3359. aMapData := nil;
  3360. end;
  3361. end;
  3362. tfLuminance8: begin
  3363. aData^ := LuminanceWeight(aPixel) and Range.r;
  3364. inc(aData);
  3365. end;
  3366. tfR3G3B2: begin
  3367. aData^ := Round(
  3368. ((aPixel.Data.r and Range.r) shl Shift.r) or
  3369. ((aPixel.Data.g and Range.g) shl Shift.g) or
  3370. ((aPixel.Data.b and Range.b) shl Shift.b));
  3371. inc(aData);
  3372. end;
  3373. end;
  3374. end;
  3375. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3376. procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3377. var
  3378. idx: QWord;
  3379. s: Integer;
  3380. bits: Byte;
  3381. f: Single;
  3382. begin
  3383. s := Trunc(fPixelSize);
  3384. f := fPixelSize - s;
  3385. bits := Round(8 * f);
  3386. case s of
  3387. 0: idx := (aData^ shr (8 - bits - {%H-}PtrInt(aMapData))) and ((1 shl bits) - 1);
  3388. 1: idx := aData^;
  3389. 2: idx := PWord(aData)^;
  3390. 4: idx := PCardinal(aData)^;
  3391. 8: idx := PQWord(aData)^;
  3392. else
  3393. raise EglBitmap.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
  3394. end;
  3395. if (idx >= Length(fColorTable)) then
  3396. raise EglBitmap.CreateFmt('invalid color index: %d', [idx]);
  3397. with fColorTable[idx] do begin
  3398. aPixel.Data.r := r;
  3399. aPixel.Data.g := g;
  3400. aPixel.Data.b := b;
  3401. aPixel.Data.a := a;
  3402. end;
  3403. inc(PByte(aMapData), bits);
  3404. if ({%H-}PtrUInt(aMapData) >= 8) then begin
  3405. inc(aData, 1);
  3406. dec(PByte(aMapData), 8);
  3407. end;
  3408. inc(aData, s);
  3409. end;
  3410. destructor TbmpColorTableFormat.Destroy;
  3411. begin
  3412. SetLength(fColorTable, 0);
  3413. inherited Destroy;
  3414. end;
  3415. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3416. //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3417. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3418. procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
  3419. var
  3420. i: Integer;
  3421. begin
  3422. for i := 0 to 3 do begin
  3423. if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
  3424. if (aSourceFD.Range.arr[i] > 0) then
  3425. aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
  3426. else
  3427. aPixel.Data.arr[i] := aDestFD.Range.arr[i];
  3428. end;
  3429. end;
  3430. end;
  3431. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3432. procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
  3433. begin
  3434. with aFuncRec do begin
  3435. if (Source.Range.r > 0) then
  3436. Dest.Data.r := Source.Data.r;
  3437. if (Source.Range.g > 0) then
  3438. Dest.Data.g := Source.Data.g;
  3439. if (Source.Range.b > 0) then
  3440. Dest.Data.b := Source.Data.b;
  3441. if (Source.Range.a > 0) then
  3442. Dest.Data.a := Source.Data.a;
  3443. end;
  3444. end;
  3445. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3446. procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3447. var
  3448. i: Integer;
  3449. begin
  3450. with aFuncRec do begin
  3451. for i := 0 to 3 do
  3452. if (Source.Range.arr[i] > 0) then
  3453. Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
  3454. end;
  3455. end;
  3456. type
  3457. TShiftData = packed record
  3458. case Integer of
  3459. 0: (r, g, b, a: SmallInt);
  3460. 1: (arr: array[0..3] of SmallInt);
  3461. end;
  3462. PShiftData = ^TShiftData;
  3463. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3464. procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3465. var
  3466. i: Integer;
  3467. begin
  3468. with aFuncRec do
  3469. for i := 0 to 3 do
  3470. if (Source.Range.arr[i] > 0) then
  3471. Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
  3472. end;
  3473. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3474. procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
  3475. begin
  3476. with aFuncRec do begin
  3477. Dest.Data := Source.Data;
  3478. if ({%H-}PtrUInt(Args) and $1 > 0) then begin
  3479. Dest.Data.r := Dest.Data.r xor Dest.Range.r;
  3480. Dest.Data.g := Dest.Data.g xor Dest.Range.g;
  3481. Dest.Data.b := Dest.Data.b xor Dest.Range.b;
  3482. end;
  3483. if ({%H-}PtrUInt(Args) and $2 > 0) then begin
  3484. Dest.Data.a := Dest.Data.a xor Dest.Range.a;
  3485. end;
  3486. end;
  3487. end;
  3488. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3489. procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
  3490. var
  3491. i: Integer;
  3492. begin
  3493. with aFuncRec do begin
  3494. for i := 0 to 3 do
  3495. Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
  3496. end;
  3497. end;
  3498. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3499. procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3500. var
  3501. Temp: Single;
  3502. begin
  3503. with FuncRec do begin
  3504. if (FuncRec.Args = nil) then begin //source has no alpha
  3505. Temp :=
  3506. Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
  3507. Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
  3508. Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
  3509. Dest.Data.a := Round(Dest.Range.a * Temp);
  3510. end else
  3511. Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
  3512. end;
  3513. end;
  3514. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3515. procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3516. type
  3517. PglBitmapPixelData = ^TglBitmapPixelData;
  3518. begin
  3519. with FuncRec do begin
  3520. Dest.Data.r := Source.Data.r;
  3521. Dest.Data.g := Source.Data.g;
  3522. Dest.Data.b := Source.Data.b;
  3523. with PglBitmapPixelData(Args)^ do
  3524. if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
  3525. (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
  3526. (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
  3527. Dest.Data.a := 0
  3528. else
  3529. Dest.Data.a := Dest.Range.a;
  3530. end;
  3531. end;
  3532. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3533. procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3534. begin
  3535. with FuncRec do begin
  3536. Dest.Data.r := Source.Data.r;
  3537. Dest.Data.g := Source.Data.g;
  3538. Dest.Data.b := Source.Data.b;
  3539. Dest.Data.a := PCardinal(Args)^;
  3540. end;
  3541. end;
  3542. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3543. procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
  3544. type
  3545. PRGBPix = ^TRGBPix;
  3546. TRGBPix = array [0..2] of byte;
  3547. var
  3548. Temp: Byte;
  3549. begin
  3550. while aWidth > 0 do begin
  3551. Temp := PRGBPix(aData)^[0];
  3552. PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
  3553. PRGBPix(aData)^[2] := Temp;
  3554. if aHasAlpha then
  3555. Inc(aData, 4)
  3556. else
  3557. Inc(aData, 3);
  3558. dec(aWidth);
  3559. end;
  3560. end;
  3561. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3562. //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3563. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3564. function TglBitmap.GetFormatDesc: TglBitmapFormatDescriptor;
  3565. begin
  3566. result := TFormatDescriptor.Get(Format);
  3567. end;
  3568. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3569. function TglBitmap.GetWidth: Integer;
  3570. begin
  3571. if (ffX in fDimension.Fields) then
  3572. result := fDimension.X
  3573. else
  3574. result := -1;
  3575. end;
  3576. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3577. function TglBitmap.GetHeight: Integer;
  3578. begin
  3579. if (ffY in fDimension.Fields) then
  3580. result := fDimension.Y
  3581. else
  3582. result := -1;
  3583. end;
  3584. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3585. function TglBitmap.GetFileWidth: Integer;
  3586. begin
  3587. result := Max(1, Width);
  3588. end;
  3589. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3590. function TglBitmap.GetFileHeight: Integer;
  3591. begin
  3592. result := Max(1, Height);
  3593. end;
  3594. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3595. procedure TglBitmap.SetCustomData(const aValue: Pointer);
  3596. begin
  3597. if fCustomData = aValue then
  3598. exit;
  3599. fCustomData := aValue;
  3600. end;
  3601. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3602. procedure TglBitmap.SetCustomName(const aValue: String);
  3603. begin
  3604. if fCustomName = aValue then
  3605. exit;
  3606. fCustomName := aValue;
  3607. end;
  3608. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3609. procedure TglBitmap.SetCustomNameW(const aValue: WideString);
  3610. begin
  3611. if fCustomNameW = aValue then
  3612. exit;
  3613. fCustomNameW := aValue;
  3614. end;
  3615. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3616. procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
  3617. begin
  3618. if fDeleteTextureOnFree = aValue then
  3619. exit;
  3620. fDeleteTextureOnFree := aValue;
  3621. end;
  3622. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3623. procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
  3624. begin
  3625. if fFormat = aValue then
  3626. exit;
  3627. if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
  3628. raise EglBitmapUnsupportedFormat.Create(Format);
  3629. SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
  3630. end;
  3631. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3632. procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
  3633. begin
  3634. if fFreeDataAfterGenTexture = aValue then
  3635. exit;
  3636. fFreeDataAfterGenTexture := aValue;
  3637. end;
  3638. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3639. procedure TglBitmap.SetID(const aValue: Cardinal);
  3640. begin
  3641. if fID = aValue then
  3642. exit;
  3643. fID := aValue;
  3644. end;
  3645. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3646. procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
  3647. begin
  3648. if fMipMap = aValue then
  3649. exit;
  3650. fMipMap := aValue;
  3651. end;
  3652. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3653. procedure TglBitmap.SetTarget(const aValue: Cardinal);
  3654. begin
  3655. if fTarget = aValue then
  3656. exit;
  3657. fTarget := aValue;
  3658. end;
  3659. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3660. procedure TglBitmap.SetAnisotropic(const aValue: Integer);
  3661. var
  3662. MaxAnisotropic: Integer;
  3663. begin
  3664. fAnisotropic := aValue;
  3665. if (ID > 0) then begin
  3666. if GL_EXT_texture_filter_anisotropic then begin
  3667. if fAnisotropic > 0 then begin
  3668. Bind(false);
  3669. glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
  3670. if aValue > MaxAnisotropic then
  3671. fAnisotropic := MaxAnisotropic;
  3672. glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
  3673. end;
  3674. end else begin
  3675. fAnisotropic := 0;
  3676. end;
  3677. end;
  3678. end;
  3679. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3680. procedure TglBitmap.CreateID;
  3681. begin
  3682. if (ID <> 0) then
  3683. glDeleteTextures(1, @fID);
  3684. glGenTextures(1, @fID);
  3685. Bind(false);
  3686. end;
  3687. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3688. procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
  3689. begin
  3690. // Set Up Parameters
  3691. SetWrap(fWrapS, fWrapT, fWrapR);
  3692. SetFilter(fFilterMin, fFilterMag);
  3693. SetAnisotropic(fAnisotropic);
  3694. SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
  3695. if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  3696. SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  3697. // Mip Maps Generation Mode
  3698. aBuildWithGlu := false;
  3699. if (MipMap = mmMipmap) then begin
  3700. if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
  3701. glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
  3702. else
  3703. aBuildWithGlu := true;
  3704. end else if (MipMap = mmMipmapGlu) then
  3705. aBuildWithGlu := true;
  3706. end;
  3707. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3708. procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  3709. const aWidth: Integer; const aHeight: Integer);
  3710. var
  3711. s: Single;
  3712. begin
  3713. if (Data <> aData) then begin
  3714. if (Assigned(Data)) then
  3715. FreeMem(Data);
  3716. fData := aData;
  3717. end;
  3718. if not Assigned(fData) then begin
  3719. fPixelSize := 0;
  3720. fRowSize := 0;
  3721. end else begin
  3722. FillChar(fDimension, SizeOf(fDimension), 0);
  3723. if aWidth <> -1 then begin
  3724. fDimension.Fields := fDimension.Fields + [ffX];
  3725. fDimension.X := aWidth;
  3726. end;
  3727. if aHeight <> -1 then begin
  3728. fDimension.Fields := fDimension.Fields + [ffY];
  3729. fDimension.Y := aHeight;
  3730. end;
  3731. s := TFormatDescriptor.Get(aFormat).PixelSize;
  3732. fFormat := aFormat;
  3733. fPixelSize := Ceil(s);
  3734. fRowSize := Ceil(s * aWidth);
  3735. end;
  3736. end;
  3737. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3738. function TglBitmap.FlipHorz: Boolean;
  3739. begin
  3740. result := false;
  3741. end;
  3742. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3743. function TglBitmap.FlipVert: Boolean;
  3744. begin
  3745. result := false;
  3746. end;
  3747. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3748. //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3749. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3750. procedure TglBitmap.AfterConstruction;
  3751. begin
  3752. inherited AfterConstruction;
  3753. fID := 0;
  3754. fTarget := 0;
  3755. fIsResident := false;
  3756. fFormat := glBitmapGetDefaultFormat;
  3757. fMipMap := glBitmapDefaultMipmap;
  3758. fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
  3759. fDeleteTextureOnFree := glBitmapGetDefaultDeleteTextureOnFree;
  3760. glBitmapGetDefaultFilter (fFilterMin, fFilterMag);
  3761. glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
  3762. glBitmapGetDefaultSwizzle (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  3763. end;
  3764. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3765. procedure TglBitmap.BeforeDestruction;
  3766. var
  3767. NewData: PByte;
  3768. begin
  3769. NewData := nil;
  3770. SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
  3771. if (fID > 0) and fDeleteTextureOnFree then
  3772. glDeleteTextures(1, @fID);
  3773. inherited BeforeDestruction;
  3774. end;
  3775. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3776. procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
  3777. var
  3778. TempPos: Integer;
  3779. begin
  3780. if not Assigned(aResType) then begin
  3781. TempPos := Pos('.', aResource);
  3782. aResType := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
  3783. aResource := UpperCase(Copy(aResource, 0, TempPos -1));
  3784. end;
  3785. end;
  3786. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3787. procedure TglBitmap.LoadFromFile(const aFilename: String);
  3788. var
  3789. fs: TFileStream;
  3790. begin
  3791. if not FileExists(aFilename) then
  3792. raise EglBitmap.Create('file does not exist: ' + aFilename);
  3793. fFilename := aFilename;
  3794. fs := TFileStream.Create(fFilename, fmOpenRead);
  3795. try
  3796. fs.Position := 0;
  3797. LoadFromStream(fs);
  3798. finally
  3799. fs.Free;
  3800. end;
  3801. end;
  3802. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3803. procedure TglBitmap.LoadFromStream(const aStream: TStream);
  3804. begin
  3805. {$IFDEF GLB_SUPPORT_PNG_READ}
  3806. if not LoadPNG(aStream) then
  3807. {$ENDIF}
  3808. {$IFDEF GLB_SUPPORT_JPEG_READ}
  3809. if not LoadJPEG(aStream) then
  3810. {$ENDIF}
  3811. if not LoadDDS(aStream) then
  3812. if not LoadTGA(aStream) then
  3813. if not LoadBMP(aStream) then
  3814. raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
  3815. end;
  3816. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3817. procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  3818. const aFormat: TglBitmapFormat; const aArgs: Pointer);
  3819. var
  3820. tmpData: PByte;
  3821. size: Integer;
  3822. begin
  3823. size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  3824. GetMem(tmpData, size);
  3825. try
  3826. FillChar(tmpData^, size, #$FF);
  3827. SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  3828. except
  3829. if Assigned(tmpData) then
  3830. FreeMem(tmpData);
  3831. raise;
  3832. end;
  3833. AddFunc(Self, aFunc, false, Format, aArgs);
  3834. end;
  3835. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3836. procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
  3837. var
  3838. rs: TResourceStream;
  3839. begin
  3840. PrepareResType(aResource, aResType);
  3841. rs := TResourceStream.Create(aInstance, aResource, aResType);
  3842. try
  3843. LoadFromStream(rs);
  3844. finally
  3845. rs.Free;
  3846. end;
  3847. end;
  3848. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3849. procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  3850. var
  3851. rs: TResourceStream;
  3852. begin
  3853. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  3854. try
  3855. LoadFromStream(rs);
  3856. finally
  3857. rs.Free;
  3858. end;
  3859. end;
  3860. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3861. procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  3862. var
  3863. fs: TFileStream;
  3864. begin
  3865. fs := TFileStream.Create(aFileName, fmCreate);
  3866. try
  3867. fs.Position := 0;
  3868. SaveToStream(fs, aFileType);
  3869. finally
  3870. fs.Free;
  3871. end;
  3872. end;
  3873. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3874. procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
  3875. begin
  3876. case aFileType of
  3877. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  3878. ftPNG: SavePNG(aStream);
  3879. {$ENDIF}
  3880. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  3881. ftJPEG: SaveJPEG(aStream);
  3882. {$ENDIF}
  3883. ftDDS: SaveDDS(aStream);
  3884. ftTGA: SaveTGA(aStream);
  3885. ftBMP: SaveBMP(aStream);
  3886. end;
  3887. end;
  3888. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3889. function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
  3890. begin
  3891. result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
  3892. end;
  3893. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3894. function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  3895. const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
  3896. var
  3897. DestData, TmpData, SourceData: pByte;
  3898. TempHeight, TempWidth: Integer;
  3899. SourceFD, DestFD: TFormatDescriptor;
  3900. SourceMD, DestMD: Pointer;
  3901. FuncRec: TglBitmapFunctionRec;
  3902. begin
  3903. Assert(Assigned(Data));
  3904. Assert(Assigned(aSource));
  3905. Assert(Assigned(aSource.Data));
  3906. result := false;
  3907. if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
  3908. SourceFD := TFormatDescriptor.Get(aSource.Format);
  3909. DestFD := TFormatDescriptor.Get(aFormat);
  3910. if (SourceFD.IsCompressed) then
  3911. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
  3912. if (DestFD.IsCompressed) then
  3913. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
  3914. // inkompatible Formats so CreateTemp
  3915. if (SourceFD.PixelSize <> DestFD.PixelSize) then
  3916. aCreateTemp := true;
  3917. // Values
  3918. TempHeight := Max(1, aSource.Height);
  3919. TempWidth := Max(1, aSource.Width);
  3920. FuncRec.Sender := Self;
  3921. FuncRec.Args := aArgs;
  3922. TmpData := nil;
  3923. if aCreateTemp then begin
  3924. GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
  3925. DestData := TmpData;
  3926. end else
  3927. DestData := Data;
  3928. try
  3929. SourceFD.PreparePixel(FuncRec.Source);
  3930. DestFD.PreparePixel (FuncRec.Dest);
  3931. SourceMD := SourceFD.CreateMappingData;
  3932. DestMD := DestFD.CreateMappingData;
  3933. FuncRec.Size := aSource.Dimension;
  3934. FuncRec.Position.Fields := FuncRec.Size.Fields;
  3935. try
  3936. SourceData := aSource.Data;
  3937. FuncRec.Position.Y := 0;
  3938. while FuncRec.Position.Y < TempHeight do begin
  3939. FuncRec.Position.X := 0;
  3940. while FuncRec.Position.X < TempWidth do begin
  3941. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  3942. aFunc(FuncRec);
  3943. DestFD.Map(FuncRec.Dest, DestData, DestMD);
  3944. inc(FuncRec.Position.X);
  3945. end;
  3946. inc(FuncRec.Position.Y);
  3947. end;
  3948. // Updating Image or InternalFormat
  3949. if aCreateTemp then
  3950. SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method
  3951. else if (aFormat <> fFormat) then
  3952. Format := aFormat;
  3953. result := true;
  3954. finally
  3955. SourceFD.FreeMappingData(SourceMD);
  3956. DestFD.FreeMappingData(DestMD);
  3957. end;
  3958. except
  3959. if aCreateTemp and Assigned(TmpData) then
  3960. FreeMem(TmpData);
  3961. raise;
  3962. end;
  3963. end;
  3964. end;
  3965. {$IFDEF GLB_SDL}
  3966. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3967. function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  3968. var
  3969. Row, RowSize: Integer;
  3970. SourceData, TmpData: PByte;
  3971. TempDepth: Integer;
  3972. FormatDesc: TFormatDescriptor;
  3973. function GetRowPointer(Row: Integer): pByte;
  3974. begin
  3975. result := aSurface.pixels;
  3976. Inc(result, Row * RowSize);
  3977. end;
  3978. begin
  3979. result := false;
  3980. FormatDesc := TFormatDescriptor.Get(Format);
  3981. if FormatDesc.IsCompressed then
  3982. raise EglBitmapUnsupportedFormat.Create(Format);
  3983. if Assigned(Data) then begin
  3984. case Trunc(FormatDesc.PixelSize) of
  3985. 1: TempDepth := 8;
  3986. 2: TempDepth := 16;
  3987. 3: TempDepth := 24;
  3988. 4: TempDepth := 32;
  3989. else
  3990. raise EglBitmapUnsupportedFormat.Create(Format);
  3991. end;
  3992. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
  3993. FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
  3994. SourceData := Data;
  3995. RowSize := FormatDesc.GetSize(FileWidth, 1);
  3996. for Row := 0 to FileHeight-1 do begin
  3997. TmpData := GetRowPointer(Row);
  3998. if Assigned(TmpData) then begin
  3999. Move(SourceData^, TmpData^, RowSize);
  4000. inc(SourceData, RowSize);
  4001. end;
  4002. end;
  4003. result := true;
  4004. end;
  4005. end;
  4006. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4007. function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  4008. var
  4009. pSource, pData, pTempData: PByte;
  4010. Row, RowSize, TempWidth, TempHeight: Integer;
  4011. IntFormat: TglBitmapFormat;
  4012. FormatDesc: TFormatDescriptor;
  4013. function GetRowPointer(Row: Integer): pByte;
  4014. begin
  4015. result := aSurface^.pixels;
  4016. Inc(result, Row * RowSize);
  4017. end;
  4018. begin
  4019. result := false;
  4020. if (Assigned(aSurface)) then begin
  4021. with aSurface^.format^ do begin
  4022. for IntFormat := High(TglBitmapFormat) to Low(TglBitmapFormat) do begin
  4023. FormatDesc := TFormatDescriptor.Get(IntFormat);
  4024. if (FormatDesc.MaskMatch(RMask, GMask, BMask, AMask)) then
  4025. break;
  4026. end;
  4027. if (IntFormat = tfEmpty) then
  4028. raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
  4029. end;
  4030. TempWidth := aSurface^.w;
  4031. TempHeight := aSurface^.h;
  4032. RowSize := FormatDesc.GetSize(TempWidth, 1);
  4033. GetMem(pData, TempHeight * RowSize);
  4034. try
  4035. pTempData := pData;
  4036. for Row := 0 to TempHeight -1 do begin
  4037. pSource := GetRowPointer(Row);
  4038. if (Assigned(pSource)) then begin
  4039. Move(pSource^, pTempData^, RowSize);
  4040. Inc(pTempData, RowSize);
  4041. end;
  4042. end;
  4043. SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  4044. result := true;
  4045. except
  4046. if Assigned(pData) then
  4047. FreeMem(pData);
  4048. raise;
  4049. end;
  4050. end;
  4051. end;
  4052. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4053. function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  4054. var
  4055. Row, Col, AlphaInterleave: Integer;
  4056. pSource, pDest: PByte;
  4057. function GetRowPointer(Row: Integer): pByte;
  4058. begin
  4059. result := aSurface.pixels;
  4060. Inc(result, Row * Width);
  4061. end;
  4062. begin
  4063. result := false;
  4064. if Assigned(Data) then begin
  4065. if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
  4066. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
  4067. AlphaInterleave := 0;
  4068. case Format of
  4069. tfLuminance8Alpha8:
  4070. AlphaInterleave := 1;
  4071. tfBGRA8, tfRGBA8:
  4072. AlphaInterleave := 3;
  4073. end;
  4074. pSource := Data;
  4075. for Row := 0 to Height -1 do begin
  4076. pDest := GetRowPointer(Row);
  4077. if Assigned(pDest) then begin
  4078. for Col := 0 to Width -1 do begin
  4079. Inc(pSource, AlphaInterleave);
  4080. pDest^ := pSource^;
  4081. Inc(pDest);
  4082. Inc(pSource);
  4083. end;
  4084. end;
  4085. end;
  4086. result := true;
  4087. end;
  4088. end;
  4089. end;
  4090. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4091. function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  4092. var
  4093. bmp: TglBitmap2D;
  4094. begin
  4095. bmp := TglBitmap2D.Create;
  4096. try
  4097. bmp.AssignFromSurface(aSurface);
  4098. result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
  4099. finally
  4100. bmp.Free;
  4101. end;
  4102. end;
  4103. {$ENDIF}
  4104. {$IFDEF GLB_DELPHI}
  4105. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4106. function CreateGrayPalette: HPALETTE;
  4107. var
  4108. Idx: Integer;
  4109. Pal: PLogPalette;
  4110. begin
  4111. GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
  4112. Pal.palVersion := $300;
  4113. Pal.palNumEntries := 256;
  4114. for Idx := 0 to Pal.palNumEntries - 1 do begin
  4115. Pal.palPalEntry[Idx].peRed := Idx;
  4116. Pal.palPalEntry[Idx].peGreen := Idx;
  4117. Pal.palPalEntry[Idx].peBlue := Idx;
  4118. Pal.palPalEntry[Idx].peFlags := 0;
  4119. end;
  4120. Result := CreatePalette(Pal^);
  4121. FreeMem(Pal);
  4122. end;
  4123. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4124. function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
  4125. var
  4126. Row: Integer;
  4127. pSource, pData: PByte;
  4128. begin
  4129. result := false;
  4130. if Assigned(Data) then begin
  4131. if Assigned(aBitmap) then begin
  4132. aBitmap.Width := Width;
  4133. aBitmap.Height := Height;
  4134. case Format of
  4135. tfAlpha8, tfLuminance8: begin
  4136. aBitmap.PixelFormat := pf8bit;
  4137. aBitmap.Palette := CreateGrayPalette;
  4138. end;
  4139. tfRGB5A1:
  4140. aBitmap.PixelFormat := pf15bit;
  4141. tfR5G6B5:
  4142. aBitmap.PixelFormat := pf16bit;
  4143. tfRGB8, tfBGR8:
  4144. aBitmap.PixelFormat := pf24bit;
  4145. tfRGBA8, tfBGRA8:
  4146. aBitmap.PixelFormat := pf32bit;
  4147. else
  4148. raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
  4149. end;
  4150. pSource := Data;
  4151. for Row := 0 to FileHeight -1 do begin
  4152. pData := aBitmap.Scanline[Row];
  4153. Move(pSource^, pData^, fRowSize);
  4154. Inc(pSource, fRowSize);
  4155. if (Format in [tfRGB8, tfRGBA8]) then // swap RGB(A) to BGR(A)
  4156. SwapRGB(pData, FileWidth, Format = tfRGBA8);
  4157. end;
  4158. result := true;
  4159. end;
  4160. end;
  4161. end;
  4162. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4163. function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  4164. var
  4165. pSource, pData, pTempData: PByte;
  4166. Row, RowSize, TempWidth, TempHeight: Integer;
  4167. IntFormat: TglBitmapFormat;
  4168. begin
  4169. result := false;
  4170. if (Assigned(aBitmap)) then begin
  4171. case aBitmap.PixelFormat of
  4172. pf8bit:
  4173. IntFormat := tfLuminance8;
  4174. pf15bit:
  4175. IntFormat := tfRGB5A1;
  4176. pf16bit:
  4177. IntFormat := tfR5G6B5;
  4178. pf24bit:
  4179. IntFormat := tfBGR8;
  4180. pf32bit:
  4181. IntFormat := tfBGRA8;
  4182. else
  4183. raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
  4184. end;
  4185. TempWidth := aBitmap.Width;
  4186. TempHeight := aBitmap.Height;
  4187. RowSize := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
  4188. GetMem(pData, TempHeight * RowSize);
  4189. try
  4190. pTempData := pData;
  4191. for Row := 0 to TempHeight -1 do begin
  4192. pSource := aBitmap.Scanline[Row];
  4193. if (Assigned(pSource)) then begin
  4194. Move(pSource^, pTempData^, RowSize);
  4195. Inc(pTempData, RowSize);
  4196. end;
  4197. end;
  4198. SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  4199. result := true;
  4200. except
  4201. if Assigned(pData) then
  4202. FreeMem(pData);
  4203. raise;
  4204. end;
  4205. end;
  4206. end;
  4207. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4208. function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  4209. var
  4210. Row, Col, AlphaInterleave: Integer;
  4211. pSource, pDest: PByte;
  4212. begin
  4213. result := false;
  4214. if Assigned(Data) then begin
  4215. if (Format in [tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8]) then begin
  4216. if Assigned(aBitmap) then begin
  4217. aBitmap.PixelFormat := pf8bit;
  4218. aBitmap.Palette := CreateGrayPalette;
  4219. aBitmap.Width := Width;
  4220. aBitmap.Height := Height;
  4221. case Format of
  4222. tfLuminance8Alpha8:
  4223. AlphaInterleave := 1;
  4224. tfRGBA8, tfBGRA8:
  4225. AlphaInterleave := 3;
  4226. else
  4227. AlphaInterleave := 0;
  4228. end;
  4229. // Copy Data
  4230. pSource := Data;
  4231. for Row := 0 to Height -1 do begin
  4232. pDest := aBitmap.Scanline[Row];
  4233. if Assigned(pDest) then begin
  4234. for Col := 0 to Width -1 do begin
  4235. Inc(pSource, AlphaInterleave);
  4236. pDest^ := pSource^;
  4237. Inc(pDest);
  4238. Inc(pSource);
  4239. end;
  4240. end;
  4241. end;
  4242. result := true;
  4243. end;
  4244. end;
  4245. end;
  4246. end;
  4247. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4248. function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4249. var
  4250. tex: TglBitmap2D;
  4251. begin
  4252. tex := TglBitmap2D.Create;
  4253. try
  4254. tex.AssignFromBitmap(ABitmap);
  4255. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4256. finally
  4257. tex.Free;
  4258. end;
  4259. end;
  4260. {$ENDIF}
  4261. {$IFDEF GLB_LAZARUS}
  4262. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4263. function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4264. var
  4265. rid: TRawImageDescription;
  4266. FormatDesc: TFormatDescriptor;
  4267. begin
  4268. result := false;
  4269. if not Assigned(aImage) or (Format = tfEmpty) then
  4270. exit;
  4271. FormatDesc := TFormatDescriptor.Get(Format);
  4272. if FormatDesc.IsCompressed then
  4273. exit;
  4274. FillChar(rid{%H-}, SizeOf(rid), 0);
  4275. if (Format in [
  4276. tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
  4277. tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
  4278. tfLuminance4Alpha4, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16]) then
  4279. rid.Format := ricfGray
  4280. else
  4281. rid.Format := ricfRGBA;
  4282. rid.Width := Width;
  4283. rid.Height := Height;
  4284. rid.Depth := CountSetBits(FormatDesc.RedMask or FormatDesc.GreenMask or FormatDesc.BlueMask or FormatDesc.AlphaMask);
  4285. rid.BitOrder := riboBitsInOrder;
  4286. rid.ByteOrder := riboLSBFirst;
  4287. rid.LineOrder := riloTopToBottom;
  4288. rid.LineEnd := rileTight;
  4289. rid.BitsPerPixel := Round(8 * FormatDesc.PixelSize);
  4290. rid.RedPrec := CountSetBits(FormatDesc.Range.r);
  4291. rid.GreenPrec := CountSetBits(FormatDesc.Range.g);
  4292. rid.BluePrec := CountSetBits(FormatDesc.Range.b);
  4293. rid.AlphaPrec := CountSetBits(FormatDesc.Range.a);
  4294. rid.RedShift := FormatDesc.Shift.r;
  4295. rid.GreenShift := FormatDesc.Shift.g;
  4296. rid.BlueShift := FormatDesc.Shift.b;
  4297. rid.AlphaShift := FormatDesc.Shift.a;
  4298. rid.MaskBitsPerPixel := 0;
  4299. rid.PaletteColorCount := 0;
  4300. aImage.DataDescription := rid;
  4301. aImage.CreateData;
  4302. Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
  4303. result := true;
  4304. end;
  4305. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4306. function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4307. var
  4308. f: TglBitmapFormat;
  4309. FormatDesc: TFormatDescriptor;
  4310. ImageData: PByte;
  4311. ImageSize: Integer;
  4312. begin
  4313. result := false;
  4314. if not Assigned(aImage) then
  4315. exit;
  4316. for f := High(f) downto Low(f) do begin
  4317. FormatDesc := TFormatDescriptor.Get(f);
  4318. with aImage.DataDescription do
  4319. if FormatDesc.MaskMatch(
  4320. (QWord(1 shl RedPrec )-1) shl RedShift,
  4321. (QWord(1 shl GreenPrec)-1) shl GreenShift,
  4322. (QWord(1 shl BluePrec )-1) shl BlueShift,
  4323. (QWord(1 shl AlphaPrec)-1) shl AlphaShift) then
  4324. break;
  4325. end;
  4326. if (f = tfEmpty) then
  4327. exit;
  4328. ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
  4329. ImageData := GetMem(ImageSize);
  4330. try
  4331. Move(aImage.PixelData^, ImageData^, (aImage.Width * aImage.Height * aImage.DataDescription.BitsPerPixel) shr 3);
  4332. SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method
  4333. except
  4334. if Assigned(ImageData) then
  4335. FreeMem(ImageData);
  4336. raise;
  4337. end;
  4338. result := true;
  4339. end;
  4340. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4341. function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4342. var
  4343. rid: TRawImageDescription;
  4344. FormatDesc: TFormatDescriptor;
  4345. Pixel: TglBitmapPixelData;
  4346. x, y: Integer;
  4347. srcMD: Pointer;
  4348. src, dst: PByte;
  4349. begin
  4350. result := false;
  4351. if not Assigned(aImage) or (Format = tfEmpty) then
  4352. exit;
  4353. FormatDesc := TFormatDescriptor.Get(Format);
  4354. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  4355. exit;
  4356. FillChar(rid{%H-}, SizeOf(rid), 0);
  4357. rid.Format := ricfGray;
  4358. rid.Width := Width;
  4359. rid.Height := Height;
  4360. rid.Depth := CountSetBits(FormatDesc.Range.a);
  4361. rid.BitOrder := riboBitsInOrder;
  4362. rid.ByteOrder := riboLSBFirst;
  4363. rid.LineOrder := riloTopToBottom;
  4364. rid.LineEnd := rileTight;
  4365. rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
  4366. rid.RedPrec := CountSetBits(FormatDesc.Range.a);
  4367. rid.GreenPrec := 0;
  4368. rid.BluePrec := 0;
  4369. rid.AlphaPrec := 0;
  4370. rid.RedShift := 0;
  4371. rid.GreenShift := 0;
  4372. rid.BlueShift := 0;
  4373. rid.AlphaShift := 0;
  4374. rid.MaskBitsPerPixel := 0;
  4375. rid.PaletteColorCount := 0;
  4376. aImage.DataDescription := rid;
  4377. aImage.CreateData;
  4378. srcMD := FormatDesc.CreateMappingData;
  4379. try
  4380. FormatDesc.PreparePixel(Pixel);
  4381. src := Data;
  4382. dst := aImage.PixelData;
  4383. for y := 0 to Height-1 do
  4384. for x := 0 to Width-1 do begin
  4385. FormatDesc.Unmap(src, Pixel, srcMD);
  4386. case rid.BitsPerPixel of
  4387. 8: begin
  4388. dst^ := Pixel.Data.a;
  4389. inc(dst);
  4390. end;
  4391. 16: begin
  4392. PWord(dst)^ := Pixel.Data.a;
  4393. inc(dst, 2);
  4394. end;
  4395. 24: begin
  4396. PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
  4397. PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
  4398. PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
  4399. inc(dst, 3);
  4400. end;
  4401. 32: begin
  4402. PCardinal(dst)^ := Pixel.Data.a;
  4403. inc(dst, 4);
  4404. end;
  4405. else
  4406. raise EglBitmapUnsupportedFormat.Create(Format);
  4407. end;
  4408. end;
  4409. finally
  4410. FormatDesc.FreeMappingData(srcMD);
  4411. end;
  4412. result := true;
  4413. end;
  4414. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4415. function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4416. var
  4417. tex: TglBitmap2D;
  4418. begin
  4419. tex := TglBitmap2D.Create;
  4420. try
  4421. tex.AssignFromLazIntfImage(aImage);
  4422. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4423. finally
  4424. tex.Free;
  4425. end;
  4426. end;
  4427. {$ENDIF}
  4428. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4429. function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
  4430. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4431. var
  4432. rs: TResourceStream;
  4433. begin
  4434. PrepareResType(aResource, aResType);
  4435. rs := TResourceStream.Create(aInstance, aResource, aResType);
  4436. try
  4437. result := AddAlphaFromStream(rs, aFunc, aArgs);
  4438. finally
  4439. rs.Free;
  4440. end;
  4441. end;
  4442. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4443. function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  4444. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4445. var
  4446. rs: TResourceStream;
  4447. begin
  4448. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  4449. try
  4450. result := AddAlphaFromStream(rs, aFunc, aArgs);
  4451. finally
  4452. rs.Free;
  4453. end;
  4454. end;
  4455. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4456. function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4457. begin
  4458. if TFormatDescriptor.Get(Format).IsCompressed then
  4459. raise EglBitmapUnsupportedFormat.Create(Format);
  4460. result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
  4461. end;
  4462. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4463. function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4464. var
  4465. FS: TFileStream;
  4466. begin
  4467. FS := TFileStream.Create(aFileName, fmOpenRead);
  4468. try
  4469. result := AddAlphaFromStream(FS, aFunc, aArgs);
  4470. finally
  4471. FS.Free;
  4472. end;
  4473. end;
  4474. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4475. function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4476. var
  4477. tex: TglBitmap2D;
  4478. begin
  4479. tex := TglBitmap2D.Create(aStream);
  4480. try
  4481. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4482. finally
  4483. tex.Free;
  4484. end;
  4485. end;
  4486. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4487. function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4488. var
  4489. DestData, DestData2, SourceData: pByte;
  4490. TempHeight, TempWidth: Integer;
  4491. SourceFD, DestFD: TFormatDescriptor;
  4492. SourceMD, DestMD, DestMD2: Pointer;
  4493. FuncRec: TglBitmapFunctionRec;
  4494. begin
  4495. result := false;
  4496. Assert(Assigned(Data));
  4497. Assert(Assigned(aBitmap));
  4498. Assert(Assigned(aBitmap.Data));
  4499. if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
  4500. result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
  4501. SourceFD := TFormatDescriptor.Get(aBitmap.Format);
  4502. DestFD := TFormatDescriptor.Get(Format);
  4503. if not Assigned(aFunc) then begin
  4504. aFunc := glBitmapAlphaFunc;
  4505. FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
  4506. end else
  4507. FuncRec.Args := aArgs;
  4508. // Values
  4509. TempHeight := aBitmap.FileHeight;
  4510. TempWidth := aBitmap.FileWidth;
  4511. FuncRec.Sender := Self;
  4512. FuncRec.Size := Dimension;
  4513. FuncRec.Position.Fields := FuncRec.Size.Fields;
  4514. DestData := Data;
  4515. DestData2 := Data;
  4516. SourceData := aBitmap.Data;
  4517. // Mapping
  4518. SourceFD.PreparePixel(FuncRec.Source);
  4519. DestFD.PreparePixel (FuncRec.Dest);
  4520. SourceMD := SourceFD.CreateMappingData;
  4521. DestMD := DestFD.CreateMappingData;
  4522. DestMD2 := DestFD.CreateMappingData;
  4523. try
  4524. FuncRec.Position.Y := 0;
  4525. while FuncRec.Position.Y < TempHeight do begin
  4526. FuncRec.Position.X := 0;
  4527. while FuncRec.Position.X < TempWidth do begin
  4528. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  4529. DestFD.Unmap (DestData, FuncRec.Dest, DestMD);
  4530. aFunc(FuncRec);
  4531. DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
  4532. inc(FuncRec.Position.X);
  4533. end;
  4534. inc(FuncRec.Position.Y);
  4535. end;
  4536. finally
  4537. SourceFD.FreeMappingData(SourceMD);
  4538. DestFD.FreeMappingData(DestMD);
  4539. DestFD.FreeMappingData(DestMD2);
  4540. end;
  4541. end;
  4542. end;
  4543. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4544. function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
  4545. begin
  4546. result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
  4547. end;
  4548. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4549. function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
  4550. var
  4551. PixelData: TglBitmapPixelData;
  4552. begin
  4553. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4554. result := AddAlphaFromColorKeyFloat(
  4555. aRed / PixelData.Range.r,
  4556. aGreen / PixelData.Range.g,
  4557. aBlue / PixelData.Range.b,
  4558. aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
  4559. end;
  4560. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4561. function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
  4562. var
  4563. values: array[0..2] of Single;
  4564. tmp: Cardinal;
  4565. i: Integer;
  4566. PixelData: TglBitmapPixelData;
  4567. begin
  4568. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4569. with PixelData do begin
  4570. values[0] := aRed;
  4571. values[1] := aGreen;
  4572. values[2] := aBlue;
  4573. for i := 0 to 2 do begin
  4574. tmp := Trunc(Range.arr[i] * aDeviation);
  4575. Data.arr[i] := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
  4576. Range.arr[i] := Max(0, Trunc(Range.arr[i] * values[i] - tmp));
  4577. end;
  4578. Data.a := 0;
  4579. Range.a := 0;
  4580. end;
  4581. result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
  4582. end;
  4583. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4584. function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
  4585. begin
  4586. result := AddAlphaFromValueFloat(aAlpha / $FF);
  4587. end;
  4588. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4589. function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  4590. var
  4591. PixelData: TglBitmapPixelData;
  4592. begin
  4593. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4594. result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
  4595. end;
  4596. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4597. function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  4598. var
  4599. PixelData: TglBitmapPixelData;
  4600. begin
  4601. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4602. with PixelData do
  4603. Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
  4604. result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
  4605. end;
  4606. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4607. function TglBitmap.RemoveAlpha: Boolean;
  4608. var
  4609. FormatDesc: TFormatDescriptor;
  4610. begin
  4611. result := false;
  4612. FormatDesc := TFormatDescriptor.Get(Format);
  4613. if Assigned(Data) then begin
  4614. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  4615. raise EglBitmapUnsupportedFormat.Create(Format);
  4616. result := ConvertTo(FormatDesc.WithoutAlpha);
  4617. end;
  4618. end;
  4619. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4620. function TglBitmap.Clone: TglBitmap;
  4621. var
  4622. Temp: TglBitmap;
  4623. TempPtr: PByte;
  4624. Size: Integer;
  4625. begin
  4626. result := nil;
  4627. Temp := (ClassType.Create as TglBitmap);
  4628. try
  4629. // copy texture data if assigned
  4630. if Assigned(Data) then begin
  4631. Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
  4632. GetMem(TempPtr, Size);
  4633. try
  4634. Move(Data^, TempPtr^, Size);
  4635. Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
  4636. except
  4637. if Assigned(TempPtr) then
  4638. FreeMem(TempPtr);
  4639. raise;
  4640. end;
  4641. end else begin
  4642. TempPtr := nil;
  4643. Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
  4644. end;
  4645. // copy properties
  4646. Temp.fID := ID;
  4647. Temp.fTarget := Target;
  4648. Temp.fFormat := Format;
  4649. Temp.fMipMap := MipMap;
  4650. Temp.fAnisotropic := Anisotropic;
  4651. Temp.fBorderColor := fBorderColor;
  4652. Temp.fDeleteTextureOnFree := DeleteTextureOnFree;
  4653. Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
  4654. Temp.fFilterMin := fFilterMin;
  4655. Temp.fFilterMag := fFilterMag;
  4656. Temp.fWrapS := fWrapS;
  4657. Temp.fWrapT := fWrapT;
  4658. Temp.fWrapR := fWrapR;
  4659. Temp.fFilename := fFilename;
  4660. Temp.fCustomName := fCustomName;
  4661. Temp.fCustomNameW := fCustomNameW;
  4662. Temp.fCustomData := fCustomData;
  4663. result := Temp;
  4664. except
  4665. FreeAndNil(Temp);
  4666. raise;
  4667. end;
  4668. end;
  4669. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4670. function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
  4671. var
  4672. SourceFD, DestFD: TFormatDescriptor;
  4673. SourcePD, DestPD: TglBitmapPixelData;
  4674. ShiftData: TShiftData;
  4675. function CanCopyDirect: Boolean;
  4676. begin
  4677. result :=
  4678. ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  4679. ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  4680. ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  4681. ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  4682. end;
  4683. function CanShift: Boolean;
  4684. begin
  4685. result :=
  4686. ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  4687. ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  4688. ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  4689. ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  4690. end;
  4691. function GetShift(aSource, aDest: Cardinal) : ShortInt;
  4692. begin
  4693. result := 0;
  4694. while (aSource > aDest) and (aSource > 0) do begin
  4695. inc(result);
  4696. aSource := aSource shr 1;
  4697. end;
  4698. end;
  4699. begin
  4700. if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
  4701. SourceFD := TFormatDescriptor.Get(Format);
  4702. DestFD := TFormatDescriptor.Get(aFormat);
  4703. SourceFD.PreparePixel(SourcePD);
  4704. DestFD.PreparePixel (DestPD);
  4705. if CanCopyDirect then
  4706. result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
  4707. else if CanShift then begin
  4708. ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
  4709. ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
  4710. ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
  4711. ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
  4712. result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
  4713. end else
  4714. result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
  4715. end else
  4716. result := true;
  4717. end;
  4718. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4719. procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
  4720. begin
  4721. if aUseRGB or aUseAlpha then
  4722. AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
  4723. ((Byte(aUseAlpha) and 1) shl 1) or
  4724. (Byte(aUseRGB) and 1) ));
  4725. end;
  4726. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4727. procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  4728. begin
  4729. fBorderColor[0] := aRed;
  4730. fBorderColor[1] := aGreen;
  4731. fBorderColor[2] := aBlue;
  4732. fBorderColor[3] := aAlpha;
  4733. if (ID > 0) then begin
  4734. Bind(false);
  4735. glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
  4736. end;
  4737. end;
  4738. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4739. procedure TglBitmap.FreeData;
  4740. var
  4741. TempPtr: PByte;
  4742. begin
  4743. TempPtr := nil;
  4744. SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method
  4745. end;
  4746. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4747. procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
  4748. const aAlpha: Byte);
  4749. begin
  4750. FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
  4751. end;
  4752. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4753. procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
  4754. var
  4755. PixelData: TglBitmapPixelData;
  4756. begin
  4757. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4758. FillWithColorFloat(
  4759. aRed / PixelData.Range.r,
  4760. aGreen / PixelData.Range.g,
  4761. aBlue / PixelData.Range.b,
  4762. aAlpha / PixelData.Range.a);
  4763. end;
  4764. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4765. procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
  4766. var
  4767. PixelData: TglBitmapPixelData;
  4768. begin
  4769. TFormatDescriptor.Get(Format).PreparePixel(PixelData);
  4770. with PixelData do begin
  4771. Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
  4772. Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
  4773. Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
  4774. Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
  4775. end;
  4776. AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
  4777. end;
  4778. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4779. procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
  4780. begin
  4781. //check MIN filter
  4782. case aMin of
  4783. GL_NEAREST:
  4784. fFilterMin := GL_NEAREST;
  4785. GL_LINEAR:
  4786. fFilterMin := GL_LINEAR;
  4787. GL_NEAREST_MIPMAP_NEAREST:
  4788. fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
  4789. GL_LINEAR_MIPMAP_NEAREST:
  4790. fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
  4791. GL_NEAREST_MIPMAP_LINEAR:
  4792. fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
  4793. GL_LINEAR_MIPMAP_LINEAR:
  4794. fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
  4795. else
  4796. raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
  4797. end;
  4798. //check MAG filter
  4799. case aMag of
  4800. GL_NEAREST:
  4801. fFilterMag := GL_NEAREST;
  4802. GL_LINEAR:
  4803. fFilterMag := GL_LINEAR;
  4804. else
  4805. raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
  4806. end;
  4807. //apply filter
  4808. if (ID > 0) then begin
  4809. Bind(false);
  4810. glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
  4811. if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
  4812. case fFilterMin of
  4813. GL_NEAREST, GL_LINEAR:
  4814. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  4815. GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
  4816. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
  4817. GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
  4818. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
  4819. end;
  4820. end else
  4821. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  4822. end;
  4823. end;
  4824. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4825. procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
  4826. procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
  4827. begin
  4828. case aValue of
  4829. GL_CLAMP:
  4830. aTarget := GL_CLAMP;
  4831. GL_REPEAT:
  4832. aTarget := GL_REPEAT;
  4833. GL_CLAMP_TO_EDGE: begin
  4834. if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
  4835. aTarget := GL_CLAMP_TO_EDGE
  4836. else
  4837. aTarget := GL_CLAMP;
  4838. end;
  4839. GL_CLAMP_TO_BORDER: begin
  4840. if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
  4841. aTarget := GL_CLAMP_TO_BORDER
  4842. else
  4843. aTarget := GL_CLAMP;
  4844. end;
  4845. GL_MIRRORED_REPEAT: begin
  4846. if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
  4847. aTarget := GL_MIRRORED_REPEAT
  4848. else
  4849. raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
  4850. end;
  4851. else
  4852. raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
  4853. end;
  4854. end;
  4855. begin
  4856. CheckAndSetWrap(S, fWrapS);
  4857. CheckAndSetWrap(T, fWrapT);
  4858. CheckAndSetWrap(R, fWrapR);
  4859. if (ID > 0) then begin
  4860. Bind(false);
  4861. glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
  4862. glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
  4863. glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
  4864. end;
  4865. end;
  4866. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4867. procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
  4868. procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
  4869. begin
  4870. if (aValue = GL_ZERO) or (aValue = GL_ONE) or (aValue = GL_ALPHA) or
  4871. (aValue = GL_RED) or (aValue = GL_GREEN) or (aValue = GL_BLUE) then
  4872. fSwizzle[aIndex] := aValue
  4873. else
  4874. raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
  4875. end;
  4876. begin
  4877. if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  4878. raise EglBitmapNotSupported.Create('texture swizzle is not supported');
  4879. CheckAndSetValue(r, 0);
  4880. CheckAndSetValue(g, 1);
  4881. CheckAndSetValue(b, 2);
  4882. CheckAndSetValue(a, 3);
  4883. if (ID > 0) then begin
  4884. Bind(false);
  4885. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, @fSwizzle[0]);
  4886. end;
  4887. end;
  4888. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4889. procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
  4890. begin
  4891. if aEnableTextureUnit then
  4892. glEnable(Target);
  4893. if (ID > 0) then
  4894. glBindTexture(Target, ID);
  4895. end;
  4896. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4897. procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
  4898. begin
  4899. if aDisableTextureUnit then
  4900. glDisable(Target);
  4901. glBindTexture(Target, 0);
  4902. end;
  4903. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4904. constructor TglBitmap.Create;
  4905. begin
  4906. if (ClassType = TglBitmap) then
  4907. raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
  4908. {$IFDEF GLB_NATIVE_OGL}
  4909. glbReadOpenGLExtensions;
  4910. {$ENDIF}
  4911. inherited Create;
  4912. end;
  4913. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4914. constructor TglBitmap.Create(const aFileName: String);
  4915. begin
  4916. Create;
  4917. LoadFromFile(aFileName);
  4918. end;
  4919. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4920. constructor TglBitmap.Create(const aStream: TStream);
  4921. begin
  4922. Create;
  4923. LoadFromStream(aStream);
  4924. end;
  4925. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4926. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat);
  4927. var
  4928. Image: PByte;
  4929. ImageSize: Integer;
  4930. begin
  4931. Create;
  4932. ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  4933. GetMem(Image, ImageSize);
  4934. try
  4935. FillChar(Image^, ImageSize, #$FF);
  4936. SetDataPointer(Image, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  4937. except
  4938. if Assigned(Image) then
  4939. FreeMem(Image);
  4940. raise;
  4941. end;
  4942. end;
  4943. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4944. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat;
  4945. const aFunc: TglBitmapFunction; const aArgs: Pointer);
  4946. begin
  4947. Create;
  4948. LoadFromFunc(aSize, aFunc, aFormat, aArgs);
  4949. end;
  4950. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4951. constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
  4952. begin
  4953. Create;
  4954. LoadFromResource(aInstance, aResource, aResType);
  4955. end;
  4956. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4957. constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  4958. begin
  4959. Create;
  4960. LoadFromResourceID(aInstance, aResourceID, aResType);
  4961. end;
  4962. {$IFDEF GLB_SUPPORT_PNG_READ}
  4963. {$IF DEFINED(GLB_LAZ_PNG)}
  4964. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4965. //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4966. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4967. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  4968. const
  4969. MAGIC_LEN = 8;
  4970. PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
  4971. var
  4972. png: TPortableNetworkGraphic;
  4973. intf: TLazIntfImage;
  4974. StreamPos: Int64;
  4975. magic: String[MAGIC_LEN];
  4976. begin
  4977. result := true;
  4978. StreamPos := aStream.Position;
  4979. SetLength(magic, MAGIC_LEN);
  4980. aStream.Read(magic[1], MAGIC_LEN);
  4981. aStream.Position := StreamPos;
  4982. if (magic <> PNG_MAGIC) then begin
  4983. result := false;
  4984. exit;
  4985. end;
  4986. png := TPortableNetworkGraphic.Create;
  4987. try try
  4988. png.LoadFromStream(aStream);
  4989. intf := png.CreateIntfImage;
  4990. try try
  4991. AssignFromLazIntfImage(intf);
  4992. except
  4993. result := false;
  4994. aStream.Position := StreamPos;
  4995. exit;
  4996. end;
  4997. finally
  4998. intf.Free;
  4999. end;
  5000. except
  5001. result := false;
  5002. aStream.Position := StreamPos;
  5003. exit;
  5004. end;
  5005. finally
  5006. png.Free;
  5007. end;
  5008. end;
  5009. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
  5010. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5011. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5012. var
  5013. Surface: PSDL_Surface;
  5014. RWops: PSDL_RWops;
  5015. begin
  5016. result := false;
  5017. RWops := glBitmapCreateRWops(aStream);
  5018. try
  5019. if IMG_isPNG(RWops) > 0 then begin
  5020. Surface := IMG_LoadPNG_RW(RWops);
  5021. try
  5022. AssignFromSurface(Surface);
  5023. result := true;
  5024. finally
  5025. SDL_FreeSurface(Surface);
  5026. end;
  5027. end;
  5028. finally
  5029. SDL_FreeRW(RWops);
  5030. end;
  5031. end;
  5032. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  5033. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5034. procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  5035. begin
  5036. TStream(png_get_io_ptr(png)).Read(buffer^, size);
  5037. end;
  5038. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5039. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5040. var
  5041. StreamPos: Int64;
  5042. signature: array [0..7] of byte;
  5043. png: png_structp;
  5044. png_info: png_infop;
  5045. TempHeight, TempWidth: Integer;
  5046. Format: TglBitmapFormat;
  5047. png_data: pByte;
  5048. png_rows: array of pByte;
  5049. Row, LineSize: Integer;
  5050. begin
  5051. result := false;
  5052. if not init_libPNG then
  5053. raise Exception.Create('LoadPNG - unable to initialize libPNG.');
  5054. try
  5055. // signature
  5056. StreamPos := aStream.Position;
  5057. aStream.Read(signature{%H-}, 8);
  5058. aStream.Position := StreamPos;
  5059. if png_check_sig(@signature, 8) <> 0 then begin
  5060. // png read struct
  5061. png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  5062. if png = nil then
  5063. raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
  5064. // png info
  5065. png_info := png_create_info_struct(png);
  5066. if png_info = nil then begin
  5067. png_destroy_read_struct(@png, nil, nil);
  5068. raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
  5069. end;
  5070. // set read callback
  5071. png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
  5072. // read informations
  5073. png_read_info(png, png_info);
  5074. // size
  5075. TempHeight := png_get_image_height(png, png_info);
  5076. TempWidth := png_get_image_width(png, png_info);
  5077. // format
  5078. case png_get_color_type(png, png_info) of
  5079. PNG_COLOR_TYPE_GRAY:
  5080. Format := tfLuminance8;
  5081. PNG_COLOR_TYPE_GRAY_ALPHA:
  5082. Format := tfLuminance8Alpha8;
  5083. PNG_COLOR_TYPE_RGB:
  5084. Format := tfRGB8;
  5085. PNG_COLOR_TYPE_RGB_ALPHA:
  5086. Format := tfRGBA8;
  5087. else
  5088. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5089. end;
  5090. // cut upper 8 bit from 16 bit formats
  5091. if png_get_bit_depth(png, png_info) > 8 then
  5092. png_set_strip_16(png);
  5093. // expand bitdepth smaller than 8
  5094. if png_get_bit_depth(png, png_info) < 8 then
  5095. png_set_expand(png);
  5096. // allocating mem for scanlines
  5097. LineSize := png_get_rowbytes(png, png_info);
  5098. GetMem(png_data, TempHeight * LineSize);
  5099. try
  5100. SetLength(png_rows, TempHeight);
  5101. for Row := Low(png_rows) to High(png_rows) do begin
  5102. png_rows[Row] := png_data;
  5103. Inc(png_rows[Row], Row * LineSize);
  5104. end;
  5105. // read complete image into scanlines
  5106. png_read_image(png, @png_rows[0]);
  5107. // read end
  5108. png_read_end(png, png_info);
  5109. // destroy read struct
  5110. png_destroy_read_struct(@png, @png_info, nil);
  5111. SetLength(png_rows, 0);
  5112. // set new data
  5113. SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
  5114. result := true;
  5115. except
  5116. if Assigned(png_data) then
  5117. FreeMem(png_data);
  5118. raise;
  5119. end;
  5120. end;
  5121. finally
  5122. quit_libPNG;
  5123. end;
  5124. end;
  5125. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  5126. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5127. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5128. var
  5129. StreamPos: Int64;
  5130. Png: TPNGObject;
  5131. Header: String[8];
  5132. Row, Col, PixSize, LineSize: Integer;
  5133. NewImage, pSource, pDest, pAlpha: pByte;
  5134. PngFormat: TglBitmapFormat;
  5135. FormatDesc: TFormatDescriptor;
  5136. const
  5137. PngHeader: String[8] = #137#80#78#71#13#10#26#10;
  5138. begin
  5139. result := false;
  5140. StreamPos := aStream.Position;
  5141. aStream.Read(Header[0], SizeOf(Header));
  5142. aStream.Position := StreamPos;
  5143. {Test if the header matches}
  5144. if Header = PngHeader then begin
  5145. Png := TPNGObject.Create;
  5146. try
  5147. Png.LoadFromStream(aStream);
  5148. case Png.Header.ColorType of
  5149. COLOR_GRAYSCALE:
  5150. PngFormat := tfLuminance8;
  5151. COLOR_GRAYSCALEALPHA:
  5152. PngFormat := tfLuminance8Alpha8;
  5153. COLOR_RGB:
  5154. PngFormat := tfBGR8;
  5155. COLOR_RGBALPHA:
  5156. PngFormat := tfBGRA8;
  5157. else
  5158. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5159. end;
  5160. FormatDesc := TFormatDescriptor.Get(PngFormat);
  5161. PixSize := Round(FormatDesc.PixelSize);
  5162. LineSize := FormatDesc.GetSize(Png.Header.Width, 1);
  5163. GetMem(NewImage, LineSize * Integer(Png.Header.Height));
  5164. try
  5165. pDest := NewImage;
  5166. case Png.Header.ColorType of
  5167. COLOR_RGB, COLOR_GRAYSCALE:
  5168. begin
  5169. for Row := 0 to Png.Height -1 do begin
  5170. Move (Png.Scanline[Row]^, pDest^, LineSize);
  5171. Inc(pDest, LineSize);
  5172. end;
  5173. end;
  5174. COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
  5175. begin
  5176. PixSize := PixSize -1;
  5177. for Row := 0 to Png.Height -1 do begin
  5178. pSource := Png.Scanline[Row];
  5179. pAlpha := pByte(Png.AlphaScanline[Row]);
  5180. for Col := 0 to Png.Width -1 do begin
  5181. Move (pSource^, pDest^, PixSize);
  5182. Inc(pSource, PixSize);
  5183. Inc(pDest, PixSize);
  5184. pDest^ := pAlpha^;
  5185. inc(pAlpha);
  5186. Inc(pDest);
  5187. end;
  5188. end;
  5189. end;
  5190. else
  5191. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5192. end;
  5193. SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
  5194. result := true;
  5195. except
  5196. if Assigned(NewImage) then
  5197. FreeMem(NewImage);
  5198. raise;
  5199. end;
  5200. finally
  5201. Png.Free;
  5202. end;
  5203. end;
  5204. end;
  5205. {$IFEND}
  5206. {$ENDIF}
  5207. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  5208. {$IFDEF GLB_LIB_PNG}
  5209. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5210. procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  5211. begin
  5212. TStream(png_get_io_ptr(png)).Write(buffer^, size);
  5213. end;
  5214. {$ENDIF}
  5215. {$IF DEFINED(GLB_LAZ_PNG)}
  5216. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5217. procedure TglBitmap.SavePNG(const aStream: TStream);
  5218. var
  5219. png: TPortableNetworkGraphic;
  5220. intf: TLazIntfImage;
  5221. raw: TRawImage;
  5222. begin
  5223. png := TPortableNetworkGraphic.Create;
  5224. intf := TLazIntfImage.Create(0, 0);
  5225. try
  5226. if not AssignToLazIntfImage(intf) then
  5227. raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
  5228. intf.GetRawImage(raw);
  5229. png.LoadFromRawImage(raw, false);
  5230. png.SaveToStream(aStream);
  5231. finally
  5232. png.Free;
  5233. intf.Free;
  5234. end;
  5235. end;
  5236. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  5237. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5238. procedure TglBitmap.SavePNG(const aStream: TStream);
  5239. var
  5240. png: png_structp;
  5241. png_info: png_infop;
  5242. png_rows: array of pByte;
  5243. LineSize: Integer;
  5244. ColorType: Integer;
  5245. Row: Integer;
  5246. FormatDesc: TFormatDescriptor;
  5247. begin
  5248. if not (ftPNG in FormatGetSupportedFiles(Format)) then
  5249. raise EglBitmapUnsupportedFormat.Create(Format);
  5250. if not init_libPNG then
  5251. raise Exception.Create('unable to initialize libPNG.');
  5252. try
  5253. case Format of
  5254. tfAlpha8, tfLuminance8:
  5255. ColorType := PNG_COLOR_TYPE_GRAY;
  5256. tfLuminance8Alpha8:
  5257. ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
  5258. tfBGR8, tfRGB8:
  5259. ColorType := PNG_COLOR_TYPE_RGB;
  5260. tfBGRA8, tfRGBA8:
  5261. ColorType := PNG_COLOR_TYPE_RGBA;
  5262. else
  5263. raise EglBitmapUnsupportedFormat.Create(Format);
  5264. end;
  5265. FormatDesc := TFormatDescriptor.Get(Format);
  5266. LineSize := FormatDesc.GetSize(Width, 1);
  5267. // creating array for scanline
  5268. SetLength(png_rows, Height);
  5269. try
  5270. for Row := 0 to Height - 1 do begin
  5271. png_rows[Row] := Data;
  5272. Inc(png_rows[Row], Row * LineSize)
  5273. end;
  5274. // write struct
  5275. png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  5276. if png = nil then
  5277. raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
  5278. // create png info
  5279. png_info := png_create_info_struct(png);
  5280. if png_info = nil then begin
  5281. png_destroy_write_struct(@png, nil);
  5282. raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
  5283. end;
  5284. // set read callback
  5285. png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
  5286. // set compression
  5287. png_set_compression_level(png, 6);
  5288. if Format in [tfBGR8, tfBGRA8] then
  5289. png_set_bgr(png);
  5290. png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
  5291. png_write_info(png, png_info);
  5292. png_write_image(png, @png_rows[0]);
  5293. png_write_end(png, png_info);
  5294. png_destroy_write_struct(@png, @png_info);
  5295. finally
  5296. SetLength(png_rows, 0);
  5297. end;
  5298. finally
  5299. quit_libPNG;
  5300. end;
  5301. end;
  5302. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  5303. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5304. procedure TglBitmap.SavePNG(const aStream: TStream);
  5305. var
  5306. Png: TPNGObject;
  5307. pSource, pDest: pByte;
  5308. X, Y, PixSize: Integer;
  5309. ColorType: Cardinal;
  5310. Alpha: Boolean;
  5311. pTemp: pByte;
  5312. Temp: Byte;
  5313. begin
  5314. if not (ftPNG in FormatGetSupportedFiles (Format)) then
  5315. raise EglBitmapUnsupportedFormat.Create(Format);
  5316. case Format of
  5317. tfAlpha8, tfLuminance8: begin
  5318. ColorType := COLOR_GRAYSCALE;
  5319. PixSize := 1;
  5320. Alpha := false;
  5321. end;
  5322. tfLuminance8Alpha8: begin
  5323. ColorType := COLOR_GRAYSCALEALPHA;
  5324. PixSize := 1;
  5325. Alpha := true;
  5326. end;
  5327. tfBGR8, tfRGB8: begin
  5328. ColorType := COLOR_RGB;
  5329. PixSize := 3;
  5330. Alpha := false;
  5331. end;
  5332. tfBGRA8, tfRGBA8: begin
  5333. ColorType := COLOR_RGBALPHA;
  5334. PixSize := 3;
  5335. Alpha := true
  5336. end;
  5337. else
  5338. raise EglBitmapUnsupportedFormat.Create(Format);
  5339. end;
  5340. Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
  5341. try
  5342. // Copy ImageData
  5343. pSource := Data;
  5344. for Y := 0 to Height -1 do begin
  5345. pDest := png.ScanLine[Y];
  5346. for X := 0 to Width -1 do begin
  5347. Move(pSource^, pDest^, PixSize);
  5348. Inc(pDest, PixSize);
  5349. Inc(pSource, PixSize);
  5350. if Alpha then begin
  5351. png.AlphaScanline[Y]^[X] := pSource^;
  5352. Inc(pSource);
  5353. end;
  5354. end;
  5355. // convert RGB line to BGR
  5356. if Format in [tfRGB8, tfRGBA8] then begin
  5357. pTemp := png.ScanLine[Y];
  5358. for X := 0 to Width -1 do begin
  5359. Temp := pByteArray(pTemp)^[0];
  5360. pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
  5361. pByteArray(pTemp)^[2] := Temp;
  5362. Inc(pTemp, 3);
  5363. end;
  5364. end;
  5365. end;
  5366. // Save to Stream
  5367. Png.CompressionLevel := 6;
  5368. Png.SaveToStream(aStream);
  5369. finally
  5370. FreeAndNil(Png);
  5371. end;
  5372. end;
  5373. {$IFEND}
  5374. {$ENDIF}
  5375. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5376. //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5377. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5378. {$IFDEF GLB_LIB_JPEG}
  5379. type
  5380. glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
  5381. glBitmap_libJPEG_source_mgr = record
  5382. pub: jpeg_source_mgr;
  5383. SrcStream: TStream;
  5384. SrcBuffer: array [1..4096] of byte;
  5385. end;
  5386. glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
  5387. glBitmap_libJPEG_dest_mgr = record
  5388. pub: jpeg_destination_mgr;
  5389. DestStream: TStream;
  5390. DestBuffer: array [1..4096] of byte;
  5391. end;
  5392. procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
  5393. begin
  5394. //DUMMY
  5395. end;
  5396. procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
  5397. begin
  5398. //DUMMY
  5399. end;
  5400. procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
  5401. begin
  5402. //DUMMY
  5403. end;
  5404. procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
  5405. begin
  5406. //DUMMY
  5407. end;
  5408. procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
  5409. begin
  5410. //DUMMY
  5411. end;
  5412. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5413. function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
  5414. var
  5415. src: glBitmap_libJPEG_source_mgr_ptr;
  5416. bytes: integer;
  5417. begin
  5418. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  5419. bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
  5420. if (bytes <= 0) then begin
  5421. src^.SrcBuffer[1] := $FF;
  5422. src^.SrcBuffer[2] := JPEG_EOI;
  5423. bytes := 2;
  5424. end;
  5425. src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
  5426. src^.pub.bytes_in_buffer := bytes;
  5427. result := true;
  5428. end;
  5429. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5430. procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
  5431. var
  5432. src: glBitmap_libJPEG_source_mgr_ptr;
  5433. begin
  5434. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  5435. if num_bytes > 0 then begin
  5436. // wanted byte isn't in buffer so set stream position and read buffer
  5437. if num_bytes > src^.pub.bytes_in_buffer then begin
  5438. src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
  5439. src^.pub.fill_input_buffer(cinfo);
  5440. end else begin
  5441. // wanted byte is in buffer so only skip
  5442. inc(src^.pub.next_input_byte, num_bytes);
  5443. dec(src^.pub.bytes_in_buffer, num_bytes);
  5444. end;
  5445. end;
  5446. end;
  5447. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5448. function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
  5449. var
  5450. dest: glBitmap_libJPEG_dest_mgr_ptr;
  5451. begin
  5452. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  5453. if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
  5454. // write complete buffer
  5455. dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
  5456. // reset buffer
  5457. dest^.pub.next_output_byte := @dest^.DestBuffer[1];
  5458. dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
  5459. end;
  5460. result := true;
  5461. end;
  5462. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5463. procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
  5464. var
  5465. Idx: Integer;
  5466. dest: glBitmap_libJPEG_dest_mgr_ptr;
  5467. begin
  5468. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  5469. for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
  5470. // check for endblock
  5471. if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
  5472. // write endblock
  5473. dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
  5474. // leave
  5475. break;
  5476. end else
  5477. dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
  5478. end;
  5479. end;
  5480. {$ENDIF}
  5481. {$IFDEF GLB_SUPPORT_JPEG_READ}
  5482. {$IF DEFINED(GLB_LAZ_JPEG)}
  5483. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5484. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5485. const
  5486. MAGIC_LEN = 2;
  5487. JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
  5488. var
  5489. jpeg: TJPEGImage;
  5490. intf: TLazIntfImage;
  5491. StreamPos: Int64;
  5492. magic: String[MAGIC_LEN];
  5493. begin
  5494. result := true;
  5495. StreamPos := aStream.Position;
  5496. SetLength(magic, MAGIC_LEN);
  5497. aStream.Read(magic[1], MAGIC_LEN);
  5498. aStream.Position := StreamPos;
  5499. if (magic <> JPEG_MAGIC) then begin
  5500. result := false;
  5501. exit;
  5502. end;
  5503. jpeg := TJPEGImage.Create;
  5504. try try
  5505. jpeg.LoadFromStream(aStream);
  5506. intf := TLazIntfImage.Create(0, 0);
  5507. try try
  5508. intf.LoadFromBitmap(jpeg.BitmapHandle, jpeg.MaskHandle);
  5509. AssignFromLazIntfImage(intf);
  5510. except
  5511. result := false;
  5512. aStream.Position := StreamPos;
  5513. exit;
  5514. end;
  5515. finally
  5516. intf.Free;
  5517. end;
  5518. except
  5519. result := false;
  5520. aStream.Position := StreamPos;
  5521. exit;
  5522. end;
  5523. finally
  5524. jpeg.Free;
  5525. end;
  5526. end;
  5527. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
  5528. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5529. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5530. var
  5531. Surface: PSDL_Surface;
  5532. RWops: PSDL_RWops;
  5533. begin
  5534. result := false;
  5535. RWops := glBitmapCreateRWops(aStream);
  5536. try
  5537. if IMG_isJPG(RWops) > 0 then begin
  5538. Surface := IMG_LoadJPG_RW(RWops);
  5539. try
  5540. AssignFromSurface(Surface);
  5541. result := true;
  5542. finally
  5543. SDL_FreeSurface(Surface);
  5544. end;
  5545. end;
  5546. finally
  5547. SDL_FreeRW(RWops);
  5548. end;
  5549. end;
  5550. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  5551. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5552. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5553. var
  5554. StreamPos: Int64;
  5555. Temp: array[0..1]of Byte;
  5556. jpeg: jpeg_decompress_struct;
  5557. jpeg_err: jpeg_error_mgr;
  5558. IntFormat: TglBitmapFormat;
  5559. pImage: pByte;
  5560. TempHeight, TempWidth: Integer;
  5561. pTemp: pByte;
  5562. Row: Integer;
  5563. FormatDesc: TFormatDescriptor;
  5564. begin
  5565. result := false;
  5566. if not init_libJPEG then
  5567. raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
  5568. try
  5569. // reading first two bytes to test file and set cursor back to begin
  5570. StreamPos := aStream.Position;
  5571. aStream.Read({%H-}Temp[0], 2);
  5572. aStream.Position := StreamPos;
  5573. // if Bitmap then read file.
  5574. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  5575. FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
  5576. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  5577. // error managment
  5578. jpeg.err := jpeg_std_error(@jpeg_err);
  5579. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  5580. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  5581. // decompression struct
  5582. jpeg_create_decompress(@jpeg);
  5583. // allocation space for streaming methods
  5584. jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
  5585. // seeting up custom functions
  5586. with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
  5587. pub.init_source := glBitmap_libJPEG_init_source;
  5588. pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
  5589. pub.skip_input_data := glBitmap_libJPEG_skip_input_data;
  5590. pub.resync_to_restart := jpeg_resync_to_restart; // use default method
  5591. pub.term_source := glBitmap_libJPEG_term_source;
  5592. pub.bytes_in_buffer := 0; // forces fill_input_buffer on first read
  5593. pub.next_input_byte := nil; // until buffer loaded
  5594. SrcStream := aStream;
  5595. end;
  5596. // set global decoding state
  5597. jpeg.global_state := DSTATE_START;
  5598. // read header of jpeg
  5599. jpeg_read_header(@jpeg, false);
  5600. // setting output parameter
  5601. case jpeg.jpeg_color_space of
  5602. JCS_GRAYSCALE:
  5603. begin
  5604. jpeg.out_color_space := JCS_GRAYSCALE;
  5605. IntFormat := tfLuminance8;
  5606. end;
  5607. else
  5608. jpeg.out_color_space := JCS_RGB;
  5609. IntFormat := tfRGB8;
  5610. end;
  5611. // reading image
  5612. jpeg_start_decompress(@jpeg);
  5613. TempHeight := jpeg.output_height;
  5614. TempWidth := jpeg.output_width;
  5615. FormatDesc := TFormatDescriptor.Get(IntFormat);
  5616. // creating new image
  5617. GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
  5618. try
  5619. pTemp := pImage;
  5620. for Row := 0 to TempHeight -1 do begin
  5621. jpeg_read_scanlines(@jpeg, @pTemp, 1);
  5622. Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
  5623. end;
  5624. // finish decompression
  5625. jpeg_finish_decompress(@jpeg);
  5626. // destroy decompression
  5627. jpeg_destroy_decompress(@jpeg);
  5628. SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  5629. result := true;
  5630. except
  5631. if Assigned(pImage) then
  5632. FreeMem(pImage);
  5633. raise;
  5634. end;
  5635. end;
  5636. finally
  5637. quit_libJPEG;
  5638. end;
  5639. end;
  5640. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  5641. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5642. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5643. var
  5644. bmp: TBitmap;
  5645. jpg: TJPEGImage;
  5646. StreamPos: Int64;
  5647. Temp: array[0..1]of Byte;
  5648. begin
  5649. result := false;
  5650. // reading first two bytes to test file and set cursor back to begin
  5651. StreamPos := aStream.Position;
  5652. aStream.Read(Temp[0], 2);
  5653. aStream.Position := StreamPos;
  5654. // if Bitmap then read file.
  5655. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  5656. bmp := TBitmap.Create;
  5657. try
  5658. jpg := TJPEGImage.Create;
  5659. try
  5660. jpg.LoadFromStream(aStream);
  5661. bmp.Assign(jpg);
  5662. result := AssignFromBitmap(bmp);
  5663. finally
  5664. jpg.Free;
  5665. end;
  5666. finally
  5667. bmp.Free;
  5668. end;
  5669. end;
  5670. end;
  5671. {$IFEND}
  5672. {$ENDIF}
  5673. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  5674. {$IF DEFINED(GLB_LAZ_JPEG)}
  5675. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5676. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  5677. var
  5678. jpeg: TJPEGImage;
  5679. intf: TLazIntfImage;
  5680. raw: TRawImage;
  5681. begin
  5682. jpeg := TJPEGImage.Create;
  5683. intf := TLazIntfImage.Create(0, 0);
  5684. try
  5685. if not AssignToLazIntfImage(intf) then
  5686. raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
  5687. intf.GetRawImage(raw);
  5688. jpeg.LoadFromRawImage(raw, false);
  5689. jpeg.SaveToStream(aStream);
  5690. finally
  5691. intf.Free;
  5692. jpeg.Free;
  5693. end;
  5694. end;
  5695. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  5696. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5697. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  5698. var
  5699. jpeg: jpeg_compress_struct;
  5700. jpeg_err: jpeg_error_mgr;
  5701. Row: Integer;
  5702. pTemp, pTemp2: pByte;
  5703. procedure CopyRow(pDest, pSource: pByte);
  5704. var
  5705. X: Integer;
  5706. begin
  5707. for X := 0 to Width - 1 do begin
  5708. pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
  5709. pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
  5710. pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
  5711. Inc(pDest, 3);
  5712. Inc(pSource, 3);
  5713. end;
  5714. end;
  5715. begin
  5716. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  5717. raise EglBitmapUnsupportedFormat.Create(Format);
  5718. if not init_libJPEG then
  5719. raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
  5720. try
  5721. FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
  5722. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  5723. // error managment
  5724. jpeg.err := jpeg_std_error(@jpeg_err);
  5725. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  5726. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  5727. // compression struct
  5728. jpeg_create_compress(@jpeg);
  5729. // allocation space for streaming methods
  5730. jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
  5731. // seeting up custom functions
  5732. with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
  5733. pub.init_destination := glBitmap_libJPEG_init_destination;
  5734. pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
  5735. pub.term_destination := glBitmap_libJPEG_term_destination;
  5736. pub.next_output_byte := @DestBuffer[1];
  5737. pub.free_in_buffer := Length(DestBuffer);
  5738. DestStream := aStream;
  5739. end;
  5740. // very important state
  5741. jpeg.global_state := CSTATE_START;
  5742. jpeg.image_width := Width;
  5743. jpeg.image_height := Height;
  5744. case Format of
  5745. tfAlpha8, tfLuminance8: begin
  5746. jpeg.input_components := 1;
  5747. jpeg.in_color_space := JCS_GRAYSCALE;
  5748. end;
  5749. tfRGB8, tfBGR8: begin
  5750. jpeg.input_components := 3;
  5751. jpeg.in_color_space := JCS_RGB;
  5752. end;
  5753. end;
  5754. jpeg_set_defaults(@jpeg);
  5755. jpeg_set_quality(@jpeg, 95, true);
  5756. jpeg_start_compress(@jpeg, true);
  5757. pTemp := Data;
  5758. if Format = tfBGR8 then
  5759. GetMem(pTemp2, fRowSize)
  5760. else
  5761. pTemp2 := pTemp;
  5762. try
  5763. for Row := 0 to jpeg.image_height -1 do begin
  5764. // prepare row
  5765. if Format = tfBGR8 then
  5766. CopyRow(pTemp2, pTemp)
  5767. else
  5768. pTemp2 := pTemp;
  5769. // write row
  5770. jpeg_write_scanlines(@jpeg, @pTemp2, 1);
  5771. inc(pTemp, fRowSize);
  5772. end;
  5773. finally
  5774. // free memory
  5775. if Format = tfBGR8 then
  5776. FreeMem(pTemp2);
  5777. end;
  5778. jpeg_finish_compress(@jpeg);
  5779. jpeg_destroy_compress(@jpeg);
  5780. finally
  5781. quit_libJPEG;
  5782. end;
  5783. end;
  5784. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  5785. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5786. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  5787. var
  5788. Bmp: TBitmap;
  5789. Jpg: TJPEGImage;
  5790. begin
  5791. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  5792. raise EglBitmapUnsupportedFormat.Create(Format);
  5793. Bmp := TBitmap.Create;
  5794. try
  5795. Jpg := TJPEGImage.Create;
  5796. try
  5797. AssignToBitmap(Bmp);
  5798. if (Format in [tfAlpha8, tfLuminance8]) then begin
  5799. Jpg.Grayscale := true;
  5800. Jpg.PixelFormat := jf8Bit;
  5801. end;
  5802. Jpg.Assign(Bmp);
  5803. Jpg.SaveToStream(aStream);
  5804. finally
  5805. FreeAndNil(Jpg);
  5806. end;
  5807. finally
  5808. FreeAndNil(Bmp);
  5809. end;
  5810. end;
  5811. {$IFEND}
  5812. {$ENDIF}
  5813. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5814. //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5815. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5816. const
  5817. BMP_MAGIC = $4D42;
  5818. BMP_COMP_RGB = 0;
  5819. BMP_COMP_RLE8 = 1;
  5820. BMP_COMP_RLE4 = 2;
  5821. BMP_COMP_BITFIELDS = 3;
  5822. type
  5823. TBMPHeader = packed record
  5824. bfType: Word;
  5825. bfSize: Cardinal;
  5826. bfReserved1: Word;
  5827. bfReserved2: Word;
  5828. bfOffBits: Cardinal;
  5829. end;
  5830. TBMPInfo = packed record
  5831. biSize: Cardinal;
  5832. biWidth: Longint;
  5833. biHeight: Longint;
  5834. biPlanes: Word;
  5835. biBitCount: Word;
  5836. biCompression: Cardinal;
  5837. biSizeImage: Cardinal;
  5838. biXPelsPerMeter: Longint;
  5839. biYPelsPerMeter: Longint;
  5840. biClrUsed: Cardinal;
  5841. biClrImportant: Cardinal;
  5842. end;
  5843. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5844. function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
  5845. //////////////////////////////////////////////////////////////////////////////////////////////////
  5846. function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapColorRec): TglBitmapFormat;
  5847. begin
  5848. result := tfEmpty;
  5849. aStream.Read(aInfo{%H-}, SizeOf(aInfo));
  5850. FillChar(aMask{%H-}, SizeOf(aMask), 0);
  5851. //Read Compression
  5852. case aInfo.biCompression of
  5853. BMP_COMP_RLE4,
  5854. BMP_COMP_RLE8: begin
  5855. raise EglBitmap.Create('RLE compression is not supported');
  5856. end;
  5857. BMP_COMP_BITFIELDS: begin
  5858. if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
  5859. aStream.Read(aMask.r, SizeOf(aMask.r));
  5860. aStream.Read(aMask.g, SizeOf(aMask.g));
  5861. aStream.Read(aMask.b, SizeOf(aMask.b));
  5862. aStream.Read(aMask.a, SizeOf(aMask.a));
  5863. end else
  5864. raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
  5865. end;
  5866. end;
  5867. //get suitable format
  5868. case aInfo.biBitCount of
  5869. 8: result := tfLuminance8;
  5870. 16: result := tfBGR5;
  5871. 24: result := tfBGR8;
  5872. 32: result := tfBGRA8;
  5873. end;
  5874. end;
  5875. function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
  5876. var
  5877. i, c: Integer;
  5878. ColorTable: TbmpColorTable;
  5879. begin
  5880. result := nil;
  5881. if (aInfo.biBitCount >= 16) then
  5882. exit;
  5883. aFormat := tfLuminance8;
  5884. c := aInfo.biClrUsed;
  5885. if (c = 0) then
  5886. c := 1 shl aInfo.biBitCount;
  5887. SetLength(ColorTable, c);
  5888. for i := 0 to c-1 do begin
  5889. aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
  5890. if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
  5891. aFormat := tfRGB8;
  5892. end;
  5893. result := TbmpColorTableFormat.Create;
  5894. result.PixelSize := aInfo.biBitCount / 8;
  5895. result.ColorTable := ColorTable;
  5896. result.Range := glBitmapColorRec($FF, $FF, $FF, $00);
  5897. end;
  5898. //////////////////////////////////////////////////////////////////////////////////////////////////
  5899. function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
  5900. const aInfo: TBMPInfo): TbmpBitfieldFormat;
  5901. var
  5902. TmpFormat: TglBitmapFormat;
  5903. FormatDesc: TFormatDescriptor;
  5904. begin
  5905. result := nil;
  5906. if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
  5907. for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  5908. FormatDesc := TFormatDescriptor.Get(TmpFormat);
  5909. if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
  5910. aFormat := FormatDesc.Format;
  5911. exit;
  5912. end;
  5913. end;
  5914. if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
  5915. aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
  5916. if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
  5917. aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
  5918. result := TbmpBitfieldFormat.Create;
  5919. result.PixelSize := aInfo.biBitCount / 8;
  5920. result.RedMask := aMask.r;
  5921. result.GreenMask := aMask.g;
  5922. result.BlueMask := aMask.b;
  5923. result.AlphaMask := aMask.a;
  5924. end;
  5925. end;
  5926. var
  5927. //simple types
  5928. StartPos: Int64;
  5929. ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
  5930. PaddingBuff: Cardinal;
  5931. LineBuf, ImageData, TmpData: PByte;
  5932. SourceMD, DestMD: Pointer;
  5933. BmpFormat: TglBitmapFormat;
  5934. //records
  5935. Mask: TglBitmapColorRec;
  5936. Header: TBMPHeader;
  5937. Info: TBMPInfo;
  5938. //classes
  5939. SpecialFormat: TFormatDescriptor;
  5940. FormatDesc: TFormatDescriptor;
  5941. //////////////////////////////////////////////////////////////////////////////////////////////////
  5942. procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
  5943. var
  5944. i: Integer;
  5945. Pixel: TglBitmapPixelData;
  5946. begin
  5947. aStream.Read(aLineBuf^, rbLineSize);
  5948. SpecialFormat.PreparePixel(Pixel);
  5949. for i := 0 to Info.biWidth-1 do begin
  5950. SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
  5951. glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
  5952. FormatDesc.Map(Pixel, aData, DestMD);
  5953. end;
  5954. end;
  5955. begin
  5956. result := false;
  5957. BmpFormat := tfEmpty;
  5958. SpecialFormat := nil;
  5959. LineBuf := nil;
  5960. SourceMD := nil;
  5961. DestMD := nil;
  5962. // Header
  5963. StartPos := aStream.Position;
  5964. aStream.Read(Header{%H-}, SizeOf(Header));
  5965. if Header.bfType = BMP_MAGIC then begin
  5966. try try
  5967. BmpFormat := ReadInfo(Info, Mask);
  5968. SpecialFormat := ReadColorTable(BmpFormat, Info);
  5969. if not Assigned(SpecialFormat) then
  5970. SpecialFormat := CheckBitfields(BmpFormat, Mask, Info);
  5971. aStream.Position := StartPos + Header.bfOffBits;
  5972. if (BmpFormat <> tfEmpty) then begin
  5973. FormatDesc := TFormatDescriptor.Get(BmpFormat);
  5974. rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
  5975. wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
  5976. Padding := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
  5977. //get Memory
  5978. DestMD := FormatDesc.CreateMappingData;
  5979. ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
  5980. GetMem(ImageData, ImageSize);
  5981. if Assigned(SpecialFormat) then begin
  5982. GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
  5983. SourceMD := SpecialFormat.CreateMappingData;
  5984. end;
  5985. //read Data
  5986. try try
  5987. FillChar(ImageData^, ImageSize, $FF);
  5988. TmpData := ImageData;
  5989. if (Info.biHeight > 0) then
  5990. Inc(TmpData, wbLineSize * (Info.biHeight-1));
  5991. for i := 0 to Abs(Info.biHeight)-1 do begin
  5992. if Assigned(SpecialFormat) then
  5993. SpecialFormatReadLine(TmpData, LineBuf) //if is special format read and convert data
  5994. else
  5995. aStream.Read(TmpData^, wbLineSize); //else only read data
  5996. if (Info.biHeight > 0) then
  5997. dec(TmpData, wbLineSize)
  5998. else
  5999. inc(TmpData, wbLineSize);
  6000. aStream.Read(PaddingBuff{%H-}, Padding);
  6001. end;
  6002. SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
  6003. result := true;
  6004. finally
  6005. if Assigned(LineBuf) then
  6006. FreeMem(LineBuf);
  6007. if Assigned(SourceMD) then
  6008. SpecialFormat.FreeMappingData(SourceMD);
  6009. FormatDesc.FreeMappingData(DestMD);
  6010. end;
  6011. except
  6012. if Assigned(ImageData) then
  6013. FreeMem(ImageData);
  6014. raise;
  6015. end;
  6016. end else
  6017. raise EglBitmap.Create('LoadBMP - No suitable format found');
  6018. except
  6019. aStream.Position := StartPos;
  6020. raise;
  6021. end;
  6022. finally
  6023. FreeAndNil(SpecialFormat);
  6024. end;
  6025. end
  6026. else aStream.Position := StartPos;
  6027. end;
  6028. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6029. procedure TglBitmap.SaveBMP(const aStream: TStream);
  6030. var
  6031. Header: TBMPHeader;
  6032. Info: TBMPInfo;
  6033. Converter: TFormatDescriptor;
  6034. FormatDesc: TFormatDescriptor;
  6035. SourceFD, DestFD: Pointer;
  6036. pData, srcData, dstData, ConvertBuffer: pByte;
  6037. Pixel: TglBitmapPixelData;
  6038. ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
  6039. RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
  6040. PaddingBuff: Cardinal;
  6041. function GetLineWidth : Integer;
  6042. begin
  6043. result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
  6044. end;
  6045. begin
  6046. if not (ftBMP in FormatGetSupportedFiles(Format)) then
  6047. raise EglBitmapUnsupportedFormat.Create(Format);
  6048. Converter := nil;
  6049. FormatDesc := TFormatDescriptor.Get(Format);
  6050. ImageSize := FormatDesc.GetSize(Dimension);
  6051. FillChar(Header{%H-}, SizeOf(Header), 0);
  6052. Header.bfType := BMP_MAGIC;
  6053. Header.bfSize := SizeOf(Header) + SizeOf(Info) + ImageSize;
  6054. Header.bfReserved1 := 0;
  6055. Header.bfReserved2 := 0;
  6056. Header.bfOffBits := SizeOf(Header) + SizeOf(Info);
  6057. FillChar(Info{%H-}, SizeOf(Info), 0);
  6058. Info.biSize := SizeOf(Info);
  6059. Info.biWidth := Width;
  6060. Info.biHeight := Height;
  6061. Info.biPlanes := 1;
  6062. Info.biCompression := BMP_COMP_RGB;
  6063. Info.biSizeImage := ImageSize;
  6064. try
  6065. case Format of
  6066. tfLuminance4: begin
  6067. Info.biBitCount := 4;
  6068. Header.bfSize := Header.bfSize + 16 * SizeOf(Cardinal);
  6069. Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
  6070. Converter := TbmpColorTableFormat.Create;
  6071. with (Converter as TbmpColorTableFormat) do begin
  6072. PixelSize := 0.5;
  6073. Format := Format;
  6074. Range := glBitmapColorRec($F, $F, $F, $0);
  6075. CreateColorTable;
  6076. end;
  6077. end;
  6078. tfR3G3B2, tfLuminance8: begin
  6079. Info.biBitCount := 8;
  6080. Header.bfSize := Header.bfSize + 256 * SizeOf(Cardinal);
  6081. Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
  6082. Converter := TbmpColorTableFormat.Create;
  6083. with (Converter as TbmpColorTableFormat) do begin
  6084. PixelSize := 1;
  6085. Format := Format;
  6086. if (Format = tfR3G3B2) then begin
  6087. Range := glBitmapColorRec($7, $7, $3, $0);
  6088. Shift := glBitmapShiftRec(0, 3, 6, 0);
  6089. end else
  6090. Range := glBitmapColorRec($FF, $FF, $FF, $0);
  6091. CreateColorTable;
  6092. end;
  6093. end;
  6094. tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
  6095. tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin
  6096. Info.biBitCount := 16;
  6097. Info.biCompression := BMP_COMP_BITFIELDS;
  6098. end;
  6099. tfBGR8, tfRGB8: begin
  6100. Info.biBitCount := 24;
  6101. if (Format = tfRGB8) then
  6102. Converter := TfdBGR8.Create; //use BGR8 Format Descriptor to Swap RGB Values
  6103. end;
  6104. tfRGB10, tfRGB10A2, tfRGBA8,
  6105. tfBGR10, tfBGR10A2, tfBGRA8: begin
  6106. Info.biBitCount := 32;
  6107. Info.biCompression := BMP_COMP_BITFIELDS;
  6108. end;
  6109. else
  6110. raise EglBitmapUnsupportedFormat.Create(Format);
  6111. end;
  6112. Info.biXPelsPerMeter := 2835;
  6113. Info.biYPelsPerMeter := 2835;
  6114. // prepare bitmasks
  6115. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  6116. Header.bfSize := Header.bfSize + 4 * SizeOf(Cardinal);
  6117. Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
  6118. RedMask := FormatDesc.RedMask;
  6119. GreenMask := FormatDesc.GreenMask;
  6120. BlueMask := FormatDesc.BlueMask;
  6121. AlphaMask := FormatDesc.AlphaMask;
  6122. end;
  6123. // headers
  6124. aStream.Write(Header, SizeOf(Header));
  6125. aStream.Write(Info, SizeOf(Info));
  6126. // colortable
  6127. if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
  6128. with (Converter as TbmpColorTableFormat) do
  6129. aStream.Write(ColorTable[0].b,
  6130. SizeOf(TbmpColorTableEnty) * Length(ColorTable));
  6131. // bitmasks
  6132. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  6133. aStream.Write(RedMask, SizeOf(Cardinal));
  6134. aStream.Write(GreenMask, SizeOf(Cardinal));
  6135. aStream.Write(BlueMask, SizeOf(Cardinal));
  6136. aStream.Write(AlphaMask, SizeOf(Cardinal));
  6137. end;
  6138. // image data
  6139. rbLineSize := Round(Info.biWidth * FormatDesc.PixelSize);
  6140. wbLineSize := Round(Info.biWidth * Info.biBitCount / 8);
  6141. Padding := GetLineWidth - wbLineSize;
  6142. PaddingBuff := 0;
  6143. pData := Data;
  6144. inc(pData, (Height-1) * rbLineSize);
  6145. // prepare row buffer. But only for RGB because RGBA supports color masks
  6146. // so it's possible to change color within the image.
  6147. if Assigned(Converter) then begin
  6148. FormatDesc.PreparePixel(Pixel);
  6149. GetMem(ConvertBuffer, wbLineSize);
  6150. SourceFD := FormatDesc.CreateMappingData;
  6151. DestFD := Converter.CreateMappingData;
  6152. end else
  6153. ConvertBuffer := nil;
  6154. try
  6155. for LineIdx := 0 to Height - 1 do begin
  6156. // preparing row
  6157. if Assigned(Converter) then begin
  6158. srcData := pData;
  6159. dstData := ConvertBuffer;
  6160. for PixelIdx := 0 to Info.biWidth-1 do begin
  6161. FormatDesc.Unmap(srcData, Pixel, SourceFD);
  6162. glBitmapConvertPixel(Pixel, FormatDesc, Converter);
  6163. Converter.Map(Pixel, dstData, DestFD);
  6164. end;
  6165. aStream.Write(ConvertBuffer^, wbLineSize);
  6166. end else begin
  6167. aStream.Write(pData^, rbLineSize);
  6168. end;
  6169. dec(pData, rbLineSize);
  6170. if (Padding > 0) then
  6171. aStream.Write(PaddingBuff, Padding);
  6172. end;
  6173. finally
  6174. // destroy row buffer
  6175. if Assigned(ConvertBuffer) then begin
  6176. FormatDesc.FreeMappingData(SourceFD);
  6177. Converter.FreeMappingData(DestFD);
  6178. FreeMem(ConvertBuffer);
  6179. end;
  6180. end;
  6181. finally
  6182. if Assigned(Converter) then
  6183. Converter.Free;
  6184. end;
  6185. end;
  6186. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6187. //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6188. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6189. type
  6190. TTGAHeader = packed record
  6191. ImageID: Byte;
  6192. ColorMapType: Byte;
  6193. ImageType: Byte;
  6194. //ColorMapSpec: Array[0..4] of Byte;
  6195. ColorMapStart: Word;
  6196. ColorMapLength: Word;
  6197. ColorMapEntrySize: Byte;
  6198. OrigX: Word;
  6199. OrigY: Word;
  6200. Width: Word;
  6201. Height: Word;
  6202. Bpp: Byte;
  6203. ImageDesc: Byte;
  6204. end;
  6205. const
  6206. TGA_UNCOMPRESSED_RGB = 2;
  6207. TGA_UNCOMPRESSED_GRAY = 3;
  6208. TGA_COMPRESSED_RGB = 10;
  6209. TGA_COMPRESSED_GRAY = 11;
  6210. TGA_NONE_COLOR_TABLE = 0;
  6211. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6212. function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
  6213. var
  6214. Header: TTGAHeader;
  6215. ImageData: System.PByte;
  6216. StartPosition: Int64;
  6217. PixelSize, LineSize: Integer;
  6218. tgaFormat: TglBitmapFormat;
  6219. FormatDesc: TFormatDescriptor;
  6220. Counter: packed record
  6221. X, Y: packed record
  6222. low, high, dir: Integer;
  6223. end;
  6224. end;
  6225. const
  6226. CACHE_SIZE = $4000;
  6227. ////////////////////////////////////////////////////////////////////////////////////////
  6228. procedure ReadUncompressed;
  6229. var
  6230. i, j: Integer;
  6231. buf, tmp1, tmp2: System.PByte;
  6232. begin
  6233. buf := nil;
  6234. if (Counter.X.dir < 0) then
  6235. GetMem(buf, LineSize);
  6236. try
  6237. while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
  6238. tmp1 := ImageData;
  6239. inc(tmp1, (Counter.Y.low * LineSize)); //pointer to LineStart
  6240. if (Counter.X.dir < 0) then begin //flip X
  6241. aStream.Read(buf^, LineSize);
  6242. tmp2 := buf;
  6243. inc(tmp2, LineSize - PixelSize); //pointer to last pixel in line
  6244. for i := 0 to Header.Width-1 do begin //for all pixels in line
  6245. for j := 0 to PixelSize-1 do begin //for all bytes in pixel
  6246. tmp1^ := tmp2^;
  6247. inc(tmp1);
  6248. inc(tmp2);
  6249. end;
  6250. dec(tmp2, 2*PixelSize); //move 2 backwards, because j-loop moved 1 forward
  6251. end;
  6252. end else
  6253. aStream.Read(tmp1^, LineSize);
  6254. inc(Counter.Y.low, Counter.Y.dir); //move to next line index
  6255. end;
  6256. finally
  6257. if Assigned(buf) then
  6258. FreeMem(buf);
  6259. end;
  6260. end;
  6261. ////////////////////////////////////////////////////////////////////////////////////////
  6262. procedure ReadCompressed;
  6263. /////////////////////////////////////////////////////////////////
  6264. var
  6265. TmpData: System.PByte;
  6266. LinePixelsRead: Integer;
  6267. procedure CheckLine;
  6268. begin
  6269. if (LinePixelsRead >= Header.Width) then begin
  6270. LinePixelsRead := 0;
  6271. inc(Counter.Y.low, Counter.Y.dir); //next line index
  6272. TmpData := ImageData;
  6273. inc(TmpData, Counter.Y.low * LineSize); //set line
  6274. if (Counter.X.dir < 0) then //if x flipped then
  6275. inc(TmpData, LineSize - PixelSize); //set last pixel
  6276. end;
  6277. end;
  6278. /////////////////////////////////////////////////////////////////
  6279. var
  6280. Cache: PByte;
  6281. CacheSize, CachePos: Integer;
  6282. procedure CachedRead(out Buffer; Count: Integer);
  6283. var
  6284. BytesRead: Integer;
  6285. begin
  6286. if (CachePos + Count > CacheSize) then begin
  6287. //if buffer overflow save non read bytes
  6288. BytesRead := 0;
  6289. if (CacheSize - CachePos > 0) then begin
  6290. BytesRead := CacheSize - CachePos;
  6291. Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
  6292. inc(CachePos, BytesRead);
  6293. end;
  6294. //load cache from file
  6295. CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
  6296. aStream.Read(Cache^, CacheSize);
  6297. CachePos := 0;
  6298. //read rest of requested bytes
  6299. if (Count - BytesRead > 0) then begin
  6300. Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
  6301. inc(CachePos, Count - BytesRead);
  6302. end;
  6303. end else begin
  6304. //if no buffer overflow just read the data
  6305. Move(PByteArray(Cache)^[CachePos], Buffer, Count);
  6306. inc(CachePos, Count);
  6307. end;
  6308. end;
  6309. procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
  6310. begin
  6311. case PixelSize of
  6312. 1: begin
  6313. aBuffer^ := aData^;
  6314. inc(aBuffer, Counter.X.dir);
  6315. end;
  6316. 2: begin
  6317. PWord(aBuffer)^ := PWord(aData)^;
  6318. inc(aBuffer, 2 * Counter.X.dir);
  6319. end;
  6320. 3: begin
  6321. PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
  6322. PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
  6323. PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
  6324. inc(aBuffer, 3 * Counter.X.dir);
  6325. end;
  6326. 4: begin
  6327. PCardinal(aBuffer)^ := PCardinal(aData)^;
  6328. inc(aBuffer, 4 * Counter.X.dir);
  6329. end;
  6330. end;
  6331. end;
  6332. var
  6333. TotalPixelsToRead, TotalPixelsRead: Integer;
  6334. Temp: Byte;
  6335. buf: array [0..3] of Byte; //1 pixel is max 32bit long
  6336. PixelRepeat: Boolean;
  6337. PixelsToRead, PixelCount: Integer;
  6338. begin
  6339. CacheSize := 0;
  6340. CachePos := 0;
  6341. TotalPixelsToRead := Header.Width * Header.Height;
  6342. TotalPixelsRead := 0;
  6343. LinePixelsRead := 0;
  6344. GetMem(Cache, CACHE_SIZE);
  6345. try
  6346. TmpData := ImageData;
  6347. inc(TmpData, Counter.Y.low * LineSize); //set line
  6348. if (Counter.X.dir < 0) then //if x flipped then
  6349. inc(TmpData, LineSize - PixelSize); //set last pixel
  6350. repeat
  6351. //read CommandByte
  6352. CachedRead(Temp, 1);
  6353. PixelRepeat := (Temp and $80) > 0;
  6354. PixelsToRead := (Temp and $7F) + 1;
  6355. inc(TotalPixelsRead, PixelsToRead);
  6356. if PixelRepeat then
  6357. CachedRead(buf[0], PixelSize);
  6358. while (PixelsToRead > 0) do begin
  6359. CheckLine;
  6360. PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
  6361. while (PixelCount > 0) do begin
  6362. if not PixelRepeat then
  6363. CachedRead(buf[0], PixelSize);
  6364. PixelToBuffer(@buf[0], TmpData);
  6365. inc(LinePixelsRead);
  6366. dec(PixelsToRead);
  6367. dec(PixelCount);
  6368. end;
  6369. end;
  6370. until (TotalPixelsRead >= TotalPixelsToRead);
  6371. finally
  6372. FreeMem(Cache);
  6373. end;
  6374. end;
  6375. function IsGrayFormat: Boolean;
  6376. begin
  6377. result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
  6378. end;
  6379. begin
  6380. result := false;
  6381. // reading header to test file and set cursor back to begin
  6382. StartPosition := aStream.Position;
  6383. aStream.Read(Header{%H-}, SizeOf(Header));
  6384. // no colormapped files
  6385. if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
  6386. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
  6387. begin
  6388. try
  6389. if Header.ImageID <> 0 then // skip image ID
  6390. aStream.Position := aStream.Position + Header.ImageID;
  6391. tgaFormat := tfEmpty;
  6392. case Header.Bpp of
  6393. 8: if IsGrayFormat then case (Header.ImageDesc and $F) of
  6394. 0: tgaFormat := tfLuminance8;
  6395. 8: tgaFormat := tfAlpha8;
  6396. end;
  6397. 16: if IsGrayFormat then case (Header.ImageDesc and $F) of
  6398. 0: tgaFormat := tfLuminance16;
  6399. 8: tgaFormat := tfLuminance8Alpha8;
  6400. end else case (Header.ImageDesc and $F) of
  6401. 0: tgaFormat := tfBGR5;
  6402. 1: tgaFormat := tfBGR5A1;
  6403. 4: tgaFormat := tfBGRA4;
  6404. end;
  6405. 24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  6406. 0: tgaFormat := tfBGR8;
  6407. end;
  6408. 32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  6409. 2: tgaFormat := tfBGR10A2;
  6410. 8: tgaFormat := tfBGRA8;
  6411. end;
  6412. end;
  6413. if (tgaFormat = tfEmpty) then
  6414. raise EglBitmap.Create('LoadTga - unsupported format');
  6415. FormatDesc := TFormatDescriptor.Get(tgaFormat);
  6416. PixelSize := FormatDesc.GetSize(1, 1);
  6417. LineSize := FormatDesc.GetSize(Header.Width, 1);
  6418. GetMem(ImageData, LineSize * Header.Height);
  6419. try
  6420. //column direction
  6421. if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
  6422. Counter.X.low := Header.Height-1;;
  6423. Counter.X.high := 0;
  6424. Counter.X.dir := -1;
  6425. end else begin
  6426. Counter.X.low := 0;
  6427. Counter.X.high := Header.Height-1;
  6428. Counter.X.dir := 1;
  6429. end;
  6430. // Row direction
  6431. if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
  6432. Counter.Y.low := 0;
  6433. Counter.Y.high := Header.Height-1;
  6434. Counter.Y.dir := 1;
  6435. end else begin
  6436. Counter.Y.low := Header.Height-1;;
  6437. Counter.Y.high := 0;
  6438. Counter.Y.dir := -1;
  6439. end;
  6440. // Read Image
  6441. case Header.ImageType of
  6442. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
  6443. ReadUncompressed;
  6444. TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
  6445. ReadCompressed;
  6446. end;
  6447. SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
  6448. result := true;
  6449. except
  6450. if Assigned(ImageData) then
  6451. FreeMem(ImageData);
  6452. raise;
  6453. end;
  6454. finally
  6455. aStream.Position := StartPosition;
  6456. end;
  6457. end
  6458. else aStream.Position := StartPosition;
  6459. end;
  6460. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6461. procedure TglBitmap.SaveTGA(const aStream: TStream);
  6462. var
  6463. Header: TTGAHeader;
  6464. LineSize, Size, x, y: Integer;
  6465. Pixel: TglBitmapPixelData;
  6466. LineBuf, SourceData, DestData: PByte;
  6467. SourceMD, DestMD: Pointer;
  6468. FormatDesc: TFormatDescriptor;
  6469. Converter: TFormatDescriptor;
  6470. begin
  6471. if not (ftTGA in FormatGetSupportedFiles(Format)) then
  6472. raise EglBitmapUnsupportedFormat.Create(Format);
  6473. //prepare header
  6474. FillChar(Header{%H-}, SizeOf(Header), 0);
  6475. //set ImageType
  6476. if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
  6477. tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
  6478. Header.ImageType := TGA_UNCOMPRESSED_GRAY
  6479. else
  6480. Header.ImageType := TGA_UNCOMPRESSED_RGB;
  6481. //set BitsPerPixel
  6482. if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
  6483. Header.Bpp := 8
  6484. else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
  6485. tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
  6486. Header.Bpp := 16
  6487. else if (Format in [tfBGR8, tfRGB8]) then
  6488. Header.Bpp := 24
  6489. else
  6490. Header.Bpp := 32;
  6491. //set AlphaBitCount
  6492. case Format of
  6493. tfRGB5A1, tfBGR5A1:
  6494. Header.ImageDesc := 1 and $F;
  6495. tfRGB10A2, tfBGR10A2:
  6496. Header.ImageDesc := 2 and $F;
  6497. tfRGBA4, tfBGRA4:
  6498. Header.ImageDesc := 4 and $F;
  6499. tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
  6500. Header.ImageDesc := 8 and $F;
  6501. end;
  6502. Header.Width := Width;
  6503. Header.Height := Height;
  6504. Header.ImageDesc := Header.ImageDesc or $20; //flip y
  6505. aStream.Write(Header, SizeOf(Header));
  6506. // convert RGB(A) to BGR(A)
  6507. Converter := nil;
  6508. FormatDesc := TFormatDescriptor.Get(Format);
  6509. Size := FormatDesc.GetSize(Dimension);
  6510. if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
  6511. if (FormatDesc.RGBInverted = tfEmpty) then
  6512. raise EglBitmap.Create('inverted RGB format is empty');
  6513. Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
  6514. if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
  6515. (Converter.PixelSize <> FormatDesc.PixelSize) then
  6516. raise EglBitmap.Create('invalid inverted RGB format');
  6517. end;
  6518. if Assigned(Converter) then begin
  6519. LineSize := FormatDesc.GetSize(Width, 1);
  6520. GetMem(LineBuf, LineSize);
  6521. SourceMD := FormatDesc.CreateMappingData;
  6522. DestMD := Converter.CreateMappingData;
  6523. try
  6524. SourceData := Data;
  6525. for y := 0 to Height-1 do begin
  6526. DestData := LineBuf;
  6527. for x := 0 to Width-1 do begin
  6528. FormatDesc.Unmap(SourceData, Pixel, SourceMD);
  6529. Converter.Map(Pixel, DestData, DestMD);
  6530. end;
  6531. aStream.Write(LineBuf^, LineSize);
  6532. end;
  6533. finally
  6534. FreeMem(LineBuf);
  6535. FormatDesc.FreeMappingData(SourceMD);
  6536. FormatDesc.FreeMappingData(DestMD);
  6537. end;
  6538. end else
  6539. aStream.Write(Data^, Size);
  6540. end;
  6541. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6542. //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6543. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6544. const
  6545. DDS_MAGIC: Cardinal = $20534444;
  6546. // DDS_header.dwFlags
  6547. DDSD_CAPS = $00000001;
  6548. DDSD_HEIGHT = $00000002;
  6549. DDSD_WIDTH = $00000004;
  6550. DDSD_PIXELFORMAT = $00001000;
  6551. // DDS_header.sPixelFormat.dwFlags
  6552. DDPF_ALPHAPIXELS = $00000001;
  6553. DDPF_ALPHA = $00000002;
  6554. DDPF_FOURCC = $00000004;
  6555. DDPF_RGB = $00000040;
  6556. DDPF_LUMINANCE = $00020000;
  6557. // DDS_header.sCaps.dwCaps1
  6558. DDSCAPS_TEXTURE = $00001000;
  6559. // DDS_header.sCaps.dwCaps2
  6560. DDSCAPS2_CUBEMAP = $00000200;
  6561. D3DFMT_DXT1 = $31545844;
  6562. D3DFMT_DXT3 = $33545844;
  6563. D3DFMT_DXT5 = $35545844;
  6564. type
  6565. TDDSPixelFormat = packed record
  6566. dwSize: Cardinal;
  6567. dwFlags: Cardinal;
  6568. dwFourCC: Cardinal;
  6569. dwRGBBitCount: Cardinal;
  6570. dwRBitMask: Cardinal;
  6571. dwGBitMask: Cardinal;
  6572. dwBBitMask: Cardinal;
  6573. dwABitMask: Cardinal;
  6574. end;
  6575. TDDSCaps = packed record
  6576. dwCaps1: Cardinal;
  6577. dwCaps2: Cardinal;
  6578. dwDDSX: Cardinal;
  6579. dwReserved: Cardinal;
  6580. end;
  6581. TDDSHeader = packed record
  6582. dwSize: Cardinal;
  6583. dwFlags: Cardinal;
  6584. dwHeight: Cardinal;
  6585. dwWidth: Cardinal;
  6586. dwPitchOrLinearSize: Cardinal;
  6587. dwDepth: Cardinal;
  6588. dwMipMapCount: Cardinal;
  6589. dwReserved: array[0..10] of Cardinal;
  6590. PixelFormat: TDDSPixelFormat;
  6591. Caps: TDDSCaps;
  6592. dwReserved2: Cardinal;
  6593. end;
  6594. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6595. function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
  6596. var
  6597. Header: TDDSHeader;
  6598. Converter: TbmpBitfieldFormat;
  6599. function GetDDSFormat: TglBitmapFormat;
  6600. var
  6601. fd: TFormatDescriptor;
  6602. i: Integer;
  6603. Range: TglBitmapColorRec;
  6604. match: Boolean;
  6605. begin
  6606. result := tfEmpty;
  6607. with Header.PixelFormat do begin
  6608. // Compresses
  6609. if ((dwFlags and DDPF_FOURCC) > 0) then begin
  6610. case Header.PixelFormat.dwFourCC of
  6611. D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
  6612. D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
  6613. D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
  6614. end;
  6615. end else if ((Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin
  6616. //find matching format
  6617. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  6618. fd := TFormatDescriptor.Get(result);
  6619. if fd.MaskMatch(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask) and
  6620. (8 * fd.PixelSize = dwRGBBitCount) then
  6621. exit;
  6622. end;
  6623. //find format with same Range
  6624. Range.r := dwRBitMask;
  6625. Range.g := dwGBitMask;
  6626. Range.b := dwBBitMask;
  6627. Range.a := dwABitMask;
  6628. for i := 0 to 3 do begin
  6629. while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do
  6630. Range.arr[i] := Range.arr[i] shr 1;
  6631. end;
  6632. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  6633. fd := TFormatDescriptor.Get(result);
  6634. match := true;
  6635. for i := 0 to 3 do
  6636. if (fd.Range.arr[i] <> Range.arr[i]) then begin
  6637. match := false;
  6638. break;
  6639. end;
  6640. if match then
  6641. break;
  6642. end;
  6643. //no format with same range found -> use default
  6644. if (result = tfEmpty) then begin
  6645. if (dwABitMask > 0) then
  6646. result := tfBGRA8
  6647. else
  6648. result := tfBGR8;
  6649. end;
  6650. Converter := TbmpBitfieldFormat.Create;
  6651. Converter.RedMask := dwRBitMask;
  6652. Converter.GreenMask := dwGBitMask;
  6653. Converter.BlueMask := dwBBitMask;
  6654. Converter.AlphaMask := dwABitMask;
  6655. Converter.PixelSize := dwRGBBitCount / 8;
  6656. end;
  6657. end;
  6658. end;
  6659. var
  6660. StreamPos: Int64;
  6661. x, y, LineSize, RowSize, Magic: Cardinal;
  6662. NewImage, TmpData, RowData, SrcData: System.PByte;
  6663. SourceMD, DestMD: Pointer;
  6664. Pixel: TglBitmapPixelData;
  6665. ddsFormat: TglBitmapFormat;
  6666. FormatDesc: TFormatDescriptor;
  6667. begin
  6668. result := false;
  6669. Converter := nil;
  6670. StreamPos := aStream.Position;
  6671. // Magic
  6672. aStream.Read(Magic{%H-}, sizeof(Magic));
  6673. if (Magic <> DDS_MAGIC) then begin
  6674. aStream.Position := StreamPos;
  6675. exit;
  6676. end;
  6677. //Header
  6678. aStream.Read(Header{%H-}, sizeof(Header));
  6679. if (Header.dwSize <> SizeOf(Header)) or
  6680. ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
  6681. (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
  6682. begin
  6683. aStream.Position := StreamPos;
  6684. exit;
  6685. end;
  6686. if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
  6687. raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
  6688. ddsFormat := GetDDSFormat;
  6689. try
  6690. if (ddsFormat = tfEmpty) then
  6691. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  6692. FormatDesc := TFormatDescriptor.Get(ddsFormat);
  6693. LineSize := Trunc(Header.dwWidth * FormatDesc.PixelSize);
  6694. GetMem(NewImage, Header.dwHeight * LineSize);
  6695. try
  6696. TmpData := NewImage;
  6697. //Converter needed
  6698. if Assigned(Converter) then begin
  6699. RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
  6700. GetMem(RowData, RowSize);
  6701. SourceMD := Converter.CreateMappingData;
  6702. DestMD := FormatDesc.CreateMappingData;
  6703. try
  6704. for y := 0 to Header.dwHeight-1 do begin
  6705. TmpData := NewImage;
  6706. inc(TmpData, y * LineSize);
  6707. SrcData := RowData;
  6708. aStream.Read(SrcData^, RowSize);
  6709. for x := 0 to Header.dwWidth-1 do begin
  6710. Converter.Unmap(SrcData, Pixel, SourceMD);
  6711. glBitmapConvertPixel(Pixel, Converter, FormatDesc);
  6712. FormatDesc.Map(Pixel, TmpData, DestMD);
  6713. end;
  6714. end;
  6715. finally
  6716. Converter.FreeMappingData(SourceMD);
  6717. FormatDesc.FreeMappingData(DestMD);
  6718. FreeMem(RowData);
  6719. end;
  6720. end else
  6721. // Compressed
  6722. if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
  6723. RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
  6724. for Y := 0 to Header.dwHeight-1 do begin
  6725. aStream.Read(TmpData^, RowSize);
  6726. Inc(TmpData, LineSize);
  6727. end;
  6728. end else
  6729. // Uncompressed
  6730. if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
  6731. RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
  6732. for Y := 0 to Header.dwHeight-1 do begin
  6733. aStream.Read(TmpData^, RowSize);
  6734. Inc(TmpData, LineSize);
  6735. end;
  6736. end else
  6737. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  6738. SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
  6739. result := true;
  6740. except
  6741. if Assigned(NewImage) then
  6742. FreeMem(NewImage);
  6743. raise;
  6744. end;
  6745. finally
  6746. FreeAndNil(Converter);
  6747. end;
  6748. end;
  6749. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6750. procedure TglBitmap.SaveDDS(const aStream: TStream);
  6751. var
  6752. Header: TDDSHeader;
  6753. FormatDesc: TFormatDescriptor;
  6754. begin
  6755. if not (ftDDS in FormatGetSupportedFiles(Format)) then
  6756. raise EglBitmapUnsupportedFormat.Create(Format);
  6757. FormatDesc := TFormatDescriptor.Get(Format);
  6758. // Generell
  6759. FillChar(Header{%H-}, SizeOf(Header), 0);
  6760. Header.dwSize := SizeOf(Header);
  6761. Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
  6762. Header.dwWidth := Max(1, Width);
  6763. Header.dwHeight := Max(1, Height);
  6764. // Caps
  6765. Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
  6766. // Pixelformat
  6767. Header.PixelFormat.dwSize := sizeof(Header);
  6768. if (FormatDesc.IsCompressed) then begin
  6769. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
  6770. case Format of
  6771. tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
  6772. tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
  6773. tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
  6774. end;
  6775. end else if (Format in [tfAlpha8, tfAlpha16]) then begin
  6776. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHA;
  6777. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6778. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6779. end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
  6780. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
  6781. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6782. Header.PixelFormat.dwRBitMask := FormatDesc.RedMask;
  6783. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6784. end else begin
  6785. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
  6786. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6787. Header.PixelFormat.dwRBitMask := FormatDesc.RedMask;
  6788. Header.PixelFormat.dwGBitMask := FormatDesc.GreenMask;
  6789. Header.PixelFormat.dwBBitMask := FormatDesc.BlueMask;
  6790. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6791. end;
  6792. if (FormatDesc.HasAlpha) then
  6793. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
  6794. aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
  6795. aStream.Write(Header, SizeOf(Header));
  6796. aStream.Write(Data^, FormatDesc.GetSize(Dimension));
  6797. end;
  6798. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6799. //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6800. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6801. procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  6802. const aWidth: Integer; const aHeight: Integer);
  6803. var
  6804. pTemp: pByte;
  6805. Size: Integer;
  6806. begin
  6807. if (aHeight > 1) then begin
  6808. Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
  6809. GetMem(pTemp, Size);
  6810. try
  6811. Move(aData^, pTemp^, Size);
  6812. FreeMem(aData);
  6813. aData := nil;
  6814. except
  6815. FreeMem(pTemp);
  6816. raise;
  6817. end;
  6818. end else
  6819. pTemp := aData;
  6820. inherited SetDataPointer(pTemp, aFormat, aWidth);
  6821. end;
  6822. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6823. function TglBitmap1D.FlipHorz: Boolean;
  6824. var
  6825. Col: Integer;
  6826. pTempDest, pDest, pSource: PByte;
  6827. begin
  6828. result := inherited FlipHorz;
  6829. if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
  6830. pSource := Data;
  6831. GetMem(pDest, fRowSize);
  6832. try
  6833. pTempDest := pDest;
  6834. Inc(pTempDest, fRowSize);
  6835. for Col := 0 to Width-1 do begin
  6836. dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
  6837. Move(pSource^, pTempDest^, fPixelSize);
  6838. Inc(pSource, fPixelSize);
  6839. end;
  6840. SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
  6841. result := true;
  6842. except
  6843. if Assigned(pDest) then
  6844. FreeMem(pDest);
  6845. raise;
  6846. end;
  6847. end;
  6848. end;
  6849. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6850. procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
  6851. var
  6852. FormatDesc: TFormatDescriptor;
  6853. begin
  6854. // Upload data
  6855. FormatDesc := TFormatDescriptor.Get(Format);
  6856. if FormatDesc.IsCompressed then begin
  6857. if not Assigned(glCompressedTexImage1D) then
  6858. raise EglBitmap.Create('compressed formats not supported by video adapter');
  6859. glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
  6860. end else if aBuildWithGlu then
  6861. gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  6862. else
  6863. glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  6864. // Free Data
  6865. if (FreeDataAfterGenTexture) then
  6866. FreeData;
  6867. end;
  6868. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6869. procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
  6870. var
  6871. BuildWithGlu, TexRec: Boolean;
  6872. TexSize: Integer;
  6873. begin
  6874. if Assigned(Data) then begin
  6875. // Check Texture Size
  6876. if (aTestTextureSize) then begin
  6877. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  6878. if (Width > TexSize) then
  6879. raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  6880. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
  6881. (Target = GL_TEXTURE_RECTANGLE);
  6882. if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  6883. raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  6884. end;
  6885. CreateId;
  6886. SetupParameters(BuildWithGlu);
  6887. UploadData(BuildWithGlu);
  6888. glAreTexturesResident(1, @fID, @fIsResident);
  6889. end;
  6890. end;
  6891. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6892. procedure TglBitmap1D.AfterConstruction;
  6893. begin
  6894. inherited;
  6895. Target := GL_TEXTURE_1D;
  6896. end;
  6897. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6898. //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6899. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6900. function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
  6901. begin
  6902. if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
  6903. result := fLines[aIndex]
  6904. else
  6905. result := nil;
  6906. end;
  6907. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6908. procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  6909. const aWidth: Integer; const aHeight: Integer);
  6910. var
  6911. Idx, LineWidth: Integer;
  6912. begin
  6913. inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
  6914. if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
  6915. // Assigning Data
  6916. if Assigned(Data) then begin
  6917. SetLength(fLines, GetHeight);
  6918. LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
  6919. for Idx := 0 to GetHeight-1 do begin
  6920. fLines[Idx] := Data;
  6921. Inc(fLines[Idx], Idx * LineWidth);
  6922. end;
  6923. end
  6924. else SetLength(fLines, 0);
  6925. end else begin
  6926. SetLength(fLines, 0);
  6927. end;
  6928. end;
  6929. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6930. procedure TglBitmap2D.UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
  6931. var
  6932. FormatDesc: TFormatDescriptor;
  6933. begin
  6934. glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
  6935. FormatDesc := TFormatDescriptor.Get(Format);
  6936. if FormatDesc.IsCompressed then begin
  6937. if not Assigned(glCompressedTexImage2D) then
  6938. raise EglBitmap.Create('compressed formats not supported by video adapter');
  6939. glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
  6940. end else if aBuildWithGlu then begin
  6941. gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
  6942. FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  6943. end else begin
  6944. glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
  6945. FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  6946. end;
  6947. // Freigeben
  6948. if (FreeDataAfterGenTexture) then
  6949. FreeData;
  6950. end;
  6951. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6952. procedure TglBitmap2D.AfterConstruction;
  6953. begin
  6954. inherited;
  6955. Target := GL_TEXTURE_2D;
  6956. end;
  6957. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6958. procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  6959. var
  6960. Temp: pByte;
  6961. Size, w, h: Integer;
  6962. FormatDesc: TFormatDescriptor;
  6963. begin
  6964. FormatDesc := TFormatDescriptor.Get(aFormat);
  6965. if FormatDesc.IsCompressed then
  6966. raise EglBitmapUnsupportedFormat.Create(aFormat);
  6967. w := aRight - aLeft;
  6968. h := aBottom - aTop;
  6969. Size := FormatDesc.GetSize(w, h);
  6970. GetMem(Temp, Size);
  6971. try
  6972. glPixelStorei(GL_PACK_ALIGNMENT, 1);
  6973. glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  6974. SetDataPointer(Temp, aFormat, w, h); //be careful, Data could be freed by this method
  6975. FlipVert;
  6976. except
  6977. if Assigned(Temp) then
  6978. FreeMem(Temp);
  6979. raise;
  6980. end;
  6981. end;
  6982. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6983. procedure TglBitmap2D.GetDataFromTexture;
  6984. var
  6985. Temp: PByte;
  6986. TempWidth, TempHeight: Integer;
  6987. TempIntFormat: Cardinal;
  6988. IntFormat, f: TglBitmapFormat;
  6989. FormatDesc: TFormatDescriptor;
  6990. begin
  6991. Bind;
  6992. // Request Data
  6993. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH, @TempWidth);
  6994. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT, @TempHeight);
  6995. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
  6996. IntFormat := tfEmpty;
  6997. for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
  6998. FormatDesc := TFormatDescriptor.Get(f);
  6999. if (FormatDesc.glInternalFormat = TempIntFormat) then begin
  7000. IntFormat := FormatDesc.Format;
  7001. break;
  7002. end;
  7003. end;
  7004. // Getting data from OpenGL
  7005. FormatDesc := TFormatDescriptor.Get(IntFormat);
  7006. GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
  7007. try
  7008. if FormatDesc.IsCompressed then begin
  7009. if not Assigned(glGetCompressedTexImage) then
  7010. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7011. glGetCompressedTexImage(Target, 0, Temp)
  7012. end else
  7013. glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  7014. SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  7015. except
  7016. if Assigned(Temp) then
  7017. FreeMem(Temp);
  7018. raise;
  7019. end;
  7020. end;
  7021. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7022. procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
  7023. var
  7024. BuildWithGlu, PotTex, TexRec: Boolean;
  7025. TexSize: Integer;
  7026. begin
  7027. if Assigned(Data) then begin
  7028. // Check Texture Size
  7029. if (aTestTextureSize) then begin
  7030. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  7031. if ((Height > TexSize) or (Width > TexSize)) then
  7032. raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  7033. PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
  7034. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
  7035. if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  7036. raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7037. end;
  7038. CreateId;
  7039. SetupParameters(BuildWithGlu);
  7040. UploadData(Target, BuildWithGlu);
  7041. glAreTexturesResident(1, @fID, @fIsResident);
  7042. end;
  7043. end;
  7044. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7045. function TglBitmap2D.FlipHorz: Boolean;
  7046. var
  7047. Col, Row: Integer;
  7048. TempDestData, DestData, SourceData: PByte;
  7049. ImgSize: Integer;
  7050. begin
  7051. result := inherited FlipHorz;
  7052. if Assigned(Data) then begin
  7053. SourceData := Data;
  7054. ImgSize := Height * fRowSize;
  7055. GetMem(DestData, ImgSize);
  7056. try
  7057. TempDestData := DestData;
  7058. Dec(TempDestData, fRowSize + fPixelSize);
  7059. for Row := 0 to Height -1 do begin
  7060. Inc(TempDestData, fRowSize * 2);
  7061. for Col := 0 to Width -1 do begin
  7062. Move(SourceData^, TempDestData^, fPixelSize);
  7063. Inc(SourceData, fPixelSize);
  7064. Dec(TempDestData, fPixelSize);
  7065. end;
  7066. end;
  7067. SetDataPointer(DestData, Format); //be careful, Data could be freed by this method
  7068. result := true;
  7069. except
  7070. if Assigned(DestData) then
  7071. FreeMem(DestData);
  7072. raise;
  7073. end;
  7074. end;
  7075. end;
  7076. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7077. function TglBitmap2D.FlipVert: Boolean;
  7078. var
  7079. Row: Integer;
  7080. TempDestData, DestData, SourceData: PByte;
  7081. begin
  7082. result := inherited FlipVert;
  7083. if Assigned(Data) then begin
  7084. SourceData := Data;
  7085. GetMem(DestData, Height * fRowSize);
  7086. try
  7087. TempDestData := DestData;
  7088. Inc(TempDestData, Width * (Height -1) * fPixelSize);
  7089. for Row := 0 to Height -1 do begin
  7090. Move(SourceData^, TempDestData^, fRowSize);
  7091. Dec(TempDestData, fRowSize);
  7092. Inc(SourceData, fRowSize);
  7093. end;
  7094. SetDataPointer(DestData, Format); //be careful, Data could be freed by this method
  7095. result := true;
  7096. except
  7097. if Assigned(DestData) then
  7098. FreeMem(DestData);
  7099. raise;
  7100. end;
  7101. end;
  7102. end;
  7103. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7104. //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7105. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7106. type
  7107. TMatrixItem = record
  7108. X, Y: Integer;
  7109. W: Single;
  7110. end;
  7111. PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
  7112. TglBitmapToNormalMapRec = Record
  7113. Scale: Single;
  7114. Heights: array of Single;
  7115. MatrixU : array of TMatrixItem;
  7116. MatrixV : array of TMatrixItem;
  7117. end;
  7118. const
  7119. ONE_OVER_255 = 1 / 255;
  7120. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7121. procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
  7122. var
  7123. Val: Single;
  7124. begin
  7125. with FuncRec do begin
  7126. Val :=
  7127. Source.Data.r * LUMINANCE_WEIGHT_R +
  7128. Source.Data.g * LUMINANCE_WEIGHT_G +
  7129. Source.Data.b * LUMINANCE_WEIGHT_B;
  7130. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
  7131. end;
  7132. end;
  7133. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7134. procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  7135. begin
  7136. with FuncRec do
  7137. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
  7138. end;
  7139. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7140. procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
  7141. type
  7142. TVec = Array[0..2] of Single;
  7143. var
  7144. Idx: Integer;
  7145. du, dv: Double;
  7146. Len: Single;
  7147. Vec: TVec;
  7148. function GetHeight(X, Y: Integer): Single;
  7149. begin
  7150. with FuncRec do begin
  7151. X := Max(0, Min(Size.X -1, X));
  7152. Y := Max(0, Min(Size.Y -1, Y));
  7153. result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
  7154. end;
  7155. end;
  7156. begin
  7157. with FuncRec do begin
  7158. with PglBitmapToNormalMapRec(Args)^ do begin
  7159. du := 0;
  7160. for Idx := Low(MatrixU) to High(MatrixU) do
  7161. du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
  7162. dv := 0;
  7163. for Idx := Low(MatrixU) to High(MatrixU) do
  7164. dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
  7165. Vec[0] := -du * Scale;
  7166. Vec[1] := -dv * Scale;
  7167. Vec[2] := 1;
  7168. end;
  7169. // Normalize
  7170. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  7171. if Len <> 0 then begin
  7172. Vec[0] := Vec[0] * Len;
  7173. Vec[1] := Vec[1] * Len;
  7174. Vec[2] := Vec[2] * Len;
  7175. end;
  7176. // Farbe zuweisem
  7177. Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
  7178. Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
  7179. Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
  7180. end;
  7181. end;
  7182. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7183. procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
  7184. var
  7185. Rec: TglBitmapToNormalMapRec;
  7186. procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
  7187. begin
  7188. if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
  7189. Matrix[Index].X := X;
  7190. Matrix[Index].Y := Y;
  7191. Matrix[Index].W := W;
  7192. end;
  7193. end;
  7194. begin
  7195. if TFormatDescriptor.Get(Format).IsCompressed then
  7196. raise EglBitmapUnsupportedFormat.Create(Format);
  7197. if aScale > 100 then
  7198. Rec.Scale := 100
  7199. else if aScale < -100 then
  7200. Rec.Scale := -100
  7201. else
  7202. Rec.Scale := aScale;
  7203. SetLength(Rec.Heights, Width * Height);
  7204. try
  7205. case aFunc of
  7206. nm4Samples: begin
  7207. SetLength(Rec.MatrixU, 2);
  7208. SetEntry(Rec.MatrixU, 0, -1, 0, -0.5);
  7209. SetEntry(Rec.MatrixU, 1, 1, 0, 0.5);
  7210. SetLength(Rec.MatrixV, 2);
  7211. SetEntry(Rec.MatrixV, 0, 0, 1, 0.5);
  7212. SetEntry(Rec.MatrixV, 1, 0, -1, -0.5);
  7213. end;
  7214. nmSobel: begin
  7215. SetLength(Rec.MatrixU, 6);
  7216. SetEntry(Rec.MatrixU, 0, -1, 1, -1.0);
  7217. SetEntry(Rec.MatrixU, 1, -1, 0, -2.0);
  7218. SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
  7219. SetEntry(Rec.MatrixU, 3, 1, 1, 1.0);
  7220. SetEntry(Rec.MatrixU, 4, 1, 0, 2.0);
  7221. SetEntry(Rec.MatrixU, 5, 1, -1, 1.0);
  7222. SetLength(Rec.MatrixV, 6);
  7223. SetEntry(Rec.MatrixV, 0, -1, 1, 1.0);
  7224. SetEntry(Rec.MatrixV, 1, 0, 1, 2.0);
  7225. SetEntry(Rec.MatrixV, 2, 1, 1, 1.0);
  7226. SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
  7227. SetEntry(Rec.MatrixV, 4, 0, -1, -2.0);
  7228. SetEntry(Rec.MatrixV, 5, 1, -1, -1.0);
  7229. end;
  7230. nm3x3: begin
  7231. SetLength(Rec.MatrixU, 6);
  7232. SetEntry(Rec.MatrixU, 0, -1, 1, -1/6);
  7233. SetEntry(Rec.MatrixU, 1, -1, 0, -1/6);
  7234. SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
  7235. SetEntry(Rec.MatrixU, 3, 1, 1, 1/6);
  7236. SetEntry(Rec.MatrixU, 4, 1, 0, 1/6);
  7237. SetEntry(Rec.MatrixU, 5, 1, -1, 1/6);
  7238. SetLength(Rec.MatrixV, 6);
  7239. SetEntry(Rec.MatrixV, 0, -1, 1, 1/6);
  7240. SetEntry(Rec.MatrixV, 1, 0, 1, 1/6);
  7241. SetEntry(Rec.MatrixV, 2, 1, 1, 1/6);
  7242. SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
  7243. SetEntry(Rec.MatrixV, 4, 0, -1, -1/6);
  7244. SetEntry(Rec.MatrixV, 5, 1, -1, -1/6);
  7245. end;
  7246. nm5x5: begin
  7247. SetLength(Rec.MatrixU, 20);
  7248. SetEntry(Rec.MatrixU, 0, -2, 2, -1 / 16);
  7249. SetEntry(Rec.MatrixU, 1, -1, 2, -1 / 10);
  7250. SetEntry(Rec.MatrixU, 2, 1, 2, 1 / 10);
  7251. SetEntry(Rec.MatrixU, 3, 2, 2, 1 / 16);
  7252. SetEntry(Rec.MatrixU, 4, -2, 1, -1 / 10);
  7253. SetEntry(Rec.MatrixU, 5, -1, 1, -1 / 8);
  7254. SetEntry(Rec.MatrixU, 6, 1, 1, 1 / 8);
  7255. SetEntry(Rec.MatrixU, 7, 2, 1, 1 / 10);
  7256. SetEntry(Rec.MatrixU, 8, -2, 0, -1 / 2.8);
  7257. SetEntry(Rec.MatrixU, 9, -1, 0, -0.5);
  7258. SetEntry(Rec.MatrixU, 10, 1, 0, 0.5);
  7259. SetEntry(Rec.MatrixU, 11, 2, 0, 1 / 2.8);
  7260. SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
  7261. SetEntry(Rec.MatrixU, 13, -1, -1, -1 / 8);
  7262. SetEntry(Rec.MatrixU, 14, 1, -1, 1 / 8);
  7263. SetEntry(Rec.MatrixU, 15, 2, -1, 1 / 10);
  7264. SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
  7265. SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
  7266. SetEntry(Rec.MatrixU, 18, 1, -2, 1 / 10);
  7267. SetEntry(Rec.MatrixU, 19, 2, -2, 1 / 16);
  7268. SetLength(Rec.MatrixV, 20);
  7269. SetEntry(Rec.MatrixV, 0, -2, 2, 1 / 16);
  7270. SetEntry(Rec.MatrixV, 1, -1, 2, 1 / 10);
  7271. SetEntry(Rec.MatrixV, 2, 0, 2, 0.25);
  7272. SetEntry(Rec.MatrixV, 3, 1, 2, 1 / 10);
  7273. SetEntry(Rec.MatrixV, 4, 2, 2, 1 / 16);
  7274. SetEntry(Rec.MatrixV, 5, -2, 1, 1 / 10);
  7275. SetEntry(Rec.MatrixV, 6, -1, 1, 1 / 8);
  7276. SetEntry(Rec.MatrixV, 7, 0, 1, 0.5);
  7277. SetEntry(Rec.MatrixV, 8, 1, 1, 1 / 8);
  7278. SetEntry(Rec.MatrixV, 9, 2, 1, 1 / 16);
  7279. SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
  7280. SetEntry(Rec.MatrixV, 11, -1, -1, -1 / 8);
  7281. SetEntry(Rec.MatrixV, 12, 0, -1, -0.5);
  7282. SetEntry(Rec.MatrixV, 13, 1, -1, -1 / 8);
  7283. SetEntry(Rec.MatrixV, 14, 2, -1, -1 / 10);
  7284. SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
  7285. SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
  7286. SetEntry(Rec.MatrixV, 17, 0, -2, -0.25);
  7287. SetEntry(Rec.MatrixV, 18, 1, -2, -1 / 10);
  7288. SetEntry(Rec.MatrixV, 19, 2, -2, -1 / 16);
  7289. end;
  7290. end;
  7291. // Daten Sammeln
  7292. if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
  7293. AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
  7294. else
  7295. AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
  7296. AddFunc(glBitmapToNormalMapFunc, false, @Rec);
  7297. finally
  7298. SetLength(Rec.Heights, 0);
  7299. end;
  7300. end;
  7301. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7302. //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7303. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7304. procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);
  7305. begin
  7306. Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
  7307. end;
  7308. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7309. procedure TglBitmapCubeMap.AfterConstruction;
  7310. begin
  7311. inherited;
  7312. if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
  7313. raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
  7314. SetWrap;
  7315. Target := GL_TEXTURE_CUBE_MAP;
  7316. fGenMode := GL_REFLECTION_MAP;
  7317. end;
  7318. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7319. procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);
  7320. var
  7321. BuildWithGlu: Boolean;
  7322. TexSize: Integer;
  7323. begin
  7324. if (aTestTextureSize) then begin
  7325. glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
  7326. if (Height > TexSize) or (Width > TexSize) then
  7327. raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
  7328. if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
  7329. raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
  7330. end;
  7331. if (ID = 0) then
  7332. CreateID;
  7333. SetupParameters(BuildWithGlu);
  7334. UploadData(aCubeTarget, BuildWithGlu);
  7335. end;
  7336. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7337. procedure TglBitmapCubeMap.Bind(const aEnableTexCoordsGen: Boolean; const aEnableTextureUnit: Boolean);
  7338. begin
  7339. inherited Bind (aEnableTextureUnit);
  7340. if aEnableTexCoordsGen then begin
  7341. glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
  7342. glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
  7343. glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
  7344. glEnable(GL_TEXTURE_GEN_S);
  7345. glEnable(GL_TEXTURE_GEN_T);
  7346. glEnable(GL_TEXTURE_GEN_R);
  7347. end;
  7348. end;
  7349. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7350. procedure TglBitmapCubeMap.Unbind(const aDisableTexCoordsGen: Boolean; const aDisableTextureUnit: Boolean);
  7351. begin
  7352. inherited Unbind(aDisableTextureUnit);
  7353. if aDisableTexCoordsGen then begin
  7354. glDisable(GL_TEXTURE_GEN_S);
  7355. glDisable(GL_TEXTURE_GEN_T);
  7356. glDisable(GL_TEXTURE_GEN_R);
  7357. end;
  7358. end;
  7359. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7360. //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7361. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7362. type
  7363. TVec = Array[0..2] of Single;
  7364. TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7365. PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
  7366. TglBitmapNormalMapRec = record
  7367. HalfSize : Integer;
  7368. Func: TglBitmapNormalMapGetVectorFunc;
  7369. end;
  7370. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7371. procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7372. begin
  7373. aVec[0] := aHalfSize;
  7374. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7375. aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
  7376. end;
  7377. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7378. procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7379. begin
  7380. aVec[0] := - aHalfSize;
  7381. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7382. aVec[2] := aPosition.X + 0.5 - aHalfSize;
  7383. end;
  7384. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7385. procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7386. begin
  7387. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7388. aVec[1] := aHalfSize;
  7389. aVec[2] := aPosition.Y + 0.5 - aHalfSize;
  7390. end;
  7391. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7392. procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7393. begin
  7394. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7395. aVec[1] := - aHalfSize;
  7396. aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
  7397. end;
  7398. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7399. procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7400. begin
  7401. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7402. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7403. aVec[2] := aHalfSize;
  7404. end;
  7405. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7406. procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7407. begin
  7408. aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
  7409. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7410. aVec[2] := - aHalfSize;
  7411. end;
  7412. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7413. procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
  7414. var
  7415. i: Integer;
  7416. Vec: TVec;
  7417. Len: Single;
  7418. begin
  7419. with FuncRec do begin
  7420. with PglBitmapNormalMapRec(Args)^ do begin
  7421. Func(Vec, Position, HalfSize);
  7422. // Normalize
  7423. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  7424. if Len <> 0 then begin
  7425. Vec[0] := Vec[0] * Len;
  7426. Vec[1] := Vec[1] * Len;
  7427. Vec[2] := Vec[2] * Len;
  7428. end;
  7429. // Scale Vector and AddVectro
  7430. Vec[0] := Vec[0] * 0.5 + 0.5;
  7431. Vec[1] := Vec[1] * 0.5 + 0.5;
  7432. Vec[2] := Vec[2] * 0.5 + 0.5;
  7433. end;
  7434. // Set Color
  7435. for i := 0 to 2 do
  7436. Dest.Data.arr[i] := Round(Vec[i] * 255);
  7437. end;
  7438. end;
  7439. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7440. procedure TglBitmapNormalMap.AfterConstruction;
  7441. begin
  7442. inherited;
  7443. fGenMode := GL_NORMAL_MAP;
  7444. end;
  7445. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7446. procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);
  7447. var
  7448. Rec: TglBitmapNormalMapRec;
  7449. SizeRec: TglBitmapPixelPosition;
  7450. begin
  7451. Rec.HalfSize := aSize div 2;
  7452. FreeDataAfterGenTexture := false;
  7453. SizeRec.Fields := [ffX, ffY];
  7454. SizeRec.X := aSize;
  7455. SizeRec.Y := aSize;
  7456. // Positive X
  7457. Rec.Func := glBitmapNormalMapPosX;
  7458. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7459. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);
  7460. // Negative X
  7461. Rec.Func := glBitmapNormalMapNegX;
  7462. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7463. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);
  7464. // Positive Y
  7465. Rec.Func := glBitmapNormalMapPosY;
  7466. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7467. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);
  7468. // Negative Y
  7469. Rec.Func := glBitmapNormalMapNegY;
  7470. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7471. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);
  7472. // Positive Z
  7473. Rec.Func := glBitmapNormalMapPosZ;
  7474. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7475. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);
  7476. // Negative Z
  7477. Rec.Func := glBitmapNormalMapNegZ;
  7478. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7479. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);
  7480. end;
  7481. initialization
  7482. glBitmapSetDefaultFormat (tfEmpty);
  7483. glBitmapSetDefaultMipmap (mmMipmap);
  7484. glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
  7485. glBitmapSetDefaultWrap (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
  7486. glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
  7487. glBitmapSetDefaultFreeDataAfterGenTexture(true);
  7488. glBitmapSetDefaultDeleteTextureOnFree (true);
  7489. TFormatDescriptor.Init;
  7490. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  7491. OpenGLInitialized := false;
  7492. InitOpenGLCS := TCriticalSection.Create;
  7493. {$ENDIF}
  7494. finalization
  7495. TFormatDescriptor.Finalize;
  7496. {$IFDEF GLB_NATIVE_OGL}
  7497. if Assigned(GL_LibHandle) then
  7498. glbFreeLibrary(GL_LibHandle);
  7499. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  7500. if Assigned(GLU_LibHandle) then
  7501. glbFreeLibrary(GLU_LibHandle);
  7502. FreeAndNil(InitOpenGLCS);
  7503. {$ENDIF}
  7504. {$ENDIF}
  7505. end.