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.

8650 lines
298 KiB

  1. {***********************************************************
  2. glBitmap by Steffen Xonna aka Lossy eX (2003-2008)
  3. http://www.opengl24.de/index.php?cat=header&file=glbitmap
  4. modified by Delphi OpenGL Community (http://delphigl.com/) (2013)
  5. ------------------------------------------------------------
  6. The contents of this file are used with permission, subject to
  7. the Mozilla Public License Version 1.1 (the "License"); you may
  8. not use this file except in compliance with the License. You may
  9. obtain a copy of the License at
  10. http://www.mozilla.org/MPL/MPL-1.1.html
  11. ------------------------------------------------------------
  12. Version 3.0.0 unstable
  13. ------------------------------------------------------------
  14. History
  15. 20-11-2013
  16. - refactoring of the complete library
  17. 21-03-2010
  18. - The define GLB_DELPHI dosn't check versions anymore. If you say you are using delphi
  19. then it's your problem if that isn't true. This prevents the unit for incompatibility
  20. with newer versions of Delphi.
  21. - Problems with D2009+ resolved (Thanks noeska and all i forgot)
  22. - GetPixel isn't set if you are loading textures inside the constructor (Thanks Wilson)
  23. 10-08-2008
  24. - AddAlphaFromglBitmap used the custom pointer instead the imagedatapointer (Thanks Wilson)
  25. - Additional Datapointer for functioninterface now has the name CustomData
  26. 24-07-2008
  27. - AssigneAlphaToBitmap overwrites his own palette (Thanks Wilson)
  28. - If you load an texture from an file the property Filename will be set to the name of the file
  29. - Three new properties to attach custom data to the Texture objects
  30. - CustomName (free for use string)
  31. - CustomNameW (free for use widestring)
  32. - CustomDataPointer (free for use pointer to attach other objects or complex structures)
  33. 27-05-2008
  34. - RLE TGAs loaded much faster
  35. 26-05-2008
  36. - fixed some problem with reading RLE TGAs.
  37. 21-05-2008
  38. - function clone now only copys data if it's assigned and now it also copies the ID
  39. - it seems that lazarus dont like comments in comments.
  40. 01-05-2008
  41. - It's possible to set the id of the texture
  42. - define GLB_NO_NATIVE_GL deactivated by default
  43. 27-04-2008
  44. - Now supports the following libraries
  45. - SDL and SDL_image
  46. - libPNG
  47. - libJPEG
  48. - Linux compatibillity via free pascal compatibility (delphi sources optional)
  49. - BMPs now loaded manuel
  50. - Large restructuring
  51. - Property DataPtr now has the name Data
  52. - Functions are more flexible between RGB(A) and BGR(A). RGB can be saved as Bitmap and will be saved as BGR
  53. - Unused Depth removed
  54. - Function FreeData to freeing image data added
  55. 24-10-2007
  56. - ImageID flag of TGAs was ignored. (Thanks Zwoetzen)
  57. 15-11-2006
  58. - Function SetBorderColor implemented (only used by opengl if wrap is set to GL_CLAMP_TO_BORDER)
  59. - Function AddAlphaFromValue implemented to use an fixed Value as Alphachannel
  60. - Function ReadOpenGLExtension is now only intern
  61. 29-06-2006
  62. - pngimage now disabled by default like all other versions.
  63. 26-06-2006
  64. - Setting up an anisotropic filter of 0 isnt allowed by nvidia (Thanks Ogridi)
  65. 22-06-2006
  66. - Fixed some Problem with Delphi 5
  67. - Now uses the newest version of pngimage. Makes saving pngs much easier.
  68. 22-03-2006
  69. - Property IsCompressed and Size removed. Not really supported by Spec (Thanks Ogridi)
  70. 09-03-2006
  71. - Internal Format ifDepth8 added
  72. - function GrabScreen now supports all uncompressed formats
  73. 31-01-2006
  74. - AddAlphaFromglBitmap implemented
  75. 29-12-2005
  76. - LoadFromResource and LoadFromResourceId now needs an Instance and an ResourceType (for ID)
  77. 28-12-2005
  78. - Width, Height and Depth internal changed to TglBitmapPixelPosition.
  79. property Width, Height, Depth are still existing and new property Dimension are avail
  80. 11-12-2005
  81. - Added native OpenGL Support. Breaking the dglOpenGL "barrier".
  82. 19-10-2005
  83. - Added function GrabScreen to class TglBitmap2D
  84. 18-10-2005
  85. - Added support to Save images
  86. - Added function Clone to Clone Instance
  87. 11-10-2005
  88. - Functions now works with Cardinals for each channel. Up to 32 Bits per channel.
  89. Usefull for Future
  90. - Several speed optimizations
  91. 09-10-2005
  92. - Internal structure change. Loading of TGA, PNG and DDS improved.
  93. Data, format and size will now set directly with SetDataPtr.
  94. - AddFunc now works with all Types of Images and Formats
  95. - Some Funtions moved to Baseclass TglBitmap
  96. 06-10-2005
  97. - Added Support to decompress DXT3 and DXT5 compressed Images.
  98. - Added Mapping to convert data from one format into an other.
  99. 05-10-2005
  100. - Added method ConvertTo in Class TglBitmap2D. Method allows to convert every
  101. supported Input format (supported by GetPixel) into any uncompresed Format
  102. - Added Support to decompress DXT1 compressed Images.
  103. - SwapColors replaced by ConvertTo
  104. 04-10-2005
  105. - Added Support for compressed DDSs
  106. - Added new internal formats (DXT1, DXT3, DXT5)
  107. 29-09-2005
  108. - Parameter Components renamed to InternalFormat
  109. 23-09-2005
  110. - Some AllocMem replaced with GetMem (little speed change)
  111. - better exception handling. Better protection from memory leaks.
  112. 22-09-2005
  113. - Added support for Direct Draw Surfaces (.DDS) (uncompressed images only)
  114. - Added new internal formats (RGB8, RGBA8, RGBA4, RGB5A1, RGB10A2, R5G6B5)
  115. 07-09-2005
  116. - Added support for Grayscale textures
  117. - Added internal formats (Alpha, Luminance, LuminanceAlpha, BGR8, BGRA8)
  118. 10-07-2005
  119. - Added support for GL_VERSION_2_0
  120. - Added support for GL_EXT_texture_filter_anisotropic
  121. 04-07-2005
  122. - Function FillWithColor fills the Image with one Color
  123. - Function LoadNormalMap added
  124. 30-06-2005
  125. - ToNormalMap allows to Create an NormalMap from the Alphachannel
  126. - ToNormalMap now supports Sobel (nmSobel) function.
  127. 29-06-2005
  128. - support for RLE Compressed RGB TGAs added
  129. 28-06-2005
  130. - Class TglBitmapNormalMap added to support Normalmap generation
  131. - Added function ToNormalMap in class TglBitmap2D to genereate normal maps from textures.
  132. 3 Filters are supported. (4 Samples, 3x3 and 5x5)
  133. 16-06-2005
  134. - Method LoadCubeMapClass removed
  135. - LoadCubeMap returnvalue is now the Texture paramter. Such as LoadTextures
  136. - virtual abstract method GenTexture in class TglBitmap now is protected
  137. 12-06-2005
  138. - now support DescriptionFlag in LoadTga. Allows vertical flipped images to be loaded as normal
  139. 10-06-2005
  140. - little enhancement for IsPowerOfTwo
  141. - TglBitmap1D.GenTexture now tests NPOT Textures
  142. 06-06-2005
  143. - some little name changes. All properties or function with Texture in name are
  144. now without texture in name. We have allways texture so we dosn't name it.
  145. 03-06-2005
  146. - GenTexture now tests if texture is NPOT and NPOT-Texture are supported or
  147. TextureTarget is GL_TEXTURE_RECTANGLE. Else it raised an exception.
  148. 02-06-2005
  149. - added support for GL_ARB_texture_rectangle, GL_EXT_texture_rectangle and GL_NV_texture_rectangle
  150. 25-04-2005
  151. - Function Unbind added
  152. - call of SetFilter or SetTextureWrap if TextureID exists results in setting properties to opengl texture.
  153. 21-04-2005
  154. - class TglBitmapCubeMap added (allows to Create Cubemaps)
  155. 29-03-2005
  156. - Added Support for PNG Images. (http://pngdelphi.sourceforge.net/)
  157. To Enable png's use the define pngimage
  158. 22-03-2005
  159. - New Functioninterface added
  160. - Function GetPixel added
  161. 27-11-2004
  162. - Property BuildMipMaps renamed to MipMap
  163. 21-11-2004
  164. - property Name removed.
  165. - BuildMipMaps is now a set of 3 values. None, GluBuildMipmaps and SGIS_generate_mipmap
  166. 22-05-2004
  167. - property name added. Only used in glForms!
  168. 26-11-2003
  169. - property FreeDataAfterGenTexture is now available as default (default = true)
  170. - BuildMipmaps now implemented in TglBitmap1D (i've forgotten it)
  171. - function MoveMemory replaced with function Move (little speed change)
  172. - several calculations stored in variables (little speed change)
  173. 29-09-2003
  174. - property BuildMipsMaps added (default = true)
  175. if BuildMipMaps isn't set GenTextures uses glTexImage[12]D else it use gluBuild[12]dMipmaps
  176. - property FreeDataAfterGenTexture added (default = true)
  177. if FreeDataAfterGenTexture is set the texturedata were deleted after the texture was generated.
  178. - parameter DisableOtherTextureUnits of Bind removed
  179. - parameter FreeDataAfterGeneration of GenTextures removed
  180. 12-09-2003
  181. - TglBitmap dosn't delete data if class was destroyed (fixed)
  182. 09-09-2003
  183. - Bind now enables TextureUnits (by params)
  184. - GenTextures can leave data (by param)
  185. - LoadTextures now optimal
  186. 03-09-2003
  187. - Performance optimization in AddFunc
  188. - procedure Bind moved to subclasses
  189. - Added new Class TglBitmap1D to support real OpenGL 1D Textures
  190. 19-08-2003
  191. - Texturefilter and texturewrap now also as defaults
  192. Minfilter = GL_LINEAR_MIPMAP_LINEAR
  193. Magfilter = GL_LINEAR
  194. Wrap(str) = GL_CLAMP_TO_EDGE
  195. - Added new format tfCompressed to create a compressed texture.
  196. - propertys IsCompressed, TextureSize and IsResident added
  197. IsCompressed and TextureSize only contains data from level 0
  198. 18-08-2003
  199. - Added function AddFunc to add PerPixelEffects to Image
  200. - LoadFromFunc now based on AddFunc
  201. - Invert now based on AddFunc
  202. - SwapColors now based on AddFunc
  203. 16-08-2003
  204. - Added function FlipHorz
  205. 15-08-2003
  206. - Added function LaodFromFunc to create images with function
  207. - Added function FlipVert
  208. - Added internal format RGB(A) if GL_EXT_bgra or OpenGL 1.2 isn't supported
  209. 29-07-2003
  210. - Added Alphafunctions to calculate alpha per function
  211. - Added Alpha from ColorKey using alphafunctions
  212. 28-07-2003
  213. - First full functionally Version of glBitmap
  214. - Support for 24Bit and 32Bit TGA Pictures added
  215. 25-07-2003
  216. - begin of programming
  217. ***********************************************************}
  218. unit glBitmap;
  219. // Please uncomment the defines below to configure the glBitmap to your preferences.
  220. // If you have configured the unit you can uncomment the warning above.
  221. {.$MESSAGE warn 'Hey. I''m the glBitmap.pas and i need to be configured. My master tell me your preferences! ;)'}
  222. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  223. // Preferences ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  224. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  225. // activate to enable build-in OpenGL support with statically linked methods
  226. // use dglOpenGL.pas if not enabled
  227. {.$DEFINE GLB_NATIVE_OGL_STATIC}
  228. // activate to enable build-in OpenGL support with dynamically linked methods
  229. // use dglOpenGL.pas if not enabled
  230. {.$DEFINE GLB_NATIVE_OGL_DYNAMIC}
  231. // activate to enable the support for SDL_surfaces
  232. {.$DEFINE GLB_SDL}
  233. // activate to enable the support for TBitmap from Delphi (not lazarus)
  234. {.$DEFINE GLB_DELPHI}
  235. // activate to enable the support for TLazIntfImage from Lazarus
  236. {.$DEFINE GLB_LAZARUS}
  237. // activate to enable the support of SDL_image to load files. (READ ONLY)
  238. // If you enable SDL_image all other libraries will be ignored!
  239. {.$DEFINE GLB_SDL_IMAGE}
  240. // activate to enable Lazarus TPortableNetworkGraphic support
  241. // if you enable this pngImage and libPNG will be ignored
  242. {.$DEFINE GLB_LAZ_PNG}
  243. // activate to enable png support with the unit pngimage -> http://pngdelphi.sourceforge.net/
  244. // if you enable pngimage the libPNG will be ignored
  245. {.$DEFINE GLB_PNGIMAGE}
  246. // activate to use the libPNG -> http://www.libpng.org/
  247. // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libpng
  248. {.$DEFINE GLB_LIB_PNG}
  249. // activate to enable Lazarus TJPEGImage support
  250. // if you enable this delphi jpegs and libJPEG will be ignored
  251. {.$DEFINE GLB_LAZ_JPEG}
  252. // if you enable delphi jpegs the libJPEG will be ignored
  253. {.$DEFINE GLB_DELPHI_JPEG}
  254. // activate to use the libJPEG -> http://www.ijg.org/
  255. // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libjpeg
  256. {.$DEFINE GLB_LIB_JPEG}
  257. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  258. // PRIVATE: do not change anything! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  259. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  260. // Delphi Versions
  261. {$IFDEF fpc}
  262. {$MODE Delphi}
  263. {$IFDEF CPUI386}
  264. {$DEFINE CPU386}
  265. {$ASMMODE INTEL}
  266. {$ENDIF}
  267. {$IFNDEF WINDOWS}
  268. {$linklib c}
  269. {$ENDIF}
  270. {$ENDIF}
  271. // Operation System
  272. {$IF DEFINED(WIN32) or DEFINED(WIN64) or DEFINED(WINDOWS)}
  273. {$DEFINE GLB_WIN}
  274. {$ELSEIF DEFINED(LINUX)}
  275. {$DEFINE GLB_LINUX}
  276. {$IFEND}
  277. // native OpenGL Support
  278. {$IF DEFINED(GLB_NATIVE_OGL_STATIC) OR DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
  279. {$DEFINE GLB_NATIVE_OGL}
  280. {$IFEND}
  281. // checking define combinations
  282. //SDL Image
  283. {$IFDEF GLB_SDL_IMAGE}
  284. {$IFNDEF GLB_SDL}
  285. {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
  286. {$DEFINE GLB_SDL}
  287. {$ENDIF}
  288. {$IFDEF GLB_LAZ_PNG}
  289. {$MESSAGE warn 'The Lazarus TPortableNetworkGraphics will be ignored because you are using SDL_image.'}
  290. {$undef GLB_LAZ_PNG}
  291. {$ENDIF}
  292. {$IFDEF GLB_PNGIMAGE}
  293. {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
  294. {$undef GLB_PNGIMAGE}
  295. {$ENDIF}
  296. {$IFDEF GLB_LAZ_JPEG}
  297. {$MESSAGE warn 'The Lazarus TJPEGImage will be ignored because you are using SDL_image.'}
  298. {$undef GLB_LAZ_JPEG}
  299. {$ENDIF}
  300. {$IFDEF GLB_DELPHI_JPEG}
  301. {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
  302. {$undef GLB_DELPHI_JPEG}
  303. {$ENDIF}
  304. {$IFDEF GLB_LIB_PNG}
  305. {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
  306. {$undef GLB_LIB_PNG}
  307. {$ENDIF}
  308. {$IFDEF GLB_LIB_JPEG}
  309. {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
  310. {$undef GLB_LIB_JPEG}
  311. {$ENDIF}
  312. {$DEFINE GLB_SUPPORT_PNG_READ}
  313. {$DEFINE GLB_SUPPORT_JPEG_READ}
  314. {$ENDIF}
  315. // Lazarus TPortableNetworkGraphic
  316. {$IFDEF GLB_LAZ_PNG}
  317. {$IFNDEF GLB_LAZARUS}
  318. {$MESSAGE warn 'Lazarus TPortableNetworkGraphic won''t work without Lazarus. Lazarus will be activated.'}
  319. {$DEFINE GLB_LAZARUS}
  320. {$ENDIF}
  321. {$IFDEF GLB_PNGIMAGE}
  322. {$MESSAGE warn 'The pngimage will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
  323. {$undef GLB_PNGIMAGE}
  324. {$ENDIF}
  325. {$IFDEF GLB_LIB_PNG}
  326. {$MESSAGE warn 'The library libPNG will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
  327. {$undef GLB_LIB_PNG}
  328. {$ENDIF}
  329. {$DEFINE GLB_SUPPORT_PNG_READ}
  330. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  331. {$ENDIF}
  332. // PNG Image
  333. {$IFDEF GLB_PNGIMAGE}
  334. {$IFDEF GLB_LIB_PNG}
  335. {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
  336. {$undef GLB_LIB_PNG}
  337. {$ENDIF}
  338. {$DEFINE GLB_SUPPORT_PNG_READ}
  339. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  340. {$ENDIF}
  341. // libPNG
  342. {$IFDEF GLB_LIB_PNG}
  343. {$DEFINE GLB_SUPPORT_PNG_READ}
  344. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  345. {$ENDIF}
  346. // Lazarus TJPEGImage
  347. {$IFDEF GLB_LAZ_JPEG}
  348. {$IFNDEF GLB_LAZARUS}
  349. {$MESSAGE warn 'Lazarus TJPEGImage won''t work without Lazarus. Lazarus will be activated.'}
  350. {$DEFINE GLB_LAZARUS}
  351. {$ENDIF}
  352. {$IFDEF GLB_DELPHI_JPEG}
  353. {$MESSAGE warn 'The Delphi JPEGImage will be ignored if you are using the Lazarus TJPEGImage.'}
  354. {$undef GLB_DELPHI_JPEG}
  355. {$ENDIF}
  356. {$IFDEF GLB_LIB_JPEG}
  357. {$MESSAGE warn 'The library libJPEG will be ignored if you are using the Lazarus TJPEGImage.'}
  358. {$undef GLB_LIB_JPEG}
  359. {$ENDIF}
  360. {$DEFINE GLB_SUPPORT_JPEG_READ}
  361. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  362. {$ENDIF}
  363. // JPEG Image
  364. {$IFDEF GLB_DELPHI_JPEG}
  365. {$IFDEF GLB_LIB_JPEG}
  366. {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
  367. {$undef GLB_LIB_JPEG}
  368. {$ENDIF}
  369. {$DEFINE GLB_SUPPORT_JPEG_READ}
  370. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  371. {$ENDIF}
  372. // libJPEG
  373. {$IFDEF GLB_LIB_JPEG}
  374. {$DEFINE GLB_SUPPORT_JPEG_READ}
  375. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  376. {$ENDIF}
  377. // native OpenGL
  378. {$IF DEFINED(GLB_NATIVE_OGL_STATIC) AND DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
  379. {$MESSAGE warn 'GLB_NATIVE_OGL_STATIC will be ignored because you enabled GLB_NATIVE_OGL_DYNAMIC'}
  380. {$IFEND}
  381. // general options
  382. {$EXTENDEDSYNTAX ON}
  383. {$LONGSTRINGS ON}
  384. {$ALIGN ON}
  385. {$IFNDEF FPC}
  386. {$OPTIMIZATION ON}
  387. {$ENDIF}
  388. interface
  389. uses
  390. {$IFNDEF GLB_NATIVE_OGL} dglOpenGL, {$ENDIF}
  391. {$IF DEFINED(GLB_WIN) AND
  392. (DEFINED(GLB_NATIVE_OGL) OR
  393. DEFINED(GLB_DELPHI))} windows, {$IFEND}
  394. {$IFDEF GLB_SDL} SDL, {$ENDIF}
  395. {$IFDEF GLB_LAZARUS} IntfGraphics, GraphType, Graphics, {$ENDIF}
  396. {$IFDEF GLB_DELPHI} Dialogs, Graphics, Types, {$ENDIF}
  397. {$IFDEF GLB_SDL_IMAGE} SDL_image, {$ENDIF}
  398. {$IFDEF GLB_PNGIMAGE} pngimage, {$ENDIF}
  399. {$IFDEF GLB_LIB_PNG} libPNG, {$ENDIF}
  400. {$IFDEF GLB_DELPHI_JPEG} JPEG, {$ENDIF}
  401. {$IFDEF GLB_LIB_JPEG} libJPEG, {$ENDIF}
  402. Classes, SysUtils;
  403. {$IFDEF GLB_NATIVE_OGL}
  404. const
  405. GL_TRUE = 1;
  406. GL_FALSE = 0;
  407. GL_ZERO = 0;
  408. GL_ONE = 1;
  409. GL_VERSION = $1F02;
  410. GL_EXTENSIONS = $1F03;
  411. GL_TEXTURE_1D = $0DE0;
  412. GL_TEXTURE_2D = $0DE1;
  413. GL_TEXTURE_RECTANGLE = $84F5;
  414. GL_NORMAL_MAP = $8511;
  415. GL_TEXTURE_CUBE_MAP = $8513;
  416. GL_REFLECTION_MAP = $8512;
  417. GL_TEXTURE_CUBE_MAP_POSITIVE_X = $8515;
  418. GL_TEXTURE_CUBE_MAP_NEGATIVE_X = $8516;
  419. GL_TEXTURE_CUBE_MAP_POSITIVE_Y = $8517;
  420. GL_TEXTURE_CUBE_MAP_NEGATIVE_Y = $8518;
  421. GL_TEXTURE_CUBE_MAP_POSITIVE_Z = $8519;
  422. GL_TEXTURE_CUBE_MAP_NEGATIVE_Z = $851A;
  423. GL_TEXTURE_WIDTH = $1000;
  424. GL_TEXTURE_HEIGHT = $1001;
  425. GL_TEXTURE_INTERNAL_FORMAT = $1003;
  426. GL_TEXTURE_SWIZZLE_RGBA = $8E46;
  427. GL_S = $2000;
  428. GL_T = $2001;
  429. GL_R = $2002;
  430. GL_Q = $2003;
  431. GL_TEXTURE_GEN_S = $0C60;
  432. GL_TEXTURE_GEN_T = $0C61;
  433. GL_TEXTURE_GEN_R = $0C62;
  434. GL_TEXTURE_GEN_Q = $0C63;
  435. GL_RED = $1903;
  436. GL_GREEN = $1904;
  437. GL_BLUE = $1905;
  438. GL_ALPHA = $1906;
  439. GL_ALPHA4 = $803B;
  440. GL_ALPHA8 = $803C;
  441. GL_ALPHA12 = $803D;
  442. GL_ALPHA16 = $803E;
  443. GL_LUMINANCE = $1909;
  444. GL_LUMINANCE4 = $803F;
  445. GL_LUMINANCE8 = $8040;
  446. GL_LUMINANCE12 = $8041;
  447. GL_LUMINANCE16 = $8042;
  448. GL_LUMINANCE_ALPHA = $190A;
  449. GL_LUMINANCE4_ALPHA4 = $8043;
  450. GL_LUMINANCE6_ALPHA2 = $8044;
  451. GL_LUMINANCE8_ALPHA8 = $8045;
  452. GL_LUMINANCE12_ALPHA4 = $8046;
  453. GL_LUMINANCE12_ALPHA12 = $8047;
  454. GL_LUMINANCE16_ALPHA16 = $8048;
  455. GL_RGB = $1907;
  456. GL_BGR = $80E0;
  457. GL_R3_G3_B2 = $2A10;
  458. GL_RGB4 = $804F;
  459. GL_RGB5 = $8050;
  460. GL_RGB565 = $8D62;
  461. GL_RGB8 = $8051;
  462. GL_RGB10 = $8052;
  463. GL_RGB12 = $8053;
  464. GL_RGB16 = $8054;
  465. GL_RGBA = $1908;
  466. GL_BGRA = $80E1;
  467. GL_RGBA2 = $8055;
  468. GL_RGBA4 = $8056;
  469. GL_RGB5_A1 = $8057;
  470. GL_RGBA8 = $8058;
  471. GL_RGB10_A2 = $8059;
  472. GL_RGBA12 = $805A;
  473. GL_RGBA16 = $805B;
  474. GL_DEPTH_COMPONENT = $1902;
  475. GL_DEPTH_COMPONENT16 = $81A5;
  476. GL_DEPTH_COMPONENT24 = $81A6;
  477. GL_DEPTH_COMPONENT32 = $81A7;
  478. GL_COMPRESSED_RGB = $84ED;
  479. GL_COMPRESSED_RGBA = $84EE;
  480. GL_COMPRESSED_RGB_S3TC_DXT1_EXT = $83F0;
  481. GL_COMPRESSED_RGBA_S3TC_DXT1_EXT = $83F1;
  482. GL_COMPRESSED_RGBA_S3TC_DXT3_EXT = $83F2;
  483. GL_COMPRESSED_RGBA_S3TC_DXT5_EXT = $83F3;
  484. GL_UNSIGNED_BYTE = $1401;
  485. GL_UNSIGNED_BYTE_3_3_2 = $8032;
  486. GL_UNSIGNED_BYTE_2_3_3_REV = $8362;
  487. GL_UNSIGNED_SHORT = $1403;
  488. GL_UNSIGNED_SHORT_5_6_5 = $8363;
  489. GL_UNSIGNED_SHORT_4_4_4_4 = $8033;
  490. GL_UNSIGNED_SHORT_5_5_5_1 = $8034;
  491. GL_UNSIGNED_SHORT_5_6_5_REV = $8364;
  492. GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;
  493. GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;
  494. GL_UNSIGNED_INT = $1405;
  495. GL_UNSIGNED_INT_8_8_8_8 = $8035;
  496. GL_UNSIGNED_INT_10_10_10_2 = $8036;
  497. GL_UNSIGNED_INT_8_8_8_8_REV = $8367;
  498. GL_UNSIGNED_INT_2_10_10_10_REV = $8368;
  499. { Texture Filter }
  500. GL_TEXTURE_MAG_FILTER = $2800;
  501. GL_TEXTURE_MIN_FILTER = $2801;
  502. GL_NEAREST = $2600;
  503. GL_NEAREST_MIPMAP_NEAREST = $2700;
  504. GL_NEAREST_MIPMAP_LINEAR = $2702;
  505. GL_LINEAR = $2601;
  506. GL_LINEAR_MIPMAP_NEAREST = $2701;
  507. GL_LINEAR_MIPMAP_LINEAR = $2703;
  508. { Texture Wrap }
  509. GL_TEXTURE_WRAP_S = $2802;
  510. GL_TEXTURE_WRAP_T = $2803;
  511. GL_TEXTURE_WRAP_R = $8072;
  512. GL_CLAMP = $2900;
  513. GL_REPEAT = $2901;
  514. GL_CLAMP_TO_EDGE = $812F;
  515. GL_CLAMP_TO_BORDER = $812D;
  516. GL_MIRRORED_REPEAT = $8370;
  517. { Other }
  518. GL_GENERATE_MIPMAP = $8191;
  519. GL_TEXTURE_BORDER_COLOR = $1004;
  520. GL_MAX_TEXTURE_SIZE = $0D33;
  521. GL_PACK_ALIGNMENT = $0D05;
  522. GL_UNPACK_ALIGNMENT = $0CF5;
  523. GL_TEXTURE_MAX_ANISOTROPY_EXT = $84FE;
  524. GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;
  525. GL_MAX_CUBE_MAP_TEXTURE_SIZE = $851C;
  526. GL_TEXTURE_GEN_MODE = $2500;
  527. {$IF DEFINED(GLB_WIN)}
  528. libglu = 'glu32.dll';
  529. libopengl = 'opengl32.dll';
  530. {$ELSEIF DEFINED(GLB_LINUX)}
  531. libglu = 'libGLU.so.1';
  532. libopengl = 'libGL.so.1';
  533. {$IFEND}
  534. type
  535. GLboolean = BYTEBOOL;
  536. GLint = Integer;
  537. GLsizei = Integer;
  538. GLuint = Cardinal;
  539. GLfloat = Single;
  540. GLenum = Cardinal;
  541. PGLvoid = Pointer;
  542. PGLboolean = ^GLboolean;
  543. PGLint = ^GLint;
  544. PGLuint = ^GLuint;
  545. PGLfloat = ^GLfloat;
  546. TglCompressedTexImage1D = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  547. TglCompressedTexImage2D = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; height: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  548. TglGetCompressedTexImage = procedure(target: GLenum; level: GLint; img: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  549. {$IF DEFINED(GLB_WIN)}
  550. TwglGetProcAddress = function (ProcName: PAnsiChar): Pointer; stdcall;
  551. {$ELSEIF DEFINED(GLB_LINUX)}
  552. TglXGetProcAddress = function(ProcName: PAnsiChar): Pointer; cdecl;
  553. TglXGetProcAddressARB = function(const name: PAnsiChar): pointer; cdecl;
  554. {$IFEND}
  555. {$IF DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
  556. TglEnable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  557. TglDisable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  558. TglGetString = function(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  559. TglGetIntegerv = procedure(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  560. TglTexParameteri = procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  561. TglTexParameteriv = procedure(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  562. TglTexParameterfv = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  563. TglGetTexParameteriv = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  564. TglGetTexParameterfv = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  565. TglGetTexLevelParameteriv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  566. TglGetTexLevelParameterfv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  567. TglTexGeni = procedure(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  568. TglGenTextures = procedure(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  569. TglBindTexture = procedure(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  570. TglDeleteTextures = procedure(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  571. TglAreTexturesResident = function(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  572. TglReadPixels = procedure(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  573. TglPixelStorei = procedure(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  574. TglTexImage1D = procedure(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  575. TglTexImage2D = procedure(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; height: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  576. TglGetTexImage = procedure(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  577. TgluBuild1DMipmaps = function(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  578. TgluBuild2DMipmaps = function(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  579. {$ELSEIF DEFINED(GLB_NATIVE_OGL_STATIC)}
  580. procedure glEnable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  581. procedure glDisable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  582. function glGetString(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  583. procedure glGetIntegerv(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  584. procedure glTexParameteri(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  585. procedure glTexParameteriv(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  586. procedure glTexParameterfv(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  587. procedure glGetTexParameteriv(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  588. procedure glGetTexParameterfv(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  589. procedure glGetTexLevelParameteriv(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  590. procedure glGetTexLevelParameterfv(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  591. procedure glTexGeni(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  592. procedure glGenTextures(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  593. procedure glBindTexture(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  594. procedure glDeleteTextures(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  595. function glAreTexturesResident(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  596. procedure glReadPixels(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  597. procedure glPixelStorei(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  598. procedure glTexImage1D(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  599. procedure glTexImage2D(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; height: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  600. procedure glGetTexImage(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  601. function gluBuild1DMipmaps(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
  602. function gluBuild2DMipmaps(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
  603. {$IFEND}
  604. var
  605. GL_VERSION_1_2,
  606. GL_VERSION_1_3,
  607. GL_VERSION_1_4,
  608. GL_VERSION_2_0,
  609. GL_VERSION_3_3,
  610. GL_SGIS_generate_mipmap,
  611. GL_ARB_texture_border_clamp,
  612. GL_ARB_texture_mirrored_repeat,
  613. GL_ARB_texture_rectangle,
  614. GL_ARB_texture_non_power_of_two,
  615. GL_ARB_texture_swizzle,
  616. GL_ARB_texture_cube_map,
  617. GL_IBM_texture_mirrored_repeat,
  618. GL_NV_texture_rectangle,
  619. GL_EXT_texture_edge_clamp,
  620. GL_EXT_texture_rectangle,
  621. GL_EXT_texture_swizzle,
  622. GL_EXT_texture_cube_map,
  623. GL_EXT_texture_filter_anisotropic: Boolean;
  624. glCompressedTexImage1D: TglCompressedTexImage1D;
  625. glCompressedTexImage2D: TglCompressedTexImage2D;
  626. glGetCompressedTexImage: TglGetCompressedTexImage;
  627. {$IF DEFINED(GLB_WIN)}
  628. wglGetProcAddress: TwglGetProcAddress;
  629. {$ELSEIF DEFINED(GLB_LINUX)}
  630. glXGetProcAddress: TglXGetProcAddress;
  631. glXGetProcAddressARB: TglXGetProcAddress;
  632. {$IFEND}
  633. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  634. glEnable: TglEnable;
  635. glDisable: TglDisable;
  636. glGetString: TglGetString;
  637. glGetIntegerv: TglGetIntegerv;
  638. glTexParameteri: TglTexParameteri;
  639. glTexParameteriv: TglTexParameteriv;
  640. glTexParameterfv: TglTexParameterfv;
  641. glGetTexParameteriv: TglGetTexParameteriv;
  642. glGetTexParameterfv: TglGetTexParameterfv;
  643. glGetTexLevelParameteriv: TglGetTexLevelParameteriv;
  644. glGetTexLevelParameterfv: TglGetTexLevelParameterfv;
  645. glTexGeni: TglTexGeni;
  646. glGenTextures: TglGenTextures;
  647. glBindTexture: TglBindTexture;
  648. glDeleteTextures: TglDeleteTextures;
  649. glAreTexturesResident: TglAreTexturesResident;
  650. glReadPixels: TglReadPixels;
  651. glPixelStorei: TglPixelStorei;
  652. glTexImage1D: TglTexImage1D;
  653. glTexImage2D: TglTexImage2D;
  654. glGetTexImage: TglGetTexImage;
  655. gluBuild1DMipmaps: TgluBuild1DMipmaps;
  656. gluBuild2DMipmaps: TgluBuild2DMipmaps;
  657. {$ENDIF}
  658. {$ENDIF}
  659. type
  660. ////////////////////////////////////////////////////////////////////////////////////////////////////
  661. TglBitmapFormat = (
  662. tfEmpty = 0, //must be smallest value!
  663. tfAlpha4,
  664. tfAlpha8,
  665. tfAlpha12,
  666. tfAlpha16,
  667. tfLuminance4,
  668. tfLuminance8,
  669. tfLuminance12,
  670. tfLuminance16,
  671. tfLuminance4Alpha4,
  672. tfLuminance6Alpha2,
  673. tfLuminance8Alpha8,
  674. tfLuminance12Alpha4,
  675. tfLuminance12Alpha12,
  676. tfLuminance16Alpha16,
  677. tfR3G3B2,
  678. tfRGB4,
  679. tfR5G6B5,
  680. tfRGB5,
  681. tfRGB8,
  682. tfRGB10,
  683. tfRGB12,
  684. tfRGB16,
  685. tfRGBA2,
  686. tfRGBA4,
  687. tfRGB5A1,
  688. tfRGBA8,
  689. tfRGB10A2,
  690. tfRGBA12,
  691. tfRGBA16,
  692. tfBGR4,
  693. tfB5G6R5,
  694. tfBGR5,
  695. tfBGR8,
  696. tfBGR10,
  697. tfBGR12,
  698. tfBGR16,
  699. tfBGRA2,
  700. tfBGRA4,
  701. tfBGR5A1,
  702. tfBGRA8,
  703. tfBGR10A2,
  704. tfBGRA12,
  705. tfBGRA16,
  706. tfDepth16,
  707. tfDepth24,
  708. tfDepth32,
  709. tfS3tcDtx1RGBA,
  710. tfS3tcDtx3RGBA,
  711. tfS3tcDtx5RGBA
  712. );
  713. TglBitmapFileType = (
  714. {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG, {$ENDIF}
  715. {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
  716. ftDDS,
  717. ftTGA,
  718. ftBMP);
  719. TglBitmapFileTypes = set of TglBitmapFileType;
  720. TglBitmapMipMap = (
  721. mmNone,
  722. mmMipmap,
  723. mmMipmapGlu);
  724. TglBitmapNormalMapFunc = (
  725. nm4Samples,
  726. nmSobel,
  727. nm3x3,
  728. nm5x5);
  729. ////////////////////////////////////////////////////////////////////////////////////////////////////
  730. EglBitmap = class(Exception);
  731. EglBitmapNotSupported = class(Exception);
  732. EglBitmapSizeToLarge = class(EglBitmap);
  733. EglBitmapNonPowerOfTwo = class(EglBitmap);
  734. EglBitmapUnsupportedFormat = class(EglBitmap)
  735. public
  736. constructor Create(const aFormat: TglBitmapFormat); overload;
  737. constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;
  738. end;
  739. ////////////////////////////////////////////////////////////////////////////////////////////////////
  740. TglBitmapColorRec = packed record
  741. case Integer of
  742. 0: (r, g, b, a: Cardinal);
  743. 1: (arr: array[0..3] of Cardinal);
  744. end;
  745. TglBitmapPixelData = packed record
  746. Data, Range: TglBitmapColorRec;
  747. Format: TglBitmapFormat;
  748. end;
  749. PglBitmapPixelData = ^TglBitmapPixelData;
  750. ////////////////////////////////////////////////////////////////////////////////////////////////////
  751. TglBitmapPixelPositionFields = set of (ffX, ffY);
  752. TglBitmapPixelPosition = record
  753. Fields : TglBitmapPixelPositionFields;
  754. X : Word;
  755. Y : Word;
  756. end;
  757. TglBitmapFormatDescriptor = class(TObject)
  758. protected
  759. function GetIsCompressed: Boolean; virtual; abstract;
  760. function GetHasRed: Boolean; virtual; abstract;
  761. function GetHasGreen: Boolean; virtual; abstract;
  762. function GetHasBlue: Boolean; virtual; abstract;
  763. function GetHasAlpha: Boolean; virtual; abstract;
  764. function GetglDataFormat: GLenum; virtual; abstract;
  765. function GetglFormat: GLenum; virtual; abstract;
  766. function GetglInternalFormat: GLenum; virtual; abstract;
  767. public
  768. property IsCompressed: Boolean read GetIsCompressed;
  769. property HasRed: Boolean read GetHasRed;
  770. property HasGreen: Boolean read GetHasGreen;
  771. property HasBlue: Boolean read GetHasBlue;
  772. property HasAlpha: Boolean read GetHasAlpha;
  773. property glFormat: GLenum read GetglFormat;
  774. property glInternalFormat: GLenum read GetglInternalFormat;
  775. property glDataFormat: GLenum read GetglDataFormat;
  776. end;
  777. ////////////////////////////////////////////////////////////////////////////////////////////////////
  778. TglBitmap = class;
  779. TglBitmapFunctionRec = record
  780. Sender: TglBitmap;
  781. Size: TglBitmapPixelPosition;
  782. Position: TglBitmapPixelPosition;
  783. Source: TglBitmapPixelData;
  784. Dest: TglBitmapPixelData;
  785. Args: Pointer;
  786. end;
  787. TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
  788. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  789. TglBitmap = class
  790. private
  791. function GetFormatDesc: TglBitmapFormatDescriptor;
  792. protected
  793. fID: GLuint;
  794. fTarget: GLuint;
  795. fAnisotropic: Integer;
  796. fDeleteTextureOnFree: Boolean;
  797. fFreeDataOnDestroy: Boolean;
  798. fFreeDataAfterGenTexture: Boolean;
  799. fData: PByte;
  800. fIsResident: GLboolean;
  801. fBorderColor: array[0..3] of Single;
  802. fDimension: TglBitmapPixelPosition;
  803. fMipMap: TglBitmapMipMap;
  804. fFormat: TglBitmapFormat;
  805. // Mapping
  806. fPixelSize: Integer;
  807. fRowSize: Integer;
  808. // Filtering
  809. fFilterMin: GLenum;
  810. fFilterMag: GLenum;
  811. // TexturWarp
  812. fWrapS: GLenum;
  813. fWrapT: GLenum;
  814. fWrapR: GLenum;
  815. //Swizzle
  816. fSwizzle: array[0..3] of GLenum;
  817. // CustomData
  818. fFilename: String;
  819. fCustomName: String;
  820. fCustomNameW: WideString;
  821. fCustomData: Pointer;
  822. //Getter
  823. function GetWidth: Integer; virtual;
  824. function GetHeight: Integer; virtual;
  825. function GetFileWidth: Integer; virtual;
  826. function GetFileHeight: Integer; virtual;
  827. //Setter
  828. procedure SetCustomData(const aValue: Pointer);
  829. procedure SetCustomName(const aValue: String);
  830. procedure SetCustomNameW(const aValue: WideString);
  831. procedure SetFreeDataOnDestroy(const aValue: Boolean);
  832. procedure SetDeleteTextureOnFree(const aValue: Boolean);
  833. procedure SetFormat(const aValue: TglBitmapFormat);
  834. procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
  835. procedure SetID(const aValue: Cardinal);
  836. procedure SetMipMap(const aValue: TglBitmapMipMap);
  837. procedure SetTarget(const aValue: Cardinal);
  838. procedure SetAnisotropic(const aValue: Integer);
  839. procedure CreateID;
  840. procedure SetupParameters(out aBuildWithGlu: Boolean);
  841. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  842. const aWidth: Integer = -1; const aHeight: Integer = -1); virtual; //be careful, aData could be freed by this method
  843. procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
  844. function FlipHorz: Boolean; virtual;
  845. function FlipVert: Boolean; virtual;
  846. property Width: Integer read GetWidth;
  847. property Height: Integer read GetHeight;
  848. property FileWidth: Integer read GetFileWidth;
  849. property FileHeight: Integer read GetFileHeight;
  850. public
  851. //Properties
  852. property ID: Cardinal read fID write SetID;
  853. property Target: Cardinal read fTarget write SetTarget;
  854. property Format: TglBitmapFormat read fFormat write SetFormat;
  855. property MipMap: TglBitmapMipMap read fMipMap write SetMipMap;
  856. property Anisotropic: Integer read fAnisotropic write SetAnisotropic;
  857. property FormatDesc: TglBitmapFormatDescriptor read GetFormatDesc;
  858. property Filename: String read fFilename;
  859. property CustomName: String read fCustomName write SetCustomName;
  860. property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
  861. property CustomData: Pointer read fCustomData write SetCustomData;
  862. property DeleteTextureOnFree: Boolean read fDeleteTextureOnFree write SetDeleteTextureOnFree;
  863. property FreeDataOnDestroy: Boolean read fFreeDataOnDestroy write SetFreeDataOnDestroy;
  864. property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
  865. property Dimension: TglBitmapPixelPosition read fDimension;
  866. property Data: PByte read fData;
  867. property IsResident: GLboolean read fIsResident;
  868. procedure AfterConstruction; override;
  869. procedure BeforeDestruction; override;
  870. procedure PrepareResType(var aResource: String; var aResType: PChar);
  871. //Load
  872. procedure LoadFromFile(const aFilename: String);
  873. procedure LoadFromStream(const aStream: TStream); virtual;
  874. procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  875. const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
  876. procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
  877. procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  878. //Save
  879. procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  880. procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
  881. //Convert
  882. function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
  883. function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  884. const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
  885. public
  886. //Alpha & Co
  887. {$IFDEF GLB_SDL}
  888. function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  889. function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  890. function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  891. function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
  892. const aArgs: Pointer = nil): Boolean;
  893. {$ENDIF}
  894. {$IFDEF GLB_DELPHI}
  895. function AssignToBitmap(const aBitmap: TBitmap): Boolean;
  896. function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  897. function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  898. function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
  899. const aArgs: Pointer = nil): Boolean;
  900. {$ENDIF}
  901. {$IFDEF GLB_LAZARUS}
  902. function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  903. function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  904. function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  905. function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil;
  906. const aArgs: Pointer = nil): Boolean;
  907. {$ENDIF}
  908. function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil;
  909. const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  910. function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  911. const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  912. function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
  913. function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  914. function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  915. function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  916. function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
  917. function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
  918. function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
  919. function AddAlphaFromValue(const aAlpha: Byte): Boolean;
  920. function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  921. function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  922. function RemoveAlpha: Boolean; virtual;
  923. public
  924. //Common
  925. function Clone: TglBitmap;
  926. function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
  927. procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
  928. procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  929. procedure FreeData;
  930. //ColorFill
  931. procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
  932. procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
  933. procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
  934. //TexParameters
  935. procedure SetFilter(const aMin, aMag: GLenum);
  936. procedure SetWrap(
  937. const S: GLenum = GL_CLAMP_TO_EDGE;
  938. const T: GLenum = GL_CLAMP_TO_EDGE;
  939. const R: GLenum = GL_CLAMP_TO_EDGE);
  940. procedure SetSwizzle(const r, g, b, a: GLenum);
  941. procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
  942. procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
  943. //Constructors
  944. constructor Create; overload;
  945. constructor Create(const aFileName: String); overload;
  946. constructor Create(const aStream: TStream); overload;
  947. constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte = nil); overload;
  948. constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
  949. constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
  950. constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
  951. private
  952. {$IFDEF GLB_SUPPORT_PNG_READ} function LoadPNG(const aStream: TStream): Boolean; virtual; {$ENDIF}
  953. {$ifdef GLB_SUPPORT_PNG_WRITE} procedure SavePNG(const aStream: TStream); virtual; {$ENDIF}
  954. {$IFDEF GLB_SUPPORT_JPEG_READ} function LoadJPEG(const aStream: TStream): Boolean; virtual; {$ENDIF}
  955. {$IFDEF GLB_SUPPORT_JPEG_WRITE} procedure SaveJPEG(const aStream: TStream); virtual; {$ENDIF}
  956. function LoadBMP(const aStream: TStream): Boolean; virtual;
  957. procedure SaveBMP(const aStream: TStream); virtual;
  958. function LoadTGA(const aStream: TStream): Boolean; virtual;
  959. procedure SaveTGA(const aStream: TStream); virtual;
  960. function LoadDDS(const aStream: TStream): Boolean; virtual;
  961. procedure SaveDDS(const aStream: TStream); virtual;
  962. end;
  963. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  964. TglBitmap1D = class(TglBitmap)
  965. protected
  966. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  967. const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
  968. procedure UploadData(const aBuildWithGlu: Boolean);
  969. public
  970. property Width;
  971. procedure AfterConstruction; override;
  972. function FlipHorz: Boolean; override;
  973. procedure GenTexture(const aTestTextureSize: Boolean = true); override;
  974. end;
  975. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  976. TglBitmap2D = class(TglBitmap)
  977. protected
  978. fLines: array of PByte;
  979. function GetScanline(const aIndex: Integer): Pointer;
  980. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  981. const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
  982. procedure UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
  983. public
  984. property Width;
  985. property Height;
  986. property Scanline[const aIndex: Integer]: Pointer read GetScanline;
  987. procedure AfterConstruction; override;
  988. procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  989. procedure GetDataFromTexture;
  990. procedure GenTexture(const aTestTextureSize: Boolean = true); override;
  991. function FlipHorz: Boolean; override;
  992. function FlipVert: Boolean; override;
  993. procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
  994. const aScale: Single = 2; const aUseAlpha: Boolean = false);
  995. end;
  996. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  997. TglBitmapCubeMap = class(TglBitmap2D)
  998. protected
  999. fGenMode: Integer;
  1000. procedure GenTexture(const aTestTextureSize: Boolean = true); reintroduce;
  1001. public
  1002. procedure AfterConstruction; override;
  1003. procedure GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean = true);
  1004. procedure Bind(const aEnableTexCoordsGen: Boolean = true; const aEnableTextureUnit: Boolean = true); reintroduce; virtual;
  1005. procedure Unbind(const aDisableTexCoordsGen: Boolean = true; const aDisableTextureUnit: Boolean = true); reintroduce; virtual;
  1006. end;
  1007. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1008. TglBitmapNormalMap = class(TglBitmapCubeMap)
  1009. public
  1010. procedure AfterConstruction; override;
  1011. procedure GenerateNormalMap(const aSize: Integer = 32; const aTestTextureSize: Boolean = true);
  1012. end;
  1013. const
  1014. NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
  1015. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1016. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1017. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1018. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1019. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1020. procedure glBitmapSetDefaultWrap(
  1021. const S: Cardinal = GL_CLAMP_TO_EDGE;
  1022. const T: Cardinal = GL_CLAMP_TO_EDGE;
  1023. const R: Cardinal = GL_CLAMP_TO_EDGE);
  1024. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1025. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1026. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1027. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1028. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  1029. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  1030. function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
  1031. function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
  1032. function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
  1033. var
  1034. glBitmapDefaultDeleteTextureOnFree: Boolean;
  1035. glBitmapDefaultFreeDataAfterGenTextures: Boolean;
  1036. glBitmapDefaultFormat: TglBitmapFormat;
  1037. glBitmapDefaultMipmap: TglBitmapMipMap;
  1038. glBitmapDefaultFilterMin: Cardinal;
  1039. glBitmapDefaultFilterMag: Cardinal;
  1040. glBitmapDefaultWrapS: Cardinal;
  1041. glBitmapDefaultWrapT: Cardinal;
  1042. glBitmapDefaultWrapR: Cardinal;
  1043. glDefaultSwizzle: array[0..3] of GLenum;
  1044. {$IFDEF GLB_DELPHI}
  1045. function CreateGrayPalette: HPALETTE;
  1046. {$ENDIF}
  1047. implementation
  1048. uses
  1049. Math, syncobjs, typinfo
  1050. {$IFDEF GLB_DELPHI}, Types{$ENDIF}
  1051. {$IF DEFINED(GLB_SUPPORT_JPEG_READ) AND DEFINED(GLB_LAZ_JPEG)}, FPReadJPEG{$IFEND};
  1052. type
  1053. {$IFNDEF fpc}
  1054. QWord = System.UInt64;
  1055. PQWord = ^QWord;
  1056. PtrInt = Longint;
  1057. PtrUInt = DWord;
  1058. {$ENDIF}
  1059. ////////////////////////////////////////////////////////////////////////////////////////////////////
  1060. TShiftRec = packed record
  1061. case Integer of
  1062. 0: (r, g, b, a: Byte);
  1063. 1: (arr: array[0..3] of Byte);
  1064. end;
  1065. TFormatDescriptor = class(TglBitmapFormatDescriptor)
  1066. private
  1067. function GetRedMask: QWord;
  1068. function GetGreenMask: QWord;
  1069. function GetBlueMask: QWord;
  1070. function GetAlphaMask: QWord;
  1071. protected
  1072. fFormat: TglBitmapFormat;
  1073. fWithAlpha: TglBitmapFormat;
  1074. fWithoutAlpha: TglBitmapFormat;
  1075. fRGBInverted: TglBitmapFormat;
  1076. fUncompressed: TglBitmapFormat;
  1077. fPixelSize: Single;
  1078. fIsCompressed: Boolean;
  1079. fRange: TglBitmapColorRec;
  1080. fShift: TShiftRec;
  1081. fglFormat: GLenum;
  1082. fglInternalFormat: GLenum;
  1083. fglDataFormat: GLenum;
  1084. function GetIsCompressed: Boolean; override;
  1085. function GetHasRed: Boolean; override;
  1086. function GetHasGreen: Boolean; override;
  1087. function GetHasBlue: Boolean; override;
  1088. function GetHasAlpha: Boolean; override;
  1089. function GetglFormat: GLenum; override;
  1090. function GetglInternalFormat: GLenum; override;
  1091. function GetglDataFormat: GLenum; override;
  1092. function GetComponents: Integer; virtual;
  1093. public
  1094. property Format: TglBitmapFormat read fFormat;
  1095. property WithAlpha: TglBitmapFormat read fWithAlpha;
  1096. property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;
  1097. property RGBInverted: TglBitmapFormat read fRGBInverted;
  1098. property Components: Integer read GetComponents;
  1099. property PixelSize: Single read fPixelSize;
  1100. property Range: TglBitmapColorRec read fRange;
  1101. property Shift: TShiftRec read fShift;
  1102. property RedMask: QWord read GetRedMask;
  1103. property GreenMask: QWord read GetGreenMask;
  1104. property BlueMask: QWord read GetBlueMask;
  1105. property AlphaMask: QWord read GetAlphaMask;
  1106. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
  1107. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
  1108. function GetSize(const aSize: TglBitmapPixelPosition): Integer; overload; virtual;
  1109. function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
  1110. function CreateMappingData: Pointer; virtual;
  1111. procedure FreeMappingData(var aMappingData: Pointer); virtual;
  1112. function IsEmpty: Boolean; virtual;
  1113. function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean; virtual;
  1114. procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
  1115. constructor Create; virtual;
  1116. public
  1117. class procedure Init;
  1118. class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1119. class function GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1120. class procedure Clear;
  1121. class procedure Finalize;
  1122. end;
  1123. TFormatDescriptorClass = class of TFormatDescriptor;
  1124. TfdEmpty = class(TFormatDescriptor);
  1125. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1126. TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1127. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1128. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1129. constructor Create; override;
  1130. end;
  1131. TfdLuminance_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1132. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1133. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1134. constructor Create; override;
  1135. end;
  1136. TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1137. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1138. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1139. constructor Create; override;
  1140. end;
  1141. TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte
  1142. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1143. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1144. constructor Create; override;
  1145. end;
  1146. TfdRGB_UB3 = class(TFormatDescriptor) //3* unsigned byte
  1147. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1148. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1149. constructor Create; override;
  1150. end;
  1151. TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
  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. TfdRGBA_UB4 = class(TfdRGB_UB3) //4* unsigned byte
  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. TfdBGRA_UB4 = class(TfdBGR_UB3) //4* unsigned byte (inverse)
  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. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1167. TfdAlpha_US1 = class(TFormatDescriptor) //1* unsigned short
  1168. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1169. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1170. constructor Create; override;
  1171. end;
  1172. TfdLuminance_US1 = class(TFormatDescriptor) //1* unsigned short
  1173. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1174. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1175. constructor Create; override;
  1176. end;
  1177. TfdUniversal_US1 = class(TFormatDescriptor) //1* unsigned short
  1178. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1179. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1180. constructor Create; override;
  1181. end;
  1182. TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short
  1183. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1184. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1185. constructor Create; override;
  1186. end;
  1187. TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short
  1188. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1189. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1190. constructor Create; override;
  1191. end;
  1192. TfdRGB_US3 = class(TFormatDescriptor) //3* unsigned short
  1193. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1194. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1195. constructor Create; override;
  1196. end;
  1197. TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)
  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. TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
  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. TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
  1208. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1209. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1210. constructor Create; override;
  1211. end;
  1212. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1213. TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int
  1214. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1215. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1216. constructor Create; override;
  1217. end;
  1218. TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int
  1219. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1220. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1221. constructor Create; override;
  1222. end;
  1223. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1224. TfdAlpha4 = class(TfdAlpha_UB1)
  1225. constructor Create; override;
  1226. end;
  1227. TfdAlpha8 = class(TfdAlpha_UB1)
  1228. constructor Create; override;
  1229. end;
  1230. TfdAlpha12 = class(TfdAlpha_US1)
  1231. constructor Create; override;
  1232. end;
  1233. TfdAlpha16 = class(TfdAlpha_US1)
  1234. constructor Create; override;
  1235. end;
  1236. TfdLuminance4 = class(TfdLuminance_UB1)
  1237. constructor Create; override;
  1238. end;
  1239. TfdLuminance8 = class(TfdLuminance_UB1)
  1240. constructor Create; override;
  1241. end;
  1242. TfdLuminance12 = class(TfdLuminance_US1)
  1243. constructor Create; override;
  1244. end;
  1245. TfdLuminance16 = class(TfdLuminance_US1)
  1246. constructor Create; override;
  1247. end;
  1248. TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
  1249. constructor Create; override;
  1250. end;
  1251. TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
  1252. constructor Create; override;
  1253. end;
  1254. TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
  1255. constructor Create; override;
  1256. end;
  1257. TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
  1258. constructor Create; override;
  1259. end;
  1260. TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)
  1261. constructor Create; override;
  1262. end;
  1263. TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
  1264. constructor Create; override;
  1265. end;
  1266. TfdR3G3B2 = class(TfdUniversal_UB1)
  1267. constructor Create; override;
  1268. end;
  1269. TfdRGB4 = class(TfdUniversal_US1)
  1270. constructor Create; override;
  1271. end;
  1272. TfdR5G6B5 = class(TfdUniversal_US1)
  1273. constructor Create; override;
  1274. end;
  1275. TfdRGB5 = class(TfdUniversal_US1)
  1276. constructor Create; override;
  1277. end;
  1278. TfdRGB8 = class(TfdRGB_UB3)
  1279. constructor Create; override;
  1280. end;
  1281. TfdRGB10 = class(TfdUniversal_UI1)
  1282. constructor Create; override;
  1283. end;
  1284. TfdRGB12 = class(TfdRGB_US3)
  1285. constructor Create; override;
  1286. end;
  1287. TfdRGB16 = class(TfdRGB_US3)
  1288. constructor Create; override;
  1289. end;
  1290. TfdRGBA2 = class(TfdRGBA_UB4)
  1291. constructor Create; override;
  1292. end;
  1293. TfdRGBA4 = class(TfdUniversal_US1)
  1294. constructor Create; override;
  1295. end;
  1296. TfdRGB5A1 = class(TfdUniversal_US1)
  1297. constructor Create; override;
  1298. end;
  1299. TfdRGBA8 = class(TfdRGBA_UB4)
  1300. constructor Create; override;
  1301. end;
  1302. TfdRGB10A2 = class(TfdUniversal_UI1)
  1303. constructor Create; override;
  1304. end;
  1305. TfdRGBA12 = class(TfdRGBA_US4)
  1306. constructor Create; override;
  1307. end;
  1308. TfdRGBA16 = class(TfdRGBA_US4)
  1309. constructor Create; override;
  1310. end;
  1311. TfdBGR4 = class(TfdUniversal_US1)
  1312. constructor Create; override;
  1313. end;
  1314. TfdB5G6R5 = class(TfdUniversal_US1)
  1315. constructor Create; override;
  1316. end;
  1317. TfdBGR5 = class(TfdUniversal_US1)
  1318. constructor Create; override;
  1319. end;
  1320. TfdBGR8 = class(TfdBGR_UB3)
  1321. constructor Create; override;
  1322. end;
  1323. TfdBGR10 = class(TfdUniversal_UI1)
  1324. constructor Create; override;
  1325. end;
  1326. TfdBGR12 = class(TfdBGR_US3)
  1327. constructor Create; override;
  1328. end;
  1329. TfdBGR16 = class(TfdBGR_US3)
  1330. constructor Create; override;
  1331. end;
  1332. TfdBGRA2 = class(TfdBGRA_UB4)
  1333. constructor Create; override;
  1334. end;
  1335. TfdBGRA4 = class(TfdUniversal_US1)
  1336. constructor Create; override;
  1337. end;
  1338. TfdBGR5A1 = class(TfdUniversal_US1)
  1339. constructor Create; override;
  1340. end;
  1341. TfdBGRA8 = class(TfdBGRA_UB4)
  1342. constructor Create; override;
  1343. end;
  1344. TfdBGR10A2 = class(TfdUniversal_UI1)
  1345. constructor Create; override;
  1346. end;
  1347. TfdBGRA12 = class(TfdBGRA_US4)
  1348. constructor Create; override;
  1349. end;
  1350. TfdBGRA16 = class(TfdBGRA_US4)
  1351. constructor Create; override;
  1352. end;
  1353. TfdDepth16 = class(TfdDepth_US1)
  1354. constructor Create; override;
  1355. end;
  1356. TfdDepth24 = class(TfdDepth_UI1)
  1357. constructor Create; override;
  1358. end;
  1359. TfdDepth32 = class(TfdDepth_UI1)
  1360. constructor Create; override;
  1361. end;
  1362. TfdS3tcDtx1RGBA = class(TFormatDescriptor)
  1363. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1364. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1365. constructor Create; override;
  1366. end;
  1367. TfdS3tcDtx3RGBA = class(TFormatDescriptor)
  1368. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1369. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1370. constructor Create; override;
  1371. end;
  1372. TfdS3tcDtx5RGBA = class(TFormatDescriptor)
  1373. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1374. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1375. constructor Create; override;
  1376. end;
  1377. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1378. TbmpBitfieldFormat = class(TFormatDescriptor)
  1379. private
  1380. procedure SetRedMask (const aValue: QWord);
  1381. procedure SetGreenMask(const aValue: QWord);
  1382. procedure SetBlueMask (const aValue: QWord);
  1383. procedure SetAlphaMask(const aValue: QWord);
  1384. procedure Update(aMask: QWord; out aRange: Cardinal; out aShift: Byte);
  1385. public
  1386. property RedMask: QWord read GetRedMask write SetRedMask;
  1387. property GreenMask: QWord read GetGreenMask write SetGreenMask;
  1388. property BlueMask: QWord read GetBlueMask write SetBlueMask;
  1389. property AlphaMask: QWord read GetAlphaMask write SetAlphaMask;
  1390. property PixelSize: Single read fPixelSize write fPixelSize;
  1391. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1392. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1393. end;
  1394. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1395. TbmpColorTableEnty = packed record
  1396. b, g, r, a: Byte;
  1397. end;
  1398. TbmpColorTable = array of TbmpColorTableEnty;
  1399. TbmpColorTableFormat = class(TFormatDescriptor)
  1400. private
  1401. fColorTable: TbmpColorTable;
  1402. public
  1403. property PixelSize: Single read fPixelSize write fPixelSize;
  1404. property ColorTable: TbmpColorTable read fColorTable write fColorTable;
  1405. property Range: TglBitmapColorRec read fRange write fRange;
  1406. property Shift: TShiftRec read fShift write fShift;
  1407. property Format: TglBitmapFormat read fFormat write fFormat;
  1408. procedure CreateColorTable;
  1409. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1410. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1411. destructor Destroy; override;
  1412. end;
  1413. const
  1414. LUMINANCE_WEIGHT_R = 0.30;
  1415. LUMINANCE_WEIGHT_G = 0.59;
  1416. LUMINANCE_WEIGHT_B = 0.11;
  1417. ALPHA_WEIGHT_R = 0.30;
  1418. ALPHA_WEIGHT_G = 0.59;
  1419. ALPHA_WEIGHT_B = 0.11;
  1420. DEPTH_WEIGHT_R = 0.333333333;
  1421. DEPTH_WEIGHT_G = 0.333333333;
  1422. DEPTH_WEIGHT_B = 0.333333333;
  1423. UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
  1424. FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
  1425. TfdEmpty,
  1426. TfdAlpha4,
  1427. TfdAlpha8,
  1428. TfdAlpha12,
  1429. TfdAlpha16,
  1430. TfdLuminance4,
  1431. TfdLuminance8,
  1432. TfdLuminance12,
  1433. TfdLuminance16,
  1434. TfdLuminance4Alpha4,
  1435. TfdLuminance6Alpha2,
  1436. TfdLuminance8Alpha8,
  1437. TfdLuminance12Alpha4,
  1438. TfdLuminance12Alpha12,
  1439. TfdLuminance16Alpha16,
  1440. TfdR3G3B2,
  1441. TfdRGB4,
  1442. TfdR5G6B5,
  1443. TfdRGB5,
  1444. TfdRGB8,
  1445. TfdRGB10,
  1446. TfdRGB12,
  1447. TfdRGB16,
  1448. TfdRGBA2,
  1449. TfdRGBA4,
  1450. TfdRGB5A1,
  1451. TfdRGBA8,
  1452. TfdRGB10A2,
  1453. TfdRGBA12,
  1454. TfdRGBA16,
  1455. TfdBGR4,
  1456. TfdB5G6R5,
  1457. TfdBGR5,
  1458. TfdBGR8,
  1459. TfdBGR10,
  1460. TfdBGR12,
  1461. TfdBGR16,
  1462. TfdBGRA2,
  1463. TfdBGRA4,
  1464. TfdBGR5A1,
  1465. TfdBGRA8,
  1466. TfdBGR10A2,
  1467. TfdBGRA12,
  1468. TfdBGRA16,
  1469. TfdDepth16,
  1470. TfdDepth24,
  1471. TfdDepth32,
  1472. TfdS3tcDtx1RGBA,
  1473. TfdS3tcDtx3RGBA,
  1474. TfdS3tcDtx5RGBA
  1475. );
  1476. var
  1477. FormatDescriptorCS: TCriticalSection;
  1478. FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
  1479. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1480. constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
  1481. begin
  1482. inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1483. end;
  1484. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1485. constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
  1486. begin
  1487. inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1488. end;
  1489. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1490. function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
  1491. begin
  1492. result.Fields := [];
  1493. if X >= 0 then
  1494. result.Fields := result.Fields + [ffX];
  1495. if Y >= 0 then
  1496. result.Fields := result.Fields + [ffY];
  1497. result.X := Max(0, X);
  1498. result.Y := Max(0, Y);
  1499. end;
  1500. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1501. function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
  1502. begin
  1503. result.r := r;
  1504. result.g := g;
  1505. result.b := b;
  1506. result.a := a;
  1507. end;
  1508. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1509. function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
  1510. var
  1511. i: Integer;
  1512. begin
  1513. result := false;
  1514. for i := 0 to high(r1.arr) do
  1515. if (r1.arr[i] <> r2.arr[i]) then
  1516. exit;
  1517. result := true;
  1518. end;
  1519. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1520. function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
  1521. begin
  1522. result.r := r;
  1523. result.g := g;
  1524. result.b := b;
  1525. result.a := a;
  1526. end;
  1527. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1528. function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
  1529. begin
  1530. result := [];
  1531. if (aFormat in [
  1532. //4 bbp
  1533. tfLuminance4,
  1534. //8bpp
  1535. tfR3G3B2, tfLuminance8,
  1536. //16bpp
  1537. tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
  1538. tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,
  1539. //24bpp
  1540. tfBGR8, tfRGB8,
  1541. //32bpp
  1542. tfRGB10, tfRGB10A2, tfRGBA8,
  1543. tfBGR10, tfBGR10A2, tfBGRA8]) then
  1544. result := result + [ftBMP];
  1545. if (aFormat in [
  1546. //8 bpp
  1547. tfLuminance8, tfAlpha8,
  1548. //16 bpp
  1549. tfLuminance16, tfLuminance8Alpha8,
  1550. tfRGB5, tfRGB5A1, tfRGBA4,
  1551. tfBGR5, tfBGR5A1, tfBGRA4,
  1552. //24 bpp
  1553. tfRGB8, tfBGR8,
  1554. //32 bpp
  1555. tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
  1556. result := result + [ftTGA];
  1557. if (aFormat in [
  1558. //8 bpp
  1559. tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,
  1560. tfR3G3B2, tfRGBA2, tfBGRA2,
  1561. //16 bpp
  1562. tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,
  1563. tfRGB4, tfR5G6B5, tfRGB5, tfRGBA4, tfRGB5A1,
  1564. tfBGR4, tfB5G6R5, tfBGR5, tfBGRA4, tfBGR5A1,
  1565. //24 bpp
  1566. tfRGB8, tfBGR8,
  1567. //32 bbp
  1568. tfLuminance16Alpha16,
  1569. tfRGBA8, tfRGB10A2,
  1570. tfBGRA8, tfBGR10A2,
  1571. //compressed
  1572. tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then
  1573. result := result + [ftDDS];
  1574. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  1575. if aFormat in [
  1576. tfAlpha8, tfLuminance8, tfLuminance8Alpha8,
  1577. tfRGB8, tfRGBA8,
  1578. tfBGR8, tfBGRA8] then
  1579. result := result + [ftPNG];
  1580. {$ENDIF}
  1581. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  1582. if aFormat in [tfAlpha8, tfLuminance8, tfRGB8, tfBGR8] then
  1583. result := result + [ftJPEG];
  1584. {$ENDIF}
  1585. end;
  1586. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1587. function IsPowerOfTwo(aNumber: Integer): Boolean;
  1588. begin
  1589. while (aNumber and 1) = 0 do
  1590. aNumber := aNumber shr 1;
  1591. result := aNumber = 1;
  1592. end;
  1593. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1594. function GetTopMostBit(aBitSet: QWord): Integer;
  1595. begin
  1596. result := 0;
  1597. while aBitSet > 0 do begin
  1598. inc(result);
  1599. aBitSet := aBitSet shr 1;
  1600. end;
  1601. end;
  1602. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1603. function CountSetBits(aBitSet: QWord): Integer;
  1604. begin
  1605. result := 0;
  1606. while aBitSet > 0 do begin
  1607. if (aBitSet and 1) = 1 then
  1608. inc(result);
  1609. aBitSet := aBitSet shr 1;
  1610. end;
  1611. end;
  1612. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1613. function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1614. begin
  1615. result := Trunc(
  1616. LUMINANCE_WEIGHT_R * aPixel.Data.r +
  1617. LUMINANCE_WEIGHT_G * aPixel.Data.g +
  1618. LUMINANCE_WEIGHT_B * aPixel.Data.b);
  1619. end;
  1620. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1621. function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1622. begin
  1623. result := Trunc(
  1624. DEPTH_WEIGHT_R * aPixel.Data.r +
  1625. DEPTH_WEIGHT_G * aPixel.Data.g +
  1626. DEPTH_WEIGHT_B * aPixel.Data.b);
  1627. end;
  1628. {$IFDEF GLB_NATIVE_OGL}
  1629. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1630. //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1631. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1632. var
  1633. GL_LibHandle: Pointer = nil;
  1634. function glbGetProcAddress(aProcName: PAnsiChar; aLibHandle: Pointer = nil; const aRaiseOnErr: Boolean = true): Pointer;
  1635. begin
  1636. if not Assigned(aLibHandle) then
  1637. aLibHandle := GL_LibHandle;
  1638. {$IF DEFINED(GLB_WIN)}
  1639. result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
  1640. if Assigned(result) then
  1641. exit;
  1642. if Assigned(wglGetProcAddress) then
  1643. result := wglGetProcAddress(aProcName);
  1644. {$ELSEIF DEFINED(GLB_LINUX)}
  1645. if Assigned(glXGetProcAddress) then begin
  1646. result := glXGetProcAddress(aProcName);
  1647. if Assigned(result) then
  1648. exit;
  1649. end;
  1650. if Assigned(glXGetProcAddressARB) then begin
  1651. result := glXGetProcAddressARB(aProcName);
  1652. if Assigned(result) then
  1653. exit;
  1654. end;
  1655. result := dlsym(aLibHandle, aProcName);
  1656. {$IFEND}
  1657. if not Assigned(result) and aRaiseOnErr then
  1658. raise EglBitmap.Create('unable to load procedure form library: ' + aProcName);
  1659. end;
  1660. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  1661. var
  1662. GLU_LibHandle: Pointer = nil;
  1663. OpenGLInitialized: Boolean;
  1664. InitOpenGLCS: TCriticalSection;
  1665. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1666. procedure glbInitOpenGL;
  1667. ////////////////////////////////////////////////////////////////////////////////
  1668. function glbLoadLibrary(const aName: PChar): Pointer;
  1669. begin
  1670. {$IF DEFINED(GLB_WIN)}
  1671. result := {%H-}Pointer(LoadLibrary(aName));
  1672. {$ELSEIF DEFINED(GLB_LINUX)}
  1673. result := dlopen(Name, RTLD_LAZY);
  1674. {$ELSE}
  1675. result := nil;
  1676. {$IFEND}
  1677. end;
  1678. ////////////////////////////////////////////////////////////////////////////////
  1679. function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
  1680. begin
  1681. result := false;
  1682. if not Assigned(aLibHandle) then
  1683. exit;
  1684. {$IF DEFINED(GLB_WIN)}
  1685. Result := FreeLibrary({%H-}HINST(aLibHandle));
  1686. {$ELSEIF DEFINED(GLB_LINUX)}
  1687. Result := dlclose(aLibHandle) = 0;
  1688. {$IFEND}
  1689. end;
  1690. begin
  1691. if Assigned(GL_LibHandle) then
  1692. glbFreeLibrary(GL_LibHandle);
  1693. if Assigned(GLU_LibHandle) then
  1694. glbFreeLibrary(GLU_LibHandle);
  1695. GL_LibHandle := glbLoadLibrary(libopengl);
  1696. if not Assigned(GL_LibHandle) then
  1697. raise EglBitmap.Create('unable to load library: ' + libopengl);
  1698. GLU_LibHandle := glbLoadLibrary(libglu);
  1699. if not Assigned(GLU_LibHandle) then
  1700. raise EglBitmap.Create('unable to load library: ' + libglu);
  1701. {$IF DEFINED(GLB_WIN)}
  1702. wglGetProcAddress := glbGetProcAddress('wglGetProcAddress');
  1703. {$ELSEIF DEFINED(GLB_LINUX)}
  1704. glXGetProcAddress := glbGetProcAddress('glXGetProcAddress');
  1705. glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB');
  1706. {$IFEND}
  1707. glEnable := glbGetProcAddress('glEnable');
  1708. glDisable := glbGetProcAddress('glDisable');
  1709. glGetString := glbGetProcAddress('glGetString');
  1710. glGetIntegerv := glbGetProcAddress('glGetIntegerv');
  1711. glTexParameteri := glbGetProcAddress('glTexParameteri');
  1712. glTexParameteriv := glbGetProcAddress('glTexParameteriv');
  1713. glTexParameterfv := glbGetProcAddress('glTexParameterfv');
  1714. glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
  1715. glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
  1716. glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
  1717. glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
  1718. glTexGeni := glbGetProcAddress('glTexGeni');
  1719. glGenTextures := glbGetProcAddress('glGenTextures');
  1720. glBindTexture := glbGetProcAddress('glBindTexture');
  1721. glDeleteTextures := glbGetProcAddress('glDeleteTextures');
  1722. glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
  1723. glReadPixels := glbGetProcAddress('glReadPixels');
  1724. glPixelStorei := glbGetProcAddress('glPixelStorei');
  1725. glTexImage1D := glbGetProcAddress('glTexImage1D');
  1726. glTexImage2D := glbGetProcAddress('glTexImage2D');
  1727. glGetTexImage := glbGetProcAddress('glGetTexImage');
  1728. gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
  1729. gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
  1730. end;
  1731. {$ENDIF}
  1732. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1733. procedure glbReadOpenGLExtensions;
  1734. var
  1735. Buffer: AnsiString;
  1736. MajorVersion, MinorVersion: Integer;
  1737. ///////////////////////////////////////////////////////////////////////////////////////////
  1738. procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
  1739. var
  1740. Separator: Integer;
  1741. begin
  1742. aMinor := 0;
  1743. aMajor := 0;
  1744. Separator := Pos(AnsiString('.'), aBuffer);
  1745. if (Separator > 1) and (Separator < Length(aBuffer)) and
  1746. (aBuffer[Separator - 1] in ['0'..'9']) and
  1747. (aBuffer[Separator + 1] in ['0'..'9']) then begin
  1748. Dec(Separator);
  1749. while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
  1750. Dec(Separator);
  1751. Delete(aBuffer, 1, Separator);
  1752. Separator := Pos(AnsiString('.'), aBuffer) + 1;
  1753. while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
  1754. Inc(Separator);
  1755. Delete(aBuffer, Separator, 255);
  1756. Separator := Pos(AnsiString('.'), aBuffer);
  1757. aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
  1758. aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
  1759. end;
  1760. end;
  1761. ///////////////////////////////////////////////////////////////////////////////////////////
  1762. function CheckExtension(const Extension: AnsiString): Boolean;
  1763. var
  1764. ExtPos: Integer;
  1765. begin
  1766. ExtPos := Pos(Extension, Buffer);
  1767. result := ExtPos > 0;
  1768. if result then
  1769. result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
  1770. end;
  1771. ///////////////////////////////////////////////////////////////////////////////////////////
  1772. function CheckVersion(const aMajor, aMinor: Integer): Boolean;
  1773. begin
  1774. result := (MajorVersion > aMajor) or ((MajorVersion = aMajor) and (MinorVersion >= aMinor));
  1775. end;
  1776. begin
  1777. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  1778. InitOpenGLCS.Enter;
  1779. try
  1780. if not OpenGLInitialized then begin
  1781. glbInitOpenGL;
  1782. OpenGLInitialized := true;
  1783. end;
  1784. finally
  1785. InitOpenGLCS.Leave;
  1786. end;
  1787. {$ENDIF}
  1788. // Version
  1789. Buffer := glGetString(GL_VERSION);
  1790. TrimVersionString(Buffer, MajorVersion, MinorVersion);
  1791. GL_VERSION_1_2 := CheckVersion(1, 2);
  1792. GL_VERSION_1_3 := CheckVersion(1, 3);
  1793. GL_VERSION_1_4 := CheckVersion(1, 4);
  1794. GL_VERSION_2_0 := CheckVersion(2, 0);
  1795. GL_VERSION_3_3 := CheckVersion(3, 3);
  1796. // Extensions
  1797. Buffer := glGetString(GL_EXTENSIONS);
  1798. GL_ARB_texture_border_clamp := CheckExtension('GL_ARB_texture_border_clamp');
  1799. GL_ARB_texture_non_power_of_two := CheckExtension('GL_ARB_texture_non_power_of_two');
  1800. GL_ARB_texture_swizzle := CheckExtension('GL_ARB_texture_swizzle');
  1801. GL_ARB_texture_cube_map := CheckExtension('GL_ARB_texture_cube_map');
  1802. GL_ARB_texture_rectangle := CheckExtension('GL_ARB_texture_rectangle');
  1803. GL_ARB_texture_mirrored_repeat := CheckExtension('GL_ARB_texture_mirrored_repeat');
  1804. GL_EXT_texture_edge_clamp := CheckExtension('GL_EXT_texture_edge_clamp');
  1805. GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
  1806. GL_EXT_texture_rectangle := CheckExtension('GL_EXT_texture_rectangle');
  1807. GL_EXT_texture_swizzle := CheckExtension('GL_EXT_texture_swizzle');
  1808. GL_EXT_texture_cube_map := CheckExtension('GL_EXT_texture_cube_map');
  1809. GL_NV_texture_rectangle := CheckExtension('GL_NV_texture_rectangle');
  1810. GL_IBM_texture_mirrored_repeat := CheckExtension('GL_IBM_texture_mirrored_repeat');
  1811. GL_SGIS_generate_mipmap := CheckExtension('GL_SGIS_generate_mipmap');
  1812. if GL_VERSION_1_3 then begin
  1813. glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1D');
  1814. glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2D');
  1815. glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
  1816. end else begin
  1817. glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1DARB', nil, false);
  1818. glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2DARB', nil, false);
  1819. glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB', nil, false);
  1820. end;
  1821. end;
  1822. {$ENDIF}
  1823. {$IFDEF GLB_SDL_IMAGE}
  1824. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1825. // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1826. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1827. function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
  1828. begin
  1829. result := TStream(context^.unknown.data1).Seek(offset, whence);
  1830. end;
  1831. function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
  1832. begin
  1833. result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
  1834. end;
  1835. function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
  1836. begin
  1837. result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
  1838. end;
  1839. function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
  1840. begin
  1841. result := 0;
  1842. end;
  1843. function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
  1844. begin
  1845. result := SDL_AllocRW;
  1846. if result = nil then
  1847. raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
  1848. result^.seek := glBitmapRWseek;
  1849. result^.read := glBitmapRWread;
  1850. result^.write := glBitmapRWwrite;
  1851. result^.close := glBitmapRWclose;
  1852. result^.unknown.data1 := Stream;
  1853. end;
  1854. {$ENDIF}
  1855. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1856. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1857. begin
  1858. glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
  1859. end;
  1860. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1861. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1862. begin
  1863. glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
  1864. end;
  1865. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1866. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1867. begin
  1868. glBitmapDefaultMipmap := aValue;
  1869. end;
  1870. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1871. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1872. begin
  1873. glBitmapDefaultFormat := aFormat;
  1874. end;
  1875. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1876. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1877. begin
  1878. glBitmapDefaultFilterMin := aMin;
  1879. glBitmapDefaultFilterMag := aMag;
  1880. end;
  1881. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1882. procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
  1883. begin
  1884. glBitmapDefaultWrapS := S;
  1885. glBitmapDefaultWrapT := T;
  1886. glBitmapDefaultWrapR := R;
  1887. end;
  1888. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1889. procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
  1890. begin
  1891. glDefaultSwizzle[0] := r;
  1892. glDefaultSwizzle[1] := g;
  1893. glDefaultSwizzle[2] := b;
  1894. glDefaultSwizzle[3] := a;
  1895. end;
  1896. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1897. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1898. begin
  1899. result := glBitmapDefaultDeleteTextureOnFree;
  1900. end;
  1901. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1902. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1903. begin
  1904. result := glBitmapDefaultFreeDataAfterGenTextures;
  1905. end;
  1906. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1907. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1908. begin
  1909. result := glBitmapDefaultMipmap;
  1910. end;
  1911. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1912. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1913. begin
  1914. result := glBitmapDefaultFormat;
  1915. end;
  1916. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1917. procedure glBitmapGetDefaultFilter(var aMin, aMag: GLenum);
  1918. begin
  1919. aMin := glBitmapDefaultFilterMin;
  1920. aMag := glBitmapDefaultFilterMag;
  1921. end;
  1922. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1923. procedure glBitmapGetDefaultTextureWrap(var S, T, R: GLenum);
  1924. begin
  1925. S := glBitmapDefaultWrapS;
  1926. T := glBitmapDefaultWrapT;
  1927. R := glBitmapDefaultWrapR;
  1928. end;
  1929. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1930. procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
  1931. begin
  1932. r := glDefaultSwizzle[0];
  1933. g := glDefaultSwizzle[1];
  1934. b := glDefaultSwizzle[2];
  1935. a := glDefaultSwizzle[3];
  1936. end;
  1937. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1938. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1939. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1940. function TFormatDescriptor.GetRedMask: QWord;
  1941. begin
  1942. result := fRange.r shl fShift.r;
  1943. end;
  1944. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1945. function TFormatDescriptor.GetGreenMask: QWord;
  1946. begin
  1947. result := fRange.g shl fShift.g;
  1948. end;
  1949. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1950. function TFormatDescriptor.GetBlueMask: QWord;
  1951. begin
  1952. result := fRange.b shl fShift.b;
  1953. end;
  1954. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1955. function TFormatDescriptor.GetAlphaMask: QWord;
  1956. begin
  1957. result := fRange.a shl fShift.a;
  1958. end;
  1959. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1960. function TFormatDescriptor.GetIsCompressed: Boolean;
  1961. begin
  1962. result := fIsCompressed;
  1963. end;
  1964. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1965. function TFormatDescriptor.GetHasRed: Boolean;
  1966. begin
  1967. result := (fRange.r > 0);
  1968. end;
  1969. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1970. function TFormatDescriptor.GetHasGreen: Boolean;
  1971. begin
  1972. result := (fRange.g > 0);
  1973. end;
  1974. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1975. function TFormatDescriptor.GetHasBlue: Boolean;
  1976. begin
  1977. result := (fRange.b > 0);
  1978. end;
  1979. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1980. function TFormatDescriptor.GetHasAlpha: Boolean;
  1981. begin
  1982. result := (fRange.a > 0);
  1983. end;
  1984. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1985. function TFormatDescriptor.GetglFormat: GLenum;
  1986. begin
  1987. result := fglFormat;
  1988. end;
  1989. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1990. function TFormatDescriptor.GetglInternalFormat: GLenum;
  1991. begin
  1992. result := fglInternalFormat;
  1993. end;
  1994. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1995. function TFormatDescriptor.GetglDataFormat: GLenum;
  1996. begin
  1997. result := fglDataFormat;
  1998. end;
  1999. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2000. function TFormatDescriptor.GetComponents: Integer;
  2001. var
  2002. i: Integer;
  2003. begin
  2004. result := 0;
  2005. for i := 0 to 3 do
  2006. if (fRange.arr[i] > 0) then
  2007. inc(result);
  2008. end;
  2009. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2010. function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
  2011. var
  2012. w, h: Integer;
  2013. begin
  2014. if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
  2015. w := Max(1, aSize.X);
  2016. h := Max(1, aSize.Y);
  2017. result := GetSize(w, h);
  2018. end else
  2019. result := 0;
  2020. end;
  2021. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2022. function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
  2023. begin
  2024. result := 0;
  2025. if (aWidth <= 0) or (aHeight <= 0) then
  2026. exit;
  2027. result := Ceil(aWidth * aHeight * fPixelSize);
  2028. end;
  2029. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2030. function TFormatDescriptor.CreateMappingData: Pointer;
  2031. begin
  2032. result := nil;
  2033. end;
  2034. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2035. procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
  2036. begin
  2037. //DUMMY
  2038. end;
  2039. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2040. function TFormatDescriptor.IsEmpty: Boolean;
  2041. begin
  2042. result := (fFormat = tfEmpty);
  2043. end;
  2044. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2045. function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean;
  2046. begin
  2047. result := false;
  2048. if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
  2049. raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
  2050. if (aRedMask <> RedMask) then
  2051. exit;
  2052. if (aGreenMask <> GreenMask) then
  2053. exit;
  2054. if (aBlueMask <> BlueMask) then
  2055. exit;
  2056. if (aAlphaMask <> AlphaMask) then
  2057. exit;
  2058. result := true;
  2059. end;
  2060. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2061. procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
  2062. begin
  2063. FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
  2064. aPixel.Data := fRange;
  2065. aPixel.Range := fRange;
  2066. aPixel.Format := fFormat;
  2067. end;
  2068. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2069. constructor TFormatDescriptor.Create;
  2070. begin
  2071. inherited Create;
  2072. fFormat := tfEmpty;
  2073. fWithAlpha := tfEmpty;
  2074. fWithoutAlpha := tfEmpty;
  2075. fRGBInverted := tfEmpty;
  2076. fUncompressed := tfEmpty;
  2077. fPixelSize := 0.0;
  2078. fIsCompressed := false;
  2079. fglFormat := 0;
  2080. fglInternalFormat := 0;
  2081. fglDataFormat := 0;
  2082. FillChar(fRange, 0, SizeOf(fRange));
  2083. FillChar(fShift, 0, SizeOf(fShift));
  2084. end;
  2085. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2086. //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2087. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2088. procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2089. begin
  2090. aData^ := aPixel.Data.a;
  2091. inc(aData);
  2092. end;
  2093. procedure TfdAlpha_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2094. begin
  2095. aPixel.Data.r := 0;
  2096. aPixel.Data.g := 0;
  2097. aPixel.Data.b := 0;
  2098. aPixel.Data.a := aData^;
  2099. inc(aData);
  2100. end;
  2101. constructor TfdAlpha_UB1.Create;
  2102. begin
  2103. inherited Create;
  2104. fPixelSize := 1.0;
  2105. fRange.a := $FF;
  2106. fglFormat := GL_ALPHA;
  2107. fglDataFormat := GL_UNSIGNED_BYTE;
  2108. end;
  2109. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2110. //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2111. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2112. procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2113. begin
  2114. aData^ := LuminanceWeight(aPixel);
  2115. inc(aData);
  2116. end;
  2117. procedure TfdLuminance_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2118. begin
  2119. aPixel.Data.r := aData^;
  2120. aPixel.Data.g := aData^;
  2121. aPixel.Data.b := aData^;
  2122. aPixel.Data.a := 0;
  2123. inc(aData);
  2124. end;
  2125. constructor TfdLuminance_UB1.Create;
  2126. begin
  2127. inherited Create;
  2128. fPixelSize := 1.0;
  2129. fRange.r := $FF;
  2130. fRange.g := $FF;
  2131. fRange.b := $FF;
  2132. fglFormat := GL_LUMINANCE;
  2133. fglDataFormat := GL_UNSIGNED_BYTE;
  2134. end;
  2135. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2136. //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2137. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2138. procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2139. var
  2140. i: Integer;
  2141. begin
  2142. aData^ := 0;
  2143. for i := 0 to 3 do
  2144. if (fRange.arr[i] > 0) then
  2145. aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2146. inc(aData);
  2147. end;
  2148. procedure TfdUniversal_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2149. var
  2150. i: Integer;
  2151. begin
  2152. for i := 0 to 3 do
  2153. aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
  2154. inc(aData);
  2155. end;
  2156. constructor TfdUniversal_UB1.Create;
  2157. begin
  2158. inherited Create;
  2159. fPixelSize := 1.0;
  2160. end;
  2161. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2162. //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2163. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2164. procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2165. begin
  2166. inherited Map(aPixel, aData, aMapData);
  2167. aData^ := aPixel.Data.a;
  2168. inc(aData);
  2169. end;
  2170. procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2171. begin
  2172. inherited Unmap(aData, aPixel, aMapData);
  2173. aPixel.Data.a := aData^;
  2174. inc(aData);
  2175. end;
  2176. constructor TfdLuminanceAlpha_UB2.Create;
  2177. begin
  2178. inherited Create;
  2179. fPixelSize := 2.0;
  2180. fRange.a := $FF;
  2181. fShift.a := 8;
  2182. fglFormat := GL_LUMINANCE_ALPHA;
  2183. fglDataFormat := GL_UNSIGNED_BYTE;
  2184. end;
  2185. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2186. //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2187. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2188. procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2189. begin
  2190. aData^ := aPixel.Data.r;
  2191. inc(aData);
  2192. aData^ := aPixel.Data.g;
  2193. inc(aData);
  2194. aData^ := aPixel.Data.b;
  2195. inc(aData);
  2196. end;
  2197. procedure TfdRGB_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2198. begin
  2199. aPixel.Data.r := aData^;
  2200. inc(aData);
  2201. aPixel.Data.g := aData^;
  2202. inc(aData);
  2203. aPixel.Data.b := aData^;
  2204. inc(aData);
  2205. aPixel.Data.a := 0;
  2206. end;
  2207. constructor TfdRGB_UB3.Create;
  2208. begin
  2209. inherited Create;
  2210. fPixelSize := 3.0;
  2211. fRange.r := $FF;
  2212. fRange.g := $FF;
  2213. fRange.b := $FF;
  2214. fShift.r := 0;
  2215. fShift.g := 8;
  2216. fShift.b := 16;
  2217. fglFormat := GL_RGB;
  2218. fglDataFormat := GL_UNSIGNED_BYTE;
  2219. end;
  2220. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2221. //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2222. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2223. procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2224. begin
  2225. aData^ := aPixel.Data.b;
  2226. inc(aData);
  2227. aData^ := aPixel.Data.g;
  2228. inc(aData);
  2229. aData^ := aPixel.Data.r;
  2230. inc(aData);
  2231. end;
  2232. procedure TfdBGR_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2233. begin
  2234. aPixel.Data.b := aData^;
  2235. inc(aData);
  2236. aPixel.Data.g := aData^;
  2237. inc(aData);
  2238. aPixel.Data.r := aData^;
  2239. inc(aData);
  2240. aPixel.Data.a := 0;
  2241. end;
  2242. constructor TfdBGR_UB3.Create;
  2243. begin
  2244. fPixelSize := 3.0;
  2245. fRange.r := $FF;
  2246. fRange.g := $FF;
  2247. fRange.b := $FF;
  2248. fShift.r := 16;
  2249. fShift.g := 8;
  2250. fShift.b := 0;
  2251. fglFormat := GL_BGR;
  2252. fglDataFormat := GL_UNSIGNED_BYTE;
  2253. end;
  2254. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2255. //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2256. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2257. procedure TfdRGBA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2258. begin
  2259. inherited Map(aPixel, aData, aMapData);
  2260. aData^ := aPixel.Data.a;
  2261. inc(aData);
  2262. end;
  2263. procedure TfdRGBA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2264. begin
  2265. inherited Unmap(aData, aPixel, aMapData);
  2266. aPixel.Data.a := aData^;
  2267. inc(aData);
  2268. end;
  2269. constructor TfdRGBA_UB4.Create;
  2270. begin
  2271. inherited Create;
  2272. fPixelSize := 4.0;
  2273. fRange.a := $FF;
  2274. fShift.a := 24;
  2275. fglFormat := GL_RGBA;
  2276. fglDataFormat := GL_UNSIGNED_BYTE;
  2277. end;
  2278. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2279. //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2280. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2281. procedure TfdBGRA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2282. begin
  2283. inherited Map(aPixel, aData, aMapData);
  2284. aData^ := aPixel.Data.a;
  2285. inc(aData);
  2286. end;
  2287. procedure TfdBGRA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2288. begin
  2289. inherited Unmap(aData, aPixel, aMapData);
  2290. aPixel.Data.a := aData^;
  2291. inc(aData);
  2292. end;
  2293. constructor TfdBGRA_UB4.Create;
  2294. begin
  2295. inherited Create;
  2296. fPixelSize := 4.0;
  2297. fRange.a := $FF;
  2298. fShift.a := 24;
  2299. fglFormat := GL_BGRA;
  2300. fglDataFormat := GL_UNSIGNED_BYTE;
  2301. end;
  2302. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2303. //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2304. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2305. procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2306. begin
  2307. PWord(aData)^ := aPixel.Data.a;
  2308. inc(aData, 2);
  2309. end;
  2310. procedure TfdAlpha_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2311. begin
  2312. aPixel.Data.r := 0;
  2313. aPixel.Data.g := 0;
  2314. aPixel.Data.b := 0;
  2315. aPixel.Data.a := PWord(aData)^;
  2316. inc(aData, 2);
  2317. end;
  2318. constructor TfdAlpha_US1.Create;
  2319. begin
  2320. inherited Create;
  2321. fPixelSize := 2.0;
  2322. fRange.a := $FFFF;
  2323. fglFormat := GL_ALPHA;
  2324. fglDataFormat := GL_UNSIGNED_SHORT;
  2325. end;
  2326. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2327. //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2328. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2329. procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2330. begin
  2331. PWord(aData)^ := LuminanceWeight(aPixel);
  2332. inc(aData, 2);
  2333. end;
  2334. procedure TfdLuminance_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2335. begin
  2336. aPixel.Data.r := PWord(aData)^;
  2337. aPixel.Data.g := PWord(aData)^;
  2338. aPixel.Data.b := PWord(aData)^;
  2339. aPixel.Data.a := 0;
  2340. inc(aData, 2);
  2341. end;
  2342. constructor TfdLuminance_US1.Create;
  2343. begin
  2344. inherited Create;
  2345. fPixelSize := 2.0;
  2346. fRange.r := $FFFF;
  2347. fRange.g := $FFFF;
  2348. fRange.b := $FFFF;
  2349. fglFormat := GL_LUMINANCE;
  2350. fglDataFormat := GL_UNSIGNED_SHORT;
  2351. end;
  2352. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2353. //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2354. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2355. procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2356. var
  2357. i: Integer;
  2358. begin
  2359. PWord(aData)^ := 0;
  2360. for i := 0 to 3 do
  2361. if (fRange.arr[i] > 0) then
  2362. PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2363. inc(aData, 2);
  2364. end;
  2365. procedure TfdUniversal_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2366. var
  2367. i: Integer;
  2368. begin
  2369. for i := 0 to 3 do
  2370. aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
  2371. inc(aData, 2);
  2372. end;
  2373. constructor TfdUniversal_US1.Create;
  2374. begin
  2375. inherited Create;
  2376. fPixelSize := 2.0;
  2377. end;
  2378. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2379. //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2380. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2381. procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2382. begin
  2383. PWord(aData)^ := DepthWeight(aPixel);
  2384. inc(aData, 2);
  2385. end;
  2386. procedure TfdDepth_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2387. begin
  2388. aPixel.Data.r := PWord(aData)^;
  2389. aPixel.Data.g := PWord(aData)^;
  2390. aPixel.Data.b := PWord(aData)^;
  2391. aPixel.Data.a := 0;
  2392. inc(aData, 2);
  2393. end;
  2394. constructor TfdDepth_US1.Create;
  2395. begin
  2396. inherited Create;
  2397. fPixelSize := 2.0;
  2398. fRange.r := $FFFF;
  2399. fRange.g := $FFFF;
  2400. fRange.b := $FFFF;
  2401. fglFormat := GL_DEPTH_COMPONENT;
  2402. fglDataFormat := GL_UNSIGNED_SHORT;
  2403. end;
  2404. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2405. //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2406. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2407. procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2408. begin
  2409. inherited Map(aPixel, aData, aMapData);
  2410. PWord(aData)^ := aPixel.Data.a;
  2411. inc(aData, 2);
  2412. end;
  2413. procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2414. begin
  2415. inherited Unmap(aData, aPixel, aMapData);
  2416. aPixel.Data.a := PWord(aData)^;
  2417. inc(aData, 2);
  2418. end;
  2419. constructor TfdLuminanceAlpha_US2.Create;
  2420. begin
  2421. inherited Create;
  2422. fPixelSize := 4.0;
  2423. fRange.a := $FFFF;
  2424. fShift.a := 16;
  2425. fglFormat := GL_LUMINANCE_ALPHA;
  2426. fglDataFormat := GL_UNSIGNED_SHORT;
  2427. end;
  2428. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2429. //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2430. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2431. procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2432. begin
  2433. PWord(aData)^ := aPixel.Data.r;
  2434. inc(aData, 2);
  2435. PWord(aData)^ := aPixel.Data.g;
  2436. inc(aData, 2);
  2437. PWord(aData)^ := aPixel.Data.b;
  2438. inc(aData, 2);
  2439. end;
  2440. procedure TfdRGB_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2441. begin
  2442. aPixel.Data.r := PWord(aData)^;
  2443. inc(aData, 2);
  2444. aPixel.Data.g := PWord(aData)^;
  2445. inc(aData, 2);
  2446. aPixel.Data.b := PWord(aData)^;
  2447. inc(aData, 2);
  2448. aPixel.Data.a := 0;
  2449. end;
  2450. constructor TfdRGB_US3.Create;
  2451. begin
  2452. inherited Create;
  2453. fPixelSize := 6.0;
  2454. fRange.r := $FFFF;
  2455. fRange.g := $FFFF;
  2456. fRange.b := $FFFF;
  2457. fShift.r := 0;
  2458. fShift.g := 16;
  2459. fShift.b := 32;
  2460. fglFormat := GL_RGB;
  2461. fglDataFormat := GL_UNSIGNED_SHORT;
  2462. end;
  2463. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2464. //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2465. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2466. procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2467. begin
  2468. PWord(aData)^ := aPixel.Data.b;
  2469. inc(aData, 2);
  2470. PWord(aData)^ := aPixel.Data.g;
  2471. inc(aData, 2);
  2472. PWord(aData)^ := aPixel.Data.r;
  2473. inc(aData, 2);
  2474. end;
  2475. procedure TfdBGR_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2476. begin
  2477. aPixel.Data.b := PWord(aData)^;
  2478. inc(aData, 2);
  2479. aPixel.Data.g := PWord(aData)^;
  2480. inc(aData, 2);
  2481. aPixel.Data.r := PWord(aData)^;
  2482. inc(aData, 2);
  2483. aPixel.Data.a := 0;
  2484. end;
  2485. constructor TfdBGR_US3.Create;
  2486. begin
  2487. inherited Create;
  2488. fPixelSize := 6.0;
  2489. fRange.r := $FFFF;
  2490. fRange.g := $FFFF;
  2491. fRange.b := $FFFF;
  2492. fShift.r := 32;
  2493. fShift.g := 16;
  2494. fShift.b := 0;
  2495. fglFormat := GL_BGR;
  2496. fglDataFormat := GL_UNSIGNED_SHORT;
  2497. end;
  2498. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2499. //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2500. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2501. procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2502. begin
  2503. inherited Map(aPixel, aData, aMapData);
  2504. PWord(aData)^ := aPixel.Data.a;
  2505. inc(aData, 2);
  2506. end;
  2507. procedure TfdRGBA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2508. begin
  2509. inherited Unmap(aData, aPixel, aMapData);
  2510. aPixel.Data.a := PWord(aData)^;
  2511. inc(aData, 2);
  2512. end;
  2513. constructor TfdRGBA_US4.Create;
  2514. begin
  2515. inherited Create;
  2516. fPixelSize := 8.0;
  2517. fRange.a := $FFFF;
  2518. fShift.a := 48;
  2519. fglFormat := GL_RGBA;
  2520. fglDataFormat := GL_UNSIGNED_SHORT;
  2521. end;
  2522. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2523. //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2524. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2525. procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2526. begin
  2527. inherited Map(aPixel, aData, aMapData);
  2528. PWord(aData)^ := aPixel.Data.a;
  2529. inc(aData, 2);
  2530. end;
  2531. procedure TfdBGRA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2532. begin
  2533. inherited Unmap(aData, aPixel, aMapData);
  2534. aPixel.Data.a := PWord(aData)^;
  2535. inc(aData, 2);
  2536. end;
  2537. constructor TfdBGRA_US4.Create;
  2538. begin
  2539. inherited Create;
  2540. fPixelSize := 8.0;
  2541. fRange.a := $FFFF;
  2542. fShift.a := 48;
  2543. fglFormat := GL_BGRA;
  2544. fglDataFormat := GL_UNSIGNED_SHORT;
  2545. end;
  2546. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2547. //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2548. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2549. procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2550. var
  2551. i: Integer;
  2552. begin
  2553. PCardinal(aData)^ := 0;
  2554. for i := 0 to 3 do
  2555. if (fRange.arr[i] > 0) then
  2556. PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2557. inc(aData, 4);
  2558. end;
  2559. procedure TfdUniversal_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2560. var
  2561. i: Integer;
  2562. begin
  2563. for i := 0 to 3 do
  2564. aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
  2565. inc(aData, 2);
  2566. end;
  2567. constructor TfdUniversal_UI1.Create;
  2568. begin
  2569. inherited Create;
  2570. fPixelSize := 4.0;
  2571. end;
  2572. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2573. //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2574. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2575. procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2576. begin
  2577. PCardinal(aData)^ := DepthWeight(aPixel);
  2578. inc(aData, 4);
  2579. end;
  2580. procedure TfdDepth_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2581. begin
  2582. aPixel.Data.r := PCardinal(aData)^;
  2583. aPixel.Data.g := PCardinal(aData)^;
  2584. aPixel.Data.b := PCardinal(aData)^;
  2585. aPixel.Data.a := 0;
  2586. inc(aData, 4);
  2587. end;
  2588. constructor TfdDepth_UI1.Create;
  2589. begin
  2590. inherited Create;
  2591. fPixelSize := 4.0;
  2592. fRange.r := $FFFFFFFF;
  2593. fRange.g := $FFFFFFFF;
  2594. fRange.b := $FFFFFFFF;
  2595. fglFormat := GL_DEPTH_COMPONENT;
  2596. fglDataFormat := GL_UNSIGNED_INT;
  2597. end;
  2598. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2599. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2600. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2601. constructor TfdAlpha4.Create;
  2602. begin
  2603. inherited Create;
  2604. fFormat := tfAlpha4;
  2605. fWithAlpha := tfAlpha4;
  2606. fglInternalFormat := GL_ALPHA4;
  2607. end;
  2608. constructor TfdAlpha8.Create;
  2609. begin
  2610. inherited Create;
  2611. fFormat := tfAlpha8;
  2612. fWithAlpha := tfAlpha8;
  2613. fglInternalFormat := GL_ALPHA8;
  2614. end;
  2615. constructor TfdAlpha12.Create;
  2616. begin
  2617. inherited Create;
  2618. fFormat := tfAlpha12;
  2619. fWithAlpha := tfAlpha12;
  2620. fglInternalFormat := GL_ALPHA12;
  2621. end;
  2622. constructor TfdAlpha16.Create;
  2623. begin
  2624. inherited Create;
  2625. fFormat := tfAlpha16;
  2626. fWithAlpha := tfAlpha16;
  2627. fglInternalFormat := GL_ALPHA16;
  2628. end;
  2629. constructor TfdLuminance4.Create;
  2630. begin
  2631. inherited Create;
  2632. fFormat := tfLuminance4;
  2633. fWithAlpha := tfLuminance4Alpha4;
  2634. fWithoutAlpha := tfLuminance4;
  2635. fglInternalFormat := GL_LUMINANCE4;
  2636. end;
  2637. constructor TfdLuminance8.Create;
  2638. begin
  2639. inherited Create;
  2640. fFormat := tfLuminance8;
  2641. fWithAlpha := tfLuminance8Alpha8;
  2642. fWithoutAlpha := tfLuminance8;
  2643. fglInternalFormat := GL_LUMINANCE8;
  2644. end;
  2645. constructor TfdLuminance12.Create;
  2646. begin
  2647. inherited Create;
  2648. fFormat := tfLuminance12;
  2649. fWithAlpha := tfLuminance12Alpha12;
  2650. fWithoutAlpha := tfLuminance12;
  2651. fglInternalFormat := GL_LUMINANCE12;
  2652. end;
  2653. constructor TfdLuminance16.Create;
  2654. begin
  2655. inherited Create;
  2656. fFormat := tfLuminance16;
  2657. fWithAlpha := tfLuminance16Alpha16;
  2658. fWithoutAlpha := tfLuminance16;
  2659. fglInternalFormat := GL_LUMINANCE16;
  2660. end;
  2661. constructor TfdLuminance4Alpha4.Create;
  2662. begin
  2663. inherited Create;
  2664. fFormat := tfLuminance4Alpha4;
  2665. fWithAlpha := tfLuminance4Alpha4;
  2666. fWithoutAlpha := tfLuminance4;
  2667. fglInternalFormat := GL_LUMINANCE4_ALPHA4;
  2668. end;
  2669. constructor TfdLuminance6Alpha2.Create;
  2670. begin
  2671. inherited Create;
  2672. fFormat := tfLuminance6Alpha2;
  2673. fWithAlpha := tfLuminance6Alpha2;
  2674. fWithoutAlpha := tfLuminance8;
  2675. fglInternalFormat := GL_LUMINANCE6_ALPHA2;
  2676. end;
  2677. constructor TfdLuminance8Alpha8.Create;
  2678. begin
  2679. inherited Create;
  2680. fFormat := tfLuminance8Alpha8;
  2681. fWithAlpha := tfLuminance8Alpha8;
  2682. fWithoutAlpha := tfLuminance8;
  2683. fglInternalFormat := GL_LUMINANCE8_ALPHA8;
  2684. end;
  2685. constructor TfdLuminance12Alpha4.Create;
  2686. begin
  2687. inherited Create;
  2688. fFormat := tfLuminance12Alpha4;
  2689. fWithAlpha := tfLuminance12Alpha4;
  2690. fWithoutAlpha := tfLuminance12;
  2691. fglInternalFormat := GL_LUMINANCE12_ALPHA4;
  2692. end;
  2693. constructor TfdLuminance12Alpha12.Create;
  2694. begin
  2695. inherited Create;
  2696. fFormat := tfLuminance12Alpha12;
  2697. fWithAlpha := tfLuminance12Alpha12;
  2698. fWithoutAlpha := tfLuminance12;
  2699. fglInternalFormat := GL_LUMINANCE12_ALPHA12;
  2700. end;
  2701. constructor TfdLuminance16Alpha16.Create;
  2702. begin
  2703. inherited Create;
  2704. fFormat := tfLuminance16Alpha16;
  2705. fWithAlpha := tfLuminance16Alpha16;
  2706. fWithoutAlpha := tfLuminance16;
  2707. fglInternalFormat := GL_LUMINANCE16_ALPHA16;
  2708. end;
  2709. constructor TfdR3G3B2.Create;
  2710. begin
  2711. inherited Create;
  2712. fFormat := tfR3G3B2;
  2713. fWithAlpha := tfRGBA2;
  2714. fWithoutAlpha := tfR3G3B2;
  2715. fRange.r := $7;
  2716. fRange.g := $7;
  2717. fRange.b := $3;
  2718. fShift.r := 0;
  2719. fShift.g := 3;
  2720. fShift.b := 6;
  2721. fglFormat := GL_RGB;
  2722. fglInternalFormat := GL_R3_G3_B2;
  2723. fglDataFormat := GL_UNSIGNED_BYTE_2_3_3_REV;
  2724. end;
  2725. constructor TfdRGB4.Create;
  2726. begin
  2727. inherited Create;
  2728. fFormat := tfRGB4;
  2729. fWithAlpha := tfRGBA4;
  2730. fWithoutAlpha := tfRGB4;
  2731. fRGBInverted := tfBGR4;
  2732. fRange.r := $F;
  2733. fRange.g := $F;
  2734. fRange.b := $F;
  2735. fShift.r := 0;
  2736. fShift.g := 4;
  2737. fShift.b := 8;
  2738. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2739. fglInternalFormat := GL_RGB4;
  2740. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2741. end;
  2742. constructor TfdR5G6B5.Create;
  2743. begin
  2744. inherited Create;
  2745. fFormat := tfR5G6B5;
  2746. fWithAlpha := tfRGBA4;
  2747. fWithoutAlpha := tfR5G6B5;
  2748. fRGBInverted := tfB5G6R5;
  2749. fRange.r := $1F;
  2750. fRange.g := $3F;
  2751. fRange.b := $1F;
  2752. fShift.r := 0;
  2753. fShift.g := 5;
  2754. fShift.b := 11;
  2755. fglFormat := GL_RGB;
  2756. fglInternalFormat := GL_RGB565;
  2757. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5_REV;
  2758. end;
  2759. constructor TfdRGB5.Create;
  2760. begin
  2761. inherited Create;
  2762. fFormat := tfRGB5;
  2763. fWithAlpha := tfRGB5A1;
  2764. fWithoutAlpha := tfRGB5;
  2765. fRGBInverted := tfBGR5;
  2766. fRange.r := $1F;
  2767. fRange.g := $1F;
  2768. fRange.b := $1F;
  2769. fShift.r := 0;
  2770. fShift.g := 5;
  2771. fShift.b := 10;
  2772. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2773. fglInternalFormat := GL_RGB5;
  2774. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2775. end;
  2776. constructor TfdRGB8.Create;
  2777. begin
  2778. inherited Create;
  2779. fFormat := tfRGB8;
  2780. fWithAlpha := tfRGBA8;
  2781. fWithoutAlpha := tfRGB8;
  2782. fRGBInverted := tfBGR8;
  2783. fglInternalFormat := GL_RGB8;
  2784. end;
  2785. constructor TfdRGB10.Create;
  2786. begin
  2787. inherited Create;
  2788. fFormat := tfRGB10;
  2789. fWithAlpha := tfRGB10A2;
  2790. fWithoutAlpha := tfRGB10;
  2791. fRGBInverted := tfBGR10;
  2792. fRange.r := $3FF;
  2793. fRange.g := $3FF;
  2794. fRange.b := $3FF;
  2795. fShift.r := 0;
  2796. fShift.g := 10;
  2797. fShift.b := 20;
  2798. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2799. fglInternalFormat := GL_RGB10;
  2800. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2801. end;
  2802. constructor TfdRGB12.Create;
  2803. begin
  2804. inherited Create;
  2805. fFormat := tfRGB12;
  2806. fWithAlpha := tfRGBA12;
  2807. fWithoutAlpha := tfRGB12;
  2808. fRGBInverted := tfBGR12;
  2809. fglInternalFormat := GL_RGB12;
  2810. end;
  2811. constructor TfdRGB16.Create;
  2812. begin
  2813. inherited Create;
  2814. fFormat := tfRGB16;
  2815. fWithAlpha := tfRGBA16;
  2816. fWithoutAlpha := tfRGB16;
  2817. fRGBInverted := tfBGR16;
  2818. fglInternalFormat := GL_RGB16;
  2819. end;
  2820. constructor TfdRGBA2.Create;
  2821. begin
  2822. inherited Create;
  2823. fFormat := tfRGBA2;
  2824. fWithAlpha := tfRGBA2;
  2825. fWithoutAlpha := tfR3G3B2;
  2826. fRGBInverted := tfBGRA2;
  2827. fglInternalFormat := GL_RGBA2;
  2828. end;
  2829. constructor TfdRGBA4.Create;
  2830. begin
  2831. inherited Create;
  2832. fFormat := tfRGBA4;
  2833. fWithAlpha := tfRGBA4;
  2834. fWithoutAlpha := tfRGB4;
  2835. fRGBInverted := tfBGRA4;
  2836. fRange.r := $F;
  2837. fRange.g := $F;
  2838. fRange.b := $F;
  2839. fRange.a := $F;
  2840. fShift.r := 0;
  2841. fShift.g := 4;
  2842. fShift.b := 8;
  2843. fShift.a := 12;
  2844. fglFormat := GL_RGBA;
  2845. fglInternalFormat := GL_RGBA4;
  2846. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2847. end;
  2848. constructor TfdRGB5A1.Create;
  2849. begin
  2850. inherited Create;
  2851. fFormat := tfRGB5A1;
  2852. fWithAlpha := tfRGB5A1;
  2853. fWithoutAlpha := tfRGB5;
  2854. fRGBInverted := tfBGR5A1;
  2855. fRange.r := $1F;
  2856. fRange.g := $1F;
  2857. fRange.b := $1F;
  2858. fRange.a := $01;
  2859. fShift.r := 0;
  2860. fShift.g := 5;
  2861. fShift.b := 10;
  2862. fShift.a := 15;
  2863. fglFormat := GL_RGBA;
  2864. fglInternalFormat := GL_RGB5_A1;
  2865. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2866. end;
  2867. constructor TfdRGBA8.Create;
  2868. begin
  2869. inherited Create;
  2870. fFormat := tfRGBA8;
  2871. fWithAlpha := tfRGBA8;
  2872. fWithoutAlpha := tfRGB8;
  2873. fRGBInverted := tfBGRA8;
  2874. fglInternalFormat := GL_RGBA8;
  2875. end;
  2876. constructor TfdRGB10A2.Create;
  2877. begin
  2878. inherited Create;
  2879. fFormat := tfRGB10A2;
  2880. fWithAlpha := tfRGB10A2;
  2881. fWithoutAlpha := tfRGB10;
  2882. fRGBInverted := tfBGR10A2;
  2883. fRange.r := $3FF;
  2884. fRange.g := $3FF;
  2885. fRange.b := $3FF;
  2886. fRange.a := $003;
  2887. fShift.r := 0;
  2888. fShift.g := 10;
  2889. fShift.b := 20;
  2890. fShift.a := 30;
  2891. fglFormat := GL_RGBA;
  2892. fglInternalFormat := GL_RGB10_A2;
  2893. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2894. end;
  2895. constructor TfdRGBA12.Create;
  2896. begin
  2897. inherited Create;
  2898. fFormat := tfRGBA12;
  2899. fWithAlpha := tfRGBA12;
  2900. fWithoutAlpha := tfRGB12;
  2901. fRGBInverted := tfBGRA12;
  2902. fglInternalFormat := GL_RGBA12;
  2903. end;
  2904. constructor TfdRGBA16.Create;
  2905. begin
  2906. inherited Create;
  2907. fFormat := tfRGBA16;
  2908. fWithAlpha := tfRGBA16;
  2909. fWithoutAlpha := tfRGB16;
  2910. fRGBInverted := tfBGRA16;
  2911. fglInternalFormat := GL_RGBA16;
  2912. end;
  2913. constructor TfdBGR4.Create;
  2914. begin
  2915. inherited Create;
  2916. fPixelSize := 2.0;
  2917. fFormat := tfBGR4;
  2918. fWithAlpha := tfBGRA4;
  2919. fWithoutAlpha := tfBGR4;
  2920. fRGBInverted := tfRGB4;
  2921. fRange.r := $F;
  2922. fRange.g := $F;
  2923. fRange.b := $F;
  2924. fRange.a := $0;
  2925. fShift.r := 8;
  2926. fShift.g := 4;
  2927. fShift.b := 0;
  2928. fShift.a := 0;
  2929. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2930. fglInternalFormat := GL_RGB4;
  2931. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2932. end;
  2933. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2934. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2935. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2936. constructor TfdB5G6R5.Create;
  2937. begin
  2938. inherited Create;
  2939. fFormat := tfB5G6R5;
  2940. fWithAlpha := tfBGRA4;
  2941. fWithoutAlpha := tfB5G6R5;
  2942. fRGBInverted := tfR5G6B5;
  2943. fRange.r := $1F;
  2944. fRange.g := $3F;
  2945. fRange.b := $1F;
  2946. fShift.r := 11;
  2947. fShift.g := 5;
  2948. fShift.b := 0;
  2949. fglFormat := GL_RGB; //B5G6R5 is only possible as R5G6B5 -> use reverted dataformat
  2950. fglInternalFormat := GL_RGB8;
  2951. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5;
  2952. end;
  2953. constructor TfdBGR5.Create;
  2954. begin
  2955. inherited Create;
  2956. fPixelSize := 2.0;
  2957. fFormat := tfBGR5;
  2958. fWithAlpha := tfBGR5A1;
  2959. fWithoutAlpha := tfBGR5;
  2960. fRGBInverted := tfRGB5;
  2961. fRange.r := $1F;
  2962. fRange.g := $1F;
  2963. fRange.b := $1F;
  2964. fRange.a := $00;
  2965. fShift.r := 10;
  2966. fShift.g := 5;
  2967. fShift.b := 0;
  2968. fShift.a := 0;
  2969. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2970. fglInternalFormat := GL_RGB5;
  2971. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2972. end;
  2973. constructor TfdBGR8.Create;
  2974. begin
  2975. inherited Create;
  2976. fFormat := tfBGR8;
  2977. fWithAlpha := tfBGRA8;
  2978. fWithoutAlpha := tfBGR8;
  2979. fRGBInverted := tfRGB8;
  2980. fglInternalFormat := GL_RGB8;
  2981. end;
  2982. constructor TfdBGR10.Create;
  2983. begin
  2984. inherited Create;
  2985. fFormat := tfBGR10;
  2986. fWithAlpha := tfBGR10A2;
  2987. fWithoutAlpha := tfBGR10;
  2988. fRGBInverted := tfRGB10;
  2989. fRange.r := $3FF;
  2990. fRange.g := $3FF;
  2991. fRange.b := $3FF;
  2992. fRange.a := $000;
  2993. fShift.r := 20;
  2994. fShift.g := 10;
  2995. fShift.b := 0;
  2996. fShift.a := 0;
  2997. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2998. fglInternalFormat := GL_RGB10;
  2999. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3000. end;
  3001. constructor TfdBGR12.Create;
  3002. begin
  3003. inherited Create;
  3004. fFormat := tfBGR12;
  3005. fWithAlpha := tfBGRA12;
  3006. fWithoutAlpha := tfBGR12;
  3007. fRGBInverted := tfRGB12;
  3008. fglInternalFormat := GL_RGB12;
  3009. end;
  3010. constructor TfdBGR16.Create;
  3011. begin
  3012. inherited Create;
  3013. fFormat := tfBGR16;
  3014. fWithAlpha := tfBGRA16;
  3015. fWithoutAlpha := tfBGR16;
  3016. fRGBInverted := tfRGB16;
  3017. fglInternalFormat := GL_RGB16;
  3018. end;
  3019. constructor TfdBGRA2.Create;
  3020. begin
  3021. inherited Create;
  3022. fFormat := tfBGRA2;
  3023. fWithAlpha := tfBGRA4;
  3024. fWithoutAlpha := tfBGR4;
  3025. fRGBInverted := tfRGBA2;
  3026. fglInternalFormat := GL_RGBA2;
  3027. end;
  3028. constructor TfdBGRA4.Create;
  3029. begin
  3030. inherited Create;
  3031. fFormat := tfBGRA4;
  3032. fWithAlpha := tfBGRA4;
  3033. fWithoutAlpha := tfBGR4;
  3034. fRGBInverted := tfRGBA4;
  3035. fRange.r := $F;
  3036. fRange.g := $F;
  3037. fRange.b := $F;
  3038. fRange.a := $F;
  3039. fShift.r := 8;
  3040. fShift.g := 4;
  3041. fShift.b := 0;
  3042. fShift.a := 12;
  3043. fglFormat := GL_BGRA;
  3044. fglInternalFormat := GL_RGBA4;
  3045. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  3046. end;
  3047. constructor TfdBGR5A1.Create;
  3048. begin
  3049. inherited Create;
  3050. fFormat := tfBGR5A1;
  3051. fWithAlpha := tfBGR5A1;
  3052. fWithoutAlpha := tfBGR5;
  3053. fRGBInverted := tfRGB5A1;
  3054. fRange.r := $1F;
  3055. fRange.g := $1F;
  3056. fRange.b := $1F;
  3057. fRange.a := $01;
  3058. fShift.r := 10;
  3059. fShift.g := 5;
  3060. fShift.b := 0;
  3061. fShift.a := 15;
  3062. fglFormat := GL_BGRA;
  3063. fglInternalFormat := GL_RGB5_A1;
  3064. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  3065. end;
  3066. constructor TfdBGRA8.Create;
  3067. begin
  3068. inherited Create;
  3069. fFormat := tfBGRA8;
  3070. fWithAlpha := tfBGRA8;
  3071. fWithoutAlpha := tfBGR8;
  3072. fRGBInverted := tfRGBA8;
  3073. fglInternalFormat := GL_RGBA8;
  3074. end;
  3075. constructor TfdBGR10A2.Create;
  3076. begin
  3077. inherited Create;
  3078. fFormat := tfBGR10A2;
  3079. fWithAlpha := tfBGR10A2;
  3080. fWithoutAlpha := tfBGR10;
  3081. fRGBInverted := tfRGB10A2;
  3082. fRange.r := $3FF;
  3083. fRange.g := $3FF;
  3084. fRange.b := $3FF;
  3085. fRange.a := $003;
  3086. fShift.r := 20;
  3087. fShift.g := 10;
  3088. fShift.b := 0;
  3089. fShift.a := 30;
  3090. fglFormat := GL_BGRA;
  3091. fglInternalFormat := GL_RGB10_A2;
  3092. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3093. end;
  3094. constructor TfdBGRA12.Create;
  3095. begin
  3096. inherited Create;
  3097. fFormat := tfBGRA12;
  3098. fWithAlpha := tfBGRA12;
  3099. fWithoutAlpha := tfBGR12;
  3100. fRGBInverted := tfRGBA12;
  3101. fglInternalFormat := GL_RGBA12;
  3102. end;
  3103. constructor TfdBGRA16.Create;
  3104. begin
  3105. inherited Create;
  3106. fFormat := tfBGRA16;
  3107. fWithAlpha := tfBGRA16;
  3108. fWithoutAlpha := tfBGR16;
  3109. fRGBInverted := tfRGBA16;
  3110. fglInternalFormat := GL_RGBA16;
  3111. end;
  3112. constructor TfdDepth16.Create;
  3113. begin
  3114. inherited Create;
  3115. fFormat := tfDepth16;
  3116. fWithAlpha := tfEmpty;
  3117. fWithoutAlpha := tfDepth16;
  3118. fglInternalFormat := GL_DEPTH_COMPONENT16;
  3119. end;
  3120. constructor TfdDepth24.Create;
  3121. begin
  3122. inherited Create;
  3123. fFormat := tfDepth24;
  3124. fWithAlpha := tfEmpty;
  3125. fWithoutAlpha := tfDepth24;
  3126. fglInternalFormat := GL_DEPTH_COMPONENT24;
  3127. end;
  3128. constructor TfdDepth32.Create;
  3129. begin
  3130. inherited Create;
  3131. fFormat := tfDepth32;
  3132. fWithAlpha := tfEmpty;
  3133. fWithoutAlpha := tfDepth32;
  3134. fglInternalFormat := GL_DEPTH_COMPONENT32;
  3135. end;
  3136. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3137. //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3138. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3139. procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3140. begin
  3141. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3142. end;
  3143. procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3144. begin
  3145. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3146. end;
  3147. constructor TfdS3tcDtx1RGBA.Create;
  3148. begin
  3149. inherited Create;
  3150. fFormat := tfS3tcDtx1RGBA;
  3151. fWithAlpha := tfS3tcDtx1RGBA;
  3152. fUncompressed := tfRGB5A1;
  3153. fPixelSize := 0.5;
  3154. fIsCompressed := true;
  3155. fglFormat := GL_COMPRESSED_RGBA;
  3156. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
  3157. fglDataFormat := GL_UNSIGNED_BYTE;
  3158. end;
  3159. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3160. //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3161. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3162. procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3163. begin
  3164. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3165. end;
  3166. procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3167. begin
  3168. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3169. end;
  3170. constructor TfdS3tcDtx3RGBA.Create;
  3171. begin
  3172. inherited Create;
  3173. fFormat := tfS3tcDtx3RGBA;
  3174. fWithAlpha := tfS3tcDtx3RGBA;
  3175. fUncompressed := tfRGBA8;
  3176. fPixelSize := 1.0;
  3177. fIsCompressed := true;
  3178. fglFormat := GL_COMPRESSED_RGBA;
  3179. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
  3180. fglDataFormat := GL_UNSIGNED_BYTE;
  3181. end;
  3182. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3183. //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3184. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3185. procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3186. begin
  3187. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3188. end;
  3189. procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3190. begin
  3191. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3192. end;
  3193. constructor TfdS3tcDtx5RGBA.Create;
  3194. begin
  3195. inherited Create;
  3196. fFormat := tfS3tcDtx3RGBA;
  3197. fWithAlpha := tfS3tcDtx3RGBA;
  3198. fUncompressed := tfRGBA8;
  3199. fPixelSize := 1.0;
  3200. fIsCompressed := true;
  3201. fglFormat := GL_COMPRESSED_RGBA;
  3202. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
  3203. fglDataFormat := GL_UNSIGNED_BYTE;
  3204. end;
  3205. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3206. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3207. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3208. class procedure TFormatDescriptor.Init;
  3209. begin
  3210. if not Assigned(FormatDescriptorCS) then
  3211. FormatDescriptorCS := TCriticalSection.Create;
  3212. end;
  3213. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3214. class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3215. begin
  3216. FormatDescriptorCS.Enter;
  3217. try
  3218. result := FormatDescriptors[aFormat];
  3219. if not Assigned(result) then begin
  3220. result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
  3221. FormatDescriptors[aFormat] := result;
  3222. end;
  3223. finally
  3224. FormatDescriptorCS.Leave;
  3225. end;
  3226. end;
  3227. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3228. class function TFormatDescriptor.GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3229. begin
  3230. result := Get(Get(aFormat).WithAlpha);
  3231. end;
  3232. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3233. class procedure TFormatDescriptor.Clear;
  3234. var
  3235. f: TglBitmapFormat;
  3236. begin
  3237. FormatDescriptorCS.Enter;
  3238. try
  3239. for f := low(FormatDescriptors) to high(FormatDescriptors) do
  3240. FreeAndNil(FormatDescriptors[f]);
  3241. finally
  3242. FormatDescriptorCS.Leave;
  3243. end;
  3244. end;
  3245. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3246. class procedure TFormatDescriptor.Finalize;
  3247. begin
  3248. Clear;
  3249. FreeAndNil(FormatDescriptorCS);
  3250. end;
  3251. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3252. //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3253. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3254. procedure TbmpBitfieldFormat.SetRedMask(const aValue: QWord);
  3255. begin
  3256. Update(aValue, fRange.r, fShift.r);
  3257. end;
  3258. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3259. procedure TbmpBitfieldFormat.SetGreenMask(const aValue: QWord);
  3260. begin
  3261. Update(aValue, fRange.g, fShift.g);
  3262. end;
  3263. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3264. procedure TbmpBitfieldFormat.SetBlueMask(const aValue: QWord);
  3265. begin
  3266. Update(aValue, fRange.b, fShift.b);
  3267. end;
  3268. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3269. procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: QWord);
  3270. begin
  3271. Update(aValue, fRange.a, fShift.a);
  3272. end;
  3273. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3274. procedure TbmpBitfieldFormat.Update(aMask: QWord; out aRange: Cardinal; out
  3275. aShift: Byte);
  3276. begin
  3277. aShift := 0;
  3278. aRange := 0;
  3279. if (aMask = 0) then
  3280. exit;
  3281. while (aMask > 0) and ((aMask and 1) = 0) do begin
  3282. inc(aShift);
  3283. aMask := aMask shr 1;
  3284. end;
  3285. aRange := 1;
  3286. while (aMask > 0) do begin
  3287. aRange := aRange shl 1;
  3288. aMask := aMask shr 1;
  3289. end;
  3290. dec(aRange);
  3291. fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
  3292. end;
  3293. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3294. procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3295. var
  3296. data: QWord;
  3297. s: Integer;
  3298. begin
  3299. data :=
  3300. ((aPixel.Data.r and fRange.r) shl fShift.r) or
  3301. ((aPixel.Data.g and fRange.g) shl fShift.g) or
  3302. ((aPixel.Data.b and fRange.b) shl fShift.b) or
  3303. ((aPixel.Data.a and fRange.a) shl fShift.a);
  3304. s := Round(fPixelSize);
  3305. case s of
  3306. 1: aData^ := data;
  3307. 2: PWord(aData)^ := data;
  3308. 4: PCardinal(aData)^ := data;
  3309. 8: PQWord(aData)^ := data;
  3310. else
  3311. raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
  3312. end;
  3313. inc(aData, s);
  3314. end;
  3315. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3316. procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3317. var
  3318. data: QWord;
  3319. s, i: Integer;
  3320. begin
  3321. s := Round(fPixelSize);
  3322. case s of
  3323. 1: data := aData^;
  3324. 2: data := PWord(aData)^;
  3325. 4: data := PCardinal(aData)^;
  3326. 8: data := PQWord(aData)^;
  3327. else
  3328. raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
  3329. end;
  3330. for i := 0 to 3 do
  3331. aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
  3332. inc(aData, s);
  3333. end;
  3334. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3335. //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3336. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3337. procedure TbmpColorTableFormat.CreateColorTable;
  3338. var
  3339. i: Integer;
  3340. begin
  3341. if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
  3342. raise EglBitmap.Create(UNSUPPORTED_FORMAT);
  3343. if (Format = tfLuminance4) then
  3344. SetLength(fColorTable, 16)
  3345. else
  3346. SetLength(fColorTable, 256);
  3347. case Format of
  3348. tfLuminance4: begin
  3349. for i := 0 to High(fColorTable) do begin
  3350. fColorTable[i].r := 16 * i;
  3351. fColorTable[i].g := 16 * i;
  3352. fColorTable[i].b := 16 * i;
  3353. fColorTable[i].a := 0;
  3354. end;
  3355. end;
  3356. tfLuminance8: begin
  3357. for i := 0 to High(fColorTable) do begin
  3358. fColorTable[i].r := i;
  3359. fColorTable[i].g := i;
  3360. fColorTable[i].b := i;
  3361. fColorTable[i].a := 0;
  3362. end;
  3363. end;
  3364. tfR3G3B2: begin
  3365. for i := 0 to High(fColorTable) do begin
  3366. fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
  3367. fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
  3368. fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
  3369. fColorTable[i].a := 0;
  3370. end;
  3371. end;
  3372. end;
  3373. end;
  3374. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3375. procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3376. var
  3377. d: Byte;
  3378. begin
  3379. if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
  3380. raise EglBitmap.Create(UNSUPPORTED_FORMAT);
  3381. case Format of
  3382. tfLuminance4: begin
  3383. if (aMapData = nil) then
  3384. aData^ := 0;
  3385. d := LuminanceWeight(aPixel) and Range.r;
  3386. aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData)));
  3387. inc(PByte(aMapData), 4);
  3388. if ({%H-}PtrUInt(aMapData) >= 8) then begin
  3389. inc(aData);
  3390. aMapData := nil;
  3391. end;
  3392. end;
  3393. tfLuminance8: begin
  3394. aData^ := LuminanceWeight(aPixel) and Range.r;
  3395. inc(aData);
  3396. end;
  3397. tfR3G3B2: begin
  3398. aData^ := Round(
  3399. ((aPixel.Data.r and Range.r) shl Shift.r) or
  3400. ((aPixel.Data.g and Range.g) shl Shift.g) or
  3401. ((aPixel.Data.b and Range.b) shl Shift.b));
  3402. inc(aData);
  3403. end;
  3404. end;
  3405. end;
  3406. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3407. procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3408. var
  3409. idx: QWord;
  3410. s: Integer;
  3411. bits: Byte;
  3412. f: Single;
  3413. begin
  3414. s := Trunc(fPixelSize);
  3415. f := fPixelSize - s;
  3416. bits := Round(8 * f);
  3417. case s of
  3418. 0: idx := (aData^ shr (8 - bits - {%H-}PtrInt(aMapData))) and ((1 shl bits) - 1);
  3419. 1: idx := aData^;
  3420. 2: idx := PWord(aData)^;
  3421. 4: idx := PCardinal(aData)^;
  3422. 8: idx := PQWord(aData)^;
  3423. else
  3424. raise EglBitmap.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
  3425. end;
  3426. if (idx >= Length(fColorTable)) then
  3427. raise EglBitmap.CreateFmt('invalid color index: %d', [idx]);
  3428. with fColorTable[idx] do begin
  3429. aPixel.Data.r := r;
  3430. aPixel.Data.g := g;
  3431. aPixel.Data.b := b;
  3432. aPixel.Data.a := a;
  3433. end;
  3434. inc(PByte(aMapData), bits);
  3435. if ({%H-}PtrUInt(aMapData) >= 8) then begin
  3436. inc(aData, 1);
  3437. dec(PByte(aMapData), 8);
  3438. end;
  3439. inc(aData, s);
  3440. end;
  3441. destructor TbmpColorTableFormat.Destroy;
  3442. begin
  3443. SetLength(fColorTable, 0);
  3444. inherited Destroy;
  3445. end;
  3446. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3447. //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3448. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3449. procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
  3450. var
  3451. i: Integer;
  3452. begin
  3453. for i := 0 to 3 do begin
  3454. if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
  3455. if (aSourceFD.Range.arr[i] > 0) then
  3456. aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
  3457. else
  3458. aPixel.Data.arr[i] := aDestFD.Range.arr[i];
  3459. end;
  3460. end;
  3461. end;
  3462. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3463. procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
  3464. begin
  3465. with aFuncRec do begin
  3466. if (Source.Range.r > 0) then
  3467. Dest.Data.r := Source.Data.r;
  3468. if (Source.Range.g > 0) then
  3469. Dest.Data.g := Source.Data.g;
  3470. if (Source.Range.b > 0) then
  3471. Dest.Data.b := Source.Data.b;
  3472. if (Source.Range.a > 0) then
  3473. Dest.Data.a := Source.Data.a;
  3474. end;
  3475. end;
  3476. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3477. procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3478. var
  3479. i: Integer;
  3480. begin
  3481. with aFuncRec do begin
  3482. for i := 0 to 3 do
  3483. if (Source.Range.arr[i] > 0) then
  3484. Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
  3485. end;
  3486. end;
  3487. type
  3488. TShiftData = packed record
  3489. case Integer of
  3490. 0: (r, g, b, a: SmallInt);
  3491. 1: (arr: array[0..3] of SmallInt);
  3492. end;
  3493. PShiftData = ^TShiftData;
  3494. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3495. procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3496. var
  3497. i: Integer;
  3498. begin
  3499. with aFuncRec do
  3500. for i := 0 to 3 do
  3501. if (Source.Range.arr[i] > 0) then
  3502. Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
  3503. end;
  3504. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3505. procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
  3506. begin
  3507. with aFuncRec do begin
  3508. Dest.Data := Source.Data;
  3509. if ({%H-}PtrUInt(Args) and $1 > 0) then begin
  3510. Dest.Data.r := Dest.Data.r xor Dest.Range.r;
  3511. Dest.Data.g := Dest.Data.g xor Dest.Range.g;
  3512. Dest.Data.b := Dest.Data.b xor Dest.Range.b;
  3513. end;
  3514. if ({%H-}PtrUInt(Args) and $2 > 0) then begin
  3515. Dest.Data.a := Dest.Data.a xor Dest.Range.a;
  3516. end;
  3517. end;
  3518. end;
  3519. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3520. procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
  3521. var
  3522. i: Integer;
  3523. begin
  3524. with aFuncRec do begin
  3525. for i := 0 to 3 do
  3526. Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
  3527. end;
  3528. end;
  3529. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3530. procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3531. var
  3532. Temp: Single;
  3533. begin
  3534. with FuncRec do begin
  3535. if (FuncRec.Args = nil) then begin //source has no alpha
  3536. Temp :=
  3537. Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
  3538. Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
  3539. Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
  3540. Dest.Data.a := Round(Dest.Range.a * Temp);
  3541. end else
  3542. Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
  3543. end;
  3544. end;
  3545. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3546. procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3547. type
  3548. PglBitmapPixelData = ^TglBitmapPixelData;
  3549. begin
  3550. with FuncRec do begin
  3551. Dest.Data.r := Source.Data.r;
  3552. Dest.Data.g := Source.Data.g;
  3553. Dest.Data.b := Source.Data.b;
  3554. with PglBitmapPixelData(Args)^ do
  3555. if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
  3556. (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
  3557. (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
  3558. Dest.Data.a := 0
  3559. else
  3560. Dest.Data.a := Dest.Range.a;
  3561. end;
  3562. end;
  3563. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3564. procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3565. begin
  3566. with FuncRec do begin
  3567. Dest.Data.r := Source.Data.r;
  3568. Dest.Data.g := Source.Data.g;
  3569. Dest.Data.b := Source.Data.b;
  3570. Dest.Data.a := PCardinal(Args)^;
  3571. end;
  3572. end;
  3573. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3574. procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
  3575. type
  3576. PRGBPix = ^TRGBPix;
  3577. TRGBPix = array [0..2] of byte;
  3578. var
  3579. Temp: Byte;
  3580. begin
  3581. while aWidth > 0 do begin
  3582. Temp := PRGBPix(aData)^[0];
  3583. PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
  3584. PRGBPix(aData)^[2] := Temp;
  3585. if aHasAlpha then
  3586. Inc(aData, 4)
  3587. else
  3588. Inc(aData, 3);
  3589. dec(aWidth);
  3590. end;
  3591. end;
  3592. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3593. //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3594. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3595. function TglBitmap.GetFormatDesc: TglBitmapFormatDescriptor;
  3596. begin
  3597. result := TFormatDescriptor.Get(Format);
  3598. end;
  3599. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3600. function TglBitmap.GetWidth: Integer;
  3601. begin
  3602. if (ffX in fDimension.Fields) then
  3603. result := fDimension.X
  3604. else
  3605. result := -1;
  3606. end;
  3607. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3608. function TglBitmap.GetHeight: Integer;
  3609. begin
  3610. if (ffY in fDimension.Fields) then
  3611. result := fDimension.Y
  3612. else
  3613. result := -1;
  3614. end;
  3615. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3616. function TglBitmap.GetFileWidth: Integer;
  3617. begin
  3618. result := Max(1, Width);
  3619. end;
  3620. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3621. function TglBitmap.GetFileHeight: Integer;
  3622. begin
  3623. result := Max(1, Height);
  3624. end;
  3625. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3626. procedure TglBitmap.SetCustomData(const aValue: Pointer);
  3627. begin
  3628. if fCustomData = aValue then
  3629. exit;
  3630. fCustomData := aValue;
  3631. end;
  3632. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3633. procedure TglBitmap.SetCustomName(const aValue: String);
  3634. begin
  3635. if fCustomName = aValue then
  3636. exit;
  3637. fCustomName := aValue;
  3638. end;
  3639. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3640. procedure TglBitmap.SetCustomNameW(const aValue: WideString);
  3641. begin
  3642. if fCustomNameW = aValue then
  3643. exit;
  3644. fCustomNameW := aValue;
  3645. end;
  3646. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3647. procedure TglBitmap.SetFreeDataOnDestroy(const aValue: Boolean);
  3648. begin
  3649. if fFreeDataOnDestroy = aValue then
  3650. exit;
  3651. fFreeDataOnDestroy := aValue;
  3652. end;
  3653. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3654. procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
  3655. begin
  3656. if fDeleteTextureOnFree = aValue then
  3657. exit;
  3658. fDeleteTextureOnFree := aValue;
  3659. end;
  3660. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3661. procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
  3662. begin
  3663. if fFormat = aValue then
  3664. exit;
  3665. if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
  3666. raise EglBitmapUnsupportedFormat.Create(Format);
  3667. SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
  3668. end;
  3669. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3670. procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
  3671. begin
  3672. if fFreeDataAfterGenTexture = aValue then
  3673. exit;
  3674. fFreeDataAfterGenTexture := aValue;
  3675. end;
  3676. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3677. procedure TglBitmap.SetID(const aValue: Cardinal);
  3678. begin
  3679. if fID = aValue then
  3680. exit;
  3681. fID := aValue;
  3682. end;
  3683. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3684. procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
  3685. begin
  3686. if fMipMap = aValue then
  3687. exit;
  3688. fMipMap := aValue;
  3689. end;
  3690. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3691. procedure TglBitmap.SetTarget(const aValue: Cardinal);
  3692. begin
  3693. if fTarget = aValue then
  3694. exit;
  3695. fTarget := aValue;
  3696. end;
  3697. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3698. procedure TglBitmap.SetAnisotropic(const aValue: Integer);
  3699. var
  3700. MaxAnisotropic: Integer;
  3701. begin
  3702. fAnisotropic := aValue;
  3703. if (ID > 0) then begin
  3704. if GL_EXT_texture_filter_anisotropic then begin
  3705. if fAnisotropic > 0 then begin
  3706. Bind(false);
  3707. glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
  3708. if aValue > MaxAnisotropic then
  3709. fAnisotropic := MaxAnisotropic;
  3710. glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
  3711. end;
  3712. end else begin
  3713. fAnisotropic := 0;
  3714. end;
  3715. end;
  3716. end;
  3717. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3718. procedure TglBitmap.CreateID;
  3719. begin
  3720. if (ID <> 0) then
  3721. glDeleteTextures(1, @fID);
  3722. glGenTextures(1, @fID);
  3723. Bind(false);
  3724. end;
  3725. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3726. procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
  3727. begin
  3728. // Set Up Parameters
  3729. SetWrap(fWrapS, fWrapT, fWrapR);
  3730. SetFilter(fFilterMin, fFilterMag);
  3731. SetAnisotropic(fAnisotropic);
  3732. SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
  3733. if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  3734. SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  3735. // Mip Maps Generation Mode
  3736. aBuildWithGlu := false;
  3737. if (MipMap = mmMipmap) then begin
  3738. if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
  3739. glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
  3740. else
  3741. aBuildWithGlu := true;
  3742. end else if (MipMap = mmMipmapGlu) then
  3743. aBuildWithGlu := true;
  3744. end;
  3745. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3746. procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  3747. const aWidth: Integer; const aHeight: Integer);
  3748. var
  3749. s: Single;
  3750. begin
  3751. if (Data <> aData) then begin
  3752. if (Assigned(Data)) then
  3753. FreeMem(Data);
  3754. fData := aData;
  3755. end;
  3756. if not Assigned(fData) then begin
  3757. fPixelSize := 0;
  3758. fRowSize := 0;
  3759. end else begin
  3760. FillChar(fDimension, SizeOf(fDimension), 0);
  3761. if aWidth <> -1 then begin
  3762. fDimension.Fields := fDimension.Fields + [ffX];
  3763. fDimension.X := aWidth;
  3764. end;
  3765. if aHeight <> -1 then begin
  3766. fDimension.Fields := fDimension.Fields + [ffY];
  3767. fDimension.Y := aHeight;
  3768. end;
  3769. s := TFormatDescriptor.Get(aFormat).PixelSize;
  3770. fFormat := aFormat;
  3771. fPixelSize := Ceil(s);
  3772. fRowSize := Ceil(s * aWidth);
  3773. end;
  3774. end;
  3775. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3776. function TglBitmap.FlipHorz: Boolean;
  3777. begin
  3778. result := false;
  3779. end;
  3780. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3781. function TglBitmap.FlipVert: Boolean;
  3782. begin
  3783. result := false;
  3784. end;
  3785. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3786. //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3787. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3788. procedure TglBitmap.AfterConstruction;
  3789. begin
  3790. inherited AfterConstruction;
  3791. fID := 0;
  3792. fTarget := 0;
  3793. fIsResident := false;
  3794. fMipMap := glBitmapDefaultMipmap;
  3795. fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
  3796. fDeleteTextureOnFree := glBitmapGetDefaultDeleteTextureOnFree;
  3797. glBitmapGetDefaultFilter (fFilterMin, fFilterMag);
  3798. glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
  3799. glBitmapGetDefaultSwizzle (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  3800. end;
  3801. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3802. procedure TglBitmap.BeforeDestruction;
  3803. var
  3804. NewData: PByte;
  3805. begin
  3806. if fFreeDataOnDestroy then begin
  3807. NewData := nil;
  3808. SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
  3809. end;
  3810. if (fID > 0) and fDeleteTextureOnFree then
  3811. glDeleteTextures(1, @fID);
  3812. inherited BeforeDestruction;
  3813. end;
  3814. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3815. procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
  3816. var
  3817. TempPos: Integer;
  3818. begin
  3819. if not Assigned(aResType) then begin
  3820. TempPos := Pos('.', aResource);
  3821. aResType := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
  3822. aResource := UpperCase(Copy(aResource, 0, TempPos -1));
  3823. end;
  3824. end;
  3825. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3826. procedure TglBitmap.LoadFromFile(const aFilename: String);
  3827. var
  3828. fs: TFileStream;
  3829. begin
  3830. if not FileExists(aFilename) then
  3831. raise EglBitmap.Create('file does not exist: ' + aFilename);
  3832. fFilename := aFilename;
  3833. fs := TFileStream.Create(fFilename, fmOpenRead);
  3834. try
  3835. fs.Position := 0;
  3836. LoadFromStream(fs);
  3837. finally
  3838. fs.Free;
  3839. end;
  3840. end;
  3841. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3842. procedure TglBitmap.LoadFromStream(const aStream: TStream);
  3843. begin
  3844. {$IFDEF GLB_SUPPORT_PNG_READ}
  3845. if not LoadPNG(aStream) then
  3846. {$ENDIF}
  3847. {$IFDEF GLB_SUPPORT_JPEG_READ}
  3848. if not LoadJPEG(aStream) then
  3849. {$ENDIF}
  3850. if not LoadDDS(aStream) then
  3851. if not LoadTGA(aStream) then
  3852. if not LoadBMP(aStream) then
  3853. raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
  3854. end;
  3855. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3856. procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  3857. const aFormat: TglBitmapFormat; const aArgs: Pointer);
  3858. var
  3859. tmpData: PByte;
  3860. size: Integer;
  3861. begin
  3862. size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  3863. GetMem(tmpData, size);
  3864. try
  3865. FillChar(tmpData^, size, #$FF);
  3866. SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  3867. except
  3868. if Assigned(tmpData) then
  3869. FreeMem(tmpData);
  3870. raise;
  3871. end;
  3872. AddFunc(Self, aFunc, false, aFormat, aArgs);
  3873. end;
  3874. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3875. procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
  3876. var
  3877. rs: TResourceStream;
  3878. begin
  3879. PrepareResType(aResource, aResType);
  3880. rs := TResourceStream.Create(aInstance, aResource, aResType);
  3881. try
  3882. LoadFromStream(rs);
  3883. finally
  3884. rs.Free;
  3885. end;
  3886. end;
  3887. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3888. procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  3889. var
  3890. rs: TResourceStream;
  3891. begin
  3892. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  3893. try
  3894. LoadFromStream(rs);
  3895. finally
  3896. rs.Free;
  3897. end;
  3898. end;
  3899. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3900. procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  3901. var
  3902. fs: TFileStream;
  3903. begin
  3904. fs := TFileStream.Create(aFileName, fmCreate);
  3905. try
  3906. fs.Position := 0;
  3907. SaveToStream(fs, aFileType);
  3908. finally
  3909. fs.Free;
  3910. end;
  3911. end;
  3912. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3913. procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
  3914. begin
  3915. case aFileType of
  3916. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  3917. ftPNG: SavePNG(aStream);
  3918. {$ENDIF}
  3919. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  3920. ftJPEG: SaveJPEG(aStream);
  3921. {$ENDIF}
  3922. ftDDS: SaveDDS(aStream);
  3923. ftTGA: SaveTGA(aStream);
  3924. ftBMP: SaveBMP(aStream);
  3925. end;
  3926. end;
  3927. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3928. function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
  3929. begin
  3930. result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
  3931. end;
  3932. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3933. function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  3934. const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
  3935. var
  3936. DestData, TmpData, SourceData: pByte;
  3937. TempHeight, TempWidth: Integer;
  3938. SourceFD, DestFD: TFormatDescriptor;
  3939. SourceMD, DestMD: Pointer;
  3940. FuncRec: TglBitmapFunctionRec;
  3941. begin
  3942. Assert(Assigned(Data));
  3943. Assert(Assigned(aSource));
  3944. Assert(Assigned(aSource.Data));
  3945. result := false;
  3946. if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
  3947. SourceFD := TFormatDescriptor.Get(aSource.Format);
  3948. DestFD := TFormatDescriptor.Get(aFormat);
  3949. if (SourceFD.IsCompressed) then
  3950. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
  3951. if (DestFD.IsCompressed) then
  3952. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
  3953. // inkompatible Formats so CreateTemp
  3954. if (SourceFD.PixelSize <> DestFD.PixelSize) then
  3955. aCreateTemp := true;
  3956. // Values
  3957. TempHeight := Max(1, aSource.Height);
  3958. TempWidth := Max(1, aSource.Width);
  3959. FuncRec.Sender := Self;
  3960. FuncRec.Args := aArgs;
  3961. TmpData := nil;
  3962. if aCreateTemp then begin
  3963. GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
  3964. DestData := TmpData;
  3965. end else
  3966. DestData := Data;
  3967. try
  3968. SourceFD.PreparePixel(FuncRec.Source);
  3969. DestFD.PreparePixel (FuncRec.Dest);
  3970. SourceMD := SourceFD.CreateMappingData;
  3971. DestMD := DestFD.CreateMappingData;
  3972. FuncRec.Size := aSource.Dimension;
  3973. FuncRec.Position.Fields := FuncRec.Size.Fields;
  3974. try
  3975. SourceData := aSource.Data;
  3976. FuncRec.Position.Y := 0;
  3977. while FuncRec.Position.Y < TempHeight do begin
  3978. FuncRec.Position.X := 0;
  3979. while FuncRec.Position.X < TempWidth do begin
  3980. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  3981. aFunc(FuncRec);
  3982. DestFD.Map(FuncRec.Dest, DestData, DestMD);
  3983. inc(FuncRec.Position.X);
  3984. end;
  3985. inc(FuncRec.Position.Y);
  3986. end;
  3987. // Updating Image or InternalFormat
  3988. if aCreateTemp then
  3989. SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method
  3990. else if (aFormat <> fFormat) then
  3991. Format := aFormat;
  3992. result := true;
  3993. finally
  3994. SourceFD.FreeMappingData(SourceMD);
  3995. DestFD.FreeMappingData(DestMD);
  3996. end;
  3997. except
  3998. if aCreateTemp and Assigned(TmpData) then
  3999. FreeMem(TmpData);
  4000. raise;
  4001. end;
  4002. end;
  4003. end;
  4004. {$IFDEF GLB_SDL}
  4005. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4006. function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  4007. var
  4008. Row, RowSize: Integer;
  4009. SourceData, TmpData: PByte;
  4010. TempDepth: Integer;
  4011. FormatDesc: TFormatDescriptor;
  4012. function GetRowPointer(Row: Integer): pByte;
  4013. begin
  4014. result := aSurface.pixels;
  4015. Inc(result, Row * RowSize);
  4016. end;
  4017. begin
  4018. result := false;
  4019. FormatDesc := TFormatDescriptor.Get(Format);
  4020. if FormatDesc.IsCompressed then
  4021. raise EglBitmapUnsupportedFormat.Create(Format);
  4022. if Assigned(Data) then begin
  4023. case Trunc(FormatDesc.PixelSize) of
  4024. 1: TempDepth := 8;
  4025. 2: TempDepth := 16;
  4026. 3: TempDepth := 24;
  4027. 4: TempDepth := 32;
  4028. else
  4029. raise EglBitmapUnsupportedFormat.Create(Format);
  4030. end;
  4031. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
  4032. FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
  4033. SourceData := Data;
  4034. RowSize := FormatDesc.GetSize(FileWidth, 1);
  4035. for Row := 0 to FileHeight-1 do begin
  4036. TmpData := GetRowPointer(Row);
  4037. if Assigned(TmpData) then begin
  4038. Move(SourceData^, TmpData^, RowSize);
  4039. inc(SourceData, RowSize);
  4040. end;
  4041. end;
  4042. result := true;
  4043. end;
  4044. end;
  4045. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4046. function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  4047. var
  4048. pSource, pData, pTempData: PByte;
  4049. Row, RowSize, TempWidth, TempHeight: Integer;
  4050. IntFormat: TglBitmapFormat;
  4051. FormatDesc: TFormatDescriptor;
  4052. function GetRowPointer(Row: Integer): pByte;
  4053. begin
  4054. result := aSurface^.pixels;
  4055. Inc(result, Row * RowSize);
  4056. end;
  4057. begin
  4058. result := false;
  4059. if (Assigned(aSurface)) then begin
  4060. with aSurface^.format^ do begin
  4061. for IntFormat := High(TglBitmapFormat) to Low(TglBitmapFormat) do begin
  4062. FormatDesc := TFormatDescriptor.Get(IntFormat);
  4063. if (FormatDesc.MaskMatch(RMask, GMask, BMask, AMask)) then
  4064. break;
  4065. end;
  4066. if (IntFormat = tfEmpty) then
  4067. raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
  4068. end;
  4069. TempWidth := aSurface^.w;
  4070. TempHeight := aSurface^.h;
  4071. RowSize := FormatDesc.GetSize(TempWidth, 1);
  4072. GetMem(pData, TempHeight * RowSize);
  4073. try
  4074. pTempData := pData;
  4075. for Row := 0 to TempHeight -1 do begin
  4076. pSource := GetRowPointer(Row);
  4077. if (Assigned(pSource)) then begin
  4078. Move(pSource^, pTempData^, RowSize);
  4079. Inc(pTempData, RowSize);
  4080. end;
  4081. end;
  4082. SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  4083. result := true;
  4084. except
  4085. if Assigned(pData) then
  4086. FreeMem(pData);
  4087. raise;
  4088. end;
  4089. end;
  4090. end;
  4091. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4092. function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  4093. var
  4094. Row, Col, AlphaInterleave: Integer;
  4095. pSource, pDest: PByte;
  4096. function GetRowPointer(Row: Integer): pByte;
  4097. begin
  4098. result := aSurface.pixels;
  4099. Inc(result, Row * Width);
  4100. end;
  4101. begin
  4102. result := false;
  4103. if Assigned(Data) then begin
  4104. if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
  4105. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
  4106. AlphaInterleave := 0;
  4107. case Format of
  4108. tfLuminance8Alpha8:
  4109. AlphaInterleave := 1;
  4110. tfBGRA8, tfRGBA8:
  4111. AlphaInterleave := 3;
  4112. end;
  4113. pSource := Data;
  4114. for Row := 0 to Height -1 do begin
  4115. pDest := GetRowPointer(Row);
  4116. if Assigned(pDest) then begin
  4117. for Col := 0 to Width -1 do begin
  4118. Inc(pSource, AlphaInterleave);
  4119. pDest^ := pSource^;
  4120. Inc(pDest);
  4121. Inc(pSource);
  4122. end;
  4123. end;
  4124. end;
  4125. result := true;
  4126. end;
  4127. end;
  4128. end;
  4129. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4130. function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  4131. var
  4132. bmp: TglBitmap2D;
  4133. begin
  4134. bmp := TglBitmap2D.Create;
  4135. try
  4136. bmp.AssignFromSurface(aSurface);
  4137. result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
  4138. finally
  4139. bmp.Free;
  4140. end;
  4141. end;
  4142. {$ENDIF}
  4143. {$IFDEF GLB_DELPHI}
  4144. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4145. function CreateGrayPalette: HPALETTE;
  4146. var
  4147. Idx: Integer;
  4148. Pal: PLogPalette;
  4149. begin
  4150. GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
  4151. Pal.palVersion := $300;
  4152. Pal.palNumEntries := 256;
  4153. for Idx := 0 to Pal.palNumEntries - 1 do begin
  4154. Pal.palPalEntry[Idx].peRed := Idx;
  4155. Pal.palPalEntry[Idx].peGreen := Idx;
  4156. Pal.palPalEntry[Idx].peBlue := Idx;
  4157. Pal.palPalEntry[Idx].peFlags := 0;
  4158. end;
  4159. Result := CreatePalette(Pal^);
  4160. FreeMem(Pal);
  4161. end;
  4162. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4163. function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
  4164. var
  4165. Row: Integer;
  4166. pSource, pData: PByte;
  4167. begin
  4168. result := false;
  4169. if Assigned(Data) then begin
  4170. if Assigned(aBitmap) then begin
  4171. aBitmap.Width := Width;
  4172. aBitmap.Height := Height;
  4173. case Format of
  4174. tfAlpha8, tfLuminance8: begin
  4175. aBitmap.PixelFormat := pf8bit;
  4176. aBitmap.Palette := CreateGrayPalette;
  4177. end;
  4178. tfRGB5A1:
  4179. aBitmap.PixelFormat := pf15bit;
  4180. tfR5G6B5:
  4181. aBitmap.PixelFormat := pf16bit;
  4182. tfRGB8, tfBGR8:
  4183. aBitmap.PixelFormat := pf24bit;
  4184. tfRGBA8, tfBGRA8:
  4185. aBitmap.PixelFormat := pf32bit;
  4186. else
  4187. raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
  4188. end;
  4189. pSource := Data;
  4190. for Row := 0 to FileHeight -1 do begin
  4191. pData := aBitmap.Scanline[Row];
  4192. Move(pSource^, pData^, fRowSize);
  4193. Inc(pSource, fRowSize);
  4194. if (Format in [tfRGB8, tfRGBA8]) then // swap RGB(A) to BGR(A)
  4195. SwapRGB(pData, FileWidth, Format = tfRGBA8);
  4196. end;
  4197. result := true;
  4198. end;
  4199. end;
  4200. end;
  4201. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4202. function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  4203. var
  4204. pSource, pData, pTempData: PByte;
  4205. Row, RowSize, TempWidth, TempHeight: Integer;
  4206. IntFormat: TglBitmapFormat;
  4207. begin
  4208. result := false;
  4209. if (Assigned(aBitmap)) then begin
  4210. case aBitmap.PixelFormat of
  4211. pf8bit:
  4212. IntFormat := tfLuminance8;
  4213. pf15bit:
  4214. IntFormat := tfRGB5A1;
  4215. pf16bit:
  4216. IntFormat := tfR5G6B5;
  4217. pf24bit:
  4218. IntFormat := tfBGR8;
  4219. pf32bit:
  4220. IntFormat := tfBGRA8;
  4221. else
  4222. raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
  4223. end;
  4224. TempWidth := aBitmap.Width;
  4225. TempHeight := aBitmap.Height;
  4226. RowSize := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
  4227. GetMem(pData, TempHeight * RowSize);
  4228. try
  4229. pTempData := pData;
  4230. for Row := 0 to TempHeight -1 do begin
  4231. pSource := aBitmap.Scanline[Row];
  4232. if (Assigned(pSource)) then begin
  4233. Move(pSource^, pTempData^, RowSize);
  4234. Inc(pTempData, RowSize);
  4235. end;
  4236. end;
  4237. SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  4238. result := true;
  4239. except
  4240. if Assigned(pData) then
  4241. FreeMem(pData);
  4242. raise;
  4243. end;
  4244. end;
  4245. end;
  4246. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4247. function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  4248. var
  4249. Row, Col, AlphaInterleave: Integer;
  4250. pSource, pDest: PByte;
  4251. begin
  4252. result := false;
  4253. if Assigned(Data) then begin
  4254. if (Format in [tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8]) then begin
  4255. if Assigned(aBitmap) then begin
  4256. aBitmap.PixelFormat := pf8bit;
  4257. aBitmap.Palette := CreateGrayPalette;
  4258. aBitmap.Width := Width;
  4259. aBitmap.Height := Height;
  4260. case Format of
  4261. tfLuminance8Alpha8:
  4262. AlphaInterleave := 1;
  4263. tfRGBA8, tfBGRA8:
  4264. AlphaInterleave := 3;
  4265. else
  4266. AlphaInterleave := 0;
  4267. end;
  4268. // Copy Data
  4269. pSource := Data;
  4270. for Row := 0 to Height -1 do begin
  4271. pDest := aBitmap.Scanline[Row];
  4272. if Assigned(pDest) then begin
  4273. for Col := 0 to Width -1 do begin
  4274. Inc(pSource, AlphaInterleave);
  4275. pDest^ := pSource^;
  4276. Inc(pDest);
  4277. Inc(pSource);
  4278. end;
  4279. end;
  4280. end;
  4281. result := true;
  4282. end;
  4283. end;
  4284. end;
  4285. end;
  4286. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4287. function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4288. var
  4289. tex: TglBitmap2D;
  4290. begin
  4291. tex := TglBitmap2D.Create;
  4292. try
  4293. tex.AssignFromBitmap(ABitmap);
  4294. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4295. finally
  4296. tex.Free;
  4297. end;
  4298. end;
  4299. {$ENDIF}
  4300. {$IFDEF GLB_LAZARUS}
  4301. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4302. function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4303. var
  4304. rid: TRawImageDescription;
  4305. FormatDesc: TFormatDescriptor;
  4306. begin
  4307. result := false;
  4308. if not Assigned(aImage) or (Format = tfEmpty) then
  4309. exit;
  4310. FormatDesc := TFormatDescriptor.Get(Format);
  4311. if FormatDesc.IsCompressed then
  4312. exit;
  4313. FillChar(rid{%H-}, SizeOf(rid), 0);
  4314. if (Format in [
  4315. tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
  4316. tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
  4317. tfLuminance4Alpha4, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16]) then
  4318. rid.Format := ricfGray
  4319. else
  4320. rid.Format := ricfRGBA;
  4321. rid.Width := Width;
  4322. rid.Height := Height;
  4323. rid.Depth := CountSetBits(FormatDesc.RedMask or FormatDesc.GreenMask or FormatDesc.BlueMask or FormatDesc.AlphaMask);
  4324. rid.BitOrder := riboBitsInOrder;
  4325. rid.ByteOrder := riboLSBFirst;
  4326. rid.LineOrder := riloTopToBottom;
  4327. rid.LineEnd := rileTight;
  4328. rid.BitsPerPixel := Round(8 * FormatDesc.PixelSize);
  4329. rid.RedPrec := CountSetBits(FormatDesc.Range.r);
  4330. rid.GreenPrec := CountSetBits(FormatDesc.Range.g);
  4331. rid.BluePrec := CountSetBits(FormatDesc.Range.b);
  4332. rid.AlphaPrec := CountSetBits(FormatDesc.Range.a);
  4333. rid.RedShift := FormatDesc.Shift.r;
  4334. rid.GreenShift := FormatDesc.Shift.g;
  4335. rid.BlueShift := FormatDesc.Shift.b;
  4336. rid.AlphaShift := FormatDesc.Shift.a;
  4337. rid.MaskBitsPerPixel := 0;
  4338. rid.PaletteColorCount := 0;
  4339. aImage.DataDescription := rid;
  4340. aImage.CreateData;
  4341. Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
  4342. result := true;
  4343. end;
  4344. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4345. function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4346. var
  4347. f: TglBitmapFormat;
  4348. FormatDesc: TFormatDescriptor;
  4349. ImageData: PByte;
  4350. ImageSize: Integer;
  4351. CanCopy: Boolean;
  4352. procedure CopyConvert;
  4353. var
  4354. bfFormat: TbmpBitfieldFormat;
  4355. pSourceLine, pDestLine: PByte;
  4356. pSourceMD, pDestMD: Pointer;
  4357. x, y: Integer;
  4358. pixel: TglBitmapPixelData;
  4359. begin
  4360. bfFormat := TbmpBitfieldFormat.Create;
  4361. with aImage.DataDescription do begin
  4362. bfFormat.RedMask := ((1 shl RedPrec) - 1) shl RedShift;
  4363. bfFormat.GreenMask := ((1 shl GreenPrec) - 1) shl GreenShift;
  4364. bfFormat.BlueMask := ((1 shl BluePrec) - 1) shl BlueShift;
  4365. bfFormat.AlphaMask := ((1 shl AlphaPrec) - 1) shl AlphaShift;
  4366. bfFormat.PixelSize := BitsPerPixel / 8;
  4367. end;
  4368. pSourceMD := bfFormat.CreateMappingData;
  4369. pDestMD := FormatDesc.CreateMappingData;
  4370. try
  4371. for y := 0 to aImage.Height-1 do begin
  4372. pSourceLine := aImage.PixelData + y * aImage.DataDescription.BytesPerLine;
  4373. pDestLine := ImageData + y * Round(FormatDesc.PixelSize * aImage.Width);
  4374. for x := 0 to aImage.Width-1 do begin
  4375. bfFormat.Unmap(pSourceLine, pixel, pSourceMD);
  4376. FormatDesc.Map(pixel, pDestLine, pDestMD);
  4377. end;
  4378. end;
  4379. finally
  4380. FormatDesc.FreeMappingData(pDestMD);
  4381. bfFormat.FreeMappingData(pSourceMD);
  4382. bfFormat.Free;
  4383. end;
  4384. end;
  4385. begin
  4386. result := false;
  4387. if not Assigned(aImage) then
  4388. exit;
  4389. for f := High(f) downto Low(f) do begin
  4390. FormatDesc := TFormatDescriptor.Get(f);
  4391. with aImage.DataDescription do
  4392. if FormatDesc.MaskMatch(
  4393. (QWord(1 shl RedPrec )-1) shl RedShift,
  4394. (QWord(1 shl GreenPrec)-1) shl GreenShift,
  4395. (QWord(1 shl BluePrec )-1) shl BlueShift,
  4396. (QWord(1 shl AlphaPrec)-1) shl AlphaShift) then
  4397. break;
  4398. end;
  4399. if (f = tfEmpty) then
  4400. exit;
  4401. CanCopy :=
  4402. (Round(FormatDesc.PixelSize * 8) = aImage.DataDescription.Depth) and
  4403. (aImage.DataDescription.BitsPerPixel = aImage.DataDescription.Depth);
  4404. ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
  4405. ImageData := GetMem(ImageSize);
  4406. try
  4407. if CanCopy then
  4408. Move(aImage.PixelData^, ImageData^, ImageSize)
  4409. else
  4410. CopyConvert;
  4411. SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method
  4412. except
  4413. if Assigned(ImageData) then
  4414. FreeMem(ImageData);
  4415. raise;
  4416. end;
  4417. result := true;
  4418. end;
  4419. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4420. function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4421. var
  4422. rid: TRawImageDescription;
  4423. FormatDesc: TFormatDescriptor;
  4424. Pixel: TglBitmapPixelData;
  4425. x, y: Integer;
  4426. srcMD: Pointer;
  4427. src, dst: PByte;
  4428. begin
  4429. result := false;
  4430. if not Assigned(aImage) or (Format = tfEmpty) then
  4431. exit;
  4432. FormatDesc := TFormatDescriptor.Get(Format);
  4433. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  4434. exit;
  4435. FillChar(rid{%H-}, SizeOf(rid), 0);
  4436. rid.Format := ricfGray;
  4437. rid.Width := Width;
  4438. rid.Height := Height;
  4439. rid.Depth := CountSetBits(FormatDesc.Range.a);
  4440. rid.BitOrder := riboBitsInOrder;
  4441. rid.ByteOrder := riboLSBFirst;
  4442. rid.LineOrder := riloTopToBottom;
  4443. rid.LineEnd := rileTight;
  4444. rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
  4445. rid.RedPrec := CountSetBits(FormatDesc.Range.a);
  4446. rid.GreenPrec := 0;
  4447. rid.BluePrec := 0;
  4448. rid.AlphaPrec := 0;
  4449. rid.RedShift := 0;
  4450. rid.GreenShift := 0;
  4451. rid.BlueShift := 0;
  4452. rid.AlphaShift := 0;
  4453. rid.MaskBitsPerPixel := 0;
  4454. rid.PaletteColorCount := 0;
  4455. aImage.DataDescription := rid;
  4456. aImage.CreateData;
  4457. srcMD := FormatDesc.CreateMappingData;
  4458. try
  4459. FormatDesc.PreparePixel(Pixel);
  4460. src := Data;
  4461. dst := aImage.PixelData;
  4462. for y := 0 to Height-1 do
  4463. for x := 0 to Width-1 do begin
  4464. FormatDesc.Unmap(src, Pixel, srcMD);
  4465. case rid.BitsPerPixel of
  4466. 8: begin
  4467. dst^ := Pixel.Data.a;
  4468. inc(dst);
  4469. end;
  4470. 16: begin
  4471. PWord(dst)^ := Pixel.Data.a;
  4472. inc(dst, 2);
  4473. end;
  4474. 24: begin
  4475. PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
  4476. PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
  4477. PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
  4478. inc(dst, 3);
  4479. end;
  4480. 32: begin
  4481. PCardinal(dst)^ := Pixel.Data.a;
  4482. inc(dst, 4);
  4483. end;
  4484. else
  4485. raise EglBitmapUnsupportedFormat.Create(Format);
  4486. end;
  4487. end;
  4488. finally
  4489. FormatDesc.FreeMappingData(srcMD);
  4490. end;
  4491. result := true;
  4492. end;
  4493. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4494. function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4495. var
  4496. tex: TglBitmap2D;
  4497. begin
  4498. tex := TglBitmap2D.Create;
  4499. try
  4500. tex.AssignFromLazIntfImage(aImage);
  4501. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4502. finally
  4503. tex.Free;
  4504. end;
  4505. end;
  4506. {$ENDIF}
  4507. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4508. function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
  4509. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4510. var
  4511. rs: TResourceStream;
  4512. begin
  4513. PrepareResType(aResource, aResType);
  4514. rs := TResourceStream.Create(aInstance, aResource, aResType);
  4515. try
  4516. result := AddAlphaFromStream(rs, aFunc, aArgs);
  4517. finally
  4518. rs.Free;
  4519. end;
  4520. end;
  4521. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4522. function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  4523. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4524. var
  4525. rs: TResourceStream;
  4526. begin
  4527. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  4528. try
  4529. result := AddAlphaFromStream(rs, aFunc, aArgs);
  4530. finally
  4531. rs.Free;
  4532. end;
  4533. end;
  4534. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4535. function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4536. begin
  4537. if TFormatDescriptor.Get(Format).IsCompressed then
  4538. raise EglBitmapUnsupportedFormat.Create(Format);
  4539. result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
  4540. end;
  4541. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4542. function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4543. var
  4544. FS: TFileStream;
  4545. begin
  4546. FS := TFileStream.Create(aFileName, fmOpenRead);
  4547. try
  4548. result := AddAlphaFromStream(FS, aFunc, aArgs);
  4549. finally
  4550. FS.Free;
  4551. end;
  4552. end;
  4553. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4554. function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4555. var
  4556. tex: TglBitmap2D;
  4557. begin
  4558. tex := TglBitmap2D.Create(aStream);
  4559. try
  4560. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4561. finally
  4562. tex.Free;
  4563. end;
  4564. end;
  4565. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4566. function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4567. var
  4568. DestData, DestData2, SourceData: pByte;
  4569. TempHeight, TempWidth: Integer;
  4570. SourceFD, DestFD: TFormatDescriptor;
  4571. SourceMD, DestMD, DestMD2: Pointer;
  4572. FuncRec: TglBitmapFunctionRec;
  4573. begin
  4574. result := false;
  4575. Assert(Assigned(Data));
  4576. Assert(Assigned(aBitmap));
  4577. Assert(Assigned(aBitmap.Data));
  4578. if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
  4579. result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
  4580. SourceFD := TFormatDescriptor.Get(aBitmap.Format);
  4581. DestFD := TFormatDescriptor.Get(Format);
  4582. if not Assigned(aFunc) then begin
  4583. aFunc := glBitmapAlphaFunc;
  4584. FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
  4585. end else
  4586. FuncRec.Args := aArgs;
  4587. // Values
  4588. TempHeight := aBitmap.FileHeight;
  4589. TempWidth := aBitmap.FileWidth;
  4590. FuncRec.Sender := Self;
  4591. FuncRec.Size := Dimension;
  4592. FuncRec.Position.Fields := FuncRec.Size.Fields;
  4593. DestData := Data;
  4594. DestData2 := Data;
  4595. SourceData := aBitmap.Data;
  4596. // Mapping
  4597. SourceFD.PreparePixel(FuncRec.Source);
  4598. DestFD.PreparePixel (FuncRec.Dest);
  4599. SourceMD := SourceFD.CreateMappingData;
  4600. DestMD := DestFD.CreateMappingData;
  4601. DestMD2 := DestFD.CreateMappingData;
  4602. try
  4603. FuncRec.Position.Y := 0;
  4604. while FuncRec.Position.Y < TempHeight do begin
  4605. FuncRec.Position.X := 0;
  4606. while FuncRec.Position.X < TempWidth do begin
  4607. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  4608. DestFD.Unmap (DestData, FuncRec.Dest, DestMD);
  4609. aFunc(FuncRec);
  4610. DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
  4611. inc(FuncRec.Position.X);
  4612. end;
  4613. inc(FuncRec.Position.Y);
  4614. end;
  4615. finally
  4616. SourceFD.FreeMappingData(SourceMD);
  4617. DestFD.FreeMappingData(DestMD);
  4618. DestFD.FreeMappingData(DestMD2);
  4619. end;
  4620. end;
  4621. end;
  4622. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4623. function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
  4624. begin
  4625. result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
  4626. end;
  4627. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4628. function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
  4629. var
  4630. PixelData: TglBitmapPixelData;
  4631. begin
  4632. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4633. result := AddAlphaFromColorKeyFloat(
  4634. aRed / PixelData.Range.r,
  4635. aGreen / PixelData.Range.g,
  4636. aBlue / PixelData.Range.b,
  4637. aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
  4638. end;
  4639. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4640. function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
  4641. var
  4642. values: array[0..2] of Single;
  4643. tmp: Cardinal;
  4644. i: Integer;
  4645. PixelData: TglBitmapPixelData;
  4646. begin
  4647. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4648. with PixelData do begin
  4649. values[0] := aRed;
  4650. values[1] := aGreen;
  4651. values[2] := aBlue;
  4652. for i := 0 to 2 do begin
  4653. tmp := Trunc(Range.arr[i] * aDeviation);
  4654. Data.arr[i] := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
  4655. Range.arr[i] := Max(0, Trunc(Range.arr[i] * values[i] - tmp));
  4656. end;
  4657. Data.a := 0;
  4658. Range.a := 0;
  4659. end;
  4660. result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
  4661. end;
  4662. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4663. function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
  4664. begin
  4665. result := AddAlphaFromValueFloat(aAlpha / $FF);
  4666. end;
  4667. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4668. function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  4669. var
  4670. PixelData: TglBitmapPixelData;
  4671. begin
  4672. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4673. result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
  4674. end;
  4675. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4676. function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  4677. var
  4678. PixelData: TglBitmapPixelData;
  4679. begin
  4680. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4681. with PixelData do
  4682. Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
  4683. result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
  4684. end;
  4685. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4686. function TglBitmap.RemoveAlpha: Boolean;
  4687. var
  4688. FormatDesc: TFormatDescriptor;
  4689. begin
  4690. result := false;
  4691. FormatDesc := TFormatDescriptor.Get(Format);
  4692. if Assigned(Data) then begin
  4693. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  4694. raise EglBitmapUnsupportedFormat.Create(Format);
  4695. result := ConvertTo(FormatDesc.WithoutAlpha);
  4696. end;
  4697. end;
  4698. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4699. function TglBitmap.Clone: TglBitmap;
  4700. var
  4701. Temp: TglBitmap;
  4702. TempPtr: PByte;
  4703. Size: Integer;
  4704. begin
  4705. result := nil;
  4706. Temp := (ClassType.Create as TglBitmap);
  4707. try
  4708. // copy texture data if assigned
  4709. if Assigned(Data) then begin
  4710. Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
  4711. GetMem(TempPtr, Size);
  4712. try
  4713. Move(Data^, TempPtr^, Size);
  4714. Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
  4715. except
  4716. if Assigned(TempPtr) then
  4717. FreeMem(TempPtr);
  4718. raise;
  4719. end;
  4720. end else begin
  4721. TempPtr := nil;
  4722. Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
  4723. end;
  4724. // copy properties
  4725. Temp.fID := ID;
  4726. Temp.fTarget := Target;
  4727. Temp.fFormat := Format;
  4728. Temp.fMipMap := MipMap;
  4729. Temp.fAnisotropic := Anisotropic;
  4730. Temp.fBorderColor := fBorderColor;
  4731. Temp.fDeleteTextureOnFree := DeleteTextureOnFree;
  4732. Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
  4733. Temp.fFilterMin := fFilterMin;
  4734. Temp.fFilterMag := fFilterMag;
  4735. Temp.fWrapS := fWrapS;
  4736. Temp.fWrapT := fWrapT;
  4737. Temp.fWrapR := fWrapR;
  4738. Temp.fFilename := fFilename;
  4739. Temp.fCustomName := fCustomName;
  4740. Temp.fCustomNameW := fCustomNameW;
  4741. Temp.fCustomData := fCustomData;
  4742. result := Temp;
  4743. except
  4744. FreeAndNil(Temp);
  4745. raise;
  4746. end;
  4747. end;
  4748. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4749. function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
  4750. var
  4751. SourceFD, DestFD: TFormatDescriptor;
  4752. SourcePD, DestPD: TglBitmapPixelData;
  4753. ShiftData: TShiftData;
  4754. function CanCopyDirect: Boolean;
  4755. begin
  4756. result :=
  4757. ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  4758. ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  4759. ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  4760. ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  4761. end;
  4762. function CanShift: Boolean;
  4763. begin
  4764. result :=
  4765. ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  4766. ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  4767. ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  4768. ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  4769. end;
  4770. function GetShift(aSource, aDest: Cardinal) : ShortInt;
  4771. begin
  4772. result := 0;
  4773. while (aSource > aDest) and (aSource > 0) do begin
  4774. inc(result);
  4775. aSource := aSource shr 1;
  4776. end;
  4777. end;
  4778. begin
  4779. if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
  4780. SourceFD := TFormatDescriptor.Get(Format);
  4781. DestFD := TFormatDescriptor.Get(aFormat);
  4782. SourceFD.PreparePixel(SourcePD);
  4783. DestFD.PreparePixel (DestPD);
  4784. if CanCopyDirect then
  4785. result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
  4786. else if CanShift then begin
  4787. ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
  4788. ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
  4789. ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
  4790. ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
  4791. result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
  4792. end else
  4793. result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
  4794. end else
  4795. result := true;
  4796. end;
  4797. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4798. procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
  4799. begin
  4800. if aUseRGB or aUseAlpha then
  4801. AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
  4802. ((Byte(aUseAlpha) and 1) shl 1) or
  4803. (Byte(aUseRGB) and 1) ));
  4804. end;
  4805. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4806. procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  4807. begin
  4808. fBorderColor[0] := aRed;
  4809. fBorderColor[1] := aGreen;
  4810. fBorderColor[2] := aBlue;
  4811. fBorderColor[3] := aAlpha;
  4812. if (ID > 0) then begin
  4813. Bind(false);
  4814. glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
  4815. end;
  4816. end;
  4817. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4818. procedure TglBitmap.FreeData;
  4819. var
  4820. TempPtr: PByte;
  4821. begin
  4822. TempPtr := nil;
  4823. SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method
  4824. end;
  4825. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4826. procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
  4827. const aAlpha: Byte);
  4828. begin
  4829. FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
  4830. end;
  4831. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4832. procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
  4833. var
  4834. PixelData: TglBitmapPixelData;
  4835. begin
  4836. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4837. FillWithColorFloat(
  4838. aRed / PixelData.Range.r,
  4839. aGreen / PixelData.Range.g,
  4840. aBlue / PixelData.Range.b,
  4841. aAlpha / PixelData.Range.a);
  4842. end;
  4843. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4844. procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
  4845. var
  4846. PixelData: TglBitmapPixelData;
  4847. begin
  4848. TFormatDescriptor.Get(Format).PreparePixel(PixelData);
  4849. with PixelData do begin
  4850. Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
  4851. Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
  4852. Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
  4853. Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
  4854. end;
  4855. AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
  4856. end;
  4857. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4858. procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
  4859. begin
  4860. //check MIN filter
  4861. case aMin of
  4862. GL_NEAREST:
  4863. fFilterMin := GL_NEAREST;
  4864. GL_LINEAR:
  4865. fFilterMin := GL_LINEAR;
  4866. GL_NEAREST_MIPMAP_NEAREST:
  4867. fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
  4868. GL_LINEAR_MIPMAP_NEAREST:
  4869. fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
  4870. GL_NEAREST_MIPMAP_LINEAR:
  4871. fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
  4872. GL_LINEAR_MIPMAP_LINEAR:
  4873. fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
  4874. else
  4875. raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
  4876. end;
  4877. //check MAG filter
  4878. case aMag of
  4879. GL_NEAREST:
  4880. fFilterMag := GL_NEAREST;
  4881. GL_LINEAR:
  4882. fFilterMag := GL_LINEAR;
  4883. else
  4884. raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
  4885. end;
  4886. //apply filter
  4887. if (ID > 0) then begin
  4888. Bind(false);
  4889. glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
  4890. if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
  4891. case fFilterMin of
  4892. GL_NEAREST, GL_LINEAR:
  4893. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  4894. GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
  4895. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
  4896. GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
  4897. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
  4898. end;
  4899. end else
  4900. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  4901. end;
  4902. end;
  4903. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4904. procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
  4905. procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
  4906. begin
  4907. case aValue of
  4908. GL_CLAMP:
  4909. aTarget := GL_CLAMP;
  4910. GL_REPEAT:
  4911. aTarget := GL_REPEAT;
  4912. GL_CLAMP_TO_EDGE: begin
  4913. if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
  4914. aTarget := GL_CLAMP_TO_EDGE
  4915. else
  4916. aTarget := GL_CLAMP;
  4917. end;
  4918. GL_CLAMP_TO_BORDER: begin
  4919. if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
  4920. aTarget := GL_CLAMP_TO_BORDER
  4921. else
  4922. aTarget := GL_CLAMP;
  4923. end;
  4924. GL_MIRRORED_REPEAT: begin
  4925. if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
  4926. aTarget := GL_MIRRORED_REPEAT
  4927. else
  4928. raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
  4929. end;
  4930. else
  4931. raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
  4932. end;
  4933. end;
  4934. begin
  4935. CheckAndSetWrap(S, fWrapS);
  4936. CheckAndSetWrap(T, fWrapT);
  4937. CheckAndSetWrap(R, fWrapR);
  4938. if (ID > 0) then begin
  4939. Bind(false);
  4940. glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
  4941. glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
  4942. glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
  4943. end;
  4944. end;
  4945. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4946. procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
  4947. procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
  4948. begin
  4949. if (aValue = GL_ZERO) or (aValue = GL_ONE) or (aValue = GL_ALPHA) or
  4950. (aValue = GL_RED) or (aValue = GL_GREEN) or (aValue = GL_BLUE) then
  4951. fSwizzle[aIndex] := aValue
  4952. else
  4953. raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
  4954. end;
  4955. begin
  4956. if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  4957. raise EglBitmapNotSupported.Create('texture swizzle is not supported');
  4958. CheckAndSetValue(r, 0);
  4959. CheckAndSetValue(g, 1);
  4960. CheckAndSetValue(b, 2);
  4961. CheckAndSetValue(a, 3);
  4962. if (ID > 0) then begin
  4963. Bind(false);
  4964. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, PGLint(@fSwizzle[0]));
  4965. end;
  4966. end;
  4967. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4968. procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
  4969. begin
  4970. if aEnableTextureUnit then
  4971. glEnable(Target);
  4972. if (ID > 0) then
  4973. glBindTexture(Target, ID);
  4974. end;
  4975. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4976. procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
  4977. begin
  4978. if aDisableTextureUnit then
  4979. glDisable(Target);
  4980. glBindTexture(Target, 0);
  4981. end;
  4982. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4983. constructor TglBitmap.Create;
  4984. begin
  4985. if (ClassType = TglBitmap) then
  4986. raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
  4987. {$IFDEF GLB_NATIVE_OGL}
  4988. glbReadOpenGLExtensions;
  4989. {$ENDIF}
  4990. inherited Create;
  4991. fFormat := glBitmapGetDefaultFormat;
  4992. fFreeDataOnDestroy := true;
  4993. end;
  4994. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4995. constructor TglBitmap.Create(const aFileName: String);
  4996. begin
  4997. Create;
  4998. LoadFromFile(aFileName);
  4999. end;
  5000. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5001. constructor TglBitmap.Create(const aStream: TStream);
  5002. begin
  5003. Create;
  5004. LoadFromStream(aStream);
  5005. end;
  5006. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5007. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; aData: PByte);
  5008. var
  5009. ImageSize: Integer;
  5010. begin
  5011. Create;
  5012. if not Assigned(aData) then begin
  5013. ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  5014. GetMem(aData, ImageSize);
  5015. try
  5016. FillChar(aData^, ImageSize, #$FF);
  5017. SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  5018. except
  5019. if Assigned(aData) then
  5020. FreeMem(aData);
  5021. raise;
  5022. end;
  5023. end else begin
  5024. SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  5025. fFreeDataOnDestroy := false;
  5026. end;
  5027. end;
  5028. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5029. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer);
  5030. begin
  5031. Create;
  5032. LoadFromFunc(aSize, aFunc, aFormat, aArgs);
  5033. end;
  5034. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5035. constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
  5036. begin
  5037. Create;
  5038. LoadFromResource(aInstance, aResource, aResType);
  5039. end;
  5040. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5041. constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  5042. begin
  5043. Create;
  5044. LoadFromResourceID(aInstance, aResourceID, aResType);
  5045. end;
  5046. {$IFDEF GLB_SUPPORT_PNG_READ}
  5047. {$IF DEFINED(GLB_LAZ_PNG)}
  5048. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5049. //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5050. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5051. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5052. const
  5053. MAGIC_LEN = 8;
  5054. PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
  5055. var
  5056. reader: TLazReaderPNG;
  5057. intf: TLazIntfImage;
  5058. StreamPos: Int64;
  5059. magic: String[MAGIC_LEN];
  5060. begin
  5061. result := true;
  5062. StreamPos := aStream.Position;
  5063. SetLength(magic, MAGIC_LEN);
  5064. aStream.Read(magic[1], MAGIC_LEN);
  5065. aStream.Position := StreamPos;
  5066. if (magic <> PNG_MAGIC) then begin
  5067. result := false;
  5068. exit;
  5069. end;
  5070. intf := TLazIntfImage.Create(0, 0);
  5071. reader := TLazReaderPNG.Create;
  5072. try try
  5073. reader.UpdateDescription := true;
  5074. reader.ImageRead(aStream, intf);
  5075. AssignFromLazIntfImage(intf);
  5076. except
  5077. result := false;
  5078. aStream.Position := StreamPos;
  5079. exit;
  5080. end;
  5081. finally
  5082. reader.Free;
  5083. intf.Free;
  5084. end;
  5085. end;
  5086. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
  5087. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5088. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5089. var
  5090. Surface: PSDL_Surface;
  5091. RWops: PSDL_RWops;
  5092. begin
  5093. result := false;
  5094. RWops := glBitmapCreateRWops(aStream);
  5095. try
  5096. if IMG_isPNG(RWops) > 0 then begin
  5097. Surface := IMG_LoadPNG_RW(RWops);
  5098. try
  5099. AssignFromSurface(Surface);
  5100. result := true;
  5101. finally
  5102. SDL_FreeSurface(Surface);
  5103. end;
  5104. end;
  5105. finally
  5106. SDL_FreeRW(RWops);
  5107. end;
  5108. end;
  5109. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  5110. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5111. procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  5112. begin
  5113. TStream(png_get_io_ptr(png)).Read(buffer^, size);
  5114. end;
  5115. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5116. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5117. var
  5118. StreamPos: Int64;
  5119. signature: array [0..7] of byte;
  5120. png: png_structp;
  5121. png_info: png_infop;
  5122. TempHeight, TempWidth: Integer;
  5123. Format: TglBitmapFormat;
  5124. png_data: pByte;
  5125. png_rows: array of pByte;
  5126. Row, LineSize: Integer;
  5127. begin
  5128. result := false;
  5129. if not init_libPNG then
  5130. raise Exception.Create('LoadPNG - unable to initialize libPNG.');
  5131. try
  5132. // signature
  5133. StreamPos := aStream.Position;
  5134. aStream.Read(signature{%H-}, 8);
  5135. aStream.Position := StreamPos;
  5136. if png_check_sig(@signature, 8) <> 0 then begin
  5137. // png read struct
  5138. png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  5139. if png = nil then
  5140. raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
  5141. // png info
  5142. png_info := png_create_info_struct(png);
  5143. if png_info = nil then begin
  5144. png_destroy_read_struct(@png, nil, nil);
  5145. raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
  5146. end;
  5147. // set read callback
  5148. png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
  5149. // read informations
  5150. png_read_info(png, png_info);
  5151. // size
  5152. TempHeight := png_get_image_height(png, png_info);
  5153. TempWidth := png_get_image_width(png, png_info);
  5154. // format
  5155. case png_get_color_type(png, png_info) of
  5156. PNG_COLOR_TYPE_GRAY:
  5157. Format := tfLuminance8;
  5158. PNG_COLOR_TYPE_GRAY_ALPHA:
  5159. Format := tfLuminance8Alpha8;
  5160. PNG_COLOR_TYPE_RGB:
  5161. Format := tfRGB8;
  5162. PNG_COLOR_TYPE_RGB_ALPHA:
  5163. Format := tfRGBA8;
  5164. else
  5165. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5166. end;
  5167. // cut upper 8 bit from 16 bit formats
  5168. if png_get_bit_depth(png, png_info) > 8 then
  5169. png_set_strip_16(png);
  5170. // expand bitdepth smaller than 8
  5171. if png_get_bit_depth(png, png_info) < 8 then
  5172. png_set_expand(png);
  5173. // allocating mem for scanlines
  5174. LineSize := png_get_rowbytes(png, png_info);
  5175. GetMem(png_data, TempHeight * LineSize);
  5176. try
  5177. SetLength(png_rows, TempHeight);
  5178. for Row := Low(png_rows) to High(png_rows) do begin
  5179. png_rows[Row] := png_data;
  5180. Inc(png_rows[Row], Row * LineSize);
  5181. end;
  5182. // read complete image into scanlines
  5183. png_read_image(png, @png_rows[0]);
  5184. // read end
  5185. png_read_end(png, png_info);
  5186. // destroy read struct
  5187. png_destroy_read_struct(@png, @png_info, nil);
  5188. SetLength(png_rows, 0);
  5189. // set new data
  5190. SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
  5191. result := true;
  5192. except
  5193. if Assigned(png_data) then
  5194. FreeMem(png_data);
  5195. raise;
  5196. end;
  5197. end;
  5198. finally
  5199. quit_libPNG;
  5200. end;
  5201. end;
  5202. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  5203. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5204. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  5205. var
  5206. StreamPos: Int64;
  5207. Png: TPNGObject;
  5208. Header: String[8];
  5209. Row, Col, PixSize, LineSize: Integer;
  5210. NewImage, pSource, pDest, pAlpha: pByte;
  5211. PngFormat: TglBitmapFormat;
  5212. FormatDesc: TFormatDescriptor;
  5213. const
  5214. PngHeader: String[8] = #137#80#78#71#13#10#26#10;
  5215. begin
  5216. result := false;
  5217. StreamPos := aStream.Position;
  5218. aStream.Read(Header[0], SizeOf(Header));
  5219. aStream.Position := StreamPos;
  5220. {Test if the header matches}
  5221. if Header = PngHeader then begin
  5222. Png := TPNGObject.Create;
  5223. try
  5224. Png.LoadFromStream(aStream);
  5225. case Png.Header.ColorType of
  5226. COLOR_GRAYSCALE:
  5227. PngFormat := tfLuminance8;
  5228. COLOR_GRAYSCALEALPHA:
  5229. PngFormat := tfLuminance8Alpha8;
  5230. COLOR_RGB:
  5231. PngFormat := tfBGR8;
  5232. COLOR_RGBALPHA:
  5233. PngFormat := tfBGRA8;
  5234. else
  5235. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5236. end;
  5237. FormatDesc := TFormatDescriptor.Get(PngFormat);
  5238. PixSize := Round(FormatDesc.PixelSize);
  5239. LineSize := FormatDesc.GetSize(Png.Header.Width, 1);
  5240. GetMem(NewImage, LineSize * Integer(Png.Header.Height));
  5241. try
  5242. pDest := NewImage;
  5243. case Png.Header.ColorType of
  5244. COLOR_RGB, COLOR_GRAYSCALE:
  5245. begin
  5246. for Row := 0 to Png.Height -1 do begin
  5247. Move (Png.Scanline[Row]^, pDest^, LineSize);
  5248. Inc(pDest, LineSize);
  5249. end;
  5250. end;
  5251. COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
  5252. begin
  5253. PixSize := PixSize -1;
  5254. for Row := 0 to Png.Height -1 do begin
  5255. pSource := Png.Scanline[Row];
  5256. pAlpha := pByte(Png.AlphaScanline[Row]);
  5257. for Col := 0 to Png.Width -1 do begin
  5258. Move (pSource^, pDest^, PixSize);
  5259. Inc(pSource, PixSize);
  5260. Inc(pDest, PixSize);
  5261. pDest^ := pAlpha^;
  5262. inc(pAlpha);
  5263. Inc(pDest);
  5264. end;
  5265. end;
  5266. end;
  5267. else
  5268. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5269. end;
  5270. SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
  5271. result := true;
  5272. except
  5273. if Assigned(NewImage) then
  5274. FreeMem(NewImage);
  5275. raise;
  5276. end;
  5277. finally
  5278. Png.Free;
  5279. end;
  5280. end;
  5281. end;
  5282. {$IFEND}
  5283. {$ENDIF}
  5284. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  5285. {$IFDEF GLB_LIB_PNG}
  5286. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5287. procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  5288. begin
  5289. TStream(png_get_io_ptr(png)).Write(buffer^, size);
  5290. end;
  5291. {$ENDIF}
  5292. {$IF DEFINED(GLB_LAZ_PNG)}
  5293. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5294. procedure TglBitmap.SavePNG(const aStream: TStream);
  5295. var
  5296. png: TPortableNetworkGraphic;
  5297. intf: TLazIntfImage;
  5298. raw: TRawImage;
  5299. begin
  5300. png := TPortableNetworkGraphic.Create;
  5301. intf := TLazIntfImage.Create(0, 0);
  5302. try
  5303. if not AssignToLazIntfImage(intf) then
  5304. raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
  5305. intf.GetRawImage(raw);
  5306. png.LoadFromRawImage(raw, false);
  5307. png.SaveToStream(aStream);
  5308. finally
  5309. png.Free;
  5310. intf.Free;
  5311. end;
  5312. end;
  5313. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  5314. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5315. procedure TglBitmap.SavePNG(const aStream: TStream);
  5316. var
  5317. png: png_structp;
  5318. png_info: png_infop;
  5319. png_rows: array of pByte;
  5320. LineSize: Integer;
  5321. ColorType: Integer;
  5322. Row: Integer;
  5323. FormatDesc: TFormatDescriptor;
  5324. begin
  5325. if not (ftPNG in FormatGetSupportedFiles(Format)) then
  5326. raise EglBitmapUnsupportedFormat.Create(Format);
  5327. if not init_libPNG then
  5328. raise Exception.Create('unable to initialize libPNG.');
  5329. try
  5330. case Format of
  5331. tfAlpha8, tfLuminance8:
  5332. ColorType := PNG_COLOR_TYPE_GRAY;
  5333. tfLuminance8Alpha8:
  5334. ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
  5335. tfBGR8, tfRGB8:
  5336. ColorType := PNG_COLOR_TYPE_RGB;
  5337. tfBGRA8, tfRGBA8:
  5338. ColorType := PNG_COLOR_TYPE_RGBA;
  5339. else
  5340. raise EglBitmapUnsupportedFormat.Create(Format);
  5341. end;
  5342. FormatDesc := TFormatDescriptor.Get(Format);
  5343. LineSize := FormatDesc.GetSize(Width, 1);
  5344. // creating array for scanline
  5345. SetLength(png_rows, Height);
  5346. try
  5347. for Row := 0 to Height - 1 do begin
  5348. png_rows[Row] := Data;
  5349. Inc(png_rows[Row], Row * LineSize)
  5350. end;
  5351. // write struct
  5352. png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  5353. if png = nil then
  5354. raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
  5355. // create png info
  5356. png_info := png_create_info_struct(png);
  5357. if png_info = nil then begin
  5358. png_destroy_write_struct(@png, nil);
  5359. raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
  5360. end;
  5361. // set read callback
  5362. png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
  5363. // set compression
  5364. png_set_compression_level(png, 6);
  5365. if Format in [tfBGR8, tfBGRA8] then
  5366. png_set_bgr(png);
  5367. png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
  5368. png_write_info(png, png_info);
  5369. png_write_image(png, @png_rows[0]);
  5370. png_write_end(png, png_info);
  5371. png_destroy_write_struct(@png, @png_info);
  5372. finally
  5373. SetLength(png_rows, 0);
  5374. end;
  5375. finally
  5376. quit_libPNG;
  5377. end;
  5378. end;
  5379. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  5380. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5381. procedure TglBitmap.SavePNG(const aStream: TStream);
  5382. var
  5383. Png: TPNGObject;
  5384. pSource, pDest: pByte;
  5385. X, Y, PixSize: Integer;
  5386. ColorType: Cardinal;
  5387. Alpha: Boolean;
  5388. pTemp: pByte;
  5389. Temp: Byte;
  5390. begin
  5391. if not (ftPNG in FormatGetSupportedFiles (Format)) then
  5392. raise EglBitmapUnsupportedFormat.Create(Format);
  5393. case Format of
  5394. tfAlpha8, tfLuminance8: begin
  5395. ColorType := COLOR_GRAYSCALE;
  5396. PixSize := 1;
  5397. Alpha := false;
  5398. end;
  5399. tfLuminance8Alpha8: begin
  5400. ColorType := COLOR_GRAYSCALEALPHA;
  5401. PixSize := 1;
  5402. Alpha := true;
  5403. end;
  5404. tfBGR8, tfRGB8: begin
  5405. ColorType := COLOR_RGB;
  5406. PixSize := 3;
  5407. Alpha := false;
  5408. end;
  5409. tfBGRA8, tfRGBA8: begin
  5410. ColorType := COLOR_RGBALPHA;
  5411. PixSize := 3;
  5412. Alpha := true
  5413. end;
  5414. else
  5415. raise EglBitmapUnsupportedFormat.Create(Format);
  5416. end;
  5417. Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
  5418. try
  5419. // Copy ImageData
  5420. pSource := Data;
  5421. for Y := 0 to Height -1 do begin
  5422. pDest := png.ScanLine[Y];
  5423. for X := 0 to Width -1 do begin
  5424. Move(pSource^, pDest^, PixSize);
  5425. Inc(pDest, PixSize);
  5426. Inc(pSource, PixSize);
  5427. if Alpha then begin
  5428. png.AlphaScanline[Y]^[X] := pSource^;
  5429. Inc(pSource);
  5430. end;
  5431. end;
  5432. // convert RGB line to BGR
  5433. if Format in [tfRGB8, tfRGBA8] then begin
  5434. pTemp := png.ScanLine[Y];
  5435. for X := 0 to Width -1 do begin
  5436. Temp := pByteArray(pTemp)^[0];
  5437. pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
  5438. pByteArray(pTemp)^[2] := Temp;
  5439. Inc(pTemp, 3);
  5440. end;
  5441. end;
  5442. end;
  5443. // Save to Stream
  5444. Png.CompressionLevel := 6;
  5445. Png.SaveToStream(aStream);
  5446. finally
  5447. FreeAndNil(Png);
  5448. end;
  5449. end;
  5450. {$IFEND}
  5451. {$ENDIF}
  5452. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5453. //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5454. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5455. {$IFDEF GLB_LIB_JPEG}
  5456. type
  5457. glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
  5458. glBitmap_libJPEG_source_mgr = record
  5459. pub: jpeg_source_mgr;
  5460. SrcStream: TStream;
  5461. SrcBuffer: array [1..4096] of byte;
  5462. end;
  5463. glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
  5464. glBitmap_libJPEG_dest_mgr = record
  5465. pub: jpeg_destination_mgr;
  5466. DestStream: TStream;
  5467. DestBuffer: array [1..4096] of byte;
  5468. end;
  5469. procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
  5470. begin
  5471. //DUMMY
  5472. end;
  5473. procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
  5474. begin
  5475. //DUMMY
  5476. end;
  5477. procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
  5478. begin
  5479. //DUMMY
  5480. end;
  5481. procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
  5482. begin
  5483. //DUMMY
  5484. end;
  5485. procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
  5486. begin
  5487. //DUMMY
  5488. end;
  5489. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5490. function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
  5491. var
  5492. src: glBitmap_libJPEG_source_mgr_ptr;
  5493. bytes: integer;
  5494. begin
  5495. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  5496. bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
  5497. if (bytes <= 0) then begin
  5498. src^.SrcBuffer[1] := $FF;
  5499. src^.SrcBuffer[2] := JPEG_EOI;
  5500. bytes := 2;
  5501. end;
  5502. src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
  5503. src^.pub.bytes_in_buffer := bytes;
  5504. result := true;
  5505. end;
  5506. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5507. procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
  5508. var
  5509. src: glBitmap_libJPEG_source_mgr_ptr;
  5510. begin
  5511. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  5512. if num_bytes > 0 then begin
  5513. // wanted byte isn't in buffer so set stream position and read buffer
  5514. if num_bytes > src^.pub.bytes_in_buffer then begin
  5515. src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
  5516. src^.pub.fill_input_buffer(cinfo);
  5517. end else begin
  5518. // wanted byte is in buffer so only skip
  5519. inc(src^.pub.next_input_byte, num_bytes);
  5520. dec(src^.pub.bytes_in_buffer, num_bytes);
  5521. end;
  5522. end;
  5523. end;
  5524. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5525. function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
  5526. var
  5527. dest: glBitmap_libJPEG_dest_mgr_ptr;
  5528. begin
  5529. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  5530. if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
  5531. // write complete buffer
  5532. dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
  5533. // reset buffer
  5534. dest^.pub.next_output_byte := @dest^.DestBuffer[1];
  5535. dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
  5536. end;
  5537. result := true;
  5538. end;
  5539. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5540. procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
  5541. var
  5542. Idx: Integer;
  5543. dest: glBitmap_libJPEG_dest_mgr_ptr;
  5544. begin
  5545. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  5546. for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
  5547. // check for endblock
  5548. if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
  5549. // write endblock
  5550. dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
  5551. // leave
  5552. break;
  5553. end else
  5554. dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
  5555. end;
  5556. end;
  5557. {$ENDIF}
  5558. {$IFDEF GLB_SUPPORT_JPEG_READ}
  5559. {$IF DEFINED(GLB_LAZ_JPEG)}
  5560. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5561. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5562. const
  5563. MAGIC_LEN = 2;
  5564. JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
  5565. var
  5566. intf: TLazIntfImage;
  5567. reader: TFPReaderJPEG;
  5568. StreamPos: Int64;
  5569. magic: String[MAGIC_LEN];
  5570. begin
  5571. result := true;
  5572. StreamPos := aStream.Position;
  5573. SetLength(magic, MAGIC_LEN);
  5574. aStream.Read(magic[1], MAGIC_LEN);
  5575. aStream.Position := StreamPos;
  5576. if (magic <> JPEG_MAGIC) then begin
  5577. result := false;
  5578. exit;
  5579. end;
  5580. reader := TFPReaderJPEG.Create;
  5581. intf := TLazIntfImage.Create(0, 0);
  5582. try try
  5583. intf.DataDescription := GetDescriptionFromDevice(0, 0, 0);
  5584. reader.ImageRead(aStream, intf);
  5585. AssignFromLazIntfImage(intf);
  5586. except
  5587. result := false;
  5588. aStream.Position := StreamPos;
  5589. exit;
  5590. end;
  5591. finally
  5592. reader.Free;
  5593. intf.Free;
  5594. end;
  5595. end;
  5596. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
  5597. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5598. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5599. var
  5600. Surface: PSDL_Surface;
  5601. RWops: PSDL_RWops;
  5602. begin
  5603. result := false;
  5604. RWops := glBitmapCreateRWops(aStream);
  5605. try
  5606. if IMG_isJPG(RWops) > 0 then begin
  5607. Surface := IMG_LoadJPG_RW(RWops);
  5608. try
  5609. AssignFromSurface(Surface);
  5610. result := true;
  5611. finally
  5612. SDL_FreeSurface(Surface);
  5613. end;
  5614. end;
  5615. finally
  5616. SDL_FreeRW(RWops);
  5617. end;
  5618. end;
  5619. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  5620. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5621. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5622. var
  5623. StreamPos: Int64;
  5624. Temp: array[0..1]of Byte;
  5625. jpeg: jpeg_decompress_struct;
  5626. jpeg_err: jpeg_error_mgr;
  5627. IntFormat: TglBitmapFormat;
  5628. pImage: pByte;
  5629. TempHeight, TempWidth: Integer;
  5630. pTemp: pByte;
  5631. Row: Integer;
  5632. FormatDesc: TFormatDescriptor;
  5633. begin
  5634. result := false;
  5635. if not init_libJPEG then
  5636. raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
  5637. try
  5638. // reading first two bytes to test file and set cursor back to begin
  5639. StreamPos := aStream.Position;
  5640. aStream.Read({%H-}Temp[0], 2);
  5641. aStream.Position := StreamPos;
  5642. // if Bitmap then read file.
  5643. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  5644. FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
  5645. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  5646. // error managment
  5647. jpeg.err := jpeg_std_error(@jpeg_err);
  5648. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  5649. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  5650. // decompression struct
  5651. jpeg_create_decompress(@jpeg);
  5652. // allocation space for streaming methods
  5653. jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
  5654. // seeting up custom functions
  5655. with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
  5656. pub.init_source := glBitmap_libJPEG_init_source;
  5657. pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
  5658. pub.skip_input_data := glBitmap_libJPEG_skip_input_data;
  5659. pub.resync_to_restart := jpeg_resync_to_restart; // use default method
  5660. pub.term_source := glBitmap_libJPEG_term_source;
  5661. pub.bytes_in_buffer := 0; // forces fill_input_buffer on first read
  5662. pub.next_input_byte := nil; // until buffer loaded
  5663. SrcStream := aStream;
  5664. end;
  5665. // set global decoding state
  5666. jpeg.global_state := DSTATE_START;
  5667. // read header of jpeg
  5668. jpeg_read_header(@jpeg, false);
  5669. // setting output parameter
  5670. case jpeg.jpeg_color_space of
  5671. JCS_GRAYSCALE:
  5672. begin
  5673. jpeg.out_color_space := JCS_GRAYSCALE;
  5674. IntFormat := tfLuminance8;
  5675. end;
  5676. else
  5677. jpeg.out_color_space := JCS_RGB;
  5678. IntFormat := tfRGB8;
  5679. end;
  5680. // reading image
  5681. jpeg_start_decompress(@jpeg);
  5682. TempHeight := jpeg.output_height;
  5683. TempWidth := jpeg.output_width;
  5684. FormatDesc := TFormatDescriptor.Get(IntFormat);
  5685. // creating new image
  5686. GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
  5687. try
  5688. pTemp := pImage;
  5689. for Row := 0 to TempHeight -1 do begin
  5690. jpeg_read_scanlines(@jpeg, @pTemp, 1);
  5691. Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
  5692. end;
  5693. // finish decompression
  5694. jpeg_finish_decompress(@jpeg);
  5695. // destroy decompression
  5696. jpeg_destroy_decompress(@jpeg);
  5697. SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  5698. result := true;
  5699. except
  5700. if Assigned(pImage) then
  5701. FreeMem(pImage);
  5702. raise;
  5703. end;
  5704. end;
  5705. finally
  5706. quit_libJPEG;
  5707. end;
  5708. end;
  5709. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  5710. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5711. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5712. var
  5713. bmp: TBitmap;
  5714. jpg: TJPEGImage;
  5715. StreamPos: Int64;
  5716. Temp: array[0..1]of Byte;
  5717. begin
  5718. result := false;
  5719. // reading first two bytes to test file and set cursor back to begin
  5720. StreamPos := aStream.Position;
  5721. aStream.Read(Temp[0], 2);
  5722. aStream.Position := StreamPos;
  5723. // if Bitmap then read file.
  5724. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  5725. bmp := TBitmap.Create;
  5726. try
  5727. jpg := TJPEGImage.Create;
  5728. try
  5729. jpg.LoadFromStream(aStream);
  5730. bmp.Assign(jpg);
  5731. result := AssignFromBitmap(bmp);
  5732. finally
  5733. jpg.Free;
  5734. end;
  5735. finally
  5736. bmp.Free;
  5737. end;
  5738. end;
  5739. end;
  5740. {$IFEND}
  5741. {$ENDIF}
  5742. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  5743. {$IF DEFINED(GLB_LAZ_JPEG)}
  5744. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5745. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  5746. var
  5747. jpeg: TJPEGImage;
  5748. intf: TLazIntfImage;
  5749. raw: TRawImage;
  5750. begin
  5751. jpeg := TJPEGImage.Create;
  5752. intf := TLazIntfImage.Create(0, 0);
  5753. try
  5754. if not AssignToLazIntfImage(intf) then
  5755. raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
  5756. intf.GetRawImage(raw);
  5757. jpeg.LoadFromRawImage(raw, false);
  5758. jpeg.SaveToStream(aStream);
  5759. finally
  5760. intf.Free;
  5761. jpeg.Free;
  5762. end;
  5763. end;
  5764. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  5765. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5766. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  5767. var
  5768. jpeg: jpeg_compress_struct;
  5769. jpeg_err: jpeg_error_mgr;
  5770. Row: Integer;
  5771. pTemp, pTemp2: pByte;
  5772. procedure CopyRow(pDest, pSource: pByte);
  5773. var
  5774. X: Integer;
  5775. begin
  5776. for X := 0 to Width - 1 do begin
  5777. pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
  5778. pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
  5779. pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
  5780. Inc(pDest, 3);
  5781. Inc(pSource, 3);
  5782. end;
  5783. end;
  5784. begin
  5785. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  5786. raise EglBitmapUnsupportedFormat.Create(Format);
  5787. if not init_libJPEG then
  5788. raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
  5789. try
  5790. FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
  5791. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  5792. // error managment
  5793. jpeg.err := jpeg_std_error(@jpeg_err);
  5794. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  5795. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  5796. // compression struct
  5797. jpeg_create_compress(@jpeg);
  5798. // allocation space for streaming methods
  5799. jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
  5800. // seeting up custom functions
  5801. with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
  5802. pub.init_destination := glBitmap_libJPEG_init_destination;
  5803. pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
  5804. pub.term_destination := glBitmap_libJPEG_term_destination;
  5805. pub.next_output_byte := @DestBuffer[1];
  5806. pub.free_in_buffer := Length(DestBuffer);
  5807. DestStream := aStream;
  5808. end;
  5809. // very important state
  5810. jpeg.global_state := CSTATE_START;
  5811. jpeg.image_width := Width;
  5812. jpeg.image_height := Height;
  5813. case Format of
  5814. tfAlpha8, tfLuminance8: begin
  5815. jpeg.input_components := 1;
  5816. jpeg.in_color_space := JCS_GRAYSCALE;
  5817. end;
  5818. tfRGB8, tfBGR8: begin
  5819. jpeg.input_components := 3;
  5820. jpeg.in_color_space := JCS_RGB;
  5821. end;
  5822. end;
  5823. jpeg_set_defaults(@jpeg);
  5824. jpeg_set_quality(@jpeg, 95, true);
  5825. jpeg_start_compress(@jpeg, true);
  5826. pTemp := Data;
  5827. if Format = tfBGR8 then
  5828. GetMem(pTemp2, fRowSize)
  5829. else
  5830. pTemp2 := pTemp;
  5831. try
  5832. for Row := 0 to jpeg.image_height -1 do begin
  5833. // prepare row
  5834. if Format = tfBGR8 then
  5835. CopyRow(pTemp2, pTemp)
  5836. else
  5837. pTemp2 := pTemp;
  5838. // write row
  5839. jpeg_write_scanlines(@jpeg, @pTemp2, 1);
  5840. inc(pTemp, fRowSize);
  5841. end;
  5842. finally
  5843. // free memory
  5844. if Format = tfBGR8 then
  5845. FreeMem(pTemp2);
  5846. end;
  5847. jpeg_finish_compress(@jpeg);
  5848. jpeg_destroy_compress(@jpeg);
  5849. finally
  5850. quit_libJPEG;
  5851. end;
  5852. end;
  5853. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  5854. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5855. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  5856. var
  5857. Bmp: TBitmap;
  5858. Jpg: TJPEGImage;
  5859. begin
  5860. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  5861. raise EglBitmapUnsupportedFormat.Create(Format);
  5862. Bmp := TBitmap.Create;
  5863. try
  5864. Jpg := TJPEGImage.Create;
  5865. try
  5866. AssignToBitmap(Bmp);
  5867. if (Format in [tfAlpha8, tfLuminance8]) then begin
  5868. Jpg.Grayscale := true;
  5869. Jpg.PixelFormat := jf8Bit;
  5870. end;
  5871. Jpg.Assign(Bmp);
  5872. Jpg.SaveToStream(aStream);
  5873. finally
  5874. FreeAndNil(Jpg);
  5875. end;
  5876. finally
  5877. FreeAndNil(Bmp);
  5878. end;
  5879. end;
  5880. {$IFEND}
  5881. {$ENDIF}
  5882. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5883. //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5884. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5885. const
  5886. BMP_MAGIC = $4D42;
  5887. BMP_COMP_RGB = 0;
  5888. BMP_COMP_RLE8 = 1;
  5889. BMP_COMP_RLE4 = 2;
  5890. BMP_COMP_BITFIELDS = 3;
  5891. type
  5892. TBMPHeader = packed record
  5893. bfType: Word;
  5894. bfSize: Cardinal;
  5895. bfReserved1: Word;
  5896. bfReserved2: Word;
  5897. bfOffBits: Cardinal;
  5898. end;
  5899. TBMPInfo = packed record
  5900. biSize: Cardinal;
  5901. biWidth: Longint;
  5902. biHeight: Longint;
  5903. biPlanes: Word;
  5904. biBitCount: Word;
  5905. biCompression: Cardinal;
  5906. biSizeImage: Cardinal;
  5907. biXPelsPerMeter: Longint;
  5908. biYPelsPerMeter: Longint;
  5909. biClrUsed: Cardinal;
  5910. biClrImportant: Cardinal;
  5911. end;
  5912. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5913. function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
  5914. //////////////////////////////////////////////////////////////////////////////////////////////////
  5915. function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapColorRec): TglBitmapFormat;
  5916. begin
  5917. result := tfEmpty;
  5918. aStream.Read(aInfo{%H-}, SizeOf(aInfo));
  5919. FillChar(aMask{%H-}, SizeOf(aMask), 0);
  5920. //Read Compression
  5921. case aInfo.biCompression of
  5922. BMP_COMP_RLE4,
  5923. BMP_COMP_RLE8: begin
  5924. raise EglBitmap.Create('RLE compression is not supported');
  5925. end;
  5926. BMP_COMP_BITFIELDS: begin
  5927. if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
  5928. aStream.Read(aMask.r, SizeOf(aMask.r));
  5929. aStream.Read(aMask.g, SizeOf(aMask.g));
  5930. aStream.Read(aMask.b, SizeOf(aMask.b));
  5931. aStream.Read(aMask.a, SizeOf(aMask.a));
  5932. end else
  5933. raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
  5934. end;
  5935. end;
  5936. //get suitable format
  5937. case aInfo.biBitCount of
  5938. 8: result := tfLuminance8;
  5939. 16: result := tfBGR5;
  5940. 24: result := tfBGR8;
  5941. 32: result := tfBGRA8;
  5942. end;
  5943. end;
  5944. function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
  5945. var
  5946. i, c: Integer;
  5947. ColorTable: TbmpColorTable;
  5948. begin
  5949. result := nil;
  5950. if (aInfo.biBitCount >= 16) then
  5951. exit;
  5952. aFormat := tfLuminance8;
  5953. c := aInfo.biClrUsed;
  5954. if (c = 0) then
  5955. c := 1 shl aInfo.biBitCount;
  5956. SetLength(ColorTable, c);
  5957. for i := 0 to c-1 do begin
  5958. aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
  5959. if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
  5960. aFormat := tfRGB8;
  5961. end;
  5962. result := TbmpColorTableFormat.Create;
  5963. result.PixelSize := aInfo.biBitCount / 8;
  5964. result.ColorTable := ColorTable;
  5965. result.Range := glBitmapColorRec($FF, $FF, $FF, $00);
  5966. end;
  5967. //////////////////////////////////////////////////////////////////////////////////////////////////
  5968. function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
  5969. const aInfo: TBMPInfo): TbmpBitfieldFormat;
  5970. var
  5971. TmpFormat: TglBitmapFormat;
  5972. FormatDesc: TFormatDescriptor;
  5973. begin
  5974. result := nil;
  5975. if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
  5976. for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  5977. FormatDesc := TFormatDescriptor.Get(TmpFormat);
  5978. if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
  5979. aFormat := FormatDesc.Format;
  5980. exit;
  5981. end;
  5982. end;
  5983. if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
  5984. aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
  5985. if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
  5986. aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
  5987. result := TbmpBitfieldFormat.Create;
  5988. result.PixelSize := aInfo.biBitCount / 8;
  5989. result.RedMask := aMask.r;
  5990. result.GreenMask := aMask.g;
  5991. result.BlueMask := aMask.b;
  5992. result.AlphaMask := aMask.a;
  5993. end;
  5994. end;
  5995. var
  5996. //simple types
  5997. StartPos: Int64;
  5998. ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
  5999. PaddingBuff: Cardinal;
  6000. LineBuf, ImageData, TmpData: PByte;
  6001. SourceMD, DestMD: Pointer;
  6002. BmpFormat: TglBitmapFormat;
  6003. //records
  6004. Mask: TglBitmapColorRec;
  6005. Header: TBMPHeader;
  6006. Info: TBMPInfo;
  6007. //classes
  6008. SpecialFormat: TFormatDescriptor;
  6009. FormatDesc: TFormatDescriptor;
  6010. //////////////////////////////////////////////////////////////////////////////////////////////////
  6011. procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
  6012. var
  6013. i: Integer;
  6014. Pixel: TglBitmapPixelData;
  6015. begin
  6016. aStream.Read(aLineBuf^, rbLineSize);
  6017. SpecialFormat.PreparePixel(Pixel);
  6018. for i := 0 to Info.biWidth-1 do begin
  6019. SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
  6020. glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
  6021. FormatDesc.Map(Pixel, aData, DestMD);
  6022. end;
  6023. end;
  6024. begin
  6025. result := false;
  6026. BmpFormat := tfEmpty;
  6027. SpecialFormat := nil;
  6028. LineBuf := nil;
  6029. SourceMD := nil;
  6030. DestMD := nil;
  6031. // Header
  6032. StartPos := aStream.Position;
  6033. aStream.Read(Header{%H-}, SizeOf(Header));
  6034. if Header.bfType = BMP_MAGIC then begin
  6035. try try
  6036. BmpFormat := ReadInfo(Info, Mask);
  6037. SpecialFormat := ReadColorTable(BmpFormat, Info);
  6038. if not Assigned(SpecialFormat) then
  6039. SpecialFormat := CheckBitfields(BmpFormat, Mask, Info);
  6040. aStream.Position := StartPos + Header.bfOffBits;
  6041. if (BmpFormat <> tfEmpty) then begin
  6042. FormatDesc := TFormatDescriptor.Get(BmpFormat);
  6043. rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
  6044. wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
  6045. Padding := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
  6046. //get Memory
  6047. DestMD := FormatDesc.CreateMappingData;
  6048. ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
  6049. GetMem(ImageData, ImageSize);
  6050. if Assigned(SpecialFormat) then begin
  6051. GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
  6052. SourceMD := SpecialFormat.CreateMappingData;
  6053. end;
  6054. //read Data
  6055. try try
  6056. FillChar(ImageData^, ImageSize, $FF);
  6057. TmpData := ImageData;
  6058. if (Info.biHeight > 0) then
  6059. Inc(TmpData, wbLineSize * (Info.biHeight-1));
  6060. for i := 0 to Abs(Info.biHeight)-1 do begin
  6061. if Assigned(SpecialFormat) then
  6062. SpecialFormatReadLine(TmpData, LineBuf) //if is special format read and convert data
  6063. else
  6064. aStream.Read(TmpData^, wbLineSize); //else only read data
  6065. if (Info.biHeight > 0) then
  6066. dec(TmpData, wbLineSize)
  6067. else
  6068. inc(TmpData, wbLineSize);
  6069. aStream.Read(PaddingBuff{%H-}, Padding);
  6070. end;
  6071. SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
  6072. result := true;
  6073. finally
  6074. if Assigned(LineBuf) then
  6075. FreeMem(LineBuf);
  6076. if Assigned(SourceMD) then
  6077. SpecialFormat.FreeMappingData(SourceMD);
  6078. FormatDesc.FreeMappingData(DestMD);
  6079. end;
  6080. except
  6081. if Assigned(ImageData) then
  6082. FreeMem(ImageData);
  6083. raise;
  6084. end;
  6085. end else
  6086. raise EglBitmap.Create('LoadBMP - No suitable format found');
  6087. except
  6088. aStream.Position := StartPos;
  6089. raise;
  6090. end;
  6091. finally
  6092. FreeAndNil(SpecialFormat);
  6093. end;
  6094. end
  6095. else aStream.Position := StartPos;
  6096. end;
  6097. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6098. procedure TglBitmap.SaveBMP(const aStream: TStream);
  6099. var
  6100. Header: TBMPHeader;
  6101. Info: TBMPInfo;
  6102. Converter: TFormatDescriptor;
  6103. FormatDesc: TFormatDescriptor;
  6104. SourceFD, DestFD: Pointer;
  6105. pData, srcData, dstData, ConvertBuffer: pByte;
  6106. Pixel: TglBitmapPixelData;
  6107. ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
  6108. RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
  6109. PaddingBuff: Cardinal;
  6110. function GetLineWidth : Integer;
  6111. begin
  6112. result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
  6113. end;
  6114. begin
  6115. if not (ftBMP in FormatGetSupportedFiles(Format)) then
  6116. raise EglBitmapUnsupportedFormat.Create(Format);
  6117. Converter := nil;
  6118. FormatDesc := TFormatDescriptor.Get(Format);
  6119. ImageSize := FormatDesc.GetSize(Dimension);
  6120. FillChar(Header{%H-}, SizeOf(Header), 0);
  6121. Header.bfType := BMP_MAGIC;
  6122. Header.bfSize := SizeOf(Header) + SizeOf(Info) + ImageSize;
  6123. Header.bfReserved1 := 0;
  6124. Header.bfReserved2 := 0;
  6125. Header.bfOffBits := SizeOf(Header) + SizeOf(Info);
  6126. FillChar(Info{%H-}, SizeOf(Info), 0);
  6127. Info.biSize := SizeOf(Info);
  6128. Info.biWidth := Width;
  6129. Info.biHeight := Height;
  6130. Info.biPlanes := 1;
  6131. Info.biCompression := BMP_COMP_RGB;
  6132. Info.biSizeImage := ImageSize;
  6133. try
  6134. case Format of
  6135. tfLuminance4: begin
  6136. Info.biBitCount := 4;
  6137. Header.bfSize := Header.bfSize + 16 * SizeOf(Cardinal);
  6138. Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
  6139. Converter := TbmpColorTableFormat.Create;
  6140. with (Converter as TbmpColorTableFormat) do begin
  6141. PixelSize := 0.5;
  6142. Format := Format;
  6143. Range := glBitmapColorRec($F, $F, $F, $0);
  6144. CreateColorTable;
  6145. end;
  6146. end;
  6147. tfR3G3B2, tfLuminance8: begin
  6148. Info.biBitCount := 8;
  6149. Header.bfSize := Header.bfSize + 256 * SizeOf(Cardinal);
  6150. Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
  6151. Converter := TbmpColorTableFormat.Create;
  6152. with (Converter as TbmpColorTableFormat) do begin
  6153. PixelSize := 1;
  6154. Format := Format;
  6155. if (Format = tfR3G3B2) then begin
  6156. Range := glBitmapColorRec($7, $7, $3, $0);
  6157. Shift := glBitmapShiftRec(0, 3, 6, 0);
  6158. end else
  6159. Range := glBitmapColorRec($FF, $FF, $FF, $0);
  6160. CreateColorTable;
  6161. end;
  6162. end;
  6163. tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
  6164. tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin
  6165. Info.biBitCount := 16;
  6166. Info.biCompression := BMP_COMP_BITFIELDS;
  6167. end;
  6168. tfBGR8, tfRGB8: begin
  6169. Info.biBitCount := 24;
  6170. if (Format = tfRGB8) then
  6171. Converter := TfdBGR8.Create; //use BGR8 Format Descriptor to Swap RGB Values
  6172. end;
  6173. tfRGB10, tfRGB10A2, tfRGBA8,
  6174. tfBGR10, tfBGR10A2, tfBGRA8: begin
  6175. Info.biBitCount := 32;
  6176. Info.biCompression := BMP_COMP_BITFIELDS;
  6177. end;
  6178. else
  6179. raise EglBitmapUnsupportedFormat.Create(Format);
  6180. end;
  6181. Info.biXPelsPerMeter := 2835;
  6182. Info.biYPelsPerMeter := 2835;
  6183. // prepare bitmasks
  6184. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  6185. Header.bfSize := Header.bfSize + 4 * SizeOf(Cardinal);
  6186. Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
  6187. RedMask := FormatDesc.RedMask;
  6188. GreenMask := FormatDesc.GreenMask;
  6189. BlueMask := FormatDesc.BlueMask;
  6190. AlphaMask := FormatDesc.AlphaMask;
  6191. end;
  6192. // headers
  6193. aStream.Write(Header, SizeOf(Header));
  6194. aStream.Write(Info, SizeOf(Info));
  6195. // colortable
  6196. if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
  6197. with (Converter as TbmpColorTableFormat) do
  6198. aStream.Write(ColorTable[0].b,
  6199. SizeOf(TbmpColorTableEnty) * Length(ColorTable));
  6200. // bitmasks
  6201. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  6202. aStream.Write(RedMask, SizeOf(Cardinal));
  6203. aStream.Write(GreenMask, SizeOf(Cardinal));
  6204. aStream.Write(BlueMask, SizeOf(Cardinal));
  6205. aStream.Write(AlphaMask, SizeOf(Cardinal));
  6206. end;
  6207. // image data
  6208. rbLineSize := Round(Info.biWidth * FormatDesc.PixelSize);
  6209. wbLineSize := Round(Info.biWidth * Info.biBitCount / 8);
  6210. Padding := GetLineWidth - wbLineSize;
  6211. PaddingBuff := 0;
  6212. pData := Data;
  6213. inc(pData, (Height-1) * rbLineSize);
  6214. // prepare row buffer. But only for RGB because RGBA supports color masks
  6215. // so it's possible to change color within the image.
  6216. if Assigned(Converter) then begin
  6217. FormatDesc.PreparePixel(Pixel);
  6218. GetMem(ConvertBuffer, wbLineSize);
  6219. SourceFD := FormatDesc.CreateMappingData;
  6220. DestFD := Converter.CreateMappingData;
  6221. end else
  6222. ConvertBuffer := nil;
  6223. try
  6224. for LineIdx := 0 to Height - 1 do begin
  6225. // preparing row
  6226. if Assigned(Converter) then begin
  6227. srcData := pData;
  6228. dstData := ConvertBuffer;
  6229. for PixelIdx := 0 to Info.biWidth-1 do begin
  6230. FormatDesc.Unmap(srcData, Pixel, SourceFD);
  6231. glBitmapConvertPixel(Pixel, FormatDesc, Converter);
  6232. Converter.Map(Pixel, dstData, DestFD);
  6233. end;
  6234. aStream.Write(ConvertBuffer^, wbLineSize);
  6235. end else begin
  6236. aStream.Write(pData^, rbLineSize);
  6237. end;
  6238. dec(pData, rbLineSize);
  6239. if (Padding > 0) then
  6240. aStream.Write(PaddingBuff, Padding);
  6241. end;
  6242. finally
  6243. // destroy row buffer
  6244. if Assigned(ConvertBuffer) then begin
  6245. FormatDesc.FreeMappingData(SourceFD);
  6246. Converter.FreeMappingData(DestFD);
  6247. FreeMem(ConvertBuffer);
  6248. end;
  6249. end;
  6250. finally
  6251. if Assigned(Converter) then
  6252. Converter.Free;
  6253. end;
  6254. end;
  6255. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6256. //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6257. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6258. type
  6259. TTGAHeader = packed record
  6260. ImageID: Byte;
  6261. ColorMapType: Byte;
  6262. ImageType: Byte;
  6263. //ColorMapSpec: Array[0..4] of Byte;
  6264. ColorMapStart: Word;
  6265. ColorMapLength: Word;
  6266. ColorMapEntrySize: Byte;
  6267. OrigX: Word;
  6268. OrigY: Word;
  6269. Width: Word;
  6270. Height: Word;
  6271. Bpp: Byte;
  6272. ImageDesc: Byte;
  6273. end;
  6274. const
  6275. TGA_UNCOMPRESSED_RGB = 2;
  6276. TGA_UNCOMPRESSED_GRAY = 3;
  6277. TGA_COMPRESSED_RGB = 10;
  6278. TGA_COMPRESSED_GRAY = 11;
  6279. TGA_NONE_COLOR_TABLE = 0;
  6280. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6281. function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
  6282. var
  6283. Header: TTGAHeader;
  6284. ImageData: System.PByte;
  6285. StartPosition: Int64;
  6286. PixelSize, LineSize: Integer;
  6287. tgaFormat: TglBitmapFormat;
  6288. FormatDesc: TFormatDescriptor;
  6289. Counter: packed record
  6290. X, Y: packed record
  6291. low, high, dir: Integer;
  6292. end;
  6293. end;
  6294. const
  6295. CACHE_SIZE = $4000;
  6296. ////////////////////////////////////////////////////////////////////////////////////////
  6297. procedure ReadUncompressed;
  6298. var
  6299. i, j: Integer;
  6300. buf, tmp1, tmp2: System.PByte;
  6301. begin
  6302. buf := nil;
  6303. if (Counter.X.dir < 0) then
  6304. GetMem(buf, LineSize);
  6305. try
  6306. while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
  6307. tmp1 := ImageData;
  6308. inc(tmp1, (Counter.Y.low * LineSize)); //pointer to LineStart
  6309. if (Counter.X.dir < 0) then begin //flip X
  6310. aStream.Read(buf^, LineSize);
  6311. tmp2 := buf;
  6312. inc(tmp2, LineSize - PixelSize); //pointer to last pixel in line
  6313. for i := 0 to Header.Width-1 do begin //for all pixels in line
  6314. for j := 0 to PixelSize-1 do begin //for all bytes in pixel
  6315. tmp1^ := tmp2^;
  6316. inc(tmp1);
  6317. inc(tmp2);
  6318. end;
  6319. dec(tmp2, 2*PixelSize); //move 2 backwards, because j-loop moved 1 forward
  6320. end;
  6321. end else
  6322. aStream.Read(tmp1^, LineSize);
  6323. inc(Counter.Y.low, Counter.Y.dir); //move to next line index
  6324. end;
  6325. finally
  6326. if Assigned(buf) then
  6327. FreeMem(buf);
  6328. end;
  6329. end;
  6330. ////////////////////////////////////////////////////////////////////////////////////////
  6331. procedure ReadCompressed;
  6332. /////////////////////////////////////////////////////////////////
  6333. var
  6334. TmpData: System.PByte;
  6335. LinePixelsRead: Integer;
  6336. procedure CheckLine;
  6337. begin
  6338. if (LinePixelsRead >= Header.Width) then begin
  6339. LinePixelsRead := 0;
  6340. inc(Counter.Y.low, Counter.Y.dir); //next line index
  6341. TmpData := ImageData;
  6342. inc(TmpData, Counter.Y.low * LineSize); //set line
  6343. if (Counter.X.dir < 0) then //if x flipped then
  6344. inc(TmpData, LineSize - PixelSize); //set last pixel
  6345. end;
  6346. end;
  6347. /////////////////////////////////////////////////////////////////
  6348. var
  6349. Cache: PByte;
  6350. CacheSize, CachePos: Integer;
  6351. procedure CachedRead(out Buffer; Count: Integer);
  6352. var
  6353. BytesRead: Integer;
  6354. begin
  6355. if (CachePos + Count > CacheSize) then begin
  6356. //if buffer overflow save non read bytes
  6357. BytesRead := 0;
  6358. if (CacheSize - CachePos > 0) then begin
  6359. BytesRead := CacheSize - CachePos;
  6360. Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
  6361. inc(CachePos, BytesRead);
  6362. end;
  6363. //load cache from file
  6364. CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
  6365. aStream.Read(Cache^, CacheSize);
  6366. CachePos := 0;
  6367. //read rest of requested bytes
  6368. if (Count - BytesRead > 0) then begin
  6369. Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
  6370. inc(CachePos, Count - BytesRead);
  6371. end;
  6372. end else begin
  6373. //if no buffer overflow just read the data
  6374. Move(PByteArray(Cache)^[CachePos], Buffer, Count);
  6375. inc(CachePos, Count);
  6376. end;
  6377. end;
  6378. procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
  6379. begin
  6380. case PixelSize of
  6381. 1: begin
  6382. aBuffer^ := aData^;
  6383. inc(aBuffer, Counter.X.dir);
  6384. end;
  6385. 2: begin
  6386. PWord(aBuffer)^ := PWord(aData)^;
  6387. inc(aBuffer, 2 * Counter.X.dir);
  6388. end;
  6389. 3: begin
  6390. PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
  6391. PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
  6392. PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
  6393. inc(aBuffer, 3 * Counter.X.dir);
  6394. end;
  6395. 4: begin
  6396. PCardinal(aBuffer)^ := PCardinal(aData)^;
  6397. inc(aBuffer, 4 * Counter.X.dir);
  6398. end;
  6399. end;
  6400. end;
  6401. var
  6402. TotalPixelsToRead, TotalPixelsRead: Integer;
  6403. Temp: Byte;
  6404. buf: array [0..3] of Byte; //1 pixel is max 32bit long
  6405. PixelRepeat: Boolean;
  6406. PixelsToRead, PixelCount: Integer;
  6407. begin
  6408. CacheSize := 0;
  6409. CachePos := 0;
  6410. TotalPixelsToRead := Header.Width * Header.Height;
  6411. TotalPixelsRead := 0;
  6412. LinePixelsRead := 0;
  6413. GetMem(Cache, CACHE_SIZE);
  6414. try
  6415. TmpData := ImageData;
  6416. inc(TmpData, Counter.Y.low * LineSize); //set line
  6417. if (Counter.X.dir < 0) then //if x flipped then
  6418. inc(TmpData, LineSize - PixelSize); //set last pixel
  6419. repeat
  6420. //read CommandByte
  6421. CachedRead(Temp, 1);
  6422. PixelRepeat := (Temp and $80) > 0;
  6423. PixelsToRead := (Temp and $7F) + 1;
  6424. inc(TotalPixelsRead, PixelsToRead);
  6425. if PixelRepeat then
  6426. CachedRead(buf[0], PixelSize);
  6427. while (PixelsToRead > 0) do begin
  6428. CheckLine;
  6429. PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
  6430. while (PixelCount > 0) do begin
  6431. if not PixelRepeat then
  6432. CachedRead(buf[0], PixelSize);
  6433. PixelToBuffer(@buf[0], TmpData);
  6434. inc(LinePixelsRead);
  6435. dec(PixelsToRead);
  6436. dec(PixelCount);
  6437. end;
  6438. end;
  6439. until (TotalPixelsRead >= TotalPixelsToRead);
  6440. finally
  6441. FreeMem(Cache);
  6442. end;
  6443. end;
  6444. function IsGrayFormat: Boolean;
  6445. begin
  6446. result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
  6447. end;
  6448. begin
  6449. result := false;
  6450. // reading header to test file and set cursor back to begin
  6451. StartPosition := aStream.Position;
  6452. aStream.Read(Header{%H-}, SizeOf(Header));
  6453. // no colormapped files
  6454. if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
  6455. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
  6456. begin
  6457. try
  6458. if Header.ImageID <> 0 then // skip image ID
  6459. aStream.Position := aStream.Position + Header.ImageID;
  6460. tgaFormat := tfEmpty;
  6461. case Header.Bpp of
  6462. 8: if IsGrayFormat then case (Header.ImageDesc and $F) of
  6463. 0: tgaFormat := tfLuminance8;
  6464. 8: tgaFormat := tfAlpha8;
  6465. end;
  6466. 16: if IsGrayFormat then case (Header.ImageDesc and $F) of
  6467. 0: tgaFormat := tfLuminance16;
  6468. 8: tgaFormat := tfLuminance8Alpha8;
  6469. end else case (Header.ImageDesc and $F) of
  6470. 0: tgaFormat := tfBGR5;
  6471. 1: tgaFormat := tfBGR5A1;
  6472. 4: tgaFormat := tfBGRA4;
  6473. end;
  6474. 24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  6475. 0: tgaFormat := tfBGR8;
  6476. end;
  6477. 32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  6478. 2: tgaFormat := tfBGR10A2;
  6479. 8: tgaFormat := tfBGRA8;
  6480. end;
  6481. end;
  6482. if (tgaFormat = tfEmpty) then
  6483. raise EglBitmap.Create('LoadTga - unsupported format');
  6484. FormatDesc := TFormatDescriptor.Get(tgaFormat);
  6485. PixelSize := FormatDesc.GetSize(1, 1);
  6486. LineSize := FormatDesc.GetSize(Header.Width, 1);
  6487. GetMem(ImageData, LineSize * Header.Height);
  6488. try
  6489. //column direction
  6490. if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
  6491. Counter.X.low := Header.Height-1;;
  6492. Counter.X.high := 0;
  6493. Counter.X.dir := -1;
  6494. end else begin
  6495. Counter.X.low := 0;
  6496. Counter.X.high := Header.Height-1;
  6497. Counter.X.dir := 1;
  6498. end;
  6499. // Row direction
  6500. if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
  6501. Counter.Y.low := 0;
  6502. Counter.Y.high := Header.Height-1;
  6503. Counter.Y.dir := 1;
  6504. end else begin
  6505. Counter.Y.low := Header.Height-1;;
  6506. Counter.Y.high := 0;
  6507. Counter.Y.dir := -1;
  6508. end;
  6509. // Read Image
  6510. case Header.ImageType of
  6511. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
  6512. ReadUncompressed;
  6513. TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
  6514. ReadCompressed;
  6515. end;
  6516. SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
  6517. result := true;
  6518. except
  6519. if Assigned(ImageData) then
  6520. FreeMem(ImageData);
  6521. raise;
  6522. end;
  6523. finally
  6524. aStream.Position := StartPosition;
  6525. end;
  6526. end
  6527. else aStream.Position := StartPosition;
  6528. end;
  6529. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6530. procedure TglBitmap.SaveTGA(const aStream: TStream);
  6531. var
  6532. Header: TTGAHeader;
  6533. LineSize, Size, x, y: Integer;
  6534. Pixel: TglBitmapPixelData;
  6535. LineBuf, SourceData, DestData: PByte;
  6536. SourceMD, DestMD: Pointer;
  6537. FormatDesc: TFormatDescriptor;
  6538. Converter: TFormatDescriptor;
  6539. begin
  6540. if not (ftTGA in FormatGetSupportedFiles(Format)) then
  6541. raise EglBitmapUnsupportedFormat.Create(Format);
  6542. //prepare header
  6543. FillChar(Header{%H-}, SizeOf(Header), 0);
  6544. //set ImageType
  6545. if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
  6546. tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
  6547. Header.ImageType := TGA_UNCOMPRESSED_GRAY
  6548. else
  6549. Header.ImageType := TGA_UNCOMPRESSED_RGB;
  6550. //set BitsPerPixel
  6551. if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
  6552. Header.Bpp := 8
  6553. else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
  6554. tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
  6555. Header.Bpp := 16
  6556. else if (Format in [tfBGR8, tfRGB8]) then
  6557. Header.Bpp := 24
  6558. else
  6559. Header.Bpp := 32;
  6560. //set AlphaBitCount
  6561. case Format of
  6562. tfRGB5A1, tfBGR5A1:
  6563. Header.ImageDesc := 1 and $F;
  6564. tfRGB10A2, tfBGR10A2:
  6565. Header.ImageDesc := 2 and $F;
  6566. tfRGBA4, tfBGRA4:
  6567. Header.ImageDesc := 4 and $F;
  6568. tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
  6569. Header.ImageDesc := 8 and $F;
  6570. end;
  6571. Header.Width := Width;
  6572. Header.Height := Height;
  6573. Header.ImageDesc := Header.ImageDesc or $20; //flip y
  6574. aStream.Write(Header, SizeOf(Header));
  6575. // convert RGB(A) to BGR(A)
  6576. Converter := nil;
  6577. FormatDesc := TFormatDescriptor.Get(Format);
  6578. Size := FormatDesc.GetSize(Dimension);
  6579. if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
  6580. if (FormatDesc.RGBInverted = tfEmpty) then
  6581. raise EglBitmap.Create('inverted RGB format is empty');
  6582. Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
  6583. if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
  6584. (Converter.PixelSize <> FormatDesc.PixelSize) then
  6585. raise EglBitmap.Create('invalid inverted RGB format');
  6586. end;
  6587. if Assigned(Converter) then begin
  6588. LineSize := FormatDesc.GetSize(Width, 1);
  6589. GetMem(LineBuf, LineSize);
  6590. SourceMD := FormatDesc.CreateMappingData;
  6591. DestMD := Converter.CreateMappingData;
  6592. try
  6593. SourceData := Data;
  6594. for y := 0 to Height-1 do begin
  6595. DestData := LineBuf;
  6596. for x := 0 to Width-1 do begin
  6597. FormatDesc.Unmap(SourceData, Pixel, SourceMD);
  6598. Converter.Map(Pixel, DestData, DestMD);
  6599. end;
  6600. aStream.Write(LineBuf^, LineSize);
  6601. end;
  6602. finally
  6603. FreeMem(LineBuf);
  6604. FormatDesc.FreeMappingData(SourceMD);
  6605. FormatDesc.FreeMappingData(DestMD);
  6606. end;
  6607. end else
  6608. aStream.Write(Data^, Size);
  6609. end;
  6610. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6611. //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6612. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6613. const
  6614. DDS_MAGIC: Cardinal = $20534444;
  6615. // DDS_header.dwFlags
  6616. DDSD_CAPS = $00000001;
  6617. DDSD_HEIGHT = $00000002;
  6618. DDSD_WIDTH = $00000004;
  6619. DDSD_PIXELFORMAT = $00001000;
  6620. // DDS_header.sPixelFormat.dwFlags
  6621. DDPF_ALPHAPIXELS = $00000001;
  6622. DDPF_ALPHA = $00000002;
  6623. DDPF_FOURCC = $00000004;
  6624. DDPF_RGB = $00000040;
  6625. DDPF_LUMINANCE = $00020000;
  6626. // DDS_header.sCaps.dwCaps1
  6627. DDSCAPS_TEXTURE = $00001000;
  6628. // DDS_header.sCaps.dwCaps2
  6629. DDSCAPS2_CUBEMAP = $00000200;
  6630. D3DFMT_DXT1 = $31545844;
  6631. D3DFMT_DXT3 = $33545844;
  6632. D3DFMT_DXT5 = $35545844;
  6633. type
  6634. TDDSPixelFormat = packed record
  6635. dwSize: Cardinal;
  6636. dwFlags: Cardinal;
  6637. dwFourCC: Cardinal;
  6638. dwRGBBitCount: Cardinal;
  6639. dwRBitMask: Cardinal;
  6640. dwGBitMask: Cardinal;
  6641. dwBBitMask: Cardinal;
  6642. dwABitMask: Cardinal;
  6643. end;
  6644. TDDSCaps = packed record
  6645. dwCaps1: Cardinal;
  6646. dwCaps2: Cardinal;
  6647. dwDDSX: Cardinal;
  6648. dwReserved: Cardinal;
  6649. end;
  6650. TDDSHeader = packed record
  6651. dwSize: Cardinal;
  6652. dwFlags: Cardinal;
  6653. dwHeight: Cardinal;
  6654. dwWidth: Cardinal;
  6655. dwPitchOrLinearSize: Cardinal;
  6656. dwDepth: Cardinal;
  6657. dwMipMapCount: Cardinal;
  6658. dwReserved: array[0..10] of Cardinal;
  6659. PixelFormat: TDDSPixelFormat;
  6660. Caps: TDDSCaps;
  6661. dwReserved2: Cardinal;
  6662. end;
  6663. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6664. function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
  6665. var
  6666. Header: TDDSHeader;
  6667. Converter: TbmpBitfieldFormat;
  6668. function GetDDSFormat: TglBitmapFormat;
  6669. var
  6670. fd: TFormatDescriptor;
  6671. i: Integer;
  6672. Range: TglBitmapColorRec;
  6673. match: Boolean;
  6674. begin
  6675. result := tfEmpty;
  6676. with Header.PixelFormat do begin
  6677. // Compresses
  6678. if ((dwFlags and DDPF_FOURCC) > 0) then begin
  6679. case Header.PixelFormat.dwFourCC of
  6680. D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
  6681. D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
  6682. D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
  6683. end;
  6684. end else if ((Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin
  6685. //find matching format
  6686. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  6687. fd := TFormatDescriptor.Get(result);
  6688. if fd.MaskMatch(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask) and
  6689. (8 * fd.PixelSize = dwRGBBitCount) then
  6690. exit;
  6691. end;
  6692. //find format with same Range
  6693. Range.r := dwRBitMask;
  6694. Range.g := dwGBitMask;
  6695. Range.b := dwBBitMask;
  6696. Range.a := dwABitMask;
  6697. for i := 0 to 3 do begin
  6698. while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do
  6699. Range.arr[i] := Range.arr[i] shr 1;
  6700. end;
  6701. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  6702. fd := TFormatDescriptor.Get(result);
  6703. match := true;
  6704. for i := 0 to 3 do
  6705. if (fd.Range.arr[i] <> Range.arr[i]) then begin
  6706. match := false;
  6707. break;
  6708. end;
  6709. if match then
  6710. break;
  6711. end;
  6712. //no format with same range found -> use default
  6713. if (result = tfEmpty) then begin
  6714. if (dwABitMask > 0) then
  6715. result := tfBGRA8
  6716. else
  6717. result := tfBGR8;
  6718. end;
  6719. Converter := TbmpBitfieldFormat.Create;
  6720. Converter.RedMask := dwRBitMask;
  6721. Converter.GreenMask := dwGBitMask;
  6722. Converter.BlueMask := dwBBitMask;
  6723. Converter.AlphaMask := dwABitMask;
  6724. Converter.PixelSize := dwRGBBitCount / 8;
  6725. end;
  6726. end;
  6727. end;
  6728. var
  6729. StreamPos: Int64;
  6730. x, y, LineSize, RowSize, Magic: Cardinal;
  6731. NewImage, TmpData, RowData, SrcData: System.PByte;
  6732. SourceMD, DestMD: Pointer;
  6733. Pixel: TglBitmapPixelData;
  6734. ddsFormat: TglBitmapFormat;
  6735. FormatDesc: TFormatDescriptor;
  6736. begin
  6737. result := false;
  6738. Converter := nil;
  6739. StreamPos := aStream.Position;
  6740. // Magic
  6741. aStream.Read(Magic{%H-}, sizeof(Magic));
  6742. if (Magic <> DDS_MAGIC) then begin
  6743. aStream.Position := StreamPos;
  6744. exit;
  6745. end;
  6746. //Header
  6747. aStream.Read(Header{%H-}, sizeof(Header));
  6748. if (Header.dwSize <> SizeOf(Header)) or
  6749. ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
  6750. (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
  6751. begin
  6752. aStream.Position := StreamPos;
  6753. exit;
  6754. end;
  6755. if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
  6756. raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
  6757. ddsFormat := GetDDSFormat;
  6758. try
  6759. if (ddsFormat = tfEmpty) then
  6760. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  6761. FormatDesc := TFormatDescriptor.Get(ddsFormat);
  6762. LineSize := Trunc(Header.dwWidth * FormatDesc.PixelSize);
  6763. GetMem(NewImage, Header.dwHeight * LineSize);
  6764. try
  6765. TmpData := NewImage;
  6766. //Converter needed
  6767. if Assigned(Converter) then begin
  6768. RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
  6769. GetMem(RowData, RowSize);
  6770. SourceMD := Converter.CreateMappingData;
  6771. DestMD := FormatDesc.CreateMappingData;
  6772. try
  6773. for y := 0 to Header.dwHeight-1 do begin
  6774. TmpData := NewImage;
  6775. inc(TmpData, y * LineSize);
  6776. SrcData := RowData;
  6777. aStream.Read(SrcData^, RowSize);
  6778. for x := 0 to Header.dwWidth-1 do begin
  6779. Converter.Unmap(SrcData, Pixel, SourceMD);
  6780. glBitmapConvertPixel(Pixel, Converter, FormatDesc);
  6781. FormatDesc.Map(Pixel, TmpData, DestMD);
  6782. end;
  6783. end;
  6784. finally
  6785. Converter.FreeMappingData(SourceMD);
  6786. FormatDesc.FreeMappingData(DestMD);
  6787. FreeMem(RowData);
  6788. end;
  6789. end else
  6790. // Compressed
  6791. if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
  6792. RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
  6793. for Y := 0 to Header.dwHeight-1 do begin
  6794. aStream.Read(TmpData^, RowSize);
  6795. Inc(TmpData, LineSize);
  6796. end;
  6797. end else
  6798. // Uncompressed
  6799. if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
  6800. RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
  6801. for Y := 0 to Header.dwHeight-1 do begin
  6802. aStream.Read(TmpData^, RowSize);
  6803. Inc(TmpData, LineSize);
  6804. end;
  6805. end else
  6806. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  6807. SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
  6808. result := true;
  6809. except
  6810. if Assigned(NewImage) then
  6811. FreeMem(NewImage);
  6812. raise;
  6813. end;
  6814. finally
  6815. FreeAndNil(Converter);
  6816. end;
  6817. end;
  6818. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6819. procedure TglBitmap.SaveDDS(const aStream: TStream);
  6820. var
  6821. Header: TDDSHeader;
  6822. FormatDesc: TFormatDescriptor;
  6823. begin
  6824. if not (ftDDS in FormatGetSupportedFiles(Format)) then
  6825. raise EglBitmapUnsupportedFormat.Create(Format);
  6826. FormatDesc := TFormatDescriptor.Get(Format);
  6827. // Generell
  6828. FillChar(Header{%H-}, SizeOf(Header), 0);
  6829. Header.dwSize := SizeOf(Header);
  6830. Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
  6831. Header.dwWidth := Max(1, Width);
  6832. Header.dwHeight := Max(1, Height);
  6833. // Caps
  6834. Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
  6835. // Pixelformat
  6836. Header.PixelFormat.dwSize := sizeof(Header);
  6837. if (FormatDesc.IsCompressed) then begin
  6838. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
  6839. case Format of
  6840. tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
  6841. tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
  6842. tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
  6843. end;
  6844. end else if (Format in [tfAlpha8, tfAlpha16]) then begin
  6845. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHA;
  6846. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6847. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6848. end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
  6849. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
  6850. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6851. Header.PixelFormat.dwRBitMask := FormatDesc.RedMask;
  6852. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6853. end else begin
  6854. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
  6855. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6856. Header.PixelFormat.dwRBitMask := FormatDesc.RedMask;
  6857. Header.PixelFormat.dwGBitMask := FormatDesc.GreenMask;
  6858. Header.PixelFormat.dwBBitMask := FormatDesc.BlueMask;
  6859. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6860. end;
  6861. if (FormatDesc.HasAlpha) then
  6862. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
  6863. aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
  6864. aStream.Write(Header, SizeOf(Header));
  6865. aStream.Write(Data^, FormatDesc.GetSize(Dimension));
  6866. end;
  6867. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6868. //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6869. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6870. procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  6871. const aWidth: Integer; const aHeight: Integer);
  6872. var
  6873. pTemp: pByte;
  6874. Size: Integer;
  6875. begin
  6876. if (aHeight > 1) then begin
  6877. Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
  6878. GetMem(pTemp, Size);
  6879. try
  6880. Move(aData^, pTemp^, Size);
  6881. FreeMem(aData);
  6882. aData := nil;
  6883. except
  6884. FreeMem(pTemp);
  6885. raise;
  6886. end;
  6887. end else
  6888. pTemp := aData;
  6889. inherited SetDataPointer(pTemp, aFormat, aWidth);
  6890. end;
  6891. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6892. function TglBitmap1D.FlipHorz: Boolean;
  6893. var
  6894. Col: Integer;
  6895. pTempDest, pDest, pSource: PByte;
  6896. begin
  6897. result := inherited FlipHorz;
  6898. if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
  6899. pSource := Data;
  6900. GetMem(pDest, fRowSize);
  6901. try
  6902. pTempDest := pDest;
  6903. Inc(pTempDest, fRowSize);
  6904. for Col := 0 to Width-1 do begin
  6905. dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
  6906. Move(pSource^, pTempDest^, fPixelSize);
  6907. Inc(pSource, fPixelSize);
  6908. end;
  6909. SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
  6910. result := true;
  6911. except
  6912. if Assigned(pDest) then
  6913. FreeMem(pDest);
  6914. raise;
  6915. end;
  6916. end;
  6917. end;
  6918. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6919. procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
  6920. var
  6921. FormatDesc: TFormatDescriptor;
  6922. begin
  6923. // Upload data
  6924. FormatDesc := TFormatDescriptor.Get(Format);
  6925. if FormatDesc.IsCompressed then begin
  6926. if not Assigned(glCompressedTexImage1D) then
  6927. raise EglBitmap.Create('compressed formats not supported by video adapter');
  6928. glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
  6929. end else if aBuildWithGlu then
  6930. gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  6931. else
  6932. glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  6933. // Free Data
  6934. if (FreeDataAfterGenTexture) then
  6935. FreeData;
  6936. end;
  6937. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6938. procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
  6939. var
  6940. BuildWithGlu, TexRec: Boolean;
  6941. TexSize: Integer;
  6942. begin
  6943. if Assigned(Data) then begin
  6944. // Check Texture Size
  6945. if (aTestTextureSize) then begin
  6946. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  6947. if (Width > TexSize) then
  6948. raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  6949. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
  6950. (Target = GL_TEXTURE_RECTANGLE);
  6951. if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  6952. raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  6953. end;
  6954. CreateId;
  6955. SetupParameters(BuildWithGlu);
  6956. UploadData(BuildWithGlu);
  6957. glAreTexturesResident(1, @fID, @fIsResident);
  6958. end;
  6959. end;
  6960. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6961. procedure TglBitmap1D.AfterConstruction;
  6962. begin
  6963. inherited;
  6964. Target := GL_TEXTURE_1D;
  6965. end;
  6966. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6967. //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6968. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6969. function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
  6970. begin
  6971. if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
  6972. result := fLines[aIndex]
  6973. else
  6974. result := nil;
  6975. end;
  6976. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6977. procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  6978. const aWidth: Integer; const aHeight: Integer);
  6979. var
  6980. Idx, LineWidth: Integer;
  6981. begin
  6982. inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
  6983. if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
  6984. // Assigning Data
  6985. if Assigned(Data) then begin
  6986. SetLength(fLines, GetHeight);
  6987. LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
  6988. for Idx := 0 to GetHeight-1 do begin
  6989. fLines[Idx] := Data;
  6990. Inc(fLines[Idx], Idx * LineWidth);
  6991. end;
  6992. end
  6993. else SetLength(fLines, 0);
  6994. end else begin
  6995. SetLength(fLines, 0);
  6996. end;
  6997. end;
  6998. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6999. procedure TglBitmap2D.UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
  7000. var
  7001. FormatDesc: TFormatDescriptor;
  7002. begin
  7003. glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
  7004. FormatDesc := TFormatDescriptor.Get(Format);
  7005. if FormatDesc.IsCompressed then begin
  7006. if not Assigned(glCompressedTexImage2D) then
  7007. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7008. glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
  7009. end else if aBuildWithGlu then begin
  7010. gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
  7011. FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  7012. end else begin
  7013. glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
  7014. FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  7015. end;
  7016. // Freigeben
  7017. if (FreeDataAfterGenTexture) then
  7018. FreeData;
  7019. end;
  7020. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7021. procedure TglBitmap2D.AfterConstruction;
  7022. begin
  7023. inherited;
  7024. Target := GL_TEXTURE_2D;
  7025. end;
  7026. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7027. procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  7028. var
  7029. Temp: pByte;
  7030. Size, w, h: Integer;
  7031. FormatDesc: TFormatDescriptor;
  7032. begin
  7033. FormatDesc := TFormatDescriptor.Get(aFormat);
  7034. if FormatDesc.IsCompressed then
  7035. raise EglBitmapUnsupportedFormat.Create(aFormat);
  7036. w := aRight - aLeft;
  7037. h := aBottom - aTop;
  7038. Size := FormatDesc.GetSize(w, h);
  7039. GetMem(Temp, Size);
  7040. try
  7041. glPixelStorei(GL_PACK_ALIGNMENT, 1);
  7042. glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  7043. SetDataPointer(Temp, aFormat, w, h); //be careful, Data could be freed by this method
  7044. FlipVert;
  7045. except
  7046. if Assigned(Temp) then
  7047. FreeMem(Temp);
  7048. raise;
  7049. end;
  7050. end;
  7051. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7052. procedure TglBitmap2D.GetDataFromTexture;
  7053. var
  7054. Temp: PByte;
  7055. TempWidth, TempHeight: Integer;
  7056. TempIntFormat: GLint;
  7057. IntFormat, f: TglBitmapFormat;
  7058. FormatDesc: TFormatDescriptor;
  7059. begin
  7060. Bind;
  7061. // Request Data
  7062. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH, @TempWidth);
  7063. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT, @TempHeight);
  7064. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
  7065. IntFormat := tfEmpty;
  7066. for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
  7067. FormatDesc := TFormatDescriptor.Get(f);
  7068. if (FormatDesc.glInternalFormat = TempIntFormat) then begin
  7069. IntFormat := FormatDesc.Format;
  7070. break;
  7071. end;
  7072. end;
  7073. // Getting data from OpenGL
  7074. FormatDesc := TFormatDescriptor.Get(IntFormat);
  7075. GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
  7076. try
  7077. if FormatDesc.IsCompressed then begin
  7078. if not Assigned(glGetCompressedTexImage) then
  7079. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7080. glGetCompressedTexImage(Target, 0, Temp)
  7081. end else
  7082. glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  7083. SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  7084. except
  7085. if Assigned(Temp) then
  7086. FreeMem(Temp);
  7087. raise;
  7088. end;
  7089. end;
  7090. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7091. procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
  7092. var
  7093. BuildWithGlu, PotTex, TexRec: Boolean;
  7094. TexSize: Integer;
  7095. begin
  7096. if Assigned(Data) then begin
  7097. // Check Texture Size
  7098. if (aTestTextureSize) then begin
  7099. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  7100. if ((Height > TexSize) or (Width > TexSize)) then
  7101. raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  7102. PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
  7103. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
  7104. if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  7105. raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7106. end;
  7107. CreateId;
  7108. SetupParameters(BuildWithGlu);
  7109. UploadData(Target, BuildWithGlu);
  7110. glAreTexturesResident(1, @fID, @fIsResident);
  7111. end;
  7112. end;
  7113. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7114. function TglBitmap2D.FlipHorz: Boolean;
  7115. var
  7116. Col, Row: Integer;
  7117. TempDestData, DestData, SourceData: PByte;
  7118. ImgSize: Integer;
  7119. begin
  7120. result := inherited FlipHorz;
  7121. if Assigned(Data) then begin
  7122. SourceData := Data;
  7123. ImgSize := Height * fRowSize;
  7124. GetMem(DestData, ImgSize);
  7125. try
  7126. TempDestData := DestData;
  7127. Dec(TempDestData, fRowSize + fPixelSize);
  7128. for Row := 0 to Height -1 do begin
  7129. Inc(TempDestData, fRowSize * 2);
  7130. for Col := 0 to Width -1 do begin
  7131. Move(SourceData^, TempDestData^, fPixelSize);
  7132. Inc(SourceData, fPixelSize);
  7133. Dec(TempDestData, fPixelSize);
  7134. end;
  7135. end;
  7136. SetDataPointer(DestData, Format); //be careful, Data could be freed by this method
  7137. result := true;
  7138. except
  7139. if Assigned(DestData) then
  7140. FreeMem(DestData);
  7141. raise;
  7142. end;
  7143. end;
  7144. end;
  7145. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7146. function TglBitmap2D.FlipVert: Boolean;
  7147. var
  7148. Row: Integer;
  7149. TempDestData, DestData, SourceData: PByte;
  7150. begin
  7151. result := inherited FlipVert;
  7152. if Assigned(Data) then begin
  7153. SourceData := Data;
  7154. GetMem(DestData, Height * fRowSize);
  7155. try
  7156. TempDestData := DestData;
  7157. Inc(TempDestData, Width * (Height -1) * fPixelSize);
  7158. for Row := 0 to Height -1 do begin
  7159. Move(SourceData^, TempDestData^, fRowSize);
  7160. Dec(TempDestData, fRowSize);
  7161. Inc(SourceData, fRowSize);
  7162. end;
  7163. SetDataPointer(DestData, Format); //be careful, Data could be freed by this method
  7164. result := true;
  7165. except
  7166. if Assigned(DestData) then
  7167. FreeMem(DestData);
  7168. raise;
  7169. end;
  7170. end;
  7171. end;
  7172. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7173. //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7174. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7175. type
  7176. TMatrixItem = record
  7177. X, Y: Integer;
  7178. W: Single;
  7179. end;
  7180. PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
  7181. TglBitmapToNormalMapRec = Record
  7182. Scale: Single;
  7183. Heights: array of Single;
  7184. MatrixU : array of TMatrixItem;
  7185. MatrixV : array of TMatrixItem;
  7186. end;
  7187. const
  7188. ONE_OVER_255 = 1 / 255;
  7189. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7190. procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
  7191. var
  7192. Val: Single;
  7193. begin
  7194. with FuncRec do begin
  7195. Val :=
  7196. Source.Data.r * LUMINANCE_WEIGHT_R +
  7197. Source.Data.g * LUMINANCE_WEIGHT_G +
  7198. Source.Data.b * LUMINANCE_WEIGHT_B;
  7199. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
  7200. end;
  7201. end;
  7202. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7203. procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  7204. begin
  7205. with FuncRec do
  7206. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
  7207. end;
  7208. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7209. procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
  7210. type
  7211. TVec = Array[0..2] of Single;
  7212. var
  7213. Idx: Integer;
  7214. du, dv: Double;
  7215. Len: Single;
  7216. Vec: TVec;
  7217. function GetHeight(X, Y: Integer): Single;
  7218. begin
  7219. with FuncRec do begin
  7220. X := Max(0, Min(Size.X -1, X));
  7221. Y := Max(0, Min(Size.Y -1, Y));
  7222. result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
  7223. end;
  7224. end;
  7225. begin
  7226. with FuncRec do begin
  7227. with PglBitmapToNormalMapRec(Args)^ do begin
  7228. du := 0;
  7229. for Idx := Low(MatrixU) to High(MatrixU) do
  7230. du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
  7231. dv := 0;
  7232. for Idx := Low(MatrixU) to High(MatrixU) do
  7233. dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
  7234. Vec[0] := -du * Scale;
  7235. Vec[1] := -dv * Scale;
  7236. Vec[2] := 1;
  7237. end;
  7238. // Normalize
  7239. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  7240. if Len <> 0 then begin
  7241. Vec[0] := Vec[0] * Len;
  7242. Vec[1] := Vec[1] * Len;
  7243. Vec[2] := Vec[2] * Len;
  7244. end;
  7245. // Farbe zuweisem
  7246. Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
  7247. Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
  7248. Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
  7249. end;
  7250. end;
  7251. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7252. procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
  7253. var
  7254. Rec: TglBitmapToNormalMapRec;
  7255. procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
  7256. begin
  7257. if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
  7258. Matrix[Index].X := X;
  7259. Matrix[Index].Y := Y;
  7260. Matrix[Index].W := W;
  7261. end;
  7262. end;
  7263. begin
  7264. if TFormatDescriptor.Get(Format).IsCompressed then
  7265. raise EglBitmapUnsupportedFormat.Create(Format);
  7266. if aScale > 100 then
  7267. Rec.Scale := 100
  7268. else if aScale < -100 then
  7269. Rec.Scale := -100
  7270. else
  7271. Rec.Scale := aScale;
  7272. SetLength(Rec.Heights, Width * Height);
  7273. try
  7274. case aFunc of
  7275. nm4Samples: begin
  7276. SetLength(Rec.MatrixU, 2);
  7277. SetEntry(Rec.MatrixU, 0, -1, 0, -0.5);
  7278. SetEntry(Rec.MatrixU, 1, 1, 0, 0.5);
  7279. SetLength(Rec.MatrixV, 2);
  7280. SetEntry(Rec.MatrixV, 0, 0, 1, 0.5);
  7281. SetEntry(Rec.MatrixV, 1, 0, -1, -0.5);
  7282. end;
  7283. nmSobel: begin
  7284. SetLength(Rec.MatrixU, 6);
  7285. SetEntry(Rec.MatrixU, 0, -1, 1, -1.0);
  7286. SetEntry(Rec.MatrixU, 1, -1, 0, -2.0);
  7287. SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
  7288. SetEntry(Rec.MatrixU, 3, 1, 1, 1.0);
  7289. SetEntry(Rec.MatrixU, 4, 1, 0, 2.0);
  7290. SetEntry(Rec.MatrixU, 5, 1, -1, 1.0);
  7291. SetLength(Rec.MatrixV, 6);
  7292. SetEntry(Rec.MatrixV, 0, -1, 1, 1.0);
  7293. SetEntry(Rec.MatrixV, 1, 0, 1, 2.0);
  7294. SetEntry(Rec.MatrixV, 2, 1, 1, 1.0);
  7295. SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
  7296. SetEntry(Rec.MatrixV, 4, 0, -1, -2.0);
  7297. SetEntry(Rec.MatrixV, 5, 1, -1, -1.0);
  7298. end;
  7299. nm3x3: begin
  7300. SetLength(Rec.MatrixU, 6);
  7301. SetEntry(Rec.MatrixU, 0, -1, 1, -1/6);
  7302. SetEntry(Rec.MatrixU, 1, -1, 0, -1/6);
  7303. SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
  7304. SetEntry(Rec.MatrixU, 3, 1, 1, 1/6);
  7305. SetEntry(Rec.MatrixU, 4, 1, 0, 1/6);
  7306. SetEntry(Rec.MatrixU, 5, 1, -1, 1/6);
  7307. SetLength(Rec.MatrixV, 6);
  7308. SetEntry(Rec.MatrixV, 0, -1, 1, 1/6);
  7309. SetEntry(Rec.MatrixV, 1, 0, 1, 1/6);
  7310. SetEntry(Rec.MatrixV, 2, 1, 1, 1/6);
  7311. SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
  7312. SetEntry(Rec.MatrixV, 4, 0, -1, -1/6);
  7313. SetEntry(Rec.MatrixV, 5, 1, -1, -1/6);
  7314. end;
  7315. nm5x5: begin
  7316. SetLength(Rec.MatrixU, 20);
  7317. SetEntry(Rec.MatrixU, 0, -2, 2, -1 / 16);
  7318. SetEntry(Rec.MatrixU, 1, -1, 2, -1 / 10);
  7319. SetEntry(Rec.MatrixU, 2, 1, 2, 1 / 10);
  7320. SetEntry(Rec.MatrixU, 3, 2, 2, 1 / 16);
  7321. SetEntry(Rec.MatrixU, 4, -2, 1, -1 / 10);
  7322. SetEntry(Rec.MatrixU, 5, -1, 1, -1 / 8);
  7323. SetEntry(Rec.MatrixU, 6, 1, 1, 1 / 8);
  7324. SetEntry(Rec.MatrixU, 7, 2, 1, 1 / 10);
  7325. SetEntry(Rec.MatrixU, 8, -2, 0, -1 / 2.8);
  7326. SetEntry(Rec.MatrixU, 9, -1, 0, -0.5);
  7327. SetEntry(Rec.MatrixU, 10, 1, 0, 0.5);
  7328. SetEntry(Rec.MatrixU, 11, 2, 0, 1 / 2.8);
  7329. SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
  7330. SetEntry(Rec.MatrixU, 13, -1, -1, -1 / 8);
  7331. SetEntry(Rec.MatrixU, 14, 1, -1, 1 / 8);
  7332. SetEntry(Rec.MatrixU, 15, 2, -1, 1 / 10);
  7333. SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
  7334. SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
  7335. SetEntry(Rec.MatrixU, 18, 1, -2, 1 / 10);
  7336. SetEntry(Rec.MatrixU, 19, 2, -2, 1 / 16);
  7337. SetLength(Rec.MatrixV, 20);
  7338. SetEntry(Rec.MatrixV, 0, -2, 2, 1 / 16);
  7339. SetEntry(Rec.MatrixV, 1, -1, 2, 1 / 10);
  7340. SetEntry(Rec.MatrixV, 2, 0, 2, 0.25);
  7341. SetEntry(Rec.MatrixV, 3, 1, 2, 1 / 10);
  7342. SetEntry(Rec.MatrixV, 4, 2, 2, 1 / 16);
  7343. SetEntry(Rec.MatrixV, 5, -2, 1, 1 / 10);
  7344. SetEntry(Rec.MatrixV, 6, -1, 1, 1 / 8);
  7345. SetEntry(Rec.MatrixV, 7, 0, 1, 0.5);
  7346. SetEntry(Rec.MatrixV, 8, 1, 1, 1 / 8);
  7347. SetEntry(Rec.MatrixV, 9, 2, 1, 1 / 16);
  7348. SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
  7349. SetEntry(Rec.MatrixV, 11, -1, -1, -1 / 8);
  7350. SetEntry(Rec.MatrixV, 12, 0, -1, -0.5);
  7351. SetEntry(Rec.MatrixV, 13, 1, -1, -1 / 8);
  7352. SetEntry(Rec.MatrixV, 14, 2, -1, -1 / 10);
  7353. SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
  7354. SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
  7355. SetEntry(Rec.MatrixV, 17, 0, -2, -0.25);
  7356. SetEntry(Rec.MatrixV, 18, 1, -2, -1 / 10);
  7357. SetEntry(Rec.MatrixV, 19, 2, -2, -1 / 16);
  7358. end;
  7359. end;
  7360. // Daten Sammeln
  7361. if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
  7362. AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
  7363. else
  7364. AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
  7365. AddFunc(glBitmapToNormalMapFunc, false, @Rec);
  7366. finally
  7367. SetLength(Rec.Heights, 0);
  7368. end;
  7369. end;
  7370. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7371. //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7372. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7373. procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);
  7374. begin
  7375. Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
  7376. end;
  7377. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7378. procedure TglBitmapCubeMap.AfterConstruction;
  7379. begin
  7380. inherited;
  7381. if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
  7382. raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
  7383. SetWrap;
  7384. Target := GL_TEXTURE_CUBE_MAP;
  7385. fGenMode := GL_REFLECTION_MAP;
  7386. end;
  7387. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7388. procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);
  7389. var
  7390. BuildWithGlu: Boolean;
  7391. TexSize: Integer;
  7392. begin
  7393. if (aTestTextureSize) then begin
  7394. glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
  7395. if (Height > TexSize) or (Width > TexSize) then
  7396. raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
  7397. if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
  7398. raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
  7399. end;
  7400. if (ID = 0) then
  7401. CreateID;
  7402. SetupParameters(BuildWithGlu);
  7403. UploadData(aCubeTarget, BuildWithGlu);
  7404. end;
  7405. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7406. procedure TglBitmapCubeMap.Bind(const aEnableTexCoordsGen: Boolean; const aEnableTextureUnit: Boolean);
  7407. begin
  7408. inherited Bind (aEnableTextureUnit);
  7409. if aEnableTexCoordsGen then begin
  7410. glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
  7411. glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
  7412. glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
  7413. glEnable(GL_TEXTURE_GEN_S);
  7414. glEnable(GL_TEXTURE_GEN_T);
  7415. glEnable(GL_TEXTURE_GEN_R);
  7416. end;
  7417. end;
  7418. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7419. procedure TglBitmapCubeMap.Unbind(const aDisableTexCoordsGen: Boolean; const aDisableTextureUnit: Boolean);
  7420. begin
  7421. inherited Unbind(aDisableTextureUnit);
  7422. if aDisableTexCoordsGen then begin
  7423. glDisable(GL_TEXTURE_GEN_S);
  7424. glDisable(GL_TEXTURE_GEN_T);
  7425. glDisable(GL_TEXTURE_GEN_R);
  7426. end;
  7427. end;
  7428. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7429. //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7430. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7431. type
  7432. TVec = Array[0..2] of Single;
  7433. TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7434. PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
  7435. TglBitmapNormalMapRec = record
  7436. HalfSize : Integer;
  7437. Func: TglBitmapNormalMapGetVectorFunc;
  7438. end;
  7439. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7440. procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7441. begin
  7442. aVec[0] := aHalfSize;
  7443. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7444. aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
  7445. end;
  7446. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7447. procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7448. begin
  7449. aVec[0] := - aHalfSize;
  7450. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7451. aVec[2] := aPosition.X + 0.5 - aHalfSize;
  7452. end;
  7453. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7454. procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7455. begin
  7456. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7457. aVec[1] := aHalfSize;
  7458. aVec[2] := aPosition.Y + 0.5 - aHalfSize;
  7459. end;
  7460. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7461. procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7462. begin
  7463. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7464. aVec[1] := - aHalfSize;
  7465. aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
  7466. end;
  7467. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7468. procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7469. begin
  7470. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7471. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7472. aVec[2] := aHalfSize;
  7473. end;
  7474. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7475. procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7476. begin
  7477. aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
  7478. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7479. aVec[2] := - aHalfSize;
  7480. end;
  7481. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7482. procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
  7483. var
  7484. i: Integer;
  7485. Vec: TVec;
  7486. Len: Single;
  7487. begin
  7488. with FuncRec do begin
  7489. with PglBitmapNormalMapRec(Args)^ do begin
  7490. Func(Vec, Position, HalfSize);
  7491. // Normalize
  7492. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  7493. if Len <> 0 then begin
  7494. Vec[0] := Vec[0] * Len;
  7495. Vec[1] := Vec[1] * Len;
  7496. Vec[2] := Vec[2] * Len;
  7497. end;
  7498. // Scale Vector and AddVectro
  7499. Vec[0] := Vec[0] * 0.5 + 0.5;
  7500. Vec[1] := Vec[1] * 0.5 + 0.5;
  7501. Vec[2] := Vec[2] * 0.5 + 0.5;
  7502. end;
  7503. // Set Color
  7504. for i := 0 to 2 do
  7505. Dest.Data.arr[i] := Round(Vec[i] * 255);
  7506. end;
  7507. end;
  7508. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7509. procedure TglBitmapNormalMap.AfterConstruction;
  7510. begin
  7511. inherited;
  7512. fGenMode := GL_NORMAL_MAP;
  7513. end;
  7514. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7515. procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);
  7516. var
  7517. Rec: TglBitmapNormalMapRec;
  7518. SizeRec: TglBitmapPixelPosition;
  7519. begin
  7520. Rec.HalfSize := aSize div 2;
  7521. FreeDataAfterGenTexture := false;
  7522. SizeRec.Fields := [ffX, ffY];
  7523. SizeRec.X := aSize;
  7524. SizeRec.Y := aSize;
  7525. // Positive X
  7526. Rec.Func := glBitmapNormalMapPosX;
  7527. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7528. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);
  7529. // Negative X
  7530. Rec.Func := glBitmapNormalMapNegX;
  7531. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7532. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);
  7533. // Positive Y
  7534. Rec.Func := glBitmapNormalMapPosY;
  7535. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7536. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);
  7537. // Negative Y
  7538. Rec.Func := glBitmapNormalMapNegY;
  7539. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7540. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);
  7541. // Positive Z
  7542. Rec.Func := glBitmapNormalMapPosZ;
  7543. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7544. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);
  7545. // Negative Z
  7546. Rec.Func := glBitmapNormalMapNegZ;
  7547. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7548. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);
  7549. end;
  7550. initialization
  7551. glBitmapSetDefaultFormat (tfEmpty);
  7552. glBitmapSetDefaultMipmap (mmMipmap);
  7553. glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
  7554. glBitmapSetDefaultWrap (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
  7555. glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
  7556. glBitmapSetDefaultFreeDataAfterGenTexture(true);
  7557. glBitmapSetDefaultDeleteTextureOnFree (true);
  7558. TFormatDescriptor.Init;
  7559. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  7560. OpenGLInitialized := false;
  7561. InitOpenGLCS := TCriticalSection.Create;
  7562. {$ENDIF}
  7563. finalization
  7564. TFormatDescriptor.Finalize;
  7565. {$IFDEF GLB_NATIVE_OGL}
  7566. if Assigned(GL_LibHandle) then
  7567. glbFreeLibrary(GL_LibHandle);
  7568. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  7569. if Assigned(GLU_LibHandle) then
  7570. glbFreeLibrary(GLU_LibHandle);
  7571. FreeAndNil(InitOpenGLCS);
  7572. {$ENDIF}
  7573. {$ENDIF}
  7574. end.