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.

8304 lines
287 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/)
  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 2.0.3
  13. ------------------------------------------------------------
  14. History
  15. 21-03-2010
  16. - The define GLB_DELPHI dosn't check versions anymore. If you say you are using delphi
  17. then it's your problem if that isn't true. This prevents the unit for incompatibility
  18. with newer versions of Delphi.
  19. - Problems with D2009+ resolved (Thanks noeska and all i forgot)
  20. - GetPixel isn't set if you are loading textures inside the constructor (Thanks Wilson)
  21. 10-08-2008
  22. - AddAlphaFromglBitmap used the custom pointer instead the imagedatapointer (Thanks Wilson)
  23. - Additional Datapointer for functioninterface now has the name CustomData
  24. 24-07-2008
  25. - AssigneAlphaToBitmap overwrites his own palette (Thanks Wilson)
  26. - If you load an texture from an file the property Filename will be set to the name of the file
  27. - Three new properties to attach custom data to the Texture objects
  28. - CustomName (free for use string)
  29. - CustomNameW (free for use widestring)
  30. - CustomDataPointer (free for use pointer to attach other objects or complex structures)
  31. 27-05-2008
  32. - RLE TGAs loaded much faster
  33. 26-05-2008
  34. - fixed some problem with reading RLE TGAs.
  35. 21-05-2008
  36. - function clone now only copys data if it's assigned and now it also copies the ID
  37. - it seems that lazarus dont like comments in comments.
  38. 01-05-2008
  39. - It's possible to set the id of the texture
  40. - define GLB_NO_NATIVE_GL deactivated by default
  41. 27-04-2008
  42. - Now supports the following libraries
  43. - SDL and SDL_image
  44. - libPNG
  45. - libJPEG
  46. - Linux compatibillity via free pascal compatibility (delphi sources optional)
  47. - BMPs now loaded manuel
  48. - Large restructuring
  49. - Property DataPtr now has the name Data
  50. - Functions are more flexible between RGB(A) and BGR(A). RGB can be saved as Bitmap and will be saved as BGR
  51. - Unused Depth removed
  52. - Function FreeData to freeing image data added
  53. 24-10-2007
  54. - ImageID flag of TGAs was ignored. (Thanks Zwoetzen)
  55. 15-11-2006
  56. - Function SetBorderColor implemented (only used by opengl if wrap is set to GL_CLAMP_TO_BORDER)
  57. - Function AddAlphaFromValue implemented to use an fixed Value as Alphachannel
  58. - Function ReadOpenGLExtension is now only intern
  59. 29-06-2006
  60. - pngimage now disabled by default like all other versions.
  61. 26-06-2006
  62. - Setting up an anisotropic filter of 0 isnt allowed by nvidia (Thanks Ogridi)
  63. 22-06-2006
  64. - Fixed some Problem with Delphi 5
  65. - Now uses the newest version of pngimage. Makes saving pngs much easier.
  66. 22-03-2006
  67. - Property IsCompressed and Size removed. Not really supported by Spec (Thanks Ogridi)
  68. 09-03-2006
  69. - Internal Format ifDepth8 added
  70. - function GrabScreen now supports all uncompressed formats
  71. 31-01-2006
  72. - AddAlphaFromglBitmap implemented
  73. 29-12-2005
  74. - LoadFromResource and LoadFromResourceId now needs an Instance and an ResourceType (for ID)
  75. 28-12-2005
  76. - Width, Height and Depth internal changed to TglBitmapPixelPosition.
  77. property Width, Height, Depth are still existing and new property Dimension are avail
  78. 11-12-2005
  79. - Added native OpenGL Support. Breaking the dglOpenGL "barrier".
  80. 19-10-2005
  81. - Added function GrabScreen to class TglBitmap2D
  82. 18-10-2005
  83. - Added support to Save images
  84. - Added function Clone to Clone Instance
  85. 11-10-2005
  86. - Functions now works with Cardinals for each channel. Up to 32 Bits per channel.
  87. Usefull for Future
  88. - Several speed optimizations
  89. 09-10-2005
  90. - Internal structure change. Loading of TGA, PNG and DDS improved.
  91. Data, format and size will now set directly with SetDataPtr.
  92. - AddFunc now works with all Types of Images and Formats
  93. - Some Funtions moved to Baseclass TglBitmap
  94. 06-10-2005
  95. - Added Support to decompress DXT3 and DXT5 compressed Images.
  96. - Added Mapping to convert data from one format into an other.
  97. 05-10-2005
  98. - Added method ConvertTo in Class TglBitmap2D. Method allows to convert every
  99. supported Input format (supported by GetPixel) into any uncompresed Format
  100. - Added Support to decompress DXT1 compressed Images.
  101. - SwapColors replaced by ConvertTo
  102. 04-10-2005
  103. - Added Support for compressed DDSs
  104. - Added new internal formats (DXT1, DXT3, DXT5)
  105. 29-09-2005
  106. - Parameter Components renamed to InternalFormat
  107. 23-09-2005
  108. - Some AllocMem replaced with GetMem (little speed change)
  109. - better exception handling. Better protection from memory leaks.
  110. 22-09-2005
  111. - Added support for Direct Draw Surfaces (.DDS) (uncompressed images only)
  112. - Added new internal formats (RGB8, RGBA8, RGBA4, RGB5A1, RGB10A2, R5G6B5)
  113. 07-09-2005
  114. - Added support for Grayscale textures
  115. - Added internal formats (Alpha, Luminance, LuminanceAlpha, BGR8, BGRA8)
  116. 10-07-2005
  117. - Added support for GL_VERSION_2_0
  118. - Added support for GL_EXT_texture_filter_anisotropic
  119. 04-07-2005
  120. - Function FillWithColor fills the Image with one Color
  121. - Function LoadNormalMap added
  122. 30-06-2005
  123. - ToNormalMap allows to Create an NormalMap from the Alphachannel
  124. - ToNormalMap now supports Sobel (nmSobel) function.
  125. 29-06-2005
  126. - support for RLE Compressed RGB TGAs added
  127. 28-06-2005
  128. - Class TglBitmapNormalMap added to support Normalmap generation
  129. - Added function ToNormalMap in class TglBitmap2D to genereate normal maps from textures.
  130. 3 Filters are supported. (4 Samples, 3x3 and 5x5)
  131. 16-06-2005
  132. - Method LoadCubeMapClass removed
  133. - LoadCubeMap returnvalue is now the Texture paramter. Such as LoadTextures
  134. - virtual abstract method GenTexture in class TglBitmap now is protected
  135. 12-06-2005
  136. - now support DescriptionFlag in LoadTga. Allows vertical flipped images to be loaded as normal
  137. 10-06-2005
  138. - little enhancement for IsPowerOfTwo
  139. - TglBitmap1D.GenTexture now tests NPOT Textures
  140. 06-06-2005
  141. - some little name changes. All properties or function with Texture in name are
  142. now without texture in name. We have allways texture so we dosn't name it.
  143. 03-06-2005
  144. - GenTexture now tests if texture is NPOT and NPOT-Texture are supported or
  145. TextureTarget is GL_TEXTURE_RECTANGLE. Else it raised an exception.
  146. 02-06-2005
  147. - added support for GL_ARB_texture_rectangle, GL_EXT_texture_rectangle and GL_NV_texture_rectangle
  148. 25-04-2005
  149. - Function Unbind added
  150. - call of SetFilter or SetTextureWrap if TextureID exists results in setting properties to opengl texture.
  151. 21-04-2005
  152. - class TglBitmapCubeMap added (allows to Create Cubemaps)
  153. 29-03-2005
  154. - Added Support for PNG Images. (http://pngdelphi.sourceforge.net/)
  155. To Enable png's use the define pngimage
  156. 22-03-2005
  157. - New Functioninterface added
  158. - Function GetPixel added
  159. 27-11-2004
  160. - Property BuildMipMaps renamed to MipMap
  161. 21-11-2004
  162. - property Name removed.
  163. - BuildMipMaps is now a set of 3 values. None, GluBuildMipmaps and SGIS_generate_mipmap
  164. 22-05-2004
  165. - property name added. Only used in glForms!
  166. 26-11-2003
  167. - property FreeDataAfterGenTexture is now available as default (default = true)
  168. - BuildMipmaps now implemented in TglBitmap1D (i've forgotten it)
  169. - function MoveMemory replaced with function Move (little speed change)
  170. - several calculations stored in variables (little speed change)
  171. 29-09-2003
  172. - property BuildMipsMaps added (default = true)
  173. if BuildMipMaps isn't set GenTextures uses glTexImage[12]D else it use gluBuild[12]dMipmaps
  174. - property FreeDataAfterGenTexture added (default = true)
  175. if FreeDataAfterGenTexture is set the texturedata were deleted after the texture was generated.
  176. - parameter DisableOtherTextureUnits of Bind removed
  177. - parameter FreeDataAfterGeneration of GenTextures removed
  178. 12-09-2003
  179. - TglBitmap dosn't delete data if class was destroyed (fixed)
  180. 09-09-2003
  181. - Bind now enables TextureUnits (by params)
  182. - GenTextures can leave data (by param)
  183. - LoadTextures now optimal
  184. 03-09-2003
  185. - Performance optimization in AddFunc
  186. - procedure Bind moved to subclasses
  187. - Added new Class TglBitmap1D to support real OpenGL 1D Textures
  188. 19-08-2003
  189. - Texturefilter and texturewrap now also as defaults
  190. Minfilter = GL_LINEAR_MIPMAP_LINEAR
  191. Magfilter = GL_LINEAR
  192. Wrap(str) = GL_CLAMP_TO_EDGE
  193. - Added new format tfCompressed to create a compressed texture.
  194. - propertys IsCompressed, TextureSize and IsResident added
  195. IsCompressed and TextureSize only contains data from level 0
  196. 18-08-2003
  197. - Added function AddFunc to add PerPixelEffects to Image
  198. - LoadFromFunc now based on AddFunc
  199. - Invert now based on AddFunc
  200. - SwapColors now based on AddFunc
  201. 16-08-2003
  202. - Added function FlipHorz
  203. 15-08-2003
  204. - Added function LaodFromFunc to create images with function
  205. - Added function FlipVert
  206. - Added internal format RGB(A) if GL_EXT_bgra or OpenGL 1.2 isn't supported
  207. 29-07-2003
  208. - Added Alphafunctions to calculate alpha per function
  209. - Added Alpha from ColorKey using alphafunctions
  210. 28-07-2003
  211. - First full functionally Version of glBitmap
  212. - Support for 24Bit and 32Bit TGA Pictures added
  213. 25-07-2003
  214. - begin of programming
  215. ***********************************************************}
  216. unit glBitmap;
  217. // Please uncomment the defines below to configure the glBitmap to your preferences.
  218. // If you have configured the unit you can uncomment the warning above.
  219. {$MESSAGE warn 'Hey. I''m the glBitmap.pas and i need to be configured. My master tell me your preferences! ;)'}
  220. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  221. // Preferences ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  222. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  223. // activate to enable build-in OpenGL support with statically linked methods
  224. // use dglOpenGL.pas if not enabled
  225. {.$DEFINE GLB_NATIVE_OGL_STATIC}
  226. // activate to enable build-in OpenGL support with dynamically linked methods
  227. // use dglOpenGL.pas if not enabled
  228. {.$DEFINE GLB_NATIVE_OGL_DYNAMIC}
  229. // activate to enable the support for SDL_surfaces
  230. {.$DEFINE GLB_SDL}
  231. // activate to enable the support for TBitmap from Delphi (not lazarus)
  232. {.$DEFINE GLB_DELPHI}
  233. // activate to enable the support for TLazIntfImage from Lazarus
  234. {$DEFINE GLB_LAZARUS}
  235. // activate to enable the support of SDL_image to load files. (READ ONLY)
  236. // If you enable SDL_image all other libraries will be ignored!
  237. {.$DEFINE GLB_SDL_IMAGE}
  238. // activate to enable png support with the unit pngimage -> http://pngdelphi.sourceforge.net/
  239. // if you enable pngimage the libPNG will be ignored
  240. {.$DEFINE GLB_PNGIMAGE}
  241. // activate to use the libPNG -> http://www.libpng.org/
  242. // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libpng
  243. {.$DEFINE GLB_LIB_PNG}
  244. // if you enable delphi jpegs the libJPEG will be ignored
  245. {.$DEFINE GLB_DELPHI_JPEG}
  246. // activate to use the libJPEG -> http://www.ijg.org/
  247. // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libjpeg
  248. {.$DEFINE GLB_LIB_JPEG}
  249. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  250. // PRIVATE: do not change anything! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  251. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  252. // Delphi Versions
  253. {$IFDEF fpc}
  254. {$MODE Delphi}
  255. {$IFDEF CPUI386}
  256. {$DEFINE CPU386}
  257. {$ASMMODE INTEL}
  258. {$ENDIF}
  259. {$IFNDEF WINDOWS}
  260. {$linklib c}
  261. {$ENDIF}
  262. {$ENDIF}
  263. // Operation System
  264. {$IF DEFINED(WIN32) or DEFINED(WIN64) or DEFINED(WINDOWS)}
  265. {$DEFINE GLB_WIN}
  266. {$ELSEIF DEFINED(LINUX)}
  267. {$DEFINE GLB_LINUX}
  268. {$IFEND}
  269. // native OpenGL Support
  270. {$IF DEFINED(GLB_NATIVE_OGL_STATIC) OR DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
  271. {$DEFINE GLB_NATIVE_OGL}
  272. {$IFEND}
  273. // checking define combinations
  274. //SDL Image
  275. {$IFDEF GLB_SDL_IMAGE}
  276. {$IFNDEF GLB_SDL}
  277. {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
  278. {$DEFINE GLB_SDL}
  279. {$ENDIF}
  280. {$IFDEF GLB_PNGIMAGE}
  281. {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
  282. {$undef GLB_PNGIMAGE}
  283. {$ENDIF}
  284. {$IFDEF GLB_DELPHI_JPEG}
  285. {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
  286. {$undef GLB_DELPHI_JPEG}
  287. {$ENDIF}
  288. {$IFDEF GLB_LIB_PNG}
  289. {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
  290. {$undef GLB_LIB_PNG}
  291. {$ENDIF}
  292. {$IFDEF GLB_LIB_JPEG}
  293. {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
  294. {$undef GLB_LIB_JPEG}
  295. {$ENDIF}
  296. {$DEFINE GLB_SUPPORT_PNG_READ}
  297. {$DEFINE GLB_SUPPORT_JPEG_READ}
  298. {$ENDIF}
  299. // PNG Image
  300. {$IFDEF GLB_PNGIMAGE}
  301. {$IFDEF GLB_LIB_PNG}
  302. {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
  303. {$undef GLB_LIB_PNG}
  304. {$ENDIF}
  305. {$DEFINE GLB_SUPPORT_PNG_READ}
  306. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  307. {$ENDIF}
  308. // libPNG
  309. {$IFDEF GLB_LIB_PNG}
  310. {$DEFINE GLB_SUPPORT_PNG_READ}
  311. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  312. {$ENDIF}
  313. // JPEG Image
  314. {$IFDEF GLB_DELPHI_JPEG}
  315. {$IFDEF GLB_LIB_JPEG}
  316. {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
  317. {$undef GLB_LIB_JPEG}
  318. {$ENDIF}
  319. {$DEFINE GLB_SUPPORT_JPEG_READ}
  320. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  321. {$ENDIF}
  322. // libJPEG
  323. {$IFDEF GLB_LIB_JPEG}
  324. {$DEFINE GLB_SUPPORT_JPEG_READ}
  325. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  326. {$ENDIF}
  327. // native OpenGL
  328. {$IF DEFINED(GLB_NATIVE_OGL_STATIC) AND DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
  329. {$MESSAGE warn 'GLB_NATIVE_OGL_STATIC will be ignored because you enabled GLB_NATIVE_OGL_DYNAMIC'}
  330. {$IFEND}
  331. // general options
  332. {$EXTENDEDSYNTAX ON}
  333. {$LONGSTRINGS ON}
  334. {$ALIGN ON}
  335. {$IFNDEF FPC}
  336. {$OPTIMIZATION ON}
  337. {$ENDIF}
  338. interface
  339. uses
  340. {$IFNDEF GLB_NATIVE_OGL} dglOpenGL, {$ENDIF}
  341. {$IF DEFINED(GLB_WIN) AND
  342. DEFINED(GLB_NATIVE_OGL)} windows, {$IFEND}
  343. {$IFDEF GLB_SDL} SDL, {$ENDIF}
  344. {$IFDEF GLB_LAZARUS} IntfGraphics, GraphType, {$ENDIF}
  345. {$IFDEF GLB_DELPHI} Dialogs, Graphics, {$ENDIF}
  346. {$IFDEF GLB_SDL_IMAGE} SDL_image, {$ENDIF}
  347. {$IFDEF GLB_PNGIMAGE} pngimage, {$ENDIF}
  348. {$IFDEF GLB_LIB_PNG} libPNG, {$ENDIF}
  349. {$IFDEF GLB_DELPHI_JPEG} JPEG, {$ENDIF}
  350. {$IFDEF GLB_LIB_JPEG} libJPEG, {$ENDIF}
  351. Classes, SysUtils;
  352. {$IFDEF GLB_NATIVE_OGL}
  353. const
  354. GL_TRUE = 1;
  355. GL_FALSE = 0;
  356. GL_ZERO = 0;
  357. GL_ONE = 1;
  358. GL_VERSION = $1F02;
  359. GL_EXTENSIONS = $1F03;
  360. GL_TEXTURE_1D = $0DE0;
  361. GL_TEXTURE_2D = $0DE1;
  362. GL_TEXTURE_RECTANGLE = $84F5;
  363. GL_NORMAL_MAP = $8511;
  364. GL_TEXTURE_CUBE_MAP = $8513;
  365. GL_REFLECTION_MAP = $8512;
  366. GL_TEXTURE_CUBE_MAP_POSITIVE_X = $8515;
  367. GL_TEXTURE_CUBE_MAP_NEGATIVE_X = $8516;
  368. GL_TEXTURE_CUBE_MAP_POSITIVE_Y = $8517;
  369. GL_TEXTURE_CUBE_MAP_NEGATIVE_Y = $8518;
  370. GL_TEXTURE_CUBE_MAP_POSITIVE_Z = $8519;
  371. GL_TEXTURE_CUBE_MAP_NEGATIVE_Z = $851A;
  372. GL_TEXTURE_WIDTH = $1000;
  373. GL_TEXTURE_HEIGHT = $1001;
  374. GL_TEXTURE_INTERNAL_FORMAT = $1003;
  375. GL_TEXTURE_SWIZZLE_RGBA = $8E46;
  376. GL_S = $2000;
  377. GL_T = $2001;
  378. GL_R = $2002;
  379. GL_Q = $2003;
  380. GL_TEXTURE_GEN_S = $0C60;
  381. GL_TEXTURE_GEN_T = $0C61;
  382. GL_TEXTURE_GEN_R = $0C62;
  383. GL_TEXTURE_GEN_Q = $0C63;
  384. GL_RED = $1903;
  385. GL_GREEN = $1904;
  386. GL_BLUE = $1905;
  387. GL_ALPHA = $1906;
  388. GL_ALPHA4 = $803B;
  389. GL_ALPHA8 = $803C;
  390. GL_ALPHA12 = $803D;
  391. GL_ALPHA16 = $803E;
  392. GL_LUMINANCE = $1909;
  393. GL_LUMINANCE4 = $803F;
  394. GL_LUMINANCE8 = $8040;
  395. GL_LUMINANCE12 = $8041;
  396. GL_LUMINANCE16 = $8042;
  397. GL_LUMINANCE_ALPHA = $190A;
  398. GL_LUMINANCE4_ALPHA4 = $8043;
  399. GL_LUMINANCE6_ALPHA2 = $8044;
  400. GL_LUMINANCE8_ALPHA8 = $8045;
  401. GL_LUMINANCE12_ALPHA4 = $8046;
  402. GL_LUMINANCE12_ALPHA12 = $8047;
  403. GL_LUMINANCE16_ALPHA16 = $8048;
  404. GL_RGB = $1907;
  405. GL_BGR = $80E0;
  406. GL_R3_G3_B2 = $2A10;
  407. GL_RGB4 = $804F;
  408. GL_RGB5 = $8050;
  409. GL_RGB565 = $8D62;
  410. GL_RGB8 = $8051;
  411. GL_RGB10 = $8052;
  412. GL_RGB12 = $8053;
  413. GL_RGB16 = $8054;
  414. GL_RGBA = $1908;
  415. GL_BGRA = $80E1;
  416. GL_RGBA2 = $8055;
  417. GL_RGBA4 = $8056;
  418. GL_RGB5_A1 = $8057;
  419. GL_RGBA8 = $8058;
  420. GL_RGB10_A2 = $8059;
  421. GL_RGBA12 = $805A;
  422. GL_RGBA16 = $805B;
  423. GL_DEPTH_COMPONENT = $1902;
  424. GL_DEPTH_COMPONENT16 = $81A5;
  425. GL_DEPTH_COMPONENT24 = $81A6;
  426. GL_DEPTH_COMPONENT32 = $81A7;
  427. GL_COMPRESSED_RGB = $84ED;
  428. GL_COMPRESSED_RGBA = $84EE;
  429. GL_COMPRESSED_RGB_S3TC_DXT1_EXT = $83F0;
  430. GL_COMPRESSED_RGBA_S3TC_DXT1_EXT = $83F1;
  431. GL_COMPRESSED_RGBA_S3TC_DXT3_EXT = $83F2;
  432. GL_COMPRESSED_RGBA_S3TC_DXT5_EXT = $83F3;
  433. GL_UNSIGNED_BYTE = $1401;
  434. GL_UNSIGNED_BYTE_3_3_2 = $8032;
  435. GL_UNSIGNED_BYTE_2_3_3_REV = $8362;
  436. GL_UNSIGNED_SHORT = $1403;
  437. GL_UNSIGNED_SHORT_5_6_5 = $8363;
  438. GL_UNSIGNED_SHORT_4_4_4_4 = $8033;
  439. GL_UNSIGNED_SHORT_5_5_5_1 = $8034;
  440. GL_UNSIGNED_SHORT_5_6_5_REV = $8364;
  441. GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;
  442. GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;
  443. GL_UNSIGNED_INT = $1405;
  444. GL_UNSIGNED_INT_8_8_8_8 = $8035;
  445. GL_UNSIGNED_INT_10_10_10_2 = $8036;
  446. GL_UNSIGNED_INT_8_8_8_8_REV = $8367;
  447. GL_UNSIGNED_INT_2_10_10_10_REV = $8368;
  448. { Texture Filter }
  449. GL_TEXTURE_MAG_FILTER = $2800;
  450. GL_TEXTURE_MIN_FILTER = $2801;
  451. GL_NEAREST = $2600;
  452. GL_NEAREST_MIPMAP_NEAREST = $2700;
  453. GL_NEAREST_MIPMAP_LINEAR = $2702;
  454. GL_LINEAR = $2601;
  455. GL_LINEAR_MIPMAP_NEAREST = $2701;
  456. GL_LINEAR_MIPMAP_LINEAR = $2703;
  457. { Texture Wrap }
  458. GL_TEXTURE_WRAP_S = $2802;
  459. GL_TEXTURE_WRAP_T = $2803;
  460. GL_TEXTURE_WRAP_R = $8072;
  461. GL_CLAMP = $2900;
  462. GL_REPEAT = $2901;
  463. GL_CLAMP_TO_EDGE = $812F;
  464. GL_CLAMP_TO_BORDER = $812D;
  465. GL_MIRRORED_REPEAT = $8370;
  466. { Other }
  467. GL_GENERATE_MIPMAP = $8191;
  468. GL_TEXTURE_BORDER_COLOR = $1004;
  469. GL_MAX_TEXTURE_SIZE = $0D33;
  470. GL_PACK_ALIGNMENT = $0D05;
  471. GL_UNPACK_ALIGNMENT = $0CF5;
  472. GL_TEXTURE_MAX_ANISOTROPY_EXT = $84FE;
  473. GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;
  474. GL_MAX_CUBE_MAP_TEXTURE_SIZE = $851C;
  475. GL_TEXTURE_GEN_MODE = $2500;
  476. {$IF DEFINED(GLB_WIN)}
  477. libglu = 'glu32.dll';
  478. libopengl = 'opengl32.dll';
  479. {$ELSEIF DEFINED(GLB_LINUX)}
  480. libglu = 'libGLU.so.1';
  481. libopengl = 'libGL.so.1';
  482. {$IFEND}
  483. type
  484. GLboolean = BYTEBOOL;
  485. GLint = Integer;
  486. GLsizei = Integer;
  487. GLuint = Cardinal;
  488. GLfloat = Single;
  489. GLenum = Cardinal;
  490. PGLvoid = Pointer;
  491. PGLboolean = ^GLboolean;
  492. PGLint = ^GLint;
  493. PGLuint = ^GLuint;
  494. PGLfloat = ^GLfloat;
  495. TglCompressedTexImage1D = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  496. 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}
  497. TglGetCompressedTexImage = procedure(target: GLenum; level: GLint; img: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  498. {$IF DEFINED(GLB_WIN)}
  499. TwglGetProcAddress = function (ProcName: PAnsiChar): Pointer; stdcall;
  500. {$ELSEIF DEFINED(GLB_LINUX)}
  501. TglXGetProcAddress = function(ProcName: PAnsiChar): Pointer; cdecl;
  502. TglXGetProcAddressARB = function(const name: PAnsiChar): pointer; cdecl;
  503. {$IFEND}
  504. {$IF DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
  505. TglEnable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  506. TglDisable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  507. TglGetString = function(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  508. TglGetIntegerv = procedure(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  509. TglTexParameteri = procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  510. TglTexParameteriv = procedure(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  511. TglTexParameterfv = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  512. TglGetTexParameteriv = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  513. TglGetTexParameterfv = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  514. TglGetTexLevelParameteriv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  515. TglGetTexLevelParameterfv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  516. TglTexGeni = procedure(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  517. TglGenTextures = procedure(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  518. TglBindTexture = procedure(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  519. TglDeleteTextures = procedure(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  520. TglAreTexturesResident = function(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  521. TglReadPixels = procedure(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  522. TglPixelStorei = procedure(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  523. 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}
  524. 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}
  525. TglGetTexImage = procedure(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  526. TgluBuild1DMipmaps = function(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  527. TgluBuild2DMipmaps = function(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  528. {$ELSEIF DEFINED(GLB_NATIVE_OGL_STATIC)}
  529. procedure glEnable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  530. procedure glDisable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  531. function glGetString(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  532. procedure glGetIntegerv(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  533. procedure glTexParameteri(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  534. procedure glTexParameteriv(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  535. procedure glTexParameterfv(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  536. procedure glGetTexParameteriv(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  537. procedure glGetTexParameterfv(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  538. procedure glGetTexLevelParameteriv(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  539. procedure glGetTexLevelParameterfv(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  540. procedure glTexGeni(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  541. procedure glGenTextures(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  542. procedure glBindTexture(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  543. procedure glDeleteTextures(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  544. function glAreTexturesResident(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  545. 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;
  546. procedure glPixelStorei(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  547. 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;
  548. 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;
  549. procedure glGetTexImage(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  550. function gluBuild1DMipmaps(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
  551. function gluBuild2DMipmaps(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
  552. {$IFEND}
  553. var
  554. GL_VERSION_1_2,
  555. GL_VERSION_1_3,
  556. GL_VERSION_1_4,
  557. GL_VERSION_2_0,
  558. GL_VERSION_3_3,
  559. GL_SGIS_generate_mipmap,
  560. GL_ARB_texture_border_clamp,
  561. GL_ARB_texture_mirrored_repeat,
  562. GL_ARB_texture_rectangle,
  563. GL_ARB_texture_non_power_of_two,
  564. GL_ARB_texture_swizzle,
  565. GL_ARB_texture_cube_map,
  566. GL_IBM_texture_mirrored_repeat,
  567. GL_NV_texture_rectangle,
  568. GL_EXT_texture_edge_clamp,
  569. GL_EXT_texture_rectangle,
  570. GL_EXT_texture_swizzle,
  571. GL_EXT_texture_cube_map,
  572. GL_EXT_texture_filter_anisotropic: Boolean;
  573. glCompressedTexImage1D: TglCompressedTexImage1D;
  574. glCompressedTexImage2D: TglCompressedTexImage2D;
  575. glGetCompressedTexImage: TglGetCompressedTexImage;
  576. {$IF DEFINED(GLB_WIN)}
  577. wglGetProcAddress: TwglGetProcAddress;
  578. {$ELSEIF DEFINED(GLB_LINUX)}
  579. glXGetProcAddress: TglXGetProcAddress;
  580. glXGetProcAddressARB: TglXGetProcAddress;
  581. {$IFEND}
  582. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  583. glEnable: TglEnable;
  584. glDisable: TglDisable;
  585. glGetString: TglGetString;
  586. glGetIntegerv: TglGetIntegerv;
  587. glTexParameteri: TglTexParameteri;
  588. glTexParameteriv: TglTexParameteriv;
  589. glTexParameterfv: TglTexParameterfv;
  590. glGetTexParameteriv: TglGetTexParameteriv;
  591. glGetTexParameterfv: TglGetTexParameterfv;
  592. glGetTexLevelParameteriv: TglGetTexLevelParameteriv;
  593. glGetTexLevelParameterfv: TglGetTexLevelParameterfv;
  594. glTexGeni: TglTexGeni;
  595. glGenTextures: TglGenTextures;
  596. glBindTexture: TglBindTexture;
  597. glDeleteTextures: TglDeleteTextures;
  598. glAreTexturesResident: TglAreTexturesResident;
  599. glReadPixels: TglReadPixels;
  600. glPixelStorei: TglPixelStorei;
  601. glTexImage1D: TglTexImage1D;
  602. glTexImage2D: TglTexImage2D;
  603. glGetTexImage: TglGetTexImage;
  604. gluBuild1DMipmaps: TgluBuild1DMipmaps;
  605. gluBuild2DMipmaps: TgluBuild2DMipmaps;
  606. {$ENDIF}
  607. {$ENDIF}
  608. type
  609. ////////////////////////////////////////////////////////////////////////////////////////////////////
  610. TglBitmapFormat = (
  611. tfEmpty = 0, //must be smallest value!
  612. tfAlpha4,
  613. tfAlpha8,
  614. tfAlpha12,
  615. tfAlpha16,
  616. tfLuminance4,
  617. tfLuminance8,
  618. tfLuminance12,
  619. tfLuminance16,
  620. tfLuminance4Alpha4,
  621. tfLuminance6Alpha2,
  622. tfLuminance8Alpha8,
  623. tfLuminance12Alpha4,
  624. tfLuminance12Alpha12,
  625. tfLuminance16Alpha16,
  626. tfR3G3B2,
  627. tfRGB4,
  628. tfR5G6B5,
  629. tfRGB5,
  630. tfRGB8,
  631. tfRGB10,
  632. tfRGB12,
  633. tfRGB16,
  634. tfRGBA2,
  635. tfRGBA4,
  636. tfRGB5A1,
  637. tfRGBA8,
  638. tfRGB10A2,
  639. tfRGBA12,
  640. tfRGBA16,
  641. tfBGR4,
  642. tfB5G6R5,
  643. tfBGR5,
  644. tfBGR8,
  645. tfBGR10,
  646. tfBGR12,
  647. tfBGR16,
  648. tfBGRA2,
  649. tfBGRA4,
  650. tfBGR5A1,
  651. tfBGRA8,
  652. tfBGR10A2,
  653. tfBGRA12,
  654. tfBGRA16,
  655. tfDepth16,
  656. tfDepth24,
  657. tfDepth32,
  658. tfS3tcDtx1RGBA,
  659. tfS3tcDtx3RGBA,
  660. tfS3tcDtx5RGBA
  661. );
  662. TglBitmapFileType = (
  663. {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG, {$ENDIF}
  664. {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
  665. ftDDS,
  666. ftTGA,
  667. ftBMP);
  668. TglBitmapFileTypes = set of TglBitmapFileType;
  669. TglBitmapMipMap = (
  670. mmNone,
  671. mmMipmap,
  672. mmMipmapGlu);
  673. TglBitmapNormalMapFunc = (
  674. nm4Samples,
  675. nmSobel,
  676. nm3x3,
  677. nm5x5);
  678. ////////////////////////////////////////////////////////////////////////////////////////////////////
  679. EglBitmap = class(Exception);
  680. EglBitmapNotSupported = class(Exception);
  681. EglBitmapSizeToLarge = class(EglBitmap);
  682. EglBitmapNonPowerOfTwo = class(EglBitmap);
  683. EglBitmapUnsupportedFormat = class(EglBitmap)
  684. constructor Create(const aFormat: TglBitmapFormat); overload;
  685. constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;
  686. end;
  687. ////////////////////////////////////////////////////////////////////////////////////////////////////
  688. TglBitmapColorRec = packed record
  689. case Integer of
  690. 0: (r, g, b, a: Cardinal);
  691. 1: (arr: array[0..3] of Cardinal);
  692. end;
  693. TglBitmapPixelData = packed record
  694. Data, Range: TglBitmapColorRec;
  695. Format: TglBitmapFormat;
  696. end;
  697. PglBitmapPixelData = ^TglBitmapPixelData;
  698. ////////////////////////////////////////////////////////////////////////////////////////////////////
  699. TglBitmapPixelPositionFields = set of (ffX, ffY);
  700. TglBitmapPixelPosition = record
  701. Fields : TglBitmapPixelPositionFields;
  702. X : Word;
  703. Y : Word;
  704. end;
  705. ////////////////////////////////////////////////////////////////////////////////////////////////////
  706. TglBitmap = class;
  707. TglBitmapFunctionRec = record
  708. Sender: TglBitmap;
  709. Size: TglBitmapPixelPosition;
  710. Position: TglBitmapPixelPosition;
  711. Source: TglBitmapPixelData;
  712. Dest: TglBitmapPixelData;
  713. Args: Pointer;
  714. end;
  715. TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
  716. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  717. TglBitmap = class
  718. protected
  719. fID: GLuint;
  720. fTarget: GLuint;
  721. fAnisotropic: Integer;
  722. fDeleteTextureOnFree: Boolean;
  723. fFreeDataAfterGenTexture: Boolean;
  724. fData: PByte;
  725. fIsResident: Boolean;
  726. fBorderColor: array[0..3] of Single;
  727. fDimension: TglBitmapPixelPosition;
  728. fMipMap: TglBitmapMipMap;
  729. fFormat: TglBitmapFormat;
  730. // Mapping
  731. fPixelSize: Integer;
  732. fRowSize: Integer;
  733. // Filtering
  734. fFilterMin: GLenum;
  735. fFilterMag: GLenum;
  736. // TexturWarp
  737. fWrapS: GLenum;
  738. fWrapT: GLenum;
  739. fWrapR: GLenum;
  740. //Swizzle
  741. fSwizzle: array[0..3] of GLenum;
  742. // CustomData
  743. fFilename: String;
  744. fCustomName: String;
  745. fCustomNameW: WideString;
  746. fCustomData: Pointer;
  747. //Getter
  748. function GetWidth: Integer; virtual;
  749. function GetHeight: Integer; virtual;
  750. function GetFileWidth: Integer; virtual;
  751. function GetFileHeight: Integer; virtual;
  752. //Setter
  753. procedure SetCustomData(const aValue: Pointer);
  754. procedure SetCustomName(const aValue: String);
  755. procedure SetCustomNameW(const aValue: WideString);
  756. procedure SetDeleteTextureOnFree(const aValue: Boolean);
  757. procedure SetFormat(const aValue: TglBitmapFormat);
  758. procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
  759. procedure SetID(const aValue: Cardinal);
  760. procedure SetMipMap(const aValue: TglBitmapMipMap);
  761. procedure SetTarget(const aValue: Cardinal);
  762. procedure SetAnisotropic(const aValue: Integer);
  763. procedure CreateID;
  764. procedure SetupParameters(out aBuildWithGlu: Boolean);
  765. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  766. const aWidth: Integer = -1; const aHeight: Integer = -1); virtual; //be careful, aData could be freed by this method
  767. procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
  768. function FlipHorz: Boolean; virtual;
  769. function FlipVert: Boolean; virtual;
  770. property Width: Integer read GetWidth;
  771. property Height: Integer read GetHeight;
  772. property FileWidth: Integer read GetFileWidth;
  773. property FileHeight: Integer read GetFileHeight;
  774. public
  775. //Properties
  776. property ID: Cardinal read fID write SetID;
  777. property Target: Cardinal read fTarget write SetTarget;
  778. property Format: TglBitmapFormat read fFormat write SetFormat;
  779. property MipMap: TglBitmapMipMap read fMipMap write SetMipMap;
  780. property Anisotropic: Integer read fAnisotropic write SetAnisotropic;
  781. property Filename: String read fFilename;
  782. property CustomName: String read fCustomName write SetCustomName;
  783. property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
  784. property CustomData: Pointer read fCustomData write SetCustomData;
  785. property DeleteTextureOnFree: Boolean read fDeleteTextureOnFree write SetDeleteTextureOnFree;
  786. property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
  787. property Dimension: TglBitmapPixelPosition read fDimension;
  788. property Data: PByte read fData;
  789. property IsResident: Boolean read fIsResident;
  790. procedure AfterConstruction; override;
  791. procedure BeforeDestruction; override;
  792. procedure PrepareResType(var aResource: String; var aResType: PChar);
  793. //Load
  794. procedure LoadFromFile(const aFilename: String);
  795. procedure LoadFromStream(const aStream: TStream); virtual;
  796. procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  797. const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
  798. procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
  799. procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  800. //Save
  801. procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  802. procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
  803. //Convert
  804. function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
  805. function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  806. const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
  807. public
  808. //Alpha & Co
  809. {$IFDEF GLB_SDL}
  810. function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  811. function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  812. function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  813. function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
  814. const aArgs: Pointer = nil): Boolean;
  815. {$ENDIF}
  816. {$IFDEF GLB_DELPHI}
  817. function AssignToBitmap(const aBitmap: TBitmap): Boolean;
  818. function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  819. function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  820. function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
  821. const aArgs: Pointer = nil): Boolean;
  822. {$ENDIF}
  823. {$IFDEF GLB_LAZARUS}
  824. function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  825. function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  826. function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  827. function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil;
  828. const aArgs: Pointer = nil): Boolean;
  829. {$ENDIF}
  830. function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil;
  831. const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  832. function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  833. const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  834. function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
  835. function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  836. function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  837. function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  838. function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
  839. function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
  840. function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
  841. function AddAlphaFromValue(const aAlpha: Byte): Boolean;
  842. function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  843. function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  844. function RemoveAlpha: Boolean; virtual;
  845. public
  846. //Common
  847. function Clone: TglBitmap;
  848. function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
  849. procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
  850. procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  851. procedure FreeData;
  852. //ColorFill
  853. procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
  854. procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
  855. procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
  856. //TexParameters
  857. procedure SetFilter(const aMin, aMag: GLenum);
  858. procedure SetWrap(
  859. const S: GLenum = GL_CLAMP_TO_EDGE;
  860. const T: GLenum = GL_CLAMP_TO_EDGE;
  861. const R: GLenum = GL_CLAMP_TO_EDGE);
  862. procedure SetSwizzle(const r, g, b, a: GLenum);
  863. procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
  864. procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
  865. //Constructors
  866. constructor Create; overload;
  867. constructor Create(const aFileName: String); overload;
  868. constructor Create(const aStream: TStream); overload;
  869. constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat); overload;
  870. constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
  871. constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
  872. constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
  873. private
  874. {$IFDEF GLB_SUPPORT_PNG_READ} function LoadPNG(const aStream: TStream): Boolean; virtual; {$ENDIF}
  875. {$ifdef GLB_SUPPORT_PNG_WRITE} procedure SavePNG(const aStream: TStream); virtual; {$ENDIF}
  876. {$IFDEF GLB_SUPPORT_JPEG_READ} function LoadJPEG(const aStream: TStream): Boolean; virtual; {$ENDIF}
  877. {$IFDEF GLB_SUPPORT_JPEG_WRITE} procedure SaveJPEG(const aStream: TStream); virtual; {$ENDIF}
  878. function LoadBMP(const aStream: TStream): Boolean; virtual;
  879. procedure SaveBMP(const aStream: TStream); virtual;
  880. function LoadTGA(const aStream: TStream): Boolean; virtual;
  881. procedure SaveTGA(const aStream: TStream); virtual;
  882. function LoadDDS(const aStream: TStream): Boolean; virtual;
  883. procedure SaveDDS(const aStream: TStream); virtual;
  884. end;
  885. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  886. TglBitmap1D = class(TglBitmap)
  887. protected
  888. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  889. const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
  890. procedure UploadData(const aBuildWithGlu: Boolean);
  891. public
  892. property Width;
  893. procedure AfterConstruction; override;
  894. function FlipHorz: Boolean; override;
  895. procedure GenTexture(const aTestTextureSize: Boolean = true); override;
  896. end;
  897. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  898. TglBitmap2D = class(TglBitmap)
  899. protected
  900. fLines: array of PByte;
  901. function GetScanline(const aIndex: Integer): Pointer;
  902. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  903. const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
  904. procedure UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
  905. public
  906. property Width;
  907. property Height;
  908. property Scanline[const aIndex: Integer]: Pointer read GetScanline;
  909. procedure AfterConstruction; override;
  910. procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  911. procedure GetDataFromTexture;
  912. procedure GenTexture(const aTestTextureSize: Boolean = true); override;
  913. function FlipHorz: Boolean; override;
  914. function FlipVert: Boolean; override;
  915. procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
  916. const aScale: Single = 2; const aUseAlpha: Boolean = false);
  917. end;
  918. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  919. TglBitmapCubeMap = class(TglBitmap2D)
  920. protected
  921. fGenMode: Integer;
  922. procedure GenTexture(const aTestTextureSize: Boolean = true); reintroduce;
  923. public
  924. procedure AfterConstruction; override;
  925. procedure GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean = true);
  926. procedure Bind(const aEnableTexCoordsGen: Boolean = true; const aEnableTextureUnit: Boolean = true); reintroduce; virtual;
  927. procedure Unbind(const aDisableTexCoordsGen: Boolean = true; const aDisableTextureUnit: Boolean = true); reintroduce; virtual;
  928. end;
  929. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  930. TglBitmapNormalMap = class(TglBitmapCubeMap)
  931. public
  932. procedure AfterConstruction; override;
  933. procedure GenerateNormalMap(const aSize: Integer = 32; const aTestTextureSize: Boolean = true);
  934. end;
  935. const
  936. NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
  937. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  938. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  939. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  940. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  941. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  942. procedure glBitmapSetDefaultWrap(
  943. const S: Cardinal = GL_CLAMP_TO_EDGE;
  944. const T: Cardinal = GL_CLAMP_TO_EDGE;
  945. const R: Cardinal = GL_CLAMP_TO_EDGE);
  946. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  947. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  948. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  949. function glBitmapGetDefaultFormat: TglBitmapFormat;
  950. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  951. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  952. function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
  953. function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
  954. function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
  955. var
  956. glBitmapDefaultDeleteTextureOnFree: Boolean;
  957. glBitmapDefaultFreeDataAfterGenTextures: Boolean;
  958. glBitmapDefaultFormat: TglBitmapFormat;
  959. glBitmapDefaultMipmap: TglBitmapMipMap;
  960. glBitmapDefaultFilterMin: Cardinal;
  961. glBitmapDefaultFilterMag: Cardinal;
  962. glBitmapDefaultWrapS: Cardinal;
  963. glBitmapDefaultWrapT: Cardinal;
  964. glBitmapDefaultWrapR: Cardinal;
  965. glDefaultSwizzle: array[0..3] of GLenum;
  966. {$IFDEF GLB_DELPHI}
  967. function CreateGrayPalette: HPALETTE;
  968. {$ENDIF}
  969. implementation
  970. uses
  971. Math, syncobjs, typinfo;
  972. type
  973. {$IFNDEF fpc}
  974. QWord = System.UInt64;
  975. PQWord = ^QWord;
  976. PtrInt = Longint;
  977. PtrUInt = DWord;
  978. {$ENDIF}
  979. ////////////////////////////////////////////////////////////////////////////////////////////////////
  980. TShiftRec = packed record
  981. case Integer of
  982. 0: (r, g, b, a: Byte);
  983. 1: (arr: array[0..3] of Byte);
  984. end;
  985. TFormatDescriptor = class(TObject)
  986. private
  987. function GetRedMask: QWord;
  988. function GetGreenMask: QWord;
  989. function GetBlueMask: QWord;
  990. function GetAlphaMask: QWord;
  991. protected
  992. fFormat: TglBitmapFormat;
  993. fWithAlpha: TglBitmapFormat;
  994. fWithoutAlpha: TglBitmapFormat;
  995. fRGBInverted: TglBitmapFormat;
  996. fUncompressed: TglBitmapFormat;
  997. fPixelSize: Single;
  998. fIsCompressed: Boolean;
  999. fRange: TglBitmapColorRec;
  1000. fShift: TShiftRec;
  1001. fglFormat: Cardinal;
  1002. fglInternalFormat: Cardinal;
  1003. fglDataFormat: Cardinal;
  1004. function GetComponents: Integer; virtual;
  1005. public
  1006. property Format: TglBitmapFormat read fFormat;
  1007. property WithAlpha: TglBitmapFormat read fWithAlpha;
  1008. property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;
  1009. property RGBInverted: TglBitmapFormat read fRGBInverted;
  1010. property Components: Integer read GetComponents;
  1011. property PixelSize: Single read fPixelSize;
  1012. property IsCompressed: Boolean read fIsCompressed;
  1013. property glFormat: Cardinal read fglFormat;
  1014. property glInternalFormat: Cardinal read fglInternalFormat;
  1015. property glDataFormat: Cardinal read fglDataFormat;
  1016. property Range: TglBitmapColorRec read fRange;
  1017. property Shift: TShiftRec read fShift;
  1018. property RedMask: QWord read GetRedMask;
  1019. property GreenMask: QWord read GetGreenMask;
  1020. property BlueMask: QWord read GetBlueMask;
  1021. property AlphaMask: QWord read GetAlphaMask;
  1022. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
  1023. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
  1024. function GetSize(const aSize: TglBitmapPixelPosition): Integer; overload; virtual;
  1025. function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
  1026. function CreateMappingData: Pointer; virtual;
  1027. procedure FreeMappingData(var aMappingData: Pointer); virtual;
  1028. function IsEmpty: Boolean; virtual;
  1029. function HasAlpha: Boolean; virtual;
  1030. function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean; virtual;
  1031. procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
  1032. constructor Create; virtual;
  1033. public
  1034. class procedure Init;
  1035. class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1036. class function GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1037. class procedure Clear;
  1038. class procedure Finalize;
  1039. end;
  1040. TFormatDescriptorClass = class of TFormatDescriptor;
  1041. TfdEmpty = class(TFormatDescriptor);
  1042. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1043. TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1044. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1045. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1046. constructor Create; override;
  1047. end;
  1048. TfdLuminance_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1049. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1050. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1051. constructor Create; override;
  1052. end;
  1053. TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1054. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1055. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1056. constructor Create; override;
  1057. end;
  1058. TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte
  1059. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1060. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1061. constructor Create; override;
  1062. end;
  1063. TfdRGB_UB3 = class(TFormatDescriptor) //3* unsigned byte
  1064. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1065. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1066. constructor Create; override;
  1067. end;
  1068. TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
  1069. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1070. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1071. constructor Create; override;
  1072. end;
  1073. TfdRGBA_UB4 = class(TfdRGB_UB3) //4* unsigned byte
  1074. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1075. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1076. constructor Create; override;
  1077. end;
  1078. TfdBGRA_UB4 = class(TfdBGR_UB3) //4* unsigned byte (inverse)
  1079. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1080. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1081. constructor Create; override;
  1082. end;
  1083. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1084. TfdAlpha_US1 = class(TFormatDescriptor) //1* unsigned short
  1085. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1086. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1087. constructor Create; override;
  1088. end;
  1089. TfdLuminance_US1 = class(TFormatDescriptor) //1* unsigned short
  1090. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1091. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1092. constructor Create; override;
  1093. end;
  1094. TfdUniversal_US1 = class(TFormatDescriptor) //1* unsigned short
  1095. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1096. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1097. constructor Create; override;
  1098. end;
  1099. TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short
  1100. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1101. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1102. constructor Create; override;
  1103. end;
  1104. TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short
  1105. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1106. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1107. constructor Create; override;
  1108. end;
  1109. TfdRGB_US3 = class(TFormatDescriptor) //3* unsigned short
  1110. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1111. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1112. constructor Create; override;
  1113. end;
  1114. TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)
  1115. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1116. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1117. constructor Create; override;
  1118. end;
  1119. TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
  1120. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1121. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1122. constructor Create; override;
  1123. end;
  1124. TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
  1125. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1126. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1127. constructor Create; override;
  1128. end;
  1129. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1130. TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int
  1131. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1132. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1133. constructor Create; override;
  1134. end;
  1135. TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int
  1136. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1137. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1138. constructor Create; override;
  1139. end;
  1140. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1141. TfdAlpha4 = class(TfdAlpha_UB1)
  1142. constructor Create; override;
  1143. end;
  1144. TfdAlpha8 = class(TfdAlpha_UB1)
  1145. constructor Create; override;
  1146. end;
  1147. TfdAlpha12 = class(TfdAlpha_US1)
  1148. constructor Create; override;
  1149. end;
  1150. TfdAlpha16 = class(TfdAlpha_US1)
  1151. constructor Create; override;
  1152. end;
  1153. TfdLuminance4 = class(TfdLuminance_UB1)
  1154. constructor Create; override;
  1155. end;
  1156. TfdLuminance8 = class(TfdLuminance_UB1)
  1157. constructor Create; override;
  1158. end;
  1159. TfdLuminance12 = class(TfdLuminance_US1)
  1160. constructor Create; override;
  1161. end;
  1162. TfdLuminance16 = class(TfdLuminance_US1)
  1163. constructor Create; override;
  1164. end;
  1165. TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
  1166. constructor Create; override;
  1167. end;
  1168. TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
  1169. constructor Create; override;
  1170. end;
  1171. TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
  1172. constructor Create; override;
  1173. end;
  1174. TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
  1175. constructor Create; override;
  1176. end;
  1177. TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)
  1178. constructor Create; override;
  1179. end;
  1180. TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
  1181. constructor Create; override;
  1182. end;
  1183. TfdR3G3B2 = class(TfdUniversal_UB1)
  1184. constructor Create; override;
  1185. end;
  1186. TfdRGB4 = class(TfdUniversal_US1)
  1187. constructor Create; override;
  1188. end;
  1189. TfdR5G6B5 = class(TfdUniversal_US1)
  1190. constructor Create; override;
  1191. end;
  1192. TfdRGB5 = class(TfdUniversal_US1)
  1193. constructor Create; override;
  1194. end;
  1195. TfdRGB8 = class(TfdRGB_UB3)
  1196. constructor Create; override;
  1197. end;
  1198. TfdRGB10 = class(TfdUniversal_UI1)
  1199. constructor Create; override;
  1200. end;
  1201. TfdRGB12 = class(TfdRGB_US3)
  1202. constructor Create; override;
  1203. end;
  1204. TfdRGB16 = class(TfdRGB_US3)
  1205. constructor Create; override;
  1206. end;
  1207. TfdRGBA2 = class(TfdRGBA_UB4)
  1208. constructor Create; override;
  1209. end;
  1210. TfdRGBA4 = class(TfdUniversal_US1)
  1211. constructor Create; override;
  1212. end;
  1213. TfdRGB5A1 = class(TfdUniversal_US1)
  1214. constructor Create; override;
  1215. end;
  1216. TfdRGBA8 = class(TfdRGBA_UB4)
  1217. constructor Create; override;
  1218. end;
  1219. TfdRGB10A2 = class(TfdUniversal_UI1)
  1220. constructor Create; override;
  1221. end;
  1222. TfdRGBA12 = class(TfdRGBA_US4)
  1223. constructor Create; override;
  1224. end;
  1225. TfdRGBA16 = class(TfdRGBA_US4)
  1226. constructor Create; override;
  1227. end;
  1228. TfdBGR4 = class(TfdUniversal_US1)
  1229. constructor Create; override;
  1230. end;
  1231. TfdB5G6R5 = class(TfdUniversal_US1)
  1232. constructor Create; override;
  1233. end;
  1234. TfdBGR5 = class(TfdUniversal_US1)
  1235. constructor Create; override;
  1236. end;
  1237. TfdBGR8 = class(TfdBGR_UB3)
  1238. constructor Create; override;
  1239. end;
  1240. TfdBGR10 = class(TfdUniversal_UI1)
  1241. constructor Create; override;
  1242. end;
  1243. TfdBGR12 = class(TfdBGR_US3)
  1244. constructor Create; override;
  1245. end;
  1246. TfdBGR16 = class(TfdBGR_US3)
  1247. constructor Create; override;
  1248. end;
  1249. TfdBGRA2 = class(TfdBGRA_UB4)
  1250. constructor Create; override;
  1251. end;
  1252. TfdBGRA4 = class(TfdUniversal_US1)
  1253. constructor Create; override;
  1254. end;
  1255. TfdBGR5A1 = class(TfdUniversal_US1)
  1256. constructor Create; override;
  1257. end;
  1258. TfdBGRA8 = class(TfdBGRA_UB4)
  1259. constructor Create; override;
  1260. end;
  1261. TfdBGR10A2 = class(TfdUniversal_UI1)
  1262. constructor Create; override;
  1263. end;
  1264. TfdBGRA12 = class(TfdBGRA_US4)
  1265. constructor Create; override;
  1266. end;
  1267. TfdBGRA16 = class(TfdBGRA_US4)
  1268. constructor Create; override;
  1269. end;
  1270. TfdDepth16 = class(TfdDepth_US1)
  1271. constructor Create; override;
  1272. end;
  1273. TfdDepth24 = class(TfdDepth_UI1)
  1274. constructor Create; override;
  1275. end;
  1276. TfdDepth32 = class(TfdDepth_UI1)
  1277. constructor Create; override;
  1278. end;
  1279. TfdS3tcDtx1RGBA = class(TFormatDescriptor)
  1280. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1281. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1282. constructor Create; override;
  1283. end;
  1284. TfdS3tcDtx3RGBA = class(TFormatDescriptor)
  1285. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1286. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1287. constructor Create; override;
  1288. end;
  1289. TfdS3tcDtx5RGBA = class(TFormatDescriptor)
  1290. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1291. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1292. constructor Create; override;
  1293. end;
  1294. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1295. TbmpBitfieldFormat = class(TFormatDescriptor)
  1296. private
  1297. procedure SetRedMask (const aValue: QWord);
  1298. procedure SetGreenMask(const aValue: QWord);
  1299. procedure SetBlueMask (const aValue: QWord);
  1300. procedure SetAlphaMask(const aValue: QWord);
  1301. procedure Update(aMask: QWord; out aRange: Cardinal; out aShift: Byte);
  1302. public
  1303. property RedMask: QWord read GetRedMask write SetRedMask;
  1304. property GreenMask: QWord read GetGreenMask write SetGreenMask;
  1305. property BlueMask: QWord read GetBlueMask write SetBlueMask;
  1306. property AlphaMask: QWord read GetAlphaMask write SetAlphaMask;
  1307. property PixelSize: Single read fPixelSize write fPixelSize;
  1308. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1309. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1310. end;
  1311. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1312. TbmpColorTableEnty = packed record
  1313. b, g, r, a: Byte;
  1314. end;
  1315. TbmpColorTable = array of TbmpColorTableEnty;
  1316. TbmpColorTableFormat = class(TFormatDescriptor)
  1317. private
  1318. fColorTable: TbmpColorTable;
  1319. public
  1320. property PixelSize: Single read fPixelSize write fPixelSize;
  1321. property ColorTable: TbmpColorTable read fColorTable write fColorTable;
  1322. property Range: TglBitmapColorRec read fRange write fRange;
  1323. property Shift: TShiftRec read fShift write fShift;
  1324. property Format: TglBitmapFormat read fFormat write fFormat;
  1325. procedure CreateColorTable;
  1326. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1327. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1328. destructor Destroy; override;
  1329. end;
  1330. const
  1331. LUMINANCE_WEIGHT_R = 0.30;
  1332. LUMINANCE_WEIGHT_G = 0.59;
  1333. LUMINANCE_WEIGHT_B = 0.11;
  1334. ALPHA_WEIGHT_R = 0.30;
  1335. ALPHA_WEIGHT_G = 0.59;
  1336. ALPHA_WEIGHT_B = 0.11;
  1337. DEPTH_WEIGHT_R = 0.333333333;
  1338. DEPTH_WEIGHT_G = 0.333333333;
  1339. DEPTH_WEIGHT_B = 0.333333333;
  1340. UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
  1341. FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
  1342. TfdEmpty,
  1343. TfdAlpha4,
  1344. TfdAlpha8,
  1345. TfdAlpha12,
  1346. TfdAlpha16,
  1347. TfdLuminance4,
  1348. TfdLuminance8,
  1349. TfdLuminance12,
  1350. TfdLuminance16,
  1351. TfdLuminance4Alpha4,
  1352. TfdLuminance6Alpha2,
  1353. TfdLuminance8Alpha8,
  1354. TfdLuminance12Alpha4,
  1355. TfdLuminance12Alpha12,
  1356. TfdLuminance16Alpha16,
  1357. TfdR3G3B2,
  1358. TfdRGB4,
  1359. TfdR5G6B5,
  1360. TfdRGB5,
  1361. TfdRGB8,
  1362. TfdRGB10,
  1363. TfdRGB12,
  1364. TfdRGB16,
  1365. TfdRGBA2,
  1366. TfdRGBA4,
  1367. TfdRGB5A1,
  1368. TfdRGBA8,
  1369. TfdRGB10A2,
  1370. TfdRGBA12,
  1371. TfdRGBA16,
  1372. TfdBGR4,
  1373. TfdB5G6R5,
  1374. TfdBGR5,
  1375. TfdBGR8,
  1376. TfdBGR10,
  1377. TfdBGR12,
  1378. TfdBGR16,
  1379. TfdBGRA2,
  1380. TfdBGRA4,
  1381. TfdBGR5A1,
  1382. TfdBGRA8,
  1383. TfdBGR10A2,
  1384. TfdBGRA12,
  1385. TfdBGRA16,
  1386. TfdDepth16,
  1387. TfdDepth24,
  1388. TfdDepth32,
  1389. TfdS3tcDtx1RGBA,
  1390. TfdS3tcDtx3RGBA,
  1391. TfdS3tcDtx5RGBA
  1392. );
  1393. var
  1394. FormatDescriptorCS: TCriticalSection;
  1395. FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
  1396. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1397. constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
  1398. begin
  1399. inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1400. end;
  1401. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1402. constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
  1403. begin
  1404. inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1405. end;
  1406. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1407. function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
  1408. begin
  1409. result.Fields := [];
  1410. if X >= 0 then
  1411. result.Fields := result.Fields + [ffX];
  1412. if Y >= 0 then
  1413. result.Fields := result.Fields + [ffY];
  1414. result.X := Max(0, X);
  1415. result.Y := Max(0, Y);
  1416. end;
  1417. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1418. function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
  1419. begin
  1420. result.r := r;
  1421. result.g := g;
  1422. result.b := b;
  1423. result.a := a;
  1424. end;
  1425. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1426. function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
  1427. var
  1428. i: Integer;
  1429. begin
  1430. result := false;
  1431. for i := 0 to high(r1.arr) do
  1432. if (r1.arr[i] <> r2.arr[i]) then
  1433. exit;
  1434. result := true;
  1435. end;
  1436. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1437. function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
  1438. begin
  1439. result.r := r;
  1440. result.g := g;
  1441. result.b := b;
  1442. result.a := a;
  1443. end;
  1444. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1445. function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
  1446. begin
  1447. result := [];
  1448. if (aFormat in [
  1449. //4 bbp
  1450. tfLuminance4,
  1451. //8bpp
  1452. tfR3G3B2, tfLuminance8,
  1453. //16bpp
  1454. tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
  1455. tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,
  1456. //24bpp
  1457. tfBGR8, tfRGB8,
  1458. //32bpp
  1459. tfRGB10, tfRGB10A2, tfRGBA8,
  1460. tfBGR10, tfBGR10A2, tfBGRA8]) then
  1461. result := result + [ftBMP];
  1462. if (aFormat in [
  1463. //8 bpp
  1464. tfLuminance8, tfAlpha8,
  1465. //16 bpp
  1466. tfLuminance16, tfLuminance8Alpha8,
  1467. tfRGB5, tfRGB5A1, tfRGBA4,
  1468. tfBGR5, tfBGR5A1, tfBGRA4,
  1469. //24 bpp
  1470. tfRGB8, tfBGR8,
  1471. //32 bpp
  1472. tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
  1473. result := result + [ftTGA];
  1474. if (aFormat in [
  1475. //8 bpp
  1476. tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,
  1477. tfR3G3B2, tfRGBA2, tfBGRA2,
  1478. //16 bpp
  1479. tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,
  1480. tfRGB4, tfR5G6B5, tfRGB5, tfRGBA4, tfRGB5A1,
  1481. tfBGR4, tfB5G6R5, tfBGR5, tfBGRA4, tfBGR5A1,
  1482. //24 bpp
  1483. tfRGB8, tfBGR8,
  1484. //32 bbp
  1485. tfLuminance16Alpha16,
  1486. tfRGBA8, tfRGB10A2,
  1487. tfBGRA8, tfBGR10A2,
  1488. //compressed
  1489. tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then
  1490. result := result + [ftDDS];
  1491. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  1492. if aFormat in [
  1493. tfAlpha8, tfLuminance8, tfLuminance8Alpha8,
  1494. tfRGB8, tfRGBA8,
  1495. tfBGR8, tfBGRA8] then
  1496. result := result + [ftPNG];
  1497. {$ENDIF}
  1498. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  1499. if aFormat in [tfAlpha8, tfLuminance8, tfRGB8, tfBGR8] then
  1500. result := result + [ftJPEG];
  1501. {$ENDIF}
  1502. end;
  1503. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1504. function IsPowerOfTwo(aNumber: Integer): Boolean;
  1505. begin
  1506. while (aNumber and 1) = 0 do
  1507. aNumber := aNumber shr 1;
  1508. result := aNumber = 1;
  1509. end;
  1510. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1511. function GetTopMostBit(aBitSet: QWord): Integer;
  1512. begin
  1513. result := 0;
  1514. while aBitSet > 0 do begin
  1515. inc(result);
  1516. aBitSet := aBitSet shr 1;
  1517. end;
  1518. end;
  1519. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1520. function CountSetBits(aBitSet: QWord): Integer;
  1521. begin
  1522. result := 0;
  1523. while aBitSet > 0 do begin
  1524. if (aBitSet and 1) = 1 then
  1525. inc(result);
  1526. aBitSet := aBitSet shr 1;
  1527. end;
  1528. end;
  1529. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1530. function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1531. begin
  1532. result := Trunc(
  1533. LUMINANCE_WEIGHT_R * aPixel.Data.r +
  1534. LUMINANCE_WEIGHT_G * aPixel.Data.g +
  1535. LUMINANCE_WEIGHT_B * aPixel.Data.b);
  1536. end;
  1537. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1538. function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1539. begin
  1540. result := Trunc(
  1541. DEPTH_WEIGHT_R * aPixel.Data.r +
  1542. DEPTH_WEIGHT_G * aPixel.Data.g +
  1543. DEPTH_WEIGHT_B * aPixel.Data.b);
  1544. end;
  1545. {$IFDEF GLB_NATIVE_OGL}
  1546. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1547. //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1548. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1549. var
  1550. GL_LibHandle: Pointer = nil;
  1551. function glbGetProcAddress(aProcName: PChar; aLibHandle: Pointer = nil): Pointer;
  1552. begin
  1553. if not Assigned(aLibHandle) then
  1554. aLibHandle := GL_LibHandle;
  1555. {$IF DEFINED(GLB_WIN)}
  1556. result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
  1557. if Assigned(result) then
  1558. exit;
  1559. if Assigned(wglGetProcAddress) then
  1560. result := wglGetProcAddress(aProcName);
  1561. {$ELSEIF DEFINED(GLB_LINUX)}
  1562. if Assigned(glXGetProcAddress) then begin
  1563. result := glXGetProcAddress(aProcName);
  1564. if Assigned(result) then
  1565. exit;
  1566. end;
  1567. if Assigned(glXGetProcAddressARB) then begin
  1568. result := glXGetProcAddressARB(aProcName);
  1569. if Assigned(result) then
  1570. exit;
  1571. end;
  1572. result := dlsym(aLibHandle, aProcName);
  1573. {$IFEND}
  1574. if not Assigned(result) then
  1575. raise EglBitmap.Create('unable to load procedure form library: ' + aProcName);
  1576. end;
  1577. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  1578. var
  1579. GLU_LibHandle: Pointer = nil;
  1580. OpenGLInitialized: Boolean;
  1581. InitOpenGLCS: TCriticalSection;
  1582. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1583. procedure glbInitOpenGL;
  1584. ////////////////////////////////////////////////////////////////////////////////
  1585. function glbLoadLibrary(const aName: PChar): Pointer;
  1586. begin
  1587. {$IF DEFINED(GLB_WIN)}
  1588. result := {%H-}Pointer(LoadLibrary(aName));
  1589. {$ELSEIF DEFINED(GLB_LINUX)}
  1590. result := dlopen(Name, RTLD_LAZY);
  1591. {$ELSE}
  1592. result := nil;
  1593. {$IFEND}
  1594. end;
  1595. ////////////////////////////////////////////////////////////////////////////////
  1596. function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
  1597. begin
  1598. result := false;
  1599. if not Assigned(aLibHandle) then
  1600. exit;
  1601. {$IF DEFINED(GLB_WIN)}
  1602. Result := FreeLibrary({%H-}HINST(aLibHandle));
  1603. {$ELSEIF DEFINED(GLB_LINUX)}
  1604. Result := dlclose(aLibHandle) = 0;
  1605. {$IFEND}
  1606. end;
  1607. begin
  1608. if Assigned(GL_LibHandle) then
  1609. glbFreeLibrary(GL_LibHandle);
  1610. if Assigned(GLU_LibHandle) then
  1611. glbFreeLibrary(GLU_LibHandle);
  1612. GL_LibHandle := glbLoadLibrary(libopengl);
  1613. if not Assigned(GL_LibHandle) then
  1614. raise EglBitmap.Create('unable to load library: ' + libopengl);
  1615. GLU_LibHandle := glbLoadLibrary(libglu);
  1616. if not Assigned(GLU_LibHandle) then
  1617. raise EglBitmap.Create('unable to load library: ' + libglu);
  1618. try
  1619. {$IF DEFINED(GLB_WIN)}
  1620. wglGetProcAddress := glbGetProcAddress('wglGetProcAddress');
  1621. {$ELSEIF DEFINED(GLB_LINUX)}
  1622. glXGetProcAddress := glbGetProcAddress('glXGetProcAddress');
  1623. glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB');
  1624. {$IFEND}
  1625. glEnable := glbGetProcAddress('glEnable');
  1626. glDisable := glbGetProcAddress('glDisable');
  1627. glGetString := glbGetProcAddress('glGetString');
  1628. glGetIntegerv := glbGetProcAddress('glGetIntegerv');
  1629. glTexParameteri := glbGetProcAddress('glTexParameteri');
  1630. glTexParameteriv := glbGetProcAddress('glTexParameteriv');
  1631. glTexParameterfv := glbGetProcAddress('glTexParameterfv');
  1632. glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
  1633. glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
  1634. glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
  1635. glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
  1636. glTexGeni := glbGetProcAddress('glTexGeni');
  1637. glGenTextures := glbGetProcAddress('glGenTextures');
  1638. glBindTexture := glbGetProcAddress('glBindTexture');
  1639. glDeleteTextures := glbGetProcAddress('glDeleteTextures');
  1640. glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
  1641. glReadPixels := glbGetProcAddress('glReadPixels');
  1642. glPixelStorei := glbGetProcAddress('glPixelStorei');
  1643. glTexImage1D := glbGetProcAddress('glTexImage1D');
  1644. glTexImage2D := glbGetProcAddress('glTexImage2D');
  1645. glGetTexImage := glbGetProcAddress('glGetTexImage');
  1646. gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
  1647. gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
  1648. finally
  1649. glbFreeLibrary(GL_LibHandle);
  1650. glbFreeLibrary(GLU_LibHandle);
  1651. end;
  1652. end;
  1653. {$ENDIF}
  1654. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1655. procedure glbReadOpenGLExtensions;
  1656. var
  1657. Buffer: AnsiString;
  1658. MajorVersion, MinorVersion: Integer;
  1659. ///////////////////////////////////////////////////////////////////////////////////////////
  1660. procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
  1661. var
  1662. Separator: Integer;
  1663. begin
  1664. aMinor := 0;
  1665. aMajor := 0;
  1666. Separator := Pos(AnsiString('.'), aBuffer);
  1667. if (Separator > 1) and (Separator < Length(aBuffer)) and
  1668. (aBuffer[Separator - 1] in ['0'..'9']) and
  1669. (aBuffer[Separator + 1] in ['0'..'9']) then begin
  1670. Dec(Separator);
  1671. while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
  1672. Dec(Separator);
  1673. Delete(aBuffer, 1, Separator);
  1674. Separator := Pos(AnsiString('.'), aBuffer) + 1;
  1675. while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
  1676. Inc(Separator);
  1677. Delete(aBuffer, Separator, 255);
  1678. Separator := Pos(AnsiString('.'), aBuffer);
  1679. aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
  1680. aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
  1681. end;
  1682. end;
  1683. ///////////////////////////////////////////////////////////////////////////////////////////
  1684. function CheckExtension(const Extension: AnsiString): Boolean;
  1685. var
  1686. ExtPos: Integer;
  1687. begin
  1688. ExtPos := Pos(Extension, Buffer);
  1689. result := ExtPos > 0;
  1690. if result then
  1691. result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
  1692. end;
  1693. ///////////////////////////////////////////////////////////////////////////////////////////
  1694. function CheckVersion(const aMajor, aMinor: Integer): Boolean;
  1695. begin
  1696. result := (MajorVersion > aMajor) or ((MajorVersion = aMajor) and (MinorVersion >= aMinor));
  1697. end;
  1698. begin
  1699. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  1700. InitOpenGLCS.Enter;
  1701. try
  1702. if not OpenGLInitialized then begin
  1703. glbInitOpenGL;
  1704. OpenGLInitialized := true;
  1705. end;
  1706. finally
  1707. InitOpenGLCS.Leave;
  1708. end;
  1709. {$ENDIF}
  1710. // Version
  1711. Buffer := glGetString(GL_VERSION);
  1712. TrimVersionString(Buffer, MajorVersion, MinorVersion);
  1713. GL_VERSION_1_2 := CheckVersion(1, 2);
  1714. GL_VERSION_1_3 := CheckVersion(1, 3);
  1715. GL_VERSION_1_4 := CheckVersion(1, 4);
  1716. GL_VERSION_2_0 := CheckVersion(2, 0);
  1717. GL_VERSION_3_3 := CheckVersion(3, 3);
  1718. // Extensions
  1719. Buffer := glGetString(GL_EXTENSIONS);
  1720. GL_ARB_texture_border_clamp := CheckExtension('GL_ARB_texture_border_clamp');
  1721. GL_ARB_texture_non_power_of_two := CheckExtension('GL_ARB_texture_non_power_of_two');
  1722. GL_ARB_texture_swizzle := CheckExtension('GL_ARB_texture_swizzle');
  1723. GL_ARB_texture_cube_map := CheckExtension('GL_ARB_texture_cube_map');
  1724. GL_ARB_texture_rectangle := CheckExtension('GL_ARB_texture_rectangle');
  1725. GL_ARB_texture_mirrored_repeat := CheckExtension('GL_ARB_texture_mirrored_repeat');
  1726. GL_EXT_texture_edge_clamp := CheckExtension('GL_EXT_texture_edge_clamp');
  1727. GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
  1728. GL_EXT_texture_rectangle := CheckExtension('GL_EXT_texture_rectangle');
  1729. GL_EXT_texture_swizzle := CheckExtension('GL_EXT_texture_swizzle');
  1730. GL_EXT_texture_cube_map := CheckExtension('GL_EXT_texture_cube_map');
  1731. GL_NV_texture_rectangle := CheckExtension('GL_NV_texture_rectangle');
  1732. GL_IBM_texture_mirrored_repeat := CheckExtension('GL_IBM_texture_mirrored_repeat');
  1733. GL_SGIS_generate_mipmap := CheckExtension('GL_SGIS_generate_mipmap');
  1734. if GL_VERSION_1_3 then begin
  1735. glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1D');
  1736. glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2D');
  1737. glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
  1738. end else begin
  1739. glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1DARB');
  1740. glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2DARB');
  1741. glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB');
  1742. end;
  1743. end;
  1744. {$ENDIF}
  1745. {$IFDEF GLB_SDL_IMAGE}
  1746. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1747. // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1748. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1749. function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
  1750. begin
  1751. result := TStream(context^.unknown.data1).Seek(offset, whence);
  1752. end;
  1753. function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
  1754. begin
  1755. result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
  1756. end;
  1757. function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
  1758. begin
  1759. result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
  1760. end;
  1761. function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
  1762. begin
  1763. result := 0;
  1764. end;
  1765. function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
  1766. begin
  1767. result := SDL_AllocRW;
  1768. if result = nil then
  1769. raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
  1770. result^.seek := glBitmapRWseek;
  1771. result^.read := glBitmapRWread;
  1772. result^.write := glBitmapRWwrite;
  1773. result^.close := glBitmapRWclose;
  1774. result^.unknown.data1 := Stream;
  1775. end;
  1776. {$ENDIF}
  1777. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1778. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1779. begin
  1780. glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
  1781. end;
  1782. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1783. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1784. begin
  1785. glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
  1786. end;
  1787. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1788. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1789. begin
  1790. glBitmapDefaultMipmap := aValue;
  1791. end;
  1792. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1793. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1794. begin
  1795. glBitmapDefaultFormat := aFormat;
  1796. end;
  1797. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1798. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1799. begin
  1800. glBitmapDefaultFilterMin := aMin;
  1801. glBitmapDefaultFilterMag := aMag;
  1802. end;
  1803. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1804. procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
  1805. begin
  1806. glBitmapDefaultWrapS := S;
  1807. glBitmapDefaultWrapT := T;
  1808. glBitmapDefaultWrapR := R;
  1809. end;
  1810. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1811. procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
  1812. begin
  1813. glDefaultSwizzle[0] := r;
  1814. glDefaultSwizzle[1] := g;
  1815. glDefaultSwizzle[2] := b;
  1816. glDefaultSwizzle[3] := a;
  1817. end;
  1818. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1819. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1820. begin
  1821. result := glBitmapDefaultDeleteTextureOnFree;
  1822. end;
  1823. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1824. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1825. begin
  1826. result := glBitmapDefaultFreeDataAfterGenTextures;
  1827. end;
  1828. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1829. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1830. begin
  1831. result := glBitmapDefaultMipmap;
  1832. end;
  1833. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1834. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1835. begin
  1836. result := glBitmapDefaultFormat;
  1837. end;
  1838. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1839. procedure glBitmapGetDefaultFilter(var aMin, aMag: GLenum);
  1840. begin
  1841. aMin := glBitmapDefaultFilterMin;
  1842. aMag := glBitmapDefaultFilterMag;
  1843. end;
  1844. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1845. procedure glBitmapGetDefaultTextureWrap(var S, T, R: GLenum);
  1846. begin
  1847. S := glBitmapDefaultWrapS;
  1848. T := glBitmapDefaultWrapT;
  1849. R := glBitmapDefaultWrapR;
  1850. end;
  1851. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1852. procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
  1853. begin
  1854. r := glDefaultSwizzle[0];
  1855. g := glDefaultSwizzle[1];
  1856. b := glDefaultSwizzle[2];
  1857. a := glDefaultSwizzle[3];
  1858. end;
  1859. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1860. //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1861. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1862. function TFormatDescriptor.GetRedMask: QWord;
  1863. begin
  1864. result := fRange.r shl fShift.r;
  1865. end;
  1866. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1867. function TFormatDescriptor.GetGreenMask: QWord;
  1868. begin
  1869. result := fRange.g shl fShift.g;
  1870. end;
  1871. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1872. function TFormatDescriptor.GetBlueMask: QWord;
  1873. begin
  1874. result := fRange.b shl fShift.b;
  1875. end;
  1876. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1877. function TFormatDescriptor.GetAlphaMask: QWord;
  1878. begin
  1879. result := fRange.a shl fShift.a;
  1880. end;
  1881. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1882. function TFormatDescriptor.GetComponents: Integer;
  1883. var
  1884. i: Integer;
  1885. begin
  1886. result := 0;
  1887. for i := 0 to 3 do
  1888. if (fRange.arr[i] > 0) then
  1889. inc(result);
  1890. end;
  1891. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1892. function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
  1893. var
  1894. w, h: Integer;
  1895. begin
  1896. if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
  1897. w := Max(1, aSize.X);
  1898. h := Max(1, aSize.Y);
  1899. result := GetSize(w, h);
  1900. end else
  1901. result := 0;
  1902. end;
  1903. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1904. function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
  1905. begin
  1906. result := 0;
  1907. if (aWidth <= 0) or (aHeight <= 0) then
  1908. exit;
  1909. result := Ceil(aWidth * aHeight * fPixelSize);
  1910. end;
  1911. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1912. function TFormatDescriptor.CreateMappingData: Pointer;
  1913. begin
  1914. result := nil;
  1915. end;
  1916. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1917. procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
  1918. begin
  1919. //DUMMY
  1920. end;
  1921. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1922. function TFormatDescriptor.IsEmpty: Boolean;
  1923. begin
  1924. result := (fFormat = tfEmpty);
  1925. end;
  1926. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1927. function TFormatDescriptor.HasAlpha: Boolean;
  1928. begin
  1929. result := (fRange.a > 0);
  1930. end;
  1931. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1932. function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean;
  1933. begin
  1934. result := false;
  1935. if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
  1936. raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
  1937. if (aRedMask <> RedMask) then
  1938. exit;
  1939. if (aGreenMask <> GreenMask) then
  1940. exit;
  1941. if (aBlueMask <> BlueMask) then
  1942. exit;
  1943. if (aAlphaMask <> AlphaMask) then
  1944. exit;
  1945. result := true;
  1946. end;
  1947. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1948. procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
  1949. begin
  1950. FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
  1951. aPixel.Data := fRange;
  1952. aPixel.Range := fRange;
  1953. aPixel.Format := fFormat;
  1954. end;
  1955. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1956. constructor TFormatDescriptor.Create;
  1957. begin
  1958. inherited Create;
  1959. fFormat := tfEmpty;
  1960. fWithAlpha := tfEmpty;
  1961. fWithoutAlpha := tfEmpty;
  1962. fRGBInverted := tfEmpty;
  1963. fUncompressed := tfEmpty;
  1964. fPixelSize := 0.0;
  1965. fIsCompressed := false;
  1966. fglFormat := 0;
  1967. fglInternalFormat := 0;
  1968. fglDataFormat := 0;
  1969. FillChar(fRange, 0, SizeOf(fRange));
  1970. FillChar(fShift, 0, SizeOf(fShift));
  1971. end;
  1972. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1973. //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1974. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1975. procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1976. begin
  1977. aData^ := aPixel.Data.a;
  1978. inc(aData);
  1979. end;
  1980. procedure TfdAlpha_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1981. begin
  1982. aPixel.Data.r := 0;
  1983. aPixel.Data.g := 0;
  1984. aPixel.Data.b := 0;
  1985. aPixel.Data.a := aData^;
  1986. inc(aData);
  1987. end;
  1988. constructor TfdAlpha_UB1.Create;
  1989. begin
  1990. inherited Create;
  1991. fPixelSize := 1.0;
  1992. fRange.a := $FF;
  1993. fglFormat := GL_ALPHA;
  1994. fglDataFormat := GL_UNSIGNED_BYTE;
  1995. end;
  1996. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1997. //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1998. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1999. procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2000. begin
  2001. aData^ := LuminanceWeight(aPixel);
  2002. inc(aData);
  2003. end;
  2004. procedure TfdLuminance_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2005. begin
  2006. aPixel.Data.r := aData^;
  2007. aPixel.Data.g := aData^;
  2008. aPixel.Data.b := aData^;
  2009. aPixel.Data.a := 0;
  2010. inc(aData);
  2011. end;
  2012. constructor TfdLuminance_UB1.Create;
  2013. begin
  2014. inherited Create;
  2015. fPixelSize := 1.0;
  2016. fRange.r := $FF;
  2017. fRange.g := $FF;
  2018. fRange.b := $FF;
  2019. fglFormat := GL_LUMINANCE;
  2020. fglDataFormat := GL_UNSIGNED_BYTE;
  2021. end;
  2022. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2023. //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2024. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2025. procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2026. var
  2027. i: Integer;
  2028. begin
  2029. aData^ := 0;
  2030. for i := 0 to 3 do
  2031. if (fRange.arr[i] > 0) then
  2032. aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2033. inc(aData);
  2034. end;
  2035. procedure TfdUniversal_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2036. var
  2037. i: Integer;
  2038. begin
  2039. for i := 0 to 3 do
  2040. aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
  2041. inc(aData);
  2042. end;
  2043. constructor TfdUniversal_UB1.Create;
  2044. begin
  2045. inherited Create;
  2046. fPixelSize := 1.0;
  2047. end;
  2048. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2049. //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2050. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2051. procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2052. begin
  2053. inherited Map(aPixel, aData, aMapData);
  2054. aData^ := aPixel.Data.a;
  2055. inc(aData);
  2056. end;
  2057. procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2058. begin
  2059. inherited Unmap(aData, aPixel, aMapData);
  2060. aPixel.Data.a := aData^;
  2061. inc(aData);
  2062. end;
  2063. constructor TfdLuminanceAlpha_UB2.Create;
  2064. begin
  2065. inherited Create;
  2066. fPixelSize := 2.0;
  2067. fRange.a := $FF;
  2068. fShift.a := 8;
  2069. fglFormat := GL_LUMINANCE_ALPHA;
  2070. fglDataFormat := GL_UNSIGNED_BYTE;
  2071. end;
  2072. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2073. //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2074. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2075. procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2076. begin
  2077. aData^ := aPixel.Data.r;
  2078. inc(aData);
  2079. aData^ := aPixel.Data.g;
  2080. inc(aData);
  2081. aData^ := aPixel.Data.b;
  2082. inc(aData);
  2083. end;
  2084. procedure TfdRGB_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2085. begin
  2086. aPixel.Data.r := aData^;
  2087. inc(aData);
  2088. aPixel.Data.g := aData^;
  2089. inc(aData);
  2090. aPixel.Data.b := aData^;
  2091. inc(aData);
  2092. aPixel.Data.a := 0;
  2093. end;
  2094. constructor TfdRGB_UB3.Create;
  2095. begin
  2096. inherited Create;
  2097. fPixelSize := 3.0;
  2098. fRange.r := $FF;
  2099. fRange.g := $FF;
  2100. fRange.b := $FF;
  2101. fShift.r := 0;
  2102. fShift.g := 8;
  2103. fShift.b := 16;
  2104. fglFormat := GL_RGB;
  2105. fglDataFormat := GL_UNSIGNED_BYTE;
  2106. end;
  2107. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2108. //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2109. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2110. procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2111. begin
  2112. aData^ := aPixel.Data.b;
  2113. inc(aData);
  2114. aData^ := aPixel.Data.g;
  2115. inc(aData);
  2116. aData^ := aPixel.Data.r;
  2117. inc(aData);
  2118. end;
  2119. procedure TfdBGR_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2120. begin
  2121. aPixel.Data.b := aData^;
  2122. inc(aData);
  2123. aPixel.Data.g := aData^;
  2124. inc(aData);
  2125. aPixel.Data.r := aData^;
  2126. inc(aData);
  2127. aPixel.Data.a := 0;
  2128. end;
  2129. constructor TfdBGR_UB3.Create;
  2130. begin
  2131. fPixelSize := 3.0;
  2132. fRange.r := $FF;
  2133. fRange.g := $FF;
  2134. fRange.b := $FF;
  2135. fShift.r := 16;
  2136. fShift.g := 8;
  2137. fShift.b := 0;
  2138. fglFormat := GL_BGR;
  2139. fglDataFormat := GL_UNSIGNED_BYTE;
  2140. end;
  2141. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2142. //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2143. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2144. procedure TfdRGBA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2145. begin
  2146. inherited Map(aPixel, aData, aMapData);
  2147. aData^ := aPixel.Data.a;
  2148. inc(aData);
  2149. end;
  2150. procedure TfdRGBA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2151. begin
  2152. inherited Unmap(aData, aPixel, aMapData);
  2153. aPixel.Data.a := aData^;
  2154. inc(aData);
  2155. end;
  2156. constructor TfdRGBA_UB4.Create;
  2157. begin
  2158. inherited Create;
  2159. fPixelSize := 4.0;
  2160. fRange.a := $FF;
  2161. fShift.a := 24;
  2162. fglFormat := GL_RGBA;
  2163. fglDataFormat := GL_UNSIGNED_BYTE;
  2164. end;
  2165. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2166. //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2167. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2168. procedure TfdBGRA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2169. begin
  2170. inherited Map(aPixel, aData, aMapData);
  2171. aData^ := aPixel.Data.a;
  2172. inc(aData);
  2173. end;
  2174. procedure TfdBGRA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2175. begin
  2176. inherited Unmap(aData, aPixel, aMapData);
  2177. aPixel.Data.a := aData^;
  2178. inc(aData);
  2179. end;
  2180. constructor TfdBGRA_UB4.Create;
  2181. begin
  2182. inherited Create;
  2183. fPixelSize := 4.0;
  2184. fRange.a := $FF;
  2185. fShift.a := 24;
  2186. fglFormat := GL_BGRA;
  2187. fglDataFormat := GL_UNSIGNED_BYTE;
  2188. end;
  2189. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2190. //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2191. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2192. procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2193. begin
  2194. PWord(aData)^ := aPixel.Data.a;
  2195. inc(aData, 2);
  2196. end;
  2197. procedure TfdAlpha_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2198. begin
  2199. aPixel.Data.r := 0;
  2200. aPixel.Data.g := 0;
  2201. aPixel.Data.b := 0;
  2202. aPixel.Data.a := PWord(aData)^;
  2203. inc(aData, 2);
  2204. end;
  2205. constructor TfdAlpha_US1.Create;
  2206. begin
  2207. inherited Create;
  2208. fPixelSize := 2.0;
  2209. fRange.a := $FFFF;
  2210. fglFormat := GL_ALPHA;
  2211. fglDataFormat := GL_UNSIGNED_SHORT;
  2212. end;
  2213. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2214. //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2215. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2216. procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2217. begin
  2218. PWord(aData)^ := LuminanceWeight(aPixel);
  2219. inc(aData, 2);
  2220. end;
  2221. procedure TfdLuminance_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2222. begin
  2223. aPixel.Data.r := PWord(aData)^;
  2224. aPixel.Data.g := PWord(aData)^;
  2225. aPixel.Data.b := PWord(aData)^;
  2226. aPixel.Data.a := 0;
  2227. inc(aData, 2);
  2228. end;
  2229. constructor TfdLuminance_US1.Create;
  2230. begin
  2231. inherited Create;
  2232. fPixelSize := 2.0;
  2233. fRange.r := $FFFF;
  2234. fRange.g := $FFFF;
  2235. fRange.b := $FFFF;
  2236. fglFormat := GL_LUMINANCE;
  2237. fglDataFormat := GL_UNSIGNED_SHORT;
  2238. end;
  2239. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2240. //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2241. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2242. procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2243. var
  2244. i: Integer;
  2245. begin
  2246. PWord(aData)^ := 0;
  2247. for i := 0 to 3 do
  2248. if (fRange.arr[i] > 0) then
  2249. PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2250. inc(aData, 2);
  2251. end;
  2252. procedure TfdUniversal_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2253. var
  2254. i: Integer;
  2255. begin
  2256. for i := 0 to 3 do
  2257. aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
  2258. inc(aData, 2);
  2259. end;
  2260. constructor TfdUniversal_US1.Create;
  2261. begin
  2262. inherited Create;
  2263. fPixelSize := 2.0;
  2264. end;
  2265. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2266. //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2267. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2268. procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2269. begin
  2270. PWord(aData)^ := DepthWeight(aPixel);
  2271. inc(aData, 2);
  2272. end;
  2273. procedure TfdDepth_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2274. begin
  2275. aPixel.Data.r := PWord(aData)^;
  2276. aPixel.Data.g := PWord(aData)^;
  2277. aPixel.Data.b := PWord(aData)^;
  2278. aPixel.Data.a := 0;
  2279. inc(aData, 2);
  2280. end;
  2281. constructor TfdDepth_US1.Create;
  2282. begin
  2283. inherited Create;
  2284. fPixelSize := 2.0;
  2285. fRange.r := $FFFF;
  2286. fRange.g := $FFFF;
  2287. fRange.b := $FFFF;
  2288. fglFormat := GL_DEPTH_COMPONENT;
  2289. fglDataFormat := GL_UNSIGNED_SHORT;
  2290. end;
  2291. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2292. //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2293. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2294. procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2295. begin
  2296. inherited Map(aPixel, aData, aMapData);
  2297. PWord(aData)^ := aPixel.Data.a;
  2298. inc(aData, 2);
  2299. end;
  2300. procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2301. begin
  2302. inherited Unmap(aData, aPixel, aMapData);
  2303. aPixel.Data.a := PWord(aData)^;
  2304. inc(aData, 2);
  2305. end;
  2306. constructor TfdLuminanceAlpha_US2.Create;
  2307. begin
  2308. inherited Create;
  2309. fPixelSize := 4.0;
  2310. fRange.a := $FFFF;
  2311. fShift.a := 16;
  2312. fglFormat := GL_LUMINANCE_ALPHA;
  2313. fglDataFormat := GL_UNSIGNED_SHORT;
  2314. end;
  2315. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2316. //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2317. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2318. procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2319. begin
  2320. PWord(aData)^ := aPixel.Data.r;
  2321. inc(aData, 2);
  2322. PWord(aData)^ := aPixel.Data.g;
  2323. inc(aData, 2);
  2324. PWord(aData)^ := aPixel.Data.b;
  2325. inc(aData, 2);
  2326. end;
  2327. procedure TfdRGB_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2328. begin
  2329. aPixel.Data.r := PWord(aData)^;
  2330. inc(aData, 2);
  2331. aPixel.Data.g := PWord(aData)^;
  2332. inc(aData, 2);
  2333. aPixel.Data.b := PWord(aData)^;
  2334. inc(aData, 2);
  2335. aPixel.Data.a := 0;
  2336. end;
  2337. constructor TfdRGB_US3.Create;
  2338. begin
  2339. inherited Create;
  2340. fPixelSize := 6.0;
  2341. fRange.r := $FFFF;
  2342. fRange.g := $FFFF;
  2343. fRange.b := $FFFF;
  2344. fShift.r := 0;
  2345. fShift.g := 16;
  2346. fShift.b := 32;
  2347. fglFormat := GL_RGB;
  2348. fglDataFormat := GL_UNSIGNED_SHORT;
  2349. end;
  2350. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2351. //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2352. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2353. procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2354. begin
  2355. PWord(aData)^ := aPixel.Data.b;
  2356. inc(aData, 2);
  2357. PWord(aData)^ := aPixel.Data.g;
  2358. inc(aData, 2);
  2359. PWord(aData)^ := aPixel.Data.r;
  2360. inc(aData, 2);
  2361. end;
  2362. procedure TfdBGR_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2363. begin
  2364. aPixel.Data.b := PWord(aData)^;
  2365. inc(aData, 2);
  2366. aPixel.Data.g := PWord(aData)^;
  2367. inc(aData, 2);
  2368. aPixel.Data.r := PWord(aData)^;
  2369. inc(aData, 2);
  2370. aPixel.Data.a := 0;
  2371. end;
  2372. constructor TfdBGR_US3.Create;
  2373. begin
  2374. inherited Create;
  2375. fPixelSize := 6.0;
  2376. fRange.r := $FFFF;
  2377. fRange.g := $FFFF;
  2378. fRange.b := $FFFF;
  2379. fShift.r := 32;
  2380. fShift.g := 16;
  2381. fShift.b := 0;
  2382. fglFormat := GL_BGR;
  2383. fglDataFormat := GL_UNSIGNED_SHORT;
  2384. end;
  2385. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2386. //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2387. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2388. procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2389. begin
  2390. inherited Map(aPixel, aData, aMapData);
  2391. PWord(aData)^ := aPixel.Data.a;
  2392. inc(aData, 2);
  2393. end;
  2394. procedure TfdRGBA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2395. begin
  2396. inherited Unmap(aData, aPixel, aMapData);
  2397. aPixel.Data.a := PWord(aData)^;
  2398. inc(aData, 2);
  2399. end;
  2400. constructor TfdRGBA_US4.Create;
  2401. begin
  2402. inherited Create;
  2403. fPixelSize := 8.0;
  2404. fRange.a := $FFFF;
  2405. fShift.a := 48;
  2406. fglFormat := GL_RGBA;
  2407. fglDataFormat := GL_UNSIGNED_SHORT;
  2408. end;
  2409. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2410. //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2411. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2412. procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2413. begin
  2414. inherited Map(aPixel, aData, aMapData);
  2415. PWord(aData)^ := aPixel.Data.a;
  2416. inc(aData, 2);
  2417. end;
  2418. procedure TfdBGRA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2419. begin
  2420. inherited Unmap(aData, aPixel, aMapData);
  2421. aPixel.Data.a := PWord(aData)^;
  2422. inc(aData, 2);
  2423. end;
  2424. constructor TfdBGRA_US4.Create;
  2425. begin
  2426. inherited Create;
  2427. fPixelSize := 8.0;
  2428. fRange.a := $FFFF;
  2429. fShift.a := 48;
  2430. fglFormat := GL_BGRA;
  2431. fglDataFormat := GL_UNSIGNED_SHORT;
  2432. end;
  2433. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2434. //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2435. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2436. procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2437. var
  2438. i: Integer;
  2439. begin
  2440. PCardinal(aData)^ := 0;
  2441. for i := 0 to 3 do
  2442. if (fRange.arr[i] > 0) then
  2443. PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2444. inc(aData, 4);
  2445. end;
  2446. procedure TfdUniversal_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2447. var
  2448. i: Integer;
  2449. begin
  2450. for i := 0 to 3 do
  2451. aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
  2452. inc(aData, 2);
  2453. end;
  2454. constructor TfdUniversal_UI1.Create;
  2455. begin
  2456. inherited Create;
  2457. fPixelSize := 4.0;
  2458. end;
  2459. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2460. //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2461. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2462. procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2463. begin
  2464. PCardinal(aData)^ := DepthWeight(aPixel);
  2465. inc(aData, 4);
  2466. end;
  2467. procedure TfdDepth_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2468. begin
  2469. aPixel.Data.r := PCardinal(aData)^;
  2470. aPixel.Data.g := PCardinal(aData)^;
  2471. aPixel.Data.b := PCardinal(aData)^;
  2472. aPixel.Data.a := 0;
  2473. inc(aData, 4);
  2474. end;
  2475. constructor TfdDepth_UI1.Create;
  2476. begin
  2477. inherited Create;
  2478. fPixelSize := 4.0;
  2479. fRange.r := $FFFFFFFF;
  2480. fRange.g := $FFFFFFFF;
  2481. fRange.b := $FFFFFFFF;
  2482. fglFormat := GL_DEPTH_COMPONENT;
  2483. fglDataFormat := GL_UNSIGNED_INT;
  2484. end;
  2485. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2486. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2487. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2488. constructor TfdAlpha4.Create;
  2489. begin
  2490. inherited Create;
  2491. fFormat := tfAlpha4;
  2492. fWithAlpha := tfAlpha4;
  2493. fglInternalFormat := GL_ALPHA4;
  2494. end;
  2495. constructor TfdAlpha8.Create;
  2496. begin
  2497. inherited Create;
  2498. fFormat := tfAlpha8;
  2499. fWithAlpha := tfAlpha8;
  2500. fglInternalFormat := GL_ALPHA8;
  2501. end;
  2502. constructor TfdAlpha12.Create;
  2503. begin
  2504. inherited Create;
  2505. fFormat := tfAlpha12;
  2506. fWithAlpha := tfAlpha12;
  2507. fglInternalFormat := GL_ALPHA12;
  2508. end;
  2509. constructor TfdAlpha16.Create;
  2510. begin
  2511. inherited Create;
  2512. fFormat := tfAlpha16;
  2513. fWithAlpha := tfAlpha16;
  2514. fglInternalFormat := GL_ALPHA16;
  2515. end;
  2516. constructor TfdLuminance4.Create;
  2517. begin
  2518. inherited Create;
  2519. fFormat := tfLuminance4;
  2520. fWithAlpha := tfLuminance4Alpha4;
  2521. fWithoutAlpha := tfLuminance4;
  2522. fglInternalFormat := GL_LUMINANCE4;
  2523. end;
  2524. constructor TfdLuminance8.Create;
  2525. begin
  2526. inherited Create;
  2527. fFormat := tfLuminance8;
  2528. fWithAlpha := tfLuminance8Alpha8;
  2529. fWithoutAlpha := tfLuminance8;
  2530. fglInternalFormat := GL_LUMINANCE8;
  2531. end;
  2532. constructor TfdLuminance12.Create;
  2533. begin
  2534. inherited Create;
  2535. fFormat := tfLuminance12;
  2536. fWithAlpha := tfLuminance12Alpha12;
  2537. fWithoutAlpha := tfLuminance12;
  2538. fglInternalFormat := GL_LUMINANCE12;
  2539. end;
  2540. constructor TfdLuminance16.Create;
  2541. begin
  2542. inherited Create;
  2543. fFormat := tfLuminance16;
  2544. fWithAlpha := tfLuminance16Alpha16;
  2545. fWithoutAlpha := tfLuminance16;
  2546. fglInternalFormat := GL_LUMINANCE16;
  2547. end;
  2548. constructor TfdLuminance4Alpha4.Create;
  2549. begin
  2550. inherited Create;
  2551. fFormat := tfLuminance4Alpha4;
  2552. fWithAlpha := tfLuminance4Alpha4;
  2553. fWithoutAlpha := tfLuminance4;
  2554. fglInternalFormat := GL_LUMINANCE4_ALPHA4;
  2555. end;
  2556. constructor TfdLuminance6Alpha2.Create;
  2557. begin
  2558. inherited Create;
  2559. fFormat := tfLuminance6Alpha2;
  2560. fWithAlpha := tfLuminance6Alpha2;
  2561. fWithoutAlpha := tfLuminance8;
  2562. fglInternalFormat := GL_LUMINANCE6_ALPHA2;
  2563. end;
  2564. constructor TfdLuminance8Alpha8.Create;
  2565. begin
  2566. inherited Create;
  2567. fFormat := tfLuminance8Alpha8;
  2568. fWithAlpha := tfLuminance8Alpha8;
  2569. fWithoutAlpha := tfLuminance8;
  2570. fglInternalFormat := GL_LUMINANCE8_ALPHA8;
  2571. end;
  2572. constructor TfdLuminance12Alpha4.Create;
  2573. begin
  2574. inherited Create;
  2575. fFormat := tfLuminance12Alpha4;
  2576. fWithAlpha := tfLuminance12Alpha4;
  2577. fWithoutAlpha := tfLuminance12;
  2578. fglInternalFormat := GL_LUMINANCE12_ALPHA4;
  2579. end;
  2580. constructor TfdLuminance12Alpha12.Create;
  2581. begin
  2582. inherited Create;
  2583. fFormat := tfLuminance12Alpha12;
  2584. fWithAlpha := tfLuminance12Alpha12;
  2585. fWithoutAlpha := tfLuminance12;
  2586. fglInternalFormat := GL_LUMINANCE12_ALPHA12;
  2587. end;
  2588. constructor TfdLuminance16Alpha16.Create;
  2589. begin
  2590. inherited Create;
  2591. fFormat := tfLuminance16Alpha16;
  2592. fWithAlpha := tfLuminance16Alpha16;
  2593. fWithoutAlpha := tfLuminance16;
  2594. fglInternalFormat := GL_LUMINANCE16_ALPHA16;
  2595. end;
  2596. constructor TfdR3G3B2.Create;
  2597. begin
  2598. inherited Create;
  2599. fFormat := tfR3G3B2;
  2600. fWithAlpha := tfRGBA2;
  2601. fWithoutAlpha := tfR3G3B2;
  2602. fRange.r := $7;
  2603. fRange.g := $7;
  2604. fRange.b := $3;
  2605. fShift.r := 0;
  2606. fShift.g := 3;
  2607. fShift.b := 6;
  2608. fglFormat := GL_RGB;
  2609. fglInternalFormat := GL_R3_G3_B2;
  2610. fglDataFormat := GL_UNSIGNED_BYTE_2_3_3_REV;
  2611. end;
  2612. constructor TfdRGB4.Create;
  2613. begin
  2614. inherited Create;
  2615. fFormat := tfRGB4;
  2616. fWithAlpha := tfRGBA4;
  2617. fWithoutAlpha := tfRGB4;
  2618. fRGBInverted := tfBGR4;
  2619. fRange.r := $F;
  2620. fRange.g := $F;
  2621. fRange.b := $F;
  2622. fShift.r := 0;
  2623. fShift.g := 4;
  2624. fShift.b := 8;
  2625. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2626. fglInternalFormat := GL_RGB4;
  2627. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2628. end;
  2629. constructor TfdR5G6B5.Create;
  2630. begin
  2631. inherited Create;
  2632. fFormat := tfR5G6B5;
  2633. fWithAlpha := tfRGBA4;
  2634. fWithoutAlpha := tfR5G6B5;
  2635. fRGBInverted := tfB5G6R5;
  2636. fRange.r := $1F;
  2637. fRange.g := $3F;
  2638. fRange.b := $1F;
  2639. fShift.r := 0;
  2640. fShift.g := 5;
  2641. fShift.b := 11;
  2642. fglFormat := GL_RGB;
  2643. fglInternalFormat := GL_RGB565;
  2644. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5_REV;
  2645. end;
  2646. constructor TfdRGB5.Create;
  2647. begin
  2648. inherited Create;
  2649. fFormat := tfRGB5;
  2650. fWithAlpha := tfRGB5A1;
  2651. fWithoutAlpha := tfRGB5;
  2652. fRGBInverted := tfBGR5;
  2653. fRange.r := $1F;
  2654. fRange.g := $1F;
  2655. fRange.b := $1F;
  2656. fShift.r := 0;
  2657. fShift.g := 5;
  2658. fShift.b := 10;
  2659. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2660. fglInternalFormat := GL_RGB5;
  2661. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2662. end;
  2663. constructor TfdRGB8.Create;
  2664. begin
  2665. inherited Create;
  2666. fFormat := tfRGB8;
  2667. fWithAlpha := tfRGBA8;
  2668. fWithoutAlpha := tfRGB8;
  2669. fRGBInverted := tfBGR8;
  2670. fglInternalFormat := GL_RGB8;
  2671. end;
  2672. constructor TfdRGB10.Create;
  2673. begin
  2674. inherited Create;
  2675. fFormat := tfRGB10;
  2676. fWithAlpha := tfRGB10A2;
  2677. fWithoutAlpha := tfRGB10;
  2678. fRGBInverted := tfBGR10;
  2679. fRange.r := $3FF;
  2680. fRange.g := $3FF;
  2681. fRange.b := $3FF;
  2682. fShift.r := 0;
  2683. fShift.g := 10;
  2684. fShift.b := 20;
  2685. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2686. fglInternalFormat := GL_RGB10;
  2687. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2688. end;
  2689. constructor TfdRGB12.Create;
  2690. begin
  2691. inherited Create;
  2692. fFormat := tfRGB12;
  2693. fWithAlpha := tfRGBA12;
  2694. fWithoutAlpha := tfRGB12;
  2695. fRGBInverted := tfBGR12;
  2696. fglInternalFormat := GL_RGB12;
  2697. end;
  2698. constructor TfdRGB16.Create;
  2699. begin
  2700. inherited Create;
  2701. fFormat := tfRGB16;
  2702. fWithAlpha := tfRGBA16;
  2703. fWithoutAlpha := tfRGB16;
  2704. fRGBInverted := tfBGR16;
  2705. fglInternalFormat := GL_RGB16;
  2706. end;
  2707. constructor TfdRGBA2.Create;
  2708. begin
  2709. inherited Create;
  2710. fFormat := tfRGBA2;
  2711. fWithAlpha := tfRGBA2;
  2712. fWithoutAlpha := tfR3G3B2;
  2713. fRGBInverted := tfBGRA2;
  2714. fglInternalFormat := GL_RGBA2;
  2715. end;
  2716. constructor TfdRGBA4.Create;
  2717. begin
  2718. inherited Create;
  2719. fFormat := tfRGBA4;
  2720. fWithAlpha := tfRGBA4;
  2721. fWithoutAlpha := tfRGB4;
  2722. fRGBInverted := tfBGRA4;
  2723. fRange.r := $F;
  2724. fRange.g := $F;
  2725. fRange.b := $F;
  2726. fRange.a := $F;
  2727. fShift.r := 0;
  2728. fShift.g := 4;
  2729. fShift.b := 8;
  2730. fShift.a := 12;
  2731. fglFormat := GL_RGBA;
  2732. fglInternalFormat := GL_RGBA4;
  2733. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2734. end;
  2735. constructor TfdRGB5A1.Create;
  2736. begin
  2737. inherited Create;
  2738. fFormat := tfRGB5A1;
  2739. fWithAlpha := tfRGB5A1;
  2740. fWithoutAlpha := tfRGB5;
  2741. fRGBInverted := tfBGR5A1;
  2742. fRange.r := $1F;
  2743. fRange.g := $1F;
  2744. fRange.b := $1F;
  2745. fRange.a := $01;
  2746. fShift.r := 0;
  2747. fShift.g := 5;
  2748. fShift.b := 10;
  2749. fShift.a := 15;
  2750. fglFormat := GL_RGBA;
  2751. fglInternalFormat := GL_RGB5_A1;
  2752. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2753. end;
  2754. constructor TfdRGBA8.Create;
  2755. begin
  2756. inherited Create;
  2757. fFormat := tfRGBA8;
  2758. fWithAlpha := tfRGBA8;
  2759. fWithoutAlpha := tfRGB8;
  2760. fRGBInverted := tfBGRA8;
  2761. fglInternalFormat := GL_RGBA8;
  2762. end;
  2763. constructor TfdRGB10A2.Create;
  2764. begin
  2765. inherited Create;
  2766. fFormat := tfRGB10A2;
  2767. fWithAlpha := tfRGB10A2;
  2768. fWithoutAlpha := tfRGB10;
  2769. fRGBInverted := tfBGR10A2;
  2770. fRange.r := $3FF;
  2771. fRange.g := $3FF;
  2772. fRange.b := $3FF;
  2773. fRange.a := $003;
  2774. fShift.r := 0;
  2775. fShift.g := 10;
  2776. fShift.b := 20;
  2777. fShift.a := 30;
  2778. fglFormat := GL_RGBA;
  2779. fglInternalFormat := GL_RGB10_A2;
  2780. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2781. end;
  2782. constructor TfdRGBA12.Create;
  2783. begin
  2784. inherited Create;
  2785. fFormat := tfRGBA12;
  2786. fWithAlpha := tfRGBA12;
  2787. fWithoutAlpha := tfRGB12;
  2788. fRGBInverted := tfBGRA12;
  2789. fglInternalFormat := GL_RGBA12;
  2790. end;
  2791. constructor TfdRGBA16.Create;
  2792. begin
  2793. inherited Create;
  2794. fFormat := tfRGBA16;
  2795. fWithAlpha := tfRGBA16;
  2796. fWithoutAlpha := tfRGB16;
  2797. fRGBInverted := tfBGRA16;
  2798. fglInternalFormat := GL_RGBA16;
  2799. end;
  2800. constructor TfdBGR4.Create;
  2801. begin
  2802. inherited Create;
  2803. fPixelSize := 2.0;
  2804. fFormat := tfBGR4;
  2805. fWithAlpha := tfBGRA4;
  2806. fWithoutAlpha := tfBGR4;
  2807. fRGBInverted := tfRGB4;
  2808. fRange.r := $F;
  2809. fRange.g := $F;
  2810. fRange.b := $F;
  2811. fRange.a := $0;
  2812. fShift.r := 8;
  2813. fShift.g := 4;
  2814. fShift.b := 0;
  2815. fShift.a := 0;
  2816. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2817. fglInternalFormat := GL_RGB4;
  2818. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2819. end;
  2820. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2821. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2822. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2823. constructor TfdB5G6R5.Create;
  2824. begin
  2825. inherited Create;
  2826. fFormat := tfB5G6R5;
  2827. fWithAlpha := tfBGRA4;
  2828. fWithoutAlpha := tfB5G6R5;
  2829. fRGBInverted := tfR5G6B5;
  2830. fRange.r := $1F;
  2831. fRange.g := $3F;
  2832. fRange.b := $1F;
  2833. fShift.r := 11;
  2834. fShift.g := 5;
  2835. fShift.b := 0;
  2836. fglFormat := GL_RGB; //B5G6R5 is only possible as R5G6B5 -> use reverted dataformat
  2837. fglInternalFormat := GL_RGB8;
  2838. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5;
  2839. end;
  2840. constructor TfdBGR5.Create;
  2841. begin
  2842. inherited Create;
  2843. fPixelSize := 2.0;
  2844. fFormat := tfBGR5;
  2845. fWithAlpha := tfBGR5A1;
  2846. fWithoutAlpha := tfBGR5;
  2847. fRGBInverted := tfRGB5;
  2848. fRange.r := $1F;
  2849. fRange.g := $1F;
  2850. fRange.b := $1F;
  2851. fRange.a := $00;
  2852. fShift.r := 10;
  2853. fShift.g := 5;
  2854. fShift.b := 0;
  2855. fShift.a := 0;
  2856. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2857. fglInternalFormat := GL_RGB5;
  2858. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2859. end;
  2860. constructor TfdBGR8.Create;
  2861. begin
  2862. inherited Create;
  2863. fFormat := tfBGR8;
  2864. fWithAlpha := tfBGRA8;
  2865. fWithoutAlpha := tfBGR8;
  2866. fRGBInverted := tfRGB8;
  2867. fglInternalFormat := GL_RGB8;
  2868. end;
  2869. constructor TfdBGR10.Create;
  2870. begin
  2871. inherited Create;
  2872. fFormat := tfBGR10;
  2873. fWithAlpha := tfBGR10A2;
  2874. fWithoutAlpha := tfBGR10;
  2875. fRGBInverted := tfRGB10;
  2876. fRange.r := $3FF;
  2877. fRange.g := $3FF;
  2878. fRange.b := $3FF;
  2879. fRange.a := $000;
  2880. fShift.r := 20;
  2881. fShift.g := 10;
  2882. fShift.b := 0;
  2883. fShift.a := 0;
  2884. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2885. fglInternalFormat := GL_RGB10;
  2886. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2887. end;
  2888. constructor TfdBGR12.Create;
  2889. begin
  2890. inherited Create;
  2891. fFormat := tfBGR12;
  2892. fWithAlpha := tfBGRA12;
  2893. fWithoutAlpha := tfBGR12;
  2894. fRGBInverted := tfRGB12;
  2895. fglInternalFormat := GL_RGB12;
  2896. end;
  2897. constructor TfdBGR16.Create;
  2898. begin
  2899. inherited Create;
  2900. fFormat := tfBGR16;
  2901. fWithAlpha := tfBGRA16;
  2902. fWithoutAlpha := tfBGR16;
  2903. fRGBInverted := tfRGB16;
  2904. fglInternalFormat := GL_RGB16;
  2905. end;
  2906. constructor TfdBGRA2.Create;
  2907. begin
  2908. inherited Create;
  2909. fFormat := tfBGRA2;
  2910. fWithAlpha := tfBGRA4;
  2911. fWithoutAlpha := tfBGR4;
  2912. fRGBInverted := tfRGBA2;
  2913. fglInternalFormat := GL_RGBA2;
  2914. end;
  2915. constructor TfdBGRA4.Create;
  2916. begin
  2917. inherited Create;
  2918. fFormat := tfBGRA4;
  2919. fWithAlpha := tfBGRA4;
  2920. fWithoutAlpha := tfBGR4;
  2921. fRGBInverted := tfRGBA4;
  2922. fRange.r := $F;
  2923. fRange.g := $F;
  2924. fRange.b := $F;
  2925. fRange.a := $F;
  2926. fShift.r := 8;
  2927. fShift.g := 4;
  2928. fShift.b := 0;
  2929. fShift.a := 12;
  2930. fglFormat := GL_BGRA;
  2931. fglInternalFormat := GL_RGBA4;
  2932. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2933. end;
  2934. constructor TfdBGR5A1.Create;
  2935. begin
  2936. inherited Create;
  2937. fFormat := tfBGR5A1;
  2938. fWithAlpha := tfBGR5A1;
  2939. fWithoutAlpha := tfBGR5;
  2940. fRGBInverted := tfRGB5A1;
  2941. fRange.r := $1F;
  2942. fRange.g := $1F;
  2943. fRange.b := $1F;
  2944. fRange.a := $01;
  2945. fShift.r := 10;
  2946. fShift.g := 5;
  2947. fShift.b := 0;
  2948. fShift.a := 15;
  2949. fglFormat := GL_BGRA;
  2950. fglInternalFormat := GL_RGB5_A1;
  2951. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2952. end;
  2953. constructor TfdBGRA8.Create;
  2954. begin
  2955. inherited Create;
  2956. fFormat := tfBGRA8;
  2957. fWithAlpha := tfBGRA8;
  2958. fWithoutAlpha := tfBGR8;
  2959. fRGBInverted := tfRGBA8;
  2960. fglInternalFormat := GL_RGBA8;
  2961. end;
  2962. constructor TfdBGR10A2.Create;
  2963. begin
  2964. inherited Create;
  2965. fFormat := tfBGR10A2;
  2966. fWithAlpha := tfBGR10A2;
  2967. fWithoutAlpha := tfBGR10;
  2968. fRGBInverted := tfRGB10A2;
  2969. fRange.r := $3FF;
  2970. fRange.g := $3FF;
  2971. fRange.b := $3FF;
  2972. fRange.a := $003;
  2973. fShift.r := 20;
  2974. fShift.g := 10;
  2975. fShift.b := 0;
  2976. fShift.a := 30;
  2977. fglFormat := GL_BGRA;
  2978. fglInternalFormat := GL_RGB10_A2;
  2979. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2980. end;
  2981. constructor TfdBGRA12.Create;
  2982. begin
  2983. inherited Create;
  2984. fFormat := tfBGRA12;
  2985. fWithAlpha := tfBGRA12;
  2986. fWithoutAlpha := tfBGR12;
  2987. fRGBInverted := tfRGBA12;
  2988. fglInternalFormat := GL_RGBA12;
  2989. end;
  2990. constructor TfdBGRA16.Create;
  2991. begin
  2992. inherited Create;
  2993. fFormat := tfBGRA16;
  2994. fWithAlpha := tfBGRA16;
  2995. fWithoutAlpha := tfBGR16;
  2996. fRGBInverted := tfRGBA16;
  2997. fglInternalFormat := GL_RGBA16;
  2998. end;
  2999. constructor TfdDepth16.Create;
  3000. begin
  3001. inherited Create;
  3002. fFormat := tfDepth16;
  3003. fWithAlpha := tfEmpty;
  3004. fWithoutAlpha := tfDepth16;
  3005. fglInternalFormat := GL_DEPTH_COMPONENT16;
  3006. end;
  3007. constructor TfdDepth24.Create;
  3008. begin
  3009. inherited Create;
  3010. fFormat := tfDepth24;
  3011. fWithAlpha := tfEmpty;
  3012. fWithoutAlpha := tfDepth24;
  3013. fglInternalFormat := GL_DEPTH_COMPONENT24;
  3014. end;
  3015. constructor TfdDepth32.Create;
  3016. begin
  3017. inherited Create;
  3018. fFormat := tfDepth32;
  3019. fWithAlpha := tfEmpty;
  3020. fWithoutAlpha := tfDepth32;
  3021. fglInternalFormat := GL_DEPTH_COMPONENT32;
  3022. end;
  3023. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3024. //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3025. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3026. procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3027. begin
  3028. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3029. end;
  3030. procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3031. begin
  3032. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3033. end;
  3034. constructor TfdS3tcDtx1RGBA.Create;
  3035. begin
  3036. inherited Create;
  3037. fFormat := tfS3tcDtx1RGBA;
  3038. fWithAlpha := tfS3tcDtx1RGBA;
  3039. fUncompressed := tfRGB5A1;
  3040. fPixelSize := 0.5;
  3041. fIsCompressed := true;
  3042. fglFormat := GL_COMPRESSED_RGBA;
  3043. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
  3044. fglDataFormat := GL_UNSIGNED_BYTE;
  3045. end;
  3046. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3047. //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3048. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3049. procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3050. begin
  3051. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3052. end;
  3053. procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3054. begin
  3055. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3056. end;
  3057. constructor TfdS3tcDtx3RGBA.Create;
  3058. begin
  3059. inherited Create;
  3060. fFormat := tfS3tcDtx3RGBA;
  3061. fWithAlpha := tfS3tcDtx3RGBA;
  3062. fUncompressed := tfRGBA8;
  3063. fPixelSize := 1.0;
  3064. fIsCompressed := true;
  3065. fglFormat := GL_COMPRESSED_RGBA;
  3066. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
  3067. fglDataFormat := GL_UNSIGNED_BYTE;
  3068. end;
  3069. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3070. //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3071. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3072. procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3073. begin
  3074. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3075. end;
  3076. procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3077. begin
  3078. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3079. end;
  3080. constructor TfdS3tcDtx5RGBA.Create;
  3081. begin
  3082. inherited Create;
  3083. fFormat := tfS3tcDtx3RGBA;
  3084. fWithAlpha := tfS3tcDtx3RGBA;
  3085. fUncompressed := tfRGBA8;
  3086. fPixelSize := 1.0;
  3087. fIsCompressed := true;
  3088. fglFormat := GL_COMPRESSED_RGBA;
  3089. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
  3090. fglDataFormat := GL_UNSIGNED_BYTE;
  3091. end;
  3092. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3093. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3094. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3095. class procedure TFormatDescriptor.Init;
  3096. begin
  3097. if not Assigned(FormatDescriptorCS) then
  3098. FormatDescriptorCS := TCriticalSection.Create;
  3099. end;
  3100. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3101. class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3102. begin
  3103. FormatDescriptorCS.Enter;
  3104. try
  3105. result := FormatDescriptors[aFormat];
  3106. if not Assigned(result) then begin
  3107. result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
  3108. FormatDescriptors[aFormat] := result;
  3109. end;
  3110. finally
  3111. FormatDescriptorCS.Leave;
  3112. end;
  3113. end;
  3114. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3115. class function TFormatDescriptor.GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3116. begin
  3117. result := Get(Get(aFormat).WithAlpha);
  3118. end;
  3119. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3120. class procedure TFormatDescriptor.Clear;
  3121. var
  3122. f: TglBitmapFormat;
  3123. begin
  3124. FormatDescriptorCS.Enter;
  3125. try
  3126. for f := low(FormatDescriptors) to high(FormatDescriptors) do
  3127. FreeAndNil(FormatDescriptors[f]);
  3128. finally
  3129. FormatDescriptorCS.Leave;
  3130. end;
  3131. end;
  3132. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3133. class procedure TFormatDescriptor.Finalize;
  3134. begin
  3135. Clear;
  3136. FreeAndNil(FormatDescriptorCS);
  3137. end;
  3138. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3139. //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3140. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3141. procedure TbmpBitfieldFormat.SetRedMask(const aValue: QWord);
  3142. begin
  3143. Update(aValue, fRange.r, fShift.r);
  3144. end;
  3145. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3146. procedure TbmpBitfieldFormat.SetGreenMask(const aValue: QWord);
  3147. begin
  3148. Update(aValue, fRange.g, fShift.g);
  3149. end;
  3150. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3151. procedure TbmpBitfieldFormat.SetBlueMask(const aValue: QWord);
  3152. begin
  3153. Update(aValue, fRange.b, fShift.b);
  3154. end;
  3155. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3156. procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: QWord);
  3157. begin
  3158. Update(aValue, fRange.a, fShift.a);
  3159. end;
  3160. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3161. procedure TbmpBitfieldFormat.Update(aMask: QWord; out aRange: Cardinal; out
  3162. aShift: Byte);
  3163. begin
  3164. aShift := 0;
  3165. aRange := 0;
  3166. if (aMask = 0) then
  3167. exit;
  3168. while (aMask > 0) and ((aMask and 1) = 0) do begin
  3169. inc(aShift);
  3170. aMask := aMask shr 1;
  3171. end;
  3172. aRange := 1;
  3173. while (aMask > 0) do begin
  3174. aRange := aRange shl 1;
  3175. aMask := aMask shr 1;
  3176. end;
  3177. dec(aRange);
  3178. fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
  3179. end;
  3180. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3181. procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3182. var
  3183. data: QWord;
  3184. s: Integer;
  3185. begin
  3186. data :=
  3187. ((aPixel.Data.r and fRange.r) shl fShift.r) or
  3188. ((aPixel.Data.g and fRange.g) shl fShift.g) or
  3189. ((aPixel.Data.b and fRange.b) shl fShift.b) or
  3190. ((aPixel.Data.a and fRange.a) shl fShift.a);
  3191. s := Round(fPixelSize);
  3192. case s of
  3193. 1: aData^ := data;
  3194. 2: PWord(aData)^ := data;
  3195. 4: PCardinal(aData)^ := data;
  3196. 8: PQWord(aData)^ := data;
  3197. else
  3198. raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
  3199. end;
  3200. inc(aData, s);
  3201. end;
  3202. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3203. procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3204. var
  3205. data: QWord;
  3206. s, i: Integer;
  3207. begin
  3208. s := Round(fPixelSize);
  3209. case s of
  3210. 1: data := aData^;
  3211. 2: data := PWord(aData)^;
  3212. 4: data := PCardinal(aData)^;
  3213. 8: data := PQWord(aData)^;
  3214. else
  3215. raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
  3216. end;
  3217. for i := 0 to 3 do
  3218. aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
  3219. inc(aData, s);
  3220. end;
  3221. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3222. //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3223. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3224. procedure TbmpColorTableFormat.CreateColorTable;
  3225. var
  3226. i: Integer;
  3227. begin
  3228. if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
  3229. raise EglBitmap.Create(UNSUPPORTED_FORMAT);
  3230. if (Format = tfLuminance4) then
  3231. SetLength(fColorTable, 16)
  3232. else
  3233. SetLength(fColorTable, 256);
  3234. case Format of
  3235. tfLuminance4: begin
  3236. for i := 0 to High(fColorTable) do begin
  3237. fColorTable[i].r := 16 * i;
  3238. fColorTable[i].g := 16 * i;
  3239. fColorTable[i].b := 16 * i;
  3240. fColorTable[i].a := 0;
  3241. end;
  3242. end;
  3243. tfLuminance8: begin
  3244. for i := 0 to High(fColorTable) do begin
  3245. fColorTable[i].r := i;
  3246. fColorTable[i].g := i;
  3247. fColorTable[i].b := i;
  3248. fColorTable[i].a := 0;
  3249. end;
  3250. end;
  3251. tfR3G3B2: begin
  3252. for i := 0 to High(fColorTable) do begin
  3253. fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
  3254. fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
  3255. fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
  3256. fColorTable[i].a := 0;
  3257. end;
  3258. end;
  3259. end;
  3260. end;
  3261. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3262. procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3263. var
  3264. d: Byte;
  3265. begin
  3266. if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
  3267. raise EglBitmap.Create(UNSUPPORTED_FORMAT);
  3268. case Format of
  3269. tfLuminance4: begin
  3270. if (aMapData = nil) then
  3271. aData^ := 0;
  3272. d := LuminanceWeight(aPixel) and Range.r;
  3273. aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData)));
  3274. inc(PByte(aMapData), 4);
  3275. if ({%H-}PtrUInt(aMapData) >= 8) then begin
  3276. inc(aData);
  3277. aMapData := nil;
  3278. end;
  3279. end;
  3280. tfLuminance8: begin
  3281. aData^ := LuminanceWeight(aPixel) and Range.r;
  3282. inc(aData);
  3283. end;
  3284. tfR3G3B2: begin
  3285. aData^ := Round(
  3286. ((aPixel.Data.r and Range.r) shl Shift.r) or
  3287. ((aPixel.Data.g and Range.g) shl Shift.g) or
  3288. ((aPixel.Data.b and Range.b) shl Shift.b));
  3289. inc(aData);
  3290. end;
  3291. end;
  3292. end;
  3293. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3294. procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3295. var
  3296. idx: QWord;
  3297. s: Integer;
  3298. bits: Byte;
  3299. f: Single;
  3300. begin
  3301. s := Trunc(fPixelSize);
  3302. f := fPixelSize - s;
  3303. bits := Round(8 * f);
  3304. case s of
  3305. 0: idx := (aData^ shr (8 - bits - {%H-}PtrInt(aMapData))) and ((1 shl bits) - 1);
  3306. 1: idx := aData^;
  3307. 2: idx := PWord(aData)^;
  3308. 4: idx := PCardinal(aData)^;
  3309. 8: idx := PQWord(aData)^;
  3310. else
  3311. raise EglBitmap.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
  3312. end;
  3313. if (idx >= Length(fColorTable)) then
  3314. raise EglBitmap.CreateFmt('invalid color index: %d', [idx]);
  3315. with fColorTable[idx] do begin
  3316. aPixel.Data.r := r;
  3317. aPixel.Data.g := g;
  3318. aPixel.Data.b := b;
  3319. aPixel.Data.a := a;
  3320. end;
  3321. inc(PByte(aMapData), bits);
  3322. if ({%H-}PtrUInt(aMapData) >= 8) then begin
  3323. inc(aData, 1);
  3324. dec(PByte(aMapData), 8);
  3325. end;
  3326. inc(aData, s);
  3327. end;
  3328. destructor TbmpColorTableFormat.Destroy;
  3329. begin
  3330. SetLength(fColorTable, 0);
  3331. inherited Destroy;
  3332. end;
  3333. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3334. //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3335. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3336. procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
  3337. var
  3338. i: Integer;
  3339. begin
  3340. for i := 0 to 3 do begin
  3341. if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
  3342. if (aSourceFD.Range.arr[i] > 0) then
  3343. aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
  3344. else
  3345. aPixel.Data.arr[i] := aDestFD.Range.arr[i];
  3346. end;
  3347. end;
  3348. end;
  3349. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3350. procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
  3351. begin
  3352. with aFuncRec do begin
  3353. if (Source.Range.r > 0) then
  3354. Dest.Data.r := Source.Data.r;
  3355. if (Source.Range.g > 0) then
  3356. Dest.Data.g := Source.Data.g;
  3357. if (Source.Range.b > 0) then
  3358. Dest.Data.b := Source.Data.b;
  3359. if (Source.Range.a > 0) then
  3360. Dest.Data.a := Source.Data.a;
  3361. end;
  3362. end;
  3363. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3364. procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3365. var
  3366. i: Integer;
  3367. begin
  3368. with aFuncRec do begin
  3369. for i := 0 to 3 do
  3370. if (Source.Range.arr[i] > 0) then
  3371. Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
  3372. end;
  3373. end;
  3374. type
  3375. TShiftData = packed record
  3376. case Integer of
  3377. 0: (r, g, b, a: SmallInt);
  3378. 1: (arr: array[0..3] of SmallInt);
  3379. end;
  3380. PShiftData = ^TShiftData;
  3381. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3382. procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3383. var
  3384. i: Integer;
  3385. begin
  3386. with aFuncRec do
  3387. for i := 0 to 3 do
  3388. if (Source.Range.arr[i] > 0) then
  3389. Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
  3390. end;
  3391. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3392. procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
  3393. begin
  3394. with aFuncRec do begin
  3395. Dest.Data := Source.Data;
  3396. if ({%H-}PtrUInt(Args) and $1 > 0) then begin
  3397. Dest.Data.r := Dest.Data.r xor Dest.Range.r;
  3398. Dest.Data.g := Dest.Data.g xor Dest.Range.g;
  3399. Dest.Data.b := Dest.Data.b xor Dest.Range.b;
  3400. end;
  3401. if ({%H-}PtrUInt(Args) and $2 > 0) then begin
  3402. Dest.Data.a := Dest.Data.a xor Dest.Range.a;
  3403. end;
  3404. end;
  3405. end;
  3406. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3407. procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
  3408. var
  3409. i: Integer;
  3410. begin
  3411. with aFuncRec do begin
  3412. for i := 0 to 3 do
  3413. Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
  3414. end;
  3415. end;
  3416. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3417. procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3418. var
  3419. Temp: Single;
  3420. begin
  3421. with FuncRec do begin
  3422. if (FuncRec.Args = nil) then begin //source has no alpha
  3423. Temp :=
  3424. Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
  3425. Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
  3426. Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
  3427. Dest.Data.a := Round(Dest.Range.a * Temp);
  3428. end else
  3429. Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
  3430. end;
  3431. end;
  3432. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3433. procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3434. type
  3435. PglBitmapPixelData = ^TglBitmapPixelData;
  3436. begin
  3437. with FuncRec do begin
  3438. Dest.Data.r := Source.Data.r;
  3439. Dest.Data.g := Source.Data.g;
  3440. Dest.Data.b := Source.Data.b;
  3441. with PglBitmapPixelData(Args)^ do
  3442. if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
  3443. (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
  3444. (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
  3445. Dest.Data.a := 0
  3446. else
  3447. Dest.Data.a := Dest.Range.a;
  3448. end;
  3449. end;
  3450. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3451. procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3452. begin
  3453. with FuncRec do begin
  3454. Dest.Data.r := Source.Data.r;
  3455. Dest.Data.g := Source.Data.g;
  3456. Dest.Data.b := Source.Data.b;
  3457. Dest.Data.a := PCardinal(Args)^;
  3458. end;
  3459. end;
  3460. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3461. procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
  3462. type
  3463. PRGBPix = ^TRGBPix;
  3464. TRGBPix = array [0..2] of byte;
  3465. var
  3466. Temp: Byte;
  3467. begin
  3468. while aWidth > 0 do begin
  3469. Temp := PRGBPix(aData)^[0];
  3470. PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
  3471. PRGBPix(aData)^[2] := Temp;
  3472. if aHasAlpha then
  3473. Inc(aData, 4)
  3474. else
  3475. Inc(aData, 3);
  3476. dec(aWidth);
  3477. end;
  3478. end;
  3479. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3480. //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3481. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3482. function TglBitmap.GetWidth: Integer;
  3483. begin
  3484. if (ffX in fDimension.Fields) then
  3485. result := fDimension.X
  3486. else
  3487. result := -1;
  3488. end;
  3489. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3490. function TglBitmap.GetHeight: Integer;
  3491. begin
  3492. if (ffY in fDimension.Fields) then
  3493. result := fDimension.Y
  3494. else
  3495. result := -1;
  3496. end;
  3497. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3498. function TglBitmap.GetFileWidth: Integer;
  3499. begin
  3500. result := Max(1, Width);
  3501. end;
  3502. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3503. function TglBitmap.GetFileHeight: Integer;
  3504. begin
  3505. result := Max(1, Height);
  3506. end;
  3507. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3508. procedure TglBitmap.SetCustomData(const aValue: Pointer);
  3509. begin
  3510. if fCustomData = aValue then
  3511. exit;
  3512. fCustomData := aValue;
  3513. end;
  3514. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3515. procedure TglBitmap.SetCustomName(const aValue: String);
  3516. begin
  3517. if fCustomName = aValue then
  3518. exit;
  3519. fCustomName := aValue;
  3520. end;
  3521. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3522. procedure TglBitmap.SetCustomNameW(const aValue: WideString);
  3523. begin
  3524. if fCustomNameW = aValue then
  3525. exit;
  3526. fCustomNameW := aValue;
  3527. end;
  3528. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3529. procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
  3530. begin
  3531. if fDeleteTextureOnFree = aValue then
  3532. exit;
  3533. fDeleteTextureOnFree := aValue;
  3534. end;
  3535. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3536. procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
  3537. begin
  3538. if fFormat = aValue then
  3539. exit;
  3540. if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
  3541. raise EglBitmapUnsupportedFormat.Create(Format);
  3542. SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
  3543. end;
  3544. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3545. procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
  3546. begin
  3547. if fFreeDataAfterGenTexture = aValue then
  3548. exit;
  3549. fFreeDataAfterGenTexture := aValue;
  3550. end;
  3551. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3552. procedure TglBitmap.SetID(const aValue: Cardinal);
  3553. begin
  3554. if fID = aValue then
  3555. exit;
  3556. fID := aValue;
  3557. end;
  3558. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3559. procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
  3560. begin
  3561. if fMipMap = aValue then
  3562. exit;
  3563. fMipMap := aValue;
  3564. end;
  3565. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3566. procedure TglBitmap.SetTarget(const aValue: Cardinal);
  3567. begin
  3568. if fTarget = aValue then
  3569. exit;
  3570. fTarget := aValue;
  3571. end;
  3572. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3573. procedure TglBitmap.SetAnisotropic(const aValue: Integer);
  3574. var
  3575. MaxAnisotropic: Integer;
  3576. begin
  3577. fAnisotropic := aValue;
  3578. if (ID > 0) then begin
  3579. if GL_EXT_texture_filter_anisotropic then begin
  3580. if fAnisotropic > 0 then begin
  3581. Bind(false);
  3582. glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
  3583. if aValue > MaxAnisotropic then
  3584. fAnisotropic := MaxAnisotropic;
  3585. glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
  3586. end;
  3587. end else begin
  3588. fAnisotropic := 0;
  3589. end;
  3590. end;
  3591. end;
  3592. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3593. procedure TglBitmap.CreateID;
  3594. begin
  3595. if (ID <> 0) then
  3596. glDeleteTextures(1, @fID);
  3597. glGenTextures(1, @fID);
  3598. Bind(false);
  3599. end;
  3600. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3601. procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
  3602. begin
  3603. // Set Up Parameters
  3604. SetWrap(fWrapS, fWrapT, fWrapR);
  3605. SetFilter(fFilterMin, fFilterMag);
  3606. SetAnisotropic(fAnisotropic);
  3607. SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
  3608. if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  3609. SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  3610. // Mip Maps Generation Mode
  3611. aBuildWithGlu := false;
  3612. if (MipMap = mmMipmap) then begin
  3613. if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
  3614. glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
  3615. else
  3616. aBuildWithGlu := true;
  3617. end else if (MipMap = mmMipmapGlu) then
  3618. aBuildWithGlu := true;
  3619. end;
  3620. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3621. procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  3622. const aWidth: Integer; const aHeight: Integer);
  3623. var
  3624. s: Single;
  3625. begin
  3626. if (Data <> aData) then begin
  3627. if (Assigned(Data)) then
  3628. FreeMem(Data);
  3629. fData := aData;
  3630. end;
  3631. FillChar(fDimension, SizeOf(fDimension), 0);
  3632. if not Assigned(fData) then begin
  3633. fFormat := tfEmpty;
  3634. fPixelSize := 0;
  3635. fRowSize := 0;
  3636. end else begin
  3637. if aWidth <> -1 then begin
  3638. fDimension.Fields := fDimension.Fields + [ffX];
  3639. fDimension.X := aWidth;
  3640. end;
  3641. if aHeight <> -1 then begin
  3642. fDimension.Fields := fDimension.Fields + [ffY];
  3643. fDimension.Y := aHeight;
  3644. end;
  3645. s := TFormatDescriptor.Get(aFormat).PixelSize;
  3646. fFormat := aFormat;
  3647. fPixelSize := Ceil(s);
  3648. fRowSize := Ceil(s * aWidth);
  3649. end;
  3650. end;
  3651. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3652. function TglBitmap.FlipHorz: Boolean;
  3653. begin
  3654. result := false;
  3655. end;
  3656. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3657. function TglBitmap.FlipVert: Boolean;
  3658. begin
  3659. result := false;
  3660. end;
  3661. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3662. //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3663. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3664. procedure TglBitmap.AfterConstruction;
  3665. begin
  3666. inherited AfterConstruction;
  3667. fID := 0;
  3668. fTarget := 0;
  3669. fIsResident := false;
  3670. fFormat := glBitmapGetDefaultFormat;
  3671. fMipMap := glBitmapDefaultMipmap;
  3672. fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
  3673. fDeleteTextureOnFree := glBitmapGetDefaultDeleteTextureOnFree;
  3674. glBitmapGetDefaultFilter (fFilterMin, fFilterMag);
  3675. glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
  3676. glBitmapGetDefaultSwizzle (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  3677. end;
  3678. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3679. procedure TglBitmap.BeforeDestruction;
  3680. var
  3681. NewData: PByte;
  3682. begin
  3683. NewData := nil;
  3684. SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
  3685. if (fID > 0) and fDeleteTextureOnFree then
  3686. glDeleteTextures(1, @fID);
  3687. inherited BeforeDestruction;
  3688. end;
  3689. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3690. procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
  3691. var
  3692. TempPos: Integer;
  3693. begin
  3694. if not Assigned(aResType) then begin
  3695. TempPos := Pos('.', aResource);
  3696. aResType := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
  3697. aResource := UpperCase(Copy(aResource, 0, TempPos -1));
  3698. end;
  3699. end;
  3700. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3701. procedure TglBitmap.LoadFromFile(const aFilename: String);
  3702. var
  3703. fs: TFileStream;
  3704. begin
  3705. if not FileExists(aFilename) then
  3706. raise EglBitmap.Create('file does not exist: ' + aFilename);
  3707. fFilename := aFilename;
  3708. fs := TFileStream.Create(fFilename, fmOpenRead);
  3709. try
  3710. fs.Position := 0;
  3711. LoadFromStream(fs);
  3712. finally
  3713. fs.Free;
  3714. end;
  3715. end;
  3716. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3717. procedure TglBitmap.LoadFromStream(const aStream: TStream);
  3718. begin
  3719. {$IFDEF GLB_SUPPORT_PNG_READ}
  3720. if not LoadPNG(aStream) then
  3721. {$ENDIF}
  3722. {$IFDEF GLB_SUPPORT_JPEG_READ}
  3723. if not LoadJPEG(aStream) then
  3724. {$ENDIF}
  3725. if not LoadDDS(aStream) then
  3726. if not LoadTGA(aStream) then
  3727. if not LoadBMP(aStream) then
  3728. raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
  3729. end;
  3730. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3731. procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  3732. const aFormat: TglBitmapFormat; const aArgs: Pointer);
  3733. var
  3734. tmpData: PByte;
  3735. size: Integer;
  3736. begin
  3737. size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  3738. GetMem(tmpData, size);
  3739. try
  3740. FillChar(tmpData^, size, #$FF);
  3741. SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  3742. except
  3743. if Assigned(tmpData) then
  3744. FreeMem(tmpData);
  3745. raise;
  3746. end;
  3747. AddFunc(Self, aFunc, false, Format, aArgs);
  3748. end;
  3749. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3750. procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
  3751. var
  3752. rs: TResourceStream;
  3753. begin
  3754. PrepareResType(aResource, aResType);
  3755. rs := TResourceStream.Create(aInstance, aResource, aResType);
  3756. try
  3757. LoadFromStream(rs);
  3758. finally
  3759. rs.Free;
  3760. end;
  3761. end;
  3762. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3763. procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  3764. var
  3765. rs: TResourceStream;
  3766. begin
  3767. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  3768. try
  3769. LoadFromStream(rs);
  3770. finally
  3771. rs.Free;
  3772. end;
  3773. end;
  3774. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3775. procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  3776. var
  3777. fs: TFileStream;
  3778. begin
  3779. fs := TFileStream.Create(aFileName, fmCreate);
  3780. try
  3781. fs.Position := 0;
  3782. SaveToStream(fs, aFileType);
  3783. finally
  3784. fs.Free;
  3785. end;
  3786. end;
  3787. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3788. procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
  3789. begin
  3790. case aFileType of
  3791. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  3792. ftPNG: SavePNG(aStream);
  3793. {$ENDIF}
  3794. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  3795. ftJPEG: SaveJPEG(aStream);
  3796. {$ENDIF}
  3797. ftDDS: SaveDDS(aStream);
  3798. ftTGA: SaveTGA(aStream);
  3799. ftBMP: SaveBMP(aStream);
  3800. end;
  3801. end;
  3802. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3803. function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
  3804. begin
  3805. result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
  3806. end;
  3807. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3808. function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  3809. const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
  3810. var
  3811. DestData, TmpData, SourceData: pByte;
  3812. TempHeight, TempWidth: Integer;
  3813. SourceFD, DestFD: TFormatDescriptor;
  3814. SourceMD, DestMD: Pointer;
  3815. FuncRec: TglBitmapFunctionRec;
  3816. begin
  3817. Assert(Assigned(Data));
  3818. Assert(Assigned(aSource));
  3819. Assert(Assigned(aSource.Data));
  3820. result := false;
  3821. if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
  3822. SourceFD := TFormatDescriptor.Get(aSource.Format);
  3823. DestFD := TFormatDescriptor.Get(aFormat);
  3824. if (SourceFD.IsCompressed) then
  3825. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
  3826. if (DestFD.IsCompressed) then
  3827. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
  3828. // inkompatible Formats so CreateTemp
  3829. if (SourceFD.PixelSize <> DestFD.PixelSize) then
  3830. aCreateTemp := true;
  3831. // Values
  3832. TempHeight := Max(1, aSource.Height);
  3833. TempWidth := Max(1, aSource.Width);
  3834. FuncRec.Sender := Self;
  3835. FuncRec.Args := aArgs;
  3836. TmpData := nil;
  3837. if aCreateTemp then begin
  3838. GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
  3839. DestData := TmpData;
  3840. end else
  3841. DestData := Data;
  3842. try
  3843. SourceFD.PreparePixel(FuncRec.Source);
  3844. DestFD.PreparePixel (FuncRec.Dest);
  3845. SourceMD := SourceFD.CreateMappingData;
  3846. DestMD := DestFD.CreateMappingData;
  3847. FuncRec.Size := aSource.Dimension;
  3848. FuncRec.Position.Fields := FuncRec.Size.Fields;
  3849. try
  3850. SourceData := aSource.Data;
  3851. FuncRec.Position.Y := 0;
  3852. while FuncRec.Position.Y < TempHeight do begin
  3853. FuncRec.Position.X := 0;
  3854. while FuncRec.Position.X < TempWidth do begin
  3855. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  3856. aFunc(FuncRec);
  3857. DestFD.Map(FuncRec.Dest, DestData, DestMD);
  3858. inc(FuncRec.Position.X);
  3859. end;
  3860. inc(FuncRec.Position.Y);
  3861. end;
  3862. // Updating Image or InternalFormat
  3863. if aCreateTemp then
  3864. SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method
  3865. else if (aFormat <> fFormat) then
  3866. Format := aFormat;
  3867. result := true;
  3868. finally
  3869. SourceFD.FreeMappingData(SourceMD);
  3870. DestFD.FreeMappingData(DestMD);
  3871. end;
  3872. except
  3873. if aCreateTemp and Assigned(TmpData) then
  3874. FreeMem(TmpData);
  3875. raise;
  3876. end;
  3877. end;
  3878. end;
  3879. {$IFDEF GLB_SDL}
  3880. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3881. function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  3882. var
  3883. Row, RowSize: Integer;
  3884. SourceData, TmpData: PByte;
  3885. TempDepth: Integer;
  3886. FormatDesc: TFormatDescriptor;
  3887. function GetRowPointer(Row: Integer): pByte;
  3888. begin
  3889. result := aSurface.pixels;
  3890. Inc(result, Row * RowSize);
  3891. end;
  3892. begin
  3893. result := false;
  3894. FormatDesc := TFormatDescriptor.Get(Format);
  3895. if FormatDesc.IsCompressed then
  3896. raise EglBitmapUnsupportedFormat.Create(Format);
  3897. if Assigned(Data) then begin
  3898. case Trunc(FormatDesc.PixelSize) of
  3899. 1: TempDepth := 8;
  3900. 2: TempDepth := 16;
  3901. 3: TempDepth := 24;
  3902. 4: TempDepth := 32;
  3903. else
  3904. raise EglBitmapUnsupportedFormat.Create(Format);
  3905. end;
  3906. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
  3907. FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
  3908. SourceData := Data;
  3909. RowSize := FormatDesc.GetSize(FileWidth, 1);
  3910. for Row := 0 to FileHeight-1 do begin
  3911. TmpData := GetRowPointer(Row);
  3912. if Assigned(TmpData) then begin
  3913. Move(SourceData^, TmpData^, RowSize);
  3914. inc(SourceData, RowSize);
  3915. end;
  3916. end;
  3917. result := true;
  3918. end;
  3919. end;
  3920. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3921. function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  3922. var
  3923. pSource, pData, pTempData: PByte;
  3924. Row, RowSize, TempWidth, TempHeight: Integer;
  3925. IntFormat: TglBitmapFormat;
  3926. FormatDesc: TFormatDescriptor;
  3927. function GetRowPointer(Row: Integer): pByte;
  3928. begin
  3929. result := aSurface^.pixels;
  3930. Inc(result, Row * RowSize);
  3931. end;
  3932. begin
  3933. result := false;
  3934. if (Assigned(aSurface)) then begin
  3935. with aSurface^.format^ do begin
  3936. for IntFormat := High(TglBitmapFormat) to Low(TglBitmapFormat) do begin
  3937. FormatDesc := TFormatDescriptor.Get(IntFormat);
  3938. if (FormatDesc.MaskMatch(RMask, GMask, BMask, AMask)) then
  3939. break;
  3940. end;
  3941. if (IntFormat = tfEmpty) then
  3942. raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
  3943. end;
  3944. TempWidth := aSurface^.w;
  3945. TempHeight := aSurface^.h;
  3946. RowSize := FormatDesc.GetSize(TempWidth, 1);
  3947. GetMem(pData, TempHeight * RowSize);
  3948. try
  3949. pTempData := pData;
  3950. for Row := 0 to TempHeight -1 do begin
  3951. pSource := GetRowPointer(Row);
  3952. if (Assigned(pSource)) then begin
  3953. Move(pSource^, pTempData^, RowSize);
  3954. Inc(pTempData, RowSize);
  3955. end;
  3956. end;
  3957. SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  3958. result := true;
  3959. except
  3960. if Assigned(pData) then
  3961. FreeMem(pData);
  3962. raise;
  3963. end;
  3964. end;
  3965. end;
  3966. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3967. function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  3968. var
  3969. Row, Col, AlphaInterleave: Integer;
  3970. pSource, pDest: PByte;
  3971. function GetRowPointer(Row: Integer): pByte;
  3972. begin
  3973. result := aSurface.pixels;
  3974. Inc(result, Row * Width);
  3975. end;
  3976. begin
  3977. result := false;
  3978. if Assigned(Data) then begin
  3979. if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
  3980. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
  3981. AlphaInterleave := 0;
  3982. case Format of
  3983. tfLuminance8Alpha8:
  3984. AlphaInterleave := 1;
  3985. tfBGRA8, tfRGBA8:
  3986. AlphaInterleave := 3;
  3987. end;
  3988. pSource := Data;
  3989. for Row := 0 to Height -1 do begin
  3990. pDest := GetRowPointer(Row);
  3991. if Assigned(pDest) then begin
  3992. for Col := 0 to Width -1 do begin
  3993. Inc(pSource, AlphaInterleave);
  3994. pDest^ := pSource^;
  3995. Inc(pDest);
  3996. Inc(pSource);
  3997. end;
  3998. end;
  3999. end;
  4000. result := true;
  4001. end;
  4002. end;
  4003. end;
  4004. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4005. function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  4006. var
  4007. bmp: TglBitmap2D;
  4008. begin
  4009. bmp := TglBitmap2D.Create;
  4010. try
  4011. bmp.AssignFromSurface(aSurface);
  4012. result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
  4013. finally
  4014. bmp.Free;
  4015. end;
  4016. end;
  4017. {$ENDIF}
  4018. {$IFDEF GLB_DELPHI}
  4019. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4020. function CreateGrayPalette: HPALETTE;
  4021. var
  4022. Idx: Integer;
  4023. Pal: PLogPalette;
  4024. begin
  4025. GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
  4026. Pal.palVersion := $300;
  4027. Pal.palNumEntries := 256;
  4028. for Idx := 0 to Pal.palNumEntries - 1 do begin
  4029. Pal.palPalEntry[Idx].peRed := Idx;
  4030. Pal.palPalEntry[Idx].peGreen := Idx;
  4031. Pal.palPalEntry[Idx].peBlue := Idx;
  4032. Pal.palPalEntry[Idx].peFlags := 0;
  4033. end;
  4034. Result := CreatePalette(Pal^);
  4035. FreeMem(Pal);
  4036. end;
  4037. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4038. function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
  4039. var
  4040. Row: Integer;
  4041. pSource, pData: PByte;
  4042. begin
  4043. result := false;
  4044. if Assigned(Data) then begin
  4045. if Assigned(aBitmap) then begin
  4046. aBitmap.Width := Width;
  4047. aBitmap.Height := Height;
  4048. case Format of
  4049. tfAlpha8, tfLuminance8: begin
  4050. aBitmap.PixelFormat := pf8bit;
  4051. aBitmap.Palette := CreateGrayPalette;
  4052. end;
  4053. tfRGB5A1:
  4054. aBitmap.PixelFormat := pf15bit;
  4055. tfR5G6B5:
  4056. aBitmap.PixelFormat := pf16bit;
  4057. tfRGB8, tfBGR8:
  4058. aBitmap.PixelFormat := pf24bit;
  4059. tfRGBA8, tfBGRA8:
  4060. aBitmap.PixelFormat := pf32bit;
  4061. else
  4062. raise EglBitmapException.Create('AssignToBitmap - Invalid Pixelformat.');
  4063. end;
  4064. pSource := Data;
  4065. for Row := 0 to FileHeight -1 do begin
  4066. pData := aBitmap.Scanline[Row];
  4067. Move(pSource^, pData^, fRowSize);
  4068. Inc(pSource, fRowSize);
  4069. if (Format in [tfRGB8, tfRGBA8]) then // swap RGB(A) to BGR(A)
  4070. SwapRGB(pData, FileWidth, Format = tfRGBA8);
  4071. end;
  4072. result := true;
  4073. end;
  4074. end;
  4075. end;
  4076. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4077. function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  4078. var
  4079. pSource, pData, pTempData: PByte;
  4080. Row, RowSize, TempWidth, TempHeight: Integer;
  4081. IntFormat: TglBitmapFormat;
  4082. begin
  4083. result := false;
  4084. if (Assigned(aBitmap)) then begin
  4085. case aBitmap.PixelFormat of
  4086. pf8bit:
  4087. IntFormat := tfLuminance8;
  4088. pf15bit:
  4089. IntFormat := tfRGB5A1;
  4090. pf16bit:
  4091. IntFormat := tfR5G6B5;
  4092. pf24bit:
  4093. IntFormat := tfBGR8;
  4094. pf32bit:
  4095. IntFormat := tfBGRA8;
  4096. else
  4097. raise EglBitmapException.Create('AssignFromBitmap - Invalid Pixelformat.');
  4098. end;
  4099. TempWidth := aBitmap.Width;
  4100. TempHeight := aBitmap.Height;
  4101. RowSize := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
  4102. GetMem(pData, TempHeight * RowSize);
  4103. try
  4104. pTempData := pData;
  4105. for Row := 0 to TempHeight -1 do begin
  4106. pSource := aBitmap.Scanline[Row];
  4107. if (Assigned(pSource)) then begin
  4108. Move(pSource^, pTempData^, RowSize);
  4109. Inc(pTempData, RowSize);
  4110. end;
  4111. end;
  4112. SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  4113. result := true;
  4114. except
  4115. if Assigned(pData) then
  4116. FreeMem(pData);
  4117. raise;
  4118. end;
  4119. end;
  4120. end;
  4121. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4122. function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  4123. var
  4124. Row, Col, AlphaInterleave: Integer;
  4125. pSource, pDest: PByte;
  4126. begin
  4127. result := false;
  4128. if Assigned(Data) then begin
  4129. if (Format in [tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8]) then begin
  4130. if Assigned(aBitmap) then begin
  4131. aBitmap.PixelFormat := pf8bit;
  4132. aBitmap.Palette := CreateGrayPalette;
  4133. aBitmap.Width := Width;
  4134. aBitmap.Height := Height;
  4135. case Format of
  4136. tfLuminance8Alpha8:
  4137. AlphaInterleave := 1;
  4138. tfRGBA8, tfBGRA8:
  4139. AlphaInterleave := 3;
  4140. else
  4141. AlphaInterleave := 0;
  4142. end;
  4143. // Copy Data
  4144. pSource := Data;
  4145. for Row := 0 to Height -1 do begin
  4146. pDest := aBitmap.Scanline[Row];
  4147. if Assigned(pDest) then begin
  4148. for Col := 0 to Width -1 do begin
  4149. Inc(pSource, AlphaInterleave);
  4150. pDest^ := pSource^;
  4151. Inc(pDest);
  4152. Inc(pSource);
  4153. end;
  4154. end;
  4155. end;
  4156. result := true;
  4157. end;
  4158. end;
  4159. end;
  4160. end;
  4161. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4162. function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4163. var
  4164. tex: TglBitmap2D;
  4165. begin
  4166. tex := TglBitmap2D.Create;
  4167. try
  4168. tex.AssignFromBitmap(ABitmap);
  4169. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4170. finally
  4171. tex.Free;
  4172. end;
  4173. end;
  4174. {$ENDIF}
  4175. {$IFDEF GLB_LAZARUS}
  4176. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4177. function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4178. var
  4179. rid: TRawImageDescription;
  4180. FormatDesc: TFormatDescriptor;
  4181. begin
  4182. result := false;
  4183. if not Assigned(aImage) or (Format = tfEmpty) then
  4184. exit;
  4185. FormatDesc := TFormatDescriptor.Get(Format);
  4186. if FormatDesc.IsCompressed then
  4187. exit;
  4188. FillChar(rid{%H-}, SizeOf(rid), 0);
  4189. if (Format in [
  4190. tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
  4191. tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
  4192. tfLuminance4Alpha4, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16]) then
  4193. rid.Format := ricfGray
  4194. else
  4195. rid.Format := ricfRGBA;
  4196. rid.Width := Width;
  4197. rid.Height := Height;
  4198. rid.Depth := CountSetBits(FormatDesc.Range.r or FormatDesc.Range.g or FormatDesc.Range.b or FormatDesc.Range.a);
  4199. rid.BitOrder := riboBitsInOrder;
  4200. rid.ByteOrder := riboLSBFirst;
  4201. rid.LineOrder := riloTopToBottom;
  4202. rid.LineEnd := rileTight;
  4203. rid.BitsPerPixel := Round(8 * FormatDesc.PixelSize);
  4204. rid.RedPrec := CountSetBits(FormatDesc.Range.r);
  4205. rid.GreenPrec := CountSetBits(FormatDesc.Range.g);
  4206. rid.BluePrec := CountSetBits(FormatDesc.Range.b);
  4207. rid.AlphaPrec := CountSetBits(FormatDesc.Range.a);
  4208. rid.RedShift := FormatDesc.Shift.r;
  4209. rid.GreenShift := FormatDesc.Shift.g;
  4210. rid.BlueShift := FormatDesc.Shift.b;
  4211. rid.AlphaShift := FormatDesc.Shift.a;
  4212. rid.MaskBitsPerPixel := 0;
  4213. rid.PaletteColorCount := 0;
  4214. aImage.DataDescription := rid;
  4215. aImage.CreateData;
  4216. Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
  4217. result := true;
  4218. end;
  4219. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4220. function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4221. var
  4222. f: TglBitmapFormat;
  4223. FormatDesc: TFormatDescriptor;
  4224. ImageData: PByte;
  4225. ImageSize: Integer;
  4226. begin
  4227. result := false;
  4228. if not Assigned(aImage) then
  4229. exit;
  4230. for f := High(f) downto Low(f) do begin
  4231. FormatDesc := TFormatDescriptor.Get(f);
  4232. with aImage.DataDescription do
  4233. if FormatDesc.MaskMatch(
  4234. (QWord(1 shl RedPrec )-1) shl RedShift,
  4235. (QWord(1 shl GreenPrec)-1) shl GreenShift,
  4236. (QWord(1 shl BluePrec )-1) shl BlueShift,
  4237. (QWord(1 shl AlphaPrec)-1) shl AlphaShift) then
  4238. break;
  4239. end;
  4240. if (f = tfEmpty) then
  4241. exit;
  4242. ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
  4243. ImageData := GetMem(ImageSize);
  4244. try
  4245. Move(aImage.PixelData^, ImageData^, (aImage.Width * aImage.Height * aImage.DataDescription.BitsPerPixel) shr 3);
  4246. SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method
  4247. except
  4248. if Assigned(ImageData) then
  4249. FreeMem(ImageData);
  4250. raise;
  4251. end;
  4252. result := true;
  4253. end;
  4254. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4255. function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4256. var
  4257. rid: TRawImageDescription;
  4258. FormatDesc: TFormatDescriptor;
  4259. Pixel: TglBitmapPixelData;
  4260. x, y: Integer;
  4261. srcMD: Pointer;
  4262. src, dst: PByte;
  4263. begin
  4264. result := false;
  4265. if not Assigned(aImage) or (Format = tfEmpty) then
  4266. exit;
  4267. FormatDesc := TFormatDescriptor.Get(Format);
  4268. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  4269. exit;
  4270. FillChar(rid{%H-}, SizeOf(rid), 0);
  4271. rid.Format := ricfGray;
  4272. rid.Width := Width;
  4273. rid.Height := Height;
  4274. rid.Depth := CountSetBits(FormatDesc.Range.a);
  4275. rid.BitOrder := riboBitsInOrder;
  4276. rid.ByteOrder := riboLSBFirst;
  4277. rid.LineOrder := riloTopToBottom;
  4278. rid.LineEnd := rileTight;
  4279. rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
  4280. rid.RedPrec := CountSetBits(FormatDesc.Range.a);
  4281. rid.GreenPrec := 0;
  4282. rid.BluePrec := 0;
  4283. rid.AlphaPrec := 0;
  4284. rid.RedShift := 0;
  4285. rid.GreenShift := 0;
  4286. rid.BlueShift := 0;
  4287. rid.AlphaShift := 0;
  4288. rid.MaskBitsPerPixel := 0;
  4289. rid.PaletteColorCount := 0;
  4290. aImage.DataDescription := rid;
  4291. aImage.CreateData;
  4292. srcMD := FormatDesc.CreateMappingData;
  4293. try
  4294. FormatDesc.PreparePixel(Pixel);
  4295. src := Data;
  4296. dst := aImage.PixelData;
  4297. for y := 0 to Height-1 do
  4298. for x := 0 to Width-1 do begin
  4299. FormatDesc.Unmap(src, Pixel, srcMD);
  4300. case rid.BitsPerPixel of
  4301. 8: begin
  4302. dst^ := Pixel.Data.a;
  4303. inc(dst);
  4304. end;
  4305. 16: begin
  4306. PWord(dst)^ := Pixel.Data.a;
  4307. inc(dst, 2);
  4308. end;
  4309. 24: begin
  4310. PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
  4311. PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
  4312. PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
  4313. inc(dst, 3);
  4314. end;
  4315. 32: begin
  4316. PCardinal(dst)^ := Pixel.Data.a;
  4317. inc(dst, 4);
  4318. end;
  4319. else
  4320. raise EglBitmapUnsupportedFormat.Create(Format);
  4321. end;
  4322. end;
  4323. finally
  4324. FormatDesc.FreeMappingData(srcMD);
  4325. end;
  4326. result := true;
  4327. end;
  4328. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4329. function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4330. var
  4331. tex: TglBitmap2D;
  4332. begin
  4333. tex := TglBitmap2D.Create;
  4334. try
  4335. tex.AssignFromLazIntfImage(aImage);
  4336. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4337. finally
  4338. tex.Free;
  4339. end;
  4340. end;
  4341. {$ENDIF}
  4342. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4343. function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
  4344. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4345. var
  4346. rs: TResourceStream;
  4347. begin
  4348. PrepareResType(aResource, aResType);
  4349. rs := TResourceStream.Create(aInstance, aResource, aResType);
  4350. try
  4351. result := AddAlphaFromStream(rs, aFunc, aArgs);
  4352. finally
  4353. rs.Free;
  4354. end;
  4355. end;
  4356. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4357. function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  4358. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4359. var
  4360. rs: TResourceStream;
  4361. begin
  4362. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  4363. try
  4364. result := AddAlphaFromStream(rs, aFunc, aArgs);
  4365. finally
  4366. rs.Free;
  4367. end;
  4368. end;
  4369. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4370. function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4371. begin
  4372. if TFormatDescriptor.Get(Format).IsCompressed then
  4373. raise EglBitmapUnsupportedFormat.Create(Format);
  4374. result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
  4375. end;
  4376. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4377. function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4378. var
  4379. FS: TFileStream;
  4380. begin
  4381. FS := TFileStream.Create(FileName, fmOpenRead);
  4382. try
  4383. result := AddAlphaFromStream(FS, aFunc, aArgs);
  4384. finally
  4385. FS.Free;
  4386. end;
  4387. end;
  4388. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4389. function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4390. var
  4391. tex: TglBitmap2D;
  4392. begin
  4393. tex := TglBitmap2D.Create(aStream);
  4394. try
  4395. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4396. finally
  4397. tex.Free;
  4398. end;
  4399. end;
  4400. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4401. function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4402. var
  4403. DestData, DestData2, SourceData: pByte;
  4404. TempHeight, TempWidth: Integer;
  4405. SourceFD, DestFD: TFormatDescriptor;
  4406. SourceMD, DestMD, DestMD2: Pointer;
  4407. FuncRec: TglBitmapFunctionRec;
  4408. begin
  4409. result := false;
  4410. Assert(Assigned(Data));
  4411. Assert(Assigned(aBitmap));
  4412. Assert(Assigned(aBitmap.Data));
  4413. if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
  4414. result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
  4415. SourceFD := TFormatDescriptor.Get(aBitmap.Format);
  4416. DestFD := TFormatDescriptor.Get(Format);
  4417. if not Assigned(aFunc) then begin
  4418. aFunc := glBitmapAlphaFunc;
  4419. FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
  4420. end else
  4421. FuncRec.Args := aArgs;
  4422. // Values
  4423. TempHeight := aBitmap.FileHeight;
  4424. TempWidth := aBitmap.FileWidth;
  4425. FuncRec.Sender := Self;
  4426. FuncRec.Size := Dimension;
  4427. FuncRec.Position.Fields := FuncRec.Size.Fields;
  4428. DestData := Data;
  4429. DestData2 := Data;
  4430. SourceData := aBitmap.Data;
  4431. // Mapping
  4432. SourceFD.PreparePixel(FuncRec.Source);
  4433. DestFD.PreparePixel (FuncRec.Dest);
  4434. SourceMD := SourceFD.CreateMappingData;
  4435. DestMD := DestFD.CreateMappingData;
  4436. DestMD2 := DestFD.CreateMappingData;
  4437. try
  4438. FuncRec.Position.Y := 0;
  4439. while FuncRec.Position.Y < TempHeight do begin
  4440. FuncRec.Position.X := 0;
  4441. while FuncRec.Position.X < TempWidth do begin
  4442. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  4443. DestFD.Unmap (DestData, FuncRec.Dest, DestMD);
  4444. aFunc(FuncRec);
  4445. DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
  4446. inc(FuncRec.Position.X);
  4447. end;
  4448. inc(FuncRec.Position.Y);
  4449. end;
  4450. finally
  4451. SourceFD.FreeMappingData(SourceMD);
  4452. DestFD.FreeMappingData(DestMD);
  4453. DestFD.FreeMappingData(DestMD2);
  4454. end;
  4455. end;
  4456. end;
  4457. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4458. function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
  4459. begin
  4460. result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
  4461. end;
  4462. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4463. function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
  4464. var
  4465. PixelData: TglBitmapPixelData;
  4466. begin
  4467. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4468. result := AddAlphaFromColorKeyFloat(
  4469. aRed / PixelData.Range.r,
  4470. aGreen / PixelData.Range.g,
  4471. aBlue / PixelData.Range.b,
  4472. aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
  4473. end;
  4474. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4475. function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
  4476. var
  4477. values: array[0..2] of Single;
  4478. tmp: Cardinal;
  4479. i: Integer;
  4480. PixelData: TglBitmapPixelData;
  4481. begin
  4482. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4483. with PixelData do begin
  4484. values[0] := aRed;
  4485. values[1] := aGreen;
  4486. values[2] := aBlue;
  4487. for i := 0 to 2 do begin
  4488. tmp := Trunc(Range.arr[i] * aDeviation);
  4489. Data.arr[i] := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
  4490. Range.arr[i] := Max(0, Trunc(Range.arr[i] * values[i] - tmp));
  4491. end;
  4492. Data.a := 0;
  4493. Range.a := 0;
  4494. end;
  4495. result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
  4496. end;
  4497. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4498. function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
  4499. begin
  4500. result := AddAlphaFromValueFloat(aAlpha / $FF);
  4501. end;
  4502. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4503. function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  4504. var
  4505. PixelData: TglBitmapPixelData;
  4506. begin
  4507. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4508. result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
  4509. end;
  4510. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4511. function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  4512. var
  4513. PixelData: TglBitmapPixelData;
  4514. begin
  4515. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4516. with PixelData do
  4517. Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
  4518. result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
  4519. end;
  4520. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4521. function TglBitmap.RemoveAlpha: Boolean;
  4522. var
  4523. FormatDesc: TFormatDescriptor;
  4524. begin
  4525. result := false;
  4526. FormatDesc := TFormatDescriptor.Get(Format);
  4527. if Assigned(Data) then begin
  4528. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  4529. raise EglBitmapUnsupportedFormat.Create(Format);
  4530. result := ConvertTo(FormatDesc.WithoutAlpha);
  4531. end;
  4532. end;
  4533. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4534. function TglBitmap.Clone: TglBitmap;
  4535. var
  4536. Temp: TglBitmap;
  4537. TempPtr: PByte;
  4538. Size: Integer;
  4539. begin
  4540. result := nil;
  4541. Temp := (ClassType.Create as TglBitmap);
  4542. try
  4543. // copy texture data if assigned
  4544. if Assigned(Data) then begin
  4545. Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
  4546. GetMem(TempPtr, Size);
  4547. try
  4548. Move(Data^, TempPtr^, Size);
  4549. Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
  4550. except
  4551. if Assigned(TempPtr) then
  4552. FreeMem(TempPtr);
  4553. raise;
  4554. end;
  4555. end else begin
  4556. TempPtr := nil;
  4557. Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
  4558. end;
  4559. // copy properties
  4560. Temp.fID := ID;
  4561. Temp.fTarget := Target;
  4562. Temp.fFormat := Format;
  4563. Temp.fMipMap := MipMap;
  4564. Temp.fAnisotropic := Anisotropic;
  4565. Temp.fBorderColor := fBorderColor;
  4566. Temp.fDeleteTextureOnFree := DeleteTextureOnFree;
  4567. Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
  4568. Temp.fFilterMin := fFilterMin;
  4569. Temp.fFilterMag := fFilterMag;
  4570. Temp.fWrapS := fWrapS;
  4571. Temp.fWrapT := fWrapT;
  4572. Temp.fWrapR := fWrapR;
  4573. Temp.fFilename := fFilename;
  4574. Temp.fCustomName := fCustomName;
  4575. Temp.fCustomNameW := fCustomNameW;
  4576. Temp.fCustomData := fCustomData;
  4577. result := Temp;
  4578. except
  4579. FreeAndNil(Temp);
  4580. raise;
  4581. end;
  4582. end;
  4583. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4584. function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
  4585. var
  4586. SourceFD, DestFD: TFormatDescriptor;
  4587. SourcePD, DestPD: TglBitmapPixelData;
  4588. ShiftData: TShiftData;
  4589. function CanCopyDirect: Boolean;
  4590. begin
  4591. result :=
  4592. ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  4593. ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  4594. ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  4595. ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  4596. end;
  4597. function CanShift: Boolean;
  4598. begin
  4599. result :=
  4600. ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  4601. ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  4602. ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  4603. ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  4604. end;
  4605. function GetShift(aSource, aDest: Cardinal) : ShortInt;
  4606. begin
  4607. result := 0;
  4608. while (aSource > aDest) and (aSource > 0) do begin
  4609. inc(result);
  4610. aSource := aSource shr 1;
  4611. end;
  4612. end;
  4613. begin
  4614. if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
  4615. SourceFD := TFormatDescriptor.Get(Format);
  4616. DestFD := TFormatDescriptor.Get(aFormat);
  4617. SourceFD.PreparePixel(SourcePD);
  4618. DestFD.PreparePixel (DestPD);
  4619. if CanCopyDirect then
  4620. result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
  4621. else if CanShift then begin
  4622. ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
  4623. ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
  4624. ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
  4625. ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
  4626. result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
  4627. end else
  4628. result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
  4629. end else
  4630. result := true;
  4631. end;
  4632. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4633. procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
  4634. begin
  4635. if aUseRGB or aUseAlpha then
  4636. AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
  4637. ((PtrInt(aUseAlpha) and 1) shl 1) or
  4638. (PtrInt(aUseRGB) and 1) ));
  4639. end;
  4640. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4641. procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  4642. begin
  4643. fBorderColor[0] := aRed;
  4644. fBorderColor[1] := aGreen;
  4645. fBorderColor[2] := aBlue;
  4646. fBorderColor[3] := aAlpha;
  4647. if (ID > 0) then begin
  4648. Bind(false);
  4649. glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
  4650. end;
  4651. end;
  4652. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4653. procedure TglBitmap.FreeData;
  4654. var
  4655. TempPtr: PByte;
  4656. begin
  4657. TempPtr := nil;
  4658. SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method
  4659. end;
  4660. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4661. procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
  4662. const aAlpha: Byte);
  4663. begin
  4664. FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
  4665. end;
  4666. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4667. procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
  4668. var
  4669. PixelData: TglBitmapPixelData;
  4670. begin
  4671. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4672. FillWithColorFloat(
  4673. aRed / PixelData.Range.r,
  4674. aGreen / PixelData.Range.g,
  4675. aBlue / PixelData.Range.b,
  4676. aAlpha / PixelData.Range.a);
  4677. end;
  4678. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4679. procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
  4680. var
  4681. PixelData: TglBitmapPixelData;
  4682. begin
  4683. TFormatDescriptor.Get(Format).PreparePixel(PixelData);
  4684. with PixelData do begin
  4685. Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
  4686. Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
  4687. Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
  4688. Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
  4689. end;
  4690. AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
  4691. end;
  4692. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4693. procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
  4694. begin
  4695. //check MIN filter
  4696. case aMin of
  4697. GL_NEAREST:
  4698. fFilterMin := GL_NEAREST;
  4699. GL_LINEAR:
  4700. fFilterMin := GL_LINEAR;
  4701. GL_NEAREST_MIPMAP_NEAREST:
  4702. fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
  4703. GL_LINEAR_MIPMAP_NEAREST:
  4704. fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
  4705. GL_NEAREST_MIPMAP_LINEAR:
  4706. fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
  4707. GL_LINEAR_MIPMAP_LINEAR:
  4708. fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
  4709. else
  4710. raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
  4711. end;
  4712. //check MAG filter
  4713. case aMag of
  4714. GL_NEAREST:
  4715. fFilterMag := GL_NEAREST;
  4716. GL_LINEAR:
  4717. fFilterMag := GL_LINEAR;
  4718. else
  4719. raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
  4720. end;
  4721. //apply filter
  4722. if (ID > 0) then begin
  4723. Bind(false);
  4724. glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
  4725. if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
  4726. case fFilterMin of
  4727. GL_NEAREST, GL_LINEAR:
  4728. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  4729. GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
  4730. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
  4731. GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
  4732. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
  4733. end;
  4734. end else
  4735. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  4736. end;
  4737. end;
  4738. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4739. procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
  4740. procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
  4741. begin
  4742. case aValue of
  4743. GL_CLAMP:
  4744. aTarget := GL_CLAMP;
  4745. GL_REPEAT:
  4746. aTarget := GL_REPEAT;
  4747. GL_CLAMP_TO_EDGE: begin
  4748. if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
  4749. aTarget := GL_CLAMP_TO_EDGE
  4750. else
  4751. aTarget := GL_CLAMP;
  4752. end;
  4753. GL_CLAMP_TO_BORDER: begin
  4754. if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
  4755. aTarget := GL_CLAMP_TO_BORDER
  4756. else
  4757. aTarget := GL_CLAMP;
  4758. end;
  4759. GL_MIRRORED_REPEAT: begin
  4760. if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
  4761. aTarget := GL_MIRRORED_REPEAT
  4762. else
  4763. raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
  4764. end;
  4765. else
  4766. raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
  4767. end;
  4768. end;
  4769. begin
  4770. CheckAndSetWrap(S, fWrapS);
  4771. CheckAndSetWrap(T, fWrapT);
  4772. CheckAndSetWrap(R, fWrapR);
  4773. if (ID > 0) then begin
  4774. Bind(false);
  4775. glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
  4776. glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
  4777. glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
  4778. end;
  4779. end;
  4780. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4781. procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
  4782. procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
  4783. begin
  4784. if (aValue = GL_ZERO) or (aValue = GL_ONE) or (aValue = GL_ALPHA) or
  4785. (aValue = GL_RED) or (aValue = GL_GREEN) or (aValue = GL_BLUE) then
  4786. fSwizzle[aIndex] := aValue
  4787. else
  4788. raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
  4789. end;
  4790. begin
  4791. if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  4792. raise EglBitmapNotSupported.Create('texture swizzle is not supported');
  4793. CheckAndSetValue(r, 0);
  4794. CheckAndSetValue(g, 1);
  4795. CheckAndSetValue(b, 2);
  4796. CheckAndSetValue(a, 3);
  4797. if (ID > 0) then begin
  4798. Bind(false);
  4799. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, @fSwizzle[0]);
  4800. end;
  4801. end;
  4802. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4803. procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
  4804. begin
  4805. if aEnableTextureUnit then
  4806. glEnable(Target);
  4807. if (ID > 0) then
  4808. glBindTexture(Target, ID);
  4809. end;
  4810. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4811. procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
  4812. begin
  4813. if aDisableTextureUnit then
  4814. glDisable(Target);
  4815. glBindTexture(Target, 0);
  4816. end;
  4817. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4818. constructor TglBitmap.Create;
  4819. begin
  4820. if (ClassType = TglBitmap) then
  4821. raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
  4822. {$IFDEF GLB_NATIVE_OGL}
  4823. glbReadOpenGLExtensions;
  4824. {$ENDIF}
  4825. inherited Create;
  4826. end;
  4827. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4828. constructor TglBitmap.Create(const aFileName: String);
  4829. begin
  4830. Create;
  4831. LoadFromFile(FileName);
  4832. end;
  4833. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4834. constructor TglBitmap.Create(const aStream: TStream);
  4835. begin
  4836. Create;
  4837. LoadFromStream(aStream);
  4838. end;
  4839. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4840. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat);
  4841. var
  4842. Image: PByte;
  4843. ImageSize: Integer;
  4844. begin
  4845. Create;
  4846. ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  4847. GetMem(Image, ImageSize);
  4848. try
  4849. FillChar(Image^, ImageSize, #$FF);
  4850. SetDataPointer(Image, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  4851. except
  4852. if Assigned(Image) then
  4853. FreeMem(Image);
  4854. raise;
  4855. end;
  4856. end;
  4857. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4858. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat;
  4859. const aFunc: TglBitmapFunction; const aArgs: Pointer);
  4860. begin
  4861. Create;
  4862. LoadFromFunc(aSize, aFunc, aFormat, aArgs);
  4863. end;
  4864. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4865. constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
  4866. begin
  4867. Create;
  4868. LoadFromResource(aInstance, aResource, aResType);
  4869. end;
  4870. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4871. constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  4872. begin
  4873. Create;
  4874. LoadFromResourceID(aInstance, aResourceID, aResType);
  4875. end;
  4876. {$IFDEF GLB_SUPPORT_PNG_READ}
  4877. {$IF DEFINED(GLB_SDL_IMAGE)}
  4878. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4879. //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4880. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4881. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  4882. var
  4883. Surface: PSDL_Surface;
  4884. RWops: PSDL_RWops;
  4885. begin
  4886. result := false;
  4887. RWops := glBitmapCreateRWops(aStream);
  4888. try
  4889. if IMG_isPNG(RWops) > 0 then begin
  4890. Surface := IMG_LoadPNG_RW(RWops);
  4891. try
  4892. AssignFromSurface(Surface);
  4893. result := true;
  4894. finally
  4895. SDL_FreeSurface(Surface);
  4896. end;
  4897. end;
  4898. finally
  4899. SDL_FreeRW(RWops);
  4900. end;
  4901. end;
  4902. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  4903. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4904. procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  4905. begin
  4906. TStream(png_get_io_ptr(png)).Read(buffer^, size);
  4907. end;
  4908. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4909. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  4910. var
  4911. StreamPos: Int64;
  4912. signature: array [0..7] of byte;
  4913. png: png_structp;
  4914. png_info: png_infop;
  4915. TempHeight, TempWidth: Integer;
  4916. Format: TglBitmapFormat;
  4917. png_data: pByte;
  4918. png_rows: array of pByte;
  4919. Row, LineSize: Integer;
  4920. begin
  4921. result := false;
  4922. if not init_libPNG then
  4923. raise Exception.Create('LoadPNG - unable to initialize libPNG.');
  4924. try
  4925. // signature
  4926. StreamPos := aStream.Position;
  4927. aStream.Read(signature{%H-}, 8);
  4928. aStream.Position := StreamPos;
  4929. if png_check_sig(@signature, 8) <> 0 then begin
  4930. // png read struct
  4931. png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  4932. if png = nil then
  4933. raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
  4934. // png info
  4935. png_info := png_create_info_struct(png);
  4936. if png_info = nil then begin
  4937. png_destroy_read_struct(@png, nil, nil);
  4938. raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
  4939. end;
  4940. // set read callback
  4941. png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
  4942. // read informations
  4943. png_read_info(png, png_info);
  4944. // size
  4945. TempHeight := png_get_image_height(png, png_info);
  4946. TempWidth := png_get_image_width(png, png_info);
  4947. // format
  4948. case png_get_color_type(png, png_info) of
  4949. PNG_COLOR_TYPE_GRAY:
  4950. Format := tfLuminance8;
  4951. PNG_COLOR_TYPE_GRAY_ALPHA:
  4952. Format := tfLuminance8Alpha8;
  4953. PNG_COLOR_TYPE_RGB:
  4954. Format := tfRGB8;
  4955. PNG_COLOR_TYPE_RGB_ALPHA:
  4956. Format := tfRGBA8;
  4957. else
  4958. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  4959. end;
  4960. // cut upper 8 bit from 16 bit formats
  4961. if png_get_bit_depth(png, png_info) > 8 then
  4962. png_set_strip_16(png);
  4963. // expand bitdepth smaller than 8
  4964. if png_get_bit_depth(png, png_info) < 8 then
  4965. png_set_expand(png);
  4966. // allocating mem for scanlines
  4967. LineSize := png_get_rowbytes(png, png_info);
  4968. GetMem(png_data, TempHeight * LineSize);
  4969. try
  4970. SetLength(png_rows, TempHeight);
  4971. for Row := Low(png_rows) to High(png_rows) do begin
  4972. png_rows[Row] := png_data;
  4973. Inc(png_rows[Row], Row * LineSize);
  4974. end;
  4975. // read complete image into scanlines
  4976. png_read_image(png, @png_rows[0]);
  4977. // read end
  4978. png_read_end(png, png_info);
  4979. // destroy read struct
  4980. png_destroy_read_struct(@png, @png_info, nil);
  4981. SetLength(png_rows, 0);
  4982. // set new data
  4983. SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
  4984. result := true;
  4985. except
  4986. if Assigned(png_data) then
  4987. FreeMem(png_data);
  4988. raise;
  4989. end;
  4990. end;
  4991. finally
  4992. quit_libPNG;
  4993. end;
  4994. end;
  4995. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  4996. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4997. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  4998. var
  4999. StreamPos: Int64;
  5000. Png: TPNGObject;
  5001. Header: String[8];
  5002. Row, Col, PixSize, LineSize: Integer;
  5003. NewImage, pSource, pDest, pAlpha: pByte;
  5004. PngFormat: TglBitmapFormat;
  5005. FormatDesc: TFormatDescriptor;
  5006. const
  5007. PngHeader: String[8] = #137#80#78#71#13#10#26#10;
  5008. begin
  5009. result := false;
  5010. StreamPos := aStream.Position;
  5011. aStream.Read(Header[0], SizeOf(Header));
  5012. aStream.Position := StreamPos;
  5013. {Test if the header matches}
  5014. if Header = PngHeader then begin
  5015. Png := TPNGObject.Create;
  5016. try
  5017. Png.LoadFromStream(aStream);
  5018. case Png.Header.ColorType of
  5019. COLOR_GRAYSCALE:
  5020. PngFormat := tfLuminance8;
  5021. COLOR_GRAYSCALEALPHA:
  5022. PngFormat := tfLuminance8Alpha8;
  5023. COLOR_RGB:
  5024. PngFormat := tfBGR8;
  5025. COLOR_RGBALPHA:
  5026. PngFormat := tfBGRA8;
  5027. else
  5028. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5029. end;
  5030. FormatDesc := TFormatDescriptor.Get(PngFormat);
  5031. PixSize := Round(FormatDesc.PixelSize);
  5032. LineSize := FormatDesc.GetSize(Png.Header.Width, 1);
  5033. GetMem(NewImage, LineSize * Integer(Png.Header.Height));
  5034. try
  5035. pDest := NewImage;
  5036. case Png.Header.ColorType of
  5037. COLOR_RGB, COLOR_GRAYSCALE:
  5038. begin
  5039. for Row := 0 to Png.Height -1 do begin
  5040. Move (Png.Scanline[Row]^, pDest^, LineSize);
  5041. Inc(pDest, LineSize);
  5042. end;
  5043. end;
  5044. COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
  5045. begin
  5046. PixSize := PixSize -1;
  5047. for Row := 0 to Png.Height -1 do begin
  5048. pSource := Png.Scanline[Row];
  5049. pAlpha := pByte(Png.AlphaScanline[Row]);
  5050. for Col := 0 to Png.Width -1 do begin
  5051. Move (pSource^, pDest^, PixSize);
  5052. Inc(pSource, PixSize);
  5053. Inc(pDest, PixSize);
  5054. pDest^ := pAlpha^;
  5055. inc(pAlpha);
  5056. Inc(pDest);
  5057. end;
  5058. end;
  5059. end;
  5060. else
  5061. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5062. end;
  5063. SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
  5064. result := true;
  5065. except
  5066. if Assigned(NewImage) then
  5067. FreeMem(NewImage);
  5068. raise;
  5069. end;
  5070. finally
  5071. Png.Free;
  5072. end;
  5073. end;
  5074. end;
  5075. {$IFEND}
  5076. {$ENDIF}
  5077. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  5078. {$IFDEF GLB_LIB_PNG}
  5079. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5080. procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  5081. begin
  5082. TStream(png_get_io_ptr(png)).Write(buffer^, size);
  5083. end;
  5084. {$ENDIF}
  5085. {$IF DEFINED(GLB_LIB_PNG)}
  5086. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5087. procedure TglBitmap.SavePNG(const aStream: TStream);
  5088. var
  5089. png: png_structp;
  5090. png_info: png_infop;
  5091. png_rows: array of pByte;
  5092. LineSize: Integer;
  5093. ColorType: Integer;
  5094. Row: Integer;
  5095. FormatDesc: TFormatDescriptor;
  5096. begin
  5097. if not (ftPNG in FormatGetSupportedFiles(Format)) then
  5098. raise EglBitmapUnsupportedFormat.Create(Format);
  5099. if not init_libPNG then
  5100. raise Exception.Create('unable to initialize libPNG.');
  5101. try
  5102. case Format of
  5103. tfAlpha8, tfLuminance8:
  5104. ColorType := PNG_COLOR_TYPE_GRAY;
  5105. tfLuminance8Alpha8:
  5106. ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
  5107. tfBGR8, tfRGB8:
  5108. ColorType := PNG_COLOR_TYPE_RGB;
  5109. tfBGRA8, tfRGBA8:
  5110. ColorType := PNG_COLOR_TYPE_RGBA;
  5111. else
  5112. raise EglBitmapUnsupportedFormat.Create(Format);
  5113. end;
  5114. FormatDesc := TFormatDescriptor.Get(Format);
  5115. LineSize := FormatDesc.GetSize(Width, 1);
  5116. // creating array for scanline
  5117. SetLength(png_rows, Height);
  5118. try
  5119. for Row := 0 to Height - 1 do begin
  5120. png_rows[Row] := Data;
  5121. Inc(png_rows[Row], Row * LineSize)
  5122. end;
  5123. // write struct
  5124. png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  5125. if png = nil then
  5126. raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
  5127. // create png info
  5128. png_info := png_create_info_struct(png);
  5129. if png_info = nil then begin
  5130. png_destroy_write_struct(@png, nil);
  5131. raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
  5132. end;
  5133. // set read callback
  5134. png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
  5135. // set compression
  5136. png_set_compression_level(png, 6);
  5137. if Format in [tfBGR8, tfBGRA8] then
  5138. png_set_bgr(png);
  5139. png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
  5140. png_write_info(png, png_info);
  5141. png_write_image(png, @png_rows[0]);
  5142. png_write_end(png, png_info);
  5143. png_destroy_write_struct(@png, @png_info);
  5144. finally
  5145. SetLength(png_rows, 0);
  5146. end;
  5147. finally
  5148. quit_libPNG;
  5149. end;
  5150. end;
  5151. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  5152. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5153. procedure TglBitmap.SavePNG(const aStream: TStream);
  5154. var
  5155. Png: TPNGObject;
  5156. pSource, pDest: pByte;
  5157. X, Y, PixSize: Integer;
  5158. ColorType: Cardinal;
  5159. Alpha: Boolean;
  5160. pTemp: pByte;
  5161. Temp: Byte;
  5162. begin
  5163. if not (ftPNG in FormatGetSupportedFiles (Format)) then
  5164. raise EglBitmapUnsupportedFormat.Create(Format);
  5165. case Format of
  5166. tfAlpha8, tfLuminance8: begin
  5167. ColorType := COLOR_GRAYSCALE;
  5168. PixSize := 1;
  5169. Alpha := false;
  5170. end;
  5171. tfLuminance8Alpha8: begin
  5172. ColorType := COLOR_GRAYSCALEALPHA;
  5173. PixSize := 1;
  5174. Alpha := true;
  5175. end;
  5176. tfBGR8, tfRGB8: begin
  5177. ColorType := COLOR_RGB;
  5178. PixSize := 3;
  5179. Alpha := false;
  5180. end;
  5181. tfBGRA8, tfRGBA8: begin
  5182. ColorType := COLOR_RGBALPHA;
  5183. PixSize := 3;
  5184. Alpha := true
  5185. end;
  5186. else
  5187. raise EglBitmapUnsupportedFormat.Create(Format);
  5188. end;
  5189. Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
  5190. try
  5191. // Copy ImageData
  5192. pSource := Data;
  5193. for Y := 0 to Height -1 do begin
  5194. pDest := png.ScanLine[Y];
  5195. for X := 0 to Width -1 do begin
  5196. Move(pSource^, pDest^, PixSize);
  5197. Inc(pDest, PixSize);
  5198. Inc(pSource, PixSize);
  5199. if Alpha then begin
  5200. png.AlphaScanline[Y]^[X] := pSource^;
  5201. Inc(pSource);
  5202. end;
  5203. end;
  5204. // convert RGB line to BGR
  5205. if Format in [tfRGB8, tfRGBA8] then begin
  5206. pTemp := png.ScanLine[Y];
  5207. for X := 0 to Width -1 do begin
  5208. Temp := pByteArray(pTemp)^[0];
  5209. pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
  5210. pByteArray(pTemp)^[2] := Temp;
  5211. Inc(pTemp, 3);
  5212. end;
  5213. end;
  5214. end;
  5215. // Save to Stream
  5216. Png.CompressionLevel := 6;
  5217. Png.SaveToStream(aStream);
  5218. finally
  5219. FreeAndNil(Png);
  5220. end;
  5221. end;
  5222. {$IFEND}
  5223. {$ENDIF}
  5224. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5225. //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5226. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5227. {$IFDEF GLB_LIB_JPEG}
  5228. type
  5229. glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
  5230. glBitmap_libJPEG_source_mgr = record
  5231. pub: jpeg_source_mgr;
  5232. SrcStream: TStream;
  5233. SrcBuffer: array [1..4096] of byte;
  5234. end;
  5235. glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
  5236. glBitmap_libJPEG_dest_mgr = record
  5237. pub: jpeg_destination_mgr;
  5238. DestStream: TStream;
  5239. DestBuffer: array [1..4096] of byte;
  5240. end;
  5241. procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
  5242. begin
  5243. //DUMMY
  5244. end;
  5245. procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
  5246. begin
  5247. //DUMMY
  5248. end;
  5249. procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
  5250. begin
  5251. //DUMMY
  5252. end;
  5253. procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
  5254. begin
  5255. //DUMMY
  5256. end;
  5257. procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
  5258. begin
  5259. //DUMMY
  5260. end;
  5261. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5262. function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
  5263. var
  5264. src: glBitmap_libJPEG_source_mgr_ptr;
  5265. bytes: integer;
  5266. begin
  5267. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  5268. bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
  5269. if (bytes <= 0) then begin
  5270. src^.SrcBuffer[1] := $FF;
  5271. src^.SrcBuffer[2] := JPEG_EOI;
  5272. bytes := 2;
  5273. end;
  5274. src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
  5275. src^.pub.bytes_in_buffer := bytes;
  5276. result := true;
  5277. end;
  5278. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5279. procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
  5280. var
  5281. src: glBitmap_libJPEG_source_mgr_ptr;
  5282. begin
  5283. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  5284. if num_bytes > 0 then begin
  5285. // wanted byte isn't in buffer so set stream position and read buffer
  5286. if num_bytes > src^.pub.bytes_in_buffer then begin
  5287. src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
  5288. src^.pub.fill_input_buffer(cinfo);
  5289. end else begin
  5290. // wanted byte is in buffer so only skip
  5291. inc(src^.pub.next_input_byte, num_bytes);
  5292. dec(src^.pub.bytes_in_buffer, num_bytes);
  5293. end;
  5294. end;
  5295. end;
  5296. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5297. function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
  5298. var
  5299. dest: glBitmap_libJPEG_dest_mgr_ptr;
  5300. begin
  5301. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  5302. if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
  5303. // write complete buffer
  5304. dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
  5305. // reset buffer
  5306. dest^.pub.next_output_byte := @dest^.DestBuffer[1];
  5307. dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
  5308. end;
  5309. result := true;
  5310. end;
  5311. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5312. procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
  5313. var
  5314. Idx: Integer;
  5315. dest: glBitmap_libJPEG_dest_mgr_ptr;
  5316. begin
  5317. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  5318. for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
  5319. // check for endblock
  5320. if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
  5321. // write endblock
  5322. dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
  5323. // leave
  5324. break;
  5325. end else
  5326. dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
  5327. end;
  5328. end;
  5329. {$ENDIF}
  5330. {$IFDEF GLB_SUPPORT_JPEG_READ}
  5331. {$IF DEFINED(GLB_SDL_IMAGE)}
  5332. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5333. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5334. var
  5335. Surface: PSDL_Surface;
  5336. RWops: PSDL_RWops;
  5337. begin
  5338. result := false;
  5339. RWops := glBitmapCreateRWops(aStream);
  5340. try
  5341. if IMG_isJPG(RWops) > 0 then begin
  5342. Surface := IMG_LoadJPG_RW(RWops);
  5343. try
  5344. AssignFromSurface(Surface);
  5345. result := true;
  5346. finally
  5347. SDL_FreeSurface(Surface);
  5348. end;
  5349. end;
  5350. finally
  5351. SDL_FreeRW(RWops);
  5352. end;
  5353. end;
  5354. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  5355. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5356. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5357. var
  5358. StreamPos: Int64;
  5359. Temp: array[0..1]of Byte;
  5360. jpeg: jpeg_decompress_struct;
  5361. jpeg_err: jpeg_error_mgr;
  5362. IntFormat: TglBitmapFormat;
  5363. pImage: pByte;
  5364. TempHeight, TempWidth: Integer;
  5365. pTemp: pByte;
  5366. Row: Integer;
  5367. FormatDesc: TFormatDescriptor;
  5368. begin
  5369. result := false;
  5370. if not init_libJPEG then
  5371. raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
  5372. try
  5373. // reading first two bytes to test file and set cursor back to begin
  5374. StreamPos := aStream.Position;
  5375. aStream.Read({%H-}Temp[0], 2);
  5376. aStream.Position := StreamPos;
  5377. // if Bitmap then read file.
  5378. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  5379. FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
  5380. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  5381. // error managment
  5382. jpeg.err := jpeg_std_error(@jpeg_err);
  5383. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  5384. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  5385. // decompression struct
  5386. jpeg_create_decompress(@jpeg);
  5387. // allocation space for streaming methods
  5388. jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
  5389. // seeting up custom functions
  5390. with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
  5391. pub.init_source := glBitmap_libJPEG_init_source;
  5392. pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
  5393. pub.skip_input_data := glBitmap_libJPEG_skip_input_data;
  5394. pub.resync_to_restart := jpeg_resync_to_restart; // use default method
  5395. pub.term_source := glBitmap_libJPEG_term_source;
  5396. pub.bytes_in_buffer := 0; // forces fill_input_buffer on first read
  5397. pub.next_input_byte := nil; // until buffer loaded
  5398. SrcStream := aStream;
  5399. end;
  5400. // set global decoding state
  5401. jpeg.global_state := DSTATE_START;
  5402. // read header of jpeg
  5403. jpeg_read_header(@jpeg, false);
  5404. // setting output parameter
  5405. case jpeg.jpeg_color_space of
  5406. JCS_GRAYSCALE:
  5407. begin
  5408. jpeg.out_color_space := JCS_GRAYSCALE;
  5409. IntFormat := tfLuminance8;
  5410. end;
  5411. else
  5412. jpeg.out_color_space := JCS_RGB;
  5413. IntFormat := tfRGB8;
  5414. end;
  5415. // reading image
  5416. jpeg_start_decompress(@jpeg);
  5417. TempHeight := jpeg.output_height;
  5418. TempWidth := jpeg.output_width;
  5419. FormatDesc := TFormatDescriptor.Get(IntFormat);
  5420. // creating new image
  5421. GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
  5422. try
  5423. pTemp := pImage;
  5424. for Row := 0 to TempHeight -1 do begin
  5425. jpeg_read_scanlines(@jpeg, @pTemp, 1);
  5426. Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
  5427. end;
  5428. // finish decompression
  5429. jpeg_finish_decompress(@jpeg);
  5430. // destroy decompression
  5431. jpeg_destroy_decompress(@jpeg);
  5432. SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  5433. result := true;
  5434. except
  5435. if Assigned(pImage) then
  5436. FreeMem(pImage);
  5437. raise;
  5438. end;
  5439. end;
  5440. finally
  5441. quit_libJPEG;
  5442. end;
  5443. end;
  5444. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  5445. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5446. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5447. var
  5448. bmp: TBitmap;
  5449. jpg: TJPEGImage;
  5450. StreamPos: Int64;
  5451. Temp: array[0..1]of Byte;
  5452. begin
  5453. result := false;
  5454. // reading first two bytes to test file and set cursor back to begin
  5455. StreamPos := aStream.Position;
  5456. aStream.Read(Temp[0], 2);
  5457. aStream.Position := StreamPos;
  5458. // if Bitmap then read file.
  5459. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  5460. bmp := TBitmap.Create;
  5461. try
  5462. jpg := TJPEGImage.Create;
  5463. try
  5464. jpg.LoadFromStream(aStream);
  5465. bmp.Assign(jpg);
  5466. result := AssignFromBitmap(bmp);
  5467. finally
  5468. jpg.Free;
  5469. end;
  5470. finally
  5471. bmp.Free;
  5472. end;
  5473. end;
  5474. end;
  5475. {$IFEND}
  5476. {$ENDIF}
  5477. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  5478. {$IF DEFINED(GLB_LIB_JPEG)}
  5479. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5480. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  5481. var
  5482. jpeg: jpeg_compress_struct;
  5483. jpeg_err: jpeg_error_mgr;
  5484. Row: Integer;
  5485. pTemp, pTemp2: pByte;
  5486. procedure CopyRow(pDest, pSource: pByte);
  5487. var
  5488. X: Integer;
  5489. begin
  5490. for X := 0 to Width - 1 do begin
  5491. pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
  5492. pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
  5493. pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
  5494. Inc(pDest, 3);
  5495. Inc(pSource, 3);
  5496. end;
  5497. end;
  5498. begin
  5499. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  5500. raise EglBitmapUnsupportedFormat.Create(Format);
  5501. if not init_libJPEG then
  5502. raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
  5503. try
  5504. FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
  5505. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  5506. // error managment
  5507. jpeg.err := jpeg_std_error(@jpeg_err);
  5508. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  5509. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  5510. // compression struct
  5511. jpeg_create_compress(@jpeg);
  5512. // allocation space for streaming methods
  5513. jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
  5514. // seeting up custom functions
  5515. with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
  5516. pub.init_destination := glBitmap_libJPEG_init_destination;
  5517. pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
  5518. pub.term_destination := glBitmap_libJPEG_term_destination;
  5519. pub.next_output_byte := @DestBuffer[1];
  5520. pub.free_in_buffer := Length(DestBuffer);
  5521. DestStream := aStream;
  5522. end;
  5523. // very important state
  5524. jpeg.global_state := CSTATE_START;
  5525. jpeg.image_width := Width;
  5526. jpeg.image_height := Height;
  5527. case Format of
  5528. tfAlpha8, tfLuminance8: begin
  5529. jpeg.input_components := 1;
  5530. jpeg.in_color_space := JCS_GRAYSCALE;
  5531. end;
  5532. tfRGB8, tfBGR8: begin
  5533. jpeg.input_components := 3;
  5534. jpeg.in_color_space := JCS_RGB;
  5535. end;
  5536. end;
  5537. jpeg_set_defaults(@jpeg);
  5538. jpeg_set_quality(@jpeg, 95, true);
  5539. jpeg_start_compress(@jpeg, true);
  5540. pTemp := Data;
  5541. if Format = tfBGR8 then
  5542. GetMem(pTemp2, fRowSize)
  5543. else
  5544. pTemp2 := pTemp;
  5545. try
  5546. for Row := 0 to jpeg.image_height -1 do begin
  5547. // prepare row
  5548. if Format = tfBGR8 then
  5549. CopyRow(pTemp2, pTemp)
  5550. else
  5551. pTemp2 := pTemp;
  5552. // write row
  5553. jpeg_write_scanlines(@jpeg, @pTemp2, 1);
  5554. inc(pTemp, fRowSize);
  5555. end;
  5556. finally
  5557. // free memory
  5558. if Format = tfBGR8 then
  5559. FreeMem(pTemp2);
  5560. end;
  5561. jpeg_finish_compress(@jpeg);
  5562. jpeg_destroy_compress(@jpeg);
  5563. finally
  5564. quit_libJPEG;
  5565. end;
  5566. end;
  5567. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  5568. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5569. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  5570. var
  5571. Bmp: TBitmap;
  5572. Jpg: TJPEGImage;
  5573. begin
  5574. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  5575. raise EglBitmapUnsupportedFormat.Create(Format);
  5576. Bmp := TBitmap.Create;
  5577. try
  5578. Jpg := TJPEGImage.Create;
  5579. try
  5580. AssignToBitmap(Bmp);
  5581. if (Format in [tfAlpha8, tfLuminance8]) then begin
  5582. Jpg.Grayscale := true;
  5583. Jpg.PixelFormat := jf8Bit;
  5584. end;
  5585. Jpg.Assign(Bmp);
  5586. Jpg.SaveToStream(aStream);
  5587. finally
  5588. FreeAndNil(Jpg);
  5589. end;
  5590. finally
  5591. FreeAndNil(Bmp);
  5592. end;
  5593. end;
  5594. {$IFEND}
  5595. {$ENDIF}
  5596. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5597. //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5598. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5599. const
  5600. BMP_MAGIC = $4D42;
  5601. BMP_COMP_RGB = 0;
  5602. BMP_COMP_RLE8 = 1;
  5603. BMP_COMP_RLE4 = 2;
  5604. BMP_COMP_BITFIELDS = 3;
  5605. type
  5606. TBMPHeader = packed record
  5607. bfType: Word;
  5608. bfSize: Cardinal;
  5609. bfReserved1: Word;
  5610. bfReserved2: Word;
  5611. bfOffBits: Cardinal;
  5612. end;
  5613. TBMPInfo = packed record
  5614. biSize: Cardinal;
  5615. biWidth: Longint;
  5616. biHeight: Longint;
  5617. biPlanes: Word;
  5618. biBitCount: Word;
  5619. biCompression: Cardinal;
  5620. biSizeImage: Cardinal;
  5621. biXPelsPerMeter: Longint;
  5622. biYPelsPerMeter: Longint;
  5623. biClrUsed: Cardinal;
  5624. biClrImportant: Cardinal;
  5625. end;
  5626. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5627. function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
  5628. //////////////////////////////////////////////////////////////////////////////////////////////////
  5629. function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapColorRec): TglBitmapFormat;
  5630. begin
  5631. result := tfEmpty;
  5632. aStream.Read(aInfo{%H-}, SizeOf(aInfo));
  5633. FillChar(aMask{%H-}, SizeOf(aMask), 0);
  5634. //Read Compression
  5635. case aInfo.biCompression of
  5636. BMP_COMP_RLE4,
  5637. BMP_COMP_RLE8: begin
  5638. raise EglBitmap.Create('RLE compression is not supported');
  5639. end;
  5640. BMP_COMP_BITFIELDS: begin
  5641. if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
  5642. aStream.Read(aMask.r, SizeOf(aMask.r));
  5643. aStream.Read(aMask.g, SizeOf(aMask.g));
  5644. aStream.Read(aMask.b, SizeOf(aMask.b));
  5645. aStream.Read(aMask.a, SizeOf(aMask.a));
  5646. end else
  5647. raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
  5648. end;
  5649. end;
  5650. //get suitable format
  5651. case aInfo.biBitCount of
  5652. 8: result := tfLuminance8;
  5653. 16: result := tfBGR5;
  5654. 24: result := tfBGR8;
  5655. 32: result := tfBGRA8;
  5656. end;
  5657. end;
  5658. function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
  5659. var
  5660. i, c: Integer;
  5661. ColorTable: TbmpColorTable;
  5662. begin
  5663. result := nil;
  5664. if (aInfo.biBitCount >= 16) then
  5665. exit;
  5666. aFormat := tfLuminance8;
  5667. c := aInfo.biClrUsed;
  5668. if (c = 0) then
  5669. c := 1 shl aInfo.biBitCount;
  5670. SetLength(ColorTable, c);
  5671. for i := 0 to c-1 do begin
  5672. aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
  5673. if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
  5674. aFormat := tfRGB8;
  5675. end;
  5676. result := TbmpColorTableFormat.Create;
  5677. result.PixelSize := aInfo.biBitCount / 8;
  5678. result.ColorTable := ColorTable;
  5679. result.Range := glBitmapColorRec($FF, $FF, $FF, $00);
  5680. end;
  5681. //////////////////////////////////////////////////////////////////////////////////////////////////
  5682. function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
  5683. const aInfo: TBMPInfo): TbmpBitfieldFormat;
  5684. var
  5685. TmpFormat: TglBitmapFormat;
  5686. FormatDesc: TFormatDescriptor;
  5687. begin
  5688. result := nil;
  5689. if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
  5690. for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  5691. FormatDesc := TFormatDescriptor.Get(TmpFormat);
  5692. if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
  5693. aFormat := FormatDesc.Format;
  5694. exit;
  5695. end;
  5696. end;
  5697. if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
  5698. aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
  5699. if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
  5700. aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
  5701. result := TbmpBitfieldFormat.Create;
  5702. result.PixelSize := aInfo.biBitCount / 8;
  5703. result.RedMask := aMask.r;
  5704. result.GreenMask := aMask.g;
  5705. result.BlueMask := aMask.b;
  5706. result.AlphaMask := aMask.a;
  5707. end;
  5708. end;
  5709. var
  5710. //simple types
  5711. StartPos: Int64;
  5712. ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
  5713. PaddingBuff: Cardinal;
  5714. LineBuf, ImageData, TmpData: PByte;
  5715. SourceMD, DestMD: Pointer;
  5716. BmpFormat: TglBitmapFormat;
  5717. //records
  5718. Mask: TglBitmapColorRec;
  5719. Header: TBMPHeader;
  5720. Info: TBMPInfo;
  5721. //classes
  5722. SpecialFormat: TFormatDescriptor;
  5723. FormatDesc: TFormatDescriptor;
  5724. //////////////////////////////////////////////////////////////////////////////////////////////////
  5725. procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
  5726. var
  5727. i: Integer;
  5728. Pixel: TglBitmapPixelData;
  5729. begin
  5730. aStream.Read(aLineBuf^, rbLineSize);
  5731. SpecialFormat.PreparePixel(Pixel);
  5732. for i := 0 to Info.biWidth-1 do begin
  5733. SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
  5734. glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
  5735. FormatDesc.Map(Pixel, aData, DestMD);
  5736. end;
  5737. end;
  5738. begin
  5739. result := false;
  5740. BmpFormat := tfEmpty;
  5741. SpecialFormat := nil;
  5742. LineBuf := nil;
  5743. SourceMD := nil;
  5744. DestMD := nil;
  5745. // Header
  5746. StartPos := aStream.Position;
  5747. aStream.Read(Header{%H-}, SizeOf(Header));
  5748. if Header.bfType = BMP_MAGIC then begin
  5749. try try
  5750. BmpFormat := ReadInfo(Info, Mask);
  5751. SpecialFormat := ReadColorTable(BmpFormat, Info);
  5752. if not Assigned(SpecialFormat) then
  5753. SpecialFormat := CheckBitfields(BmpFormat, Mask, Info);
  5754. aStream.Position := StartPos + Header.bfOffBits;
  5755. if (BmpFormat <> tfEmpty) then begin
  5756. FormatDesc := TFormatDescriptor.Get(BmpFormat);
  5757. rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
  5758. wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
  5759. Padding := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
  5760. //get Memory
  5761. DestMD := FormatDesc.CreateMappingData;
  5762. ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
  5763. GetMem(ImageData, ImageSize);
  5764. if Assigned(SpecialFormat) then begin
  5765. GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
  5766. SourceMD := SpecialFormat.CreateMappingData;
  5767. end;
  5768. //read Data
  5769. try try
  5770. FillChar(ImageData^, ImageSize, $FF);
  5771. TmpData := ImageData;
  5772. if (Info.biHeight > 0) then
  5773. Inc(TmpData, wbLineSize * (Info.biHeight-1));
  5774. for i := 0 to Abs(Info.biHeight)-1 do begin
  5775. if Assigned(SpecialFormat) then
  5776. SpecialFormatReadLine(TmpData, LineBuf) //if is special format read and convert data
  5777. else
  5778. aStream.Read(TmpData^, wbLineSize); //else only read data
  5779. if (Info.biHeight > 0) then
  5780. dec(TmpData, wbLineSize)
  5781. else
  5782. inc(TmpData, wbLineSize);
  5783. aStream.Read(PaddingBuff{%H-}, Padding);
  5784. end;
  5785. SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
  5786. result := true;
  5787. finally
  5788. if Assigned(LineBuf) then
  5789. FreeMem(LineBuf);
  5790. if Assigned(SourceMD) then
  5791. SpecialFormat.FreeMappingData(SourceMD);
  5792. FormatDesc.FreeMappingData(DestMD);
  5793. end;
  5794. except
  5795. if Assigned(ImageData) then
  5796. FreeMem(ImageData);
  5797. raise;
  5798. end;
  5799. end else
  5800. raise EglBitmap.Create('LoadBMP - No suitable format found');
  5801. except
  5802. aStream.Position := StartPos;
  5803. raise;
  5804. end;
  5805. finally
  5806. FreeAndNil(SpecialFormat);
  5807. end;
  5808. end
  5809. else aStream.Position := StartPos;
  5810. end;
  5811. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5812. procedure TglBitmap.SaveBMP(const aStream: TStream);
  5813. var
  5814. Header: TBMPHeader;
  5815. Info: TBMPInfo;
  5816. Converter: TbmpColorTableFormat;
  5817. FormatDesc: TFormatDescriptor;
  5818. SourceFD, DestFD: Pointer;
  5819. pData, srcData, dstData, ConvertBuffer: pByte;
  5820. Pixel: TglBitmapPixelData;
  5821. ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
  5822. RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
  5823. PaddingBuff: Cardinal;
  5824. function GetLineWidth : Integer;
  5825. begin
  5826. result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
  5827. end;
  5828. begin
  5829. if not (ftBMP in FormatGetSupportedFiles(Format)) then
  5830. raise EglBitmapUnsupportedFormat.Create(Format);
  5831. Converter := nil;
  5832. FormatDesc := TFormatDescriptor.Get(Format);
  5833. ImageSize := FormatDesc.GetSize(Dimension);
  5834. FillChar(Header{%H-}, SizeOf(Header), 0);
  5835. Header.bfType := BMP_MAGIC;
  5836. Header.bfSize := SizeOf(Header) + SizeOf(Info) + ImageSize;
  5837. Header.bfReserved1 := 0;
  5838. Header.bfReserved2 := 0;
  5839. Header.bfOffBits := SizeOf(Header) + SizeOf(Info);
  5840. FillChar(Info{%H-}, SizeOf(Info), 0);
  5841. Info.biSize := SizeOf(Info);
  5842. Info.biWidth := Width;
  5843. Info.biHeight := Height;
  5844. Info.biPlanes := 1;
  5845. Info.biCompression := BMP_COMP_RGB;
  5846. Info.biSizeImage := ImageSize;
  5847. try
  5848. case Format of
  5849. tfLuminance4: begin
  5850. Info.biBitCount := 4;
  5851. Header.bfSize := Header.bfSize + 16 * SizeOf(Cardinal);
  5852. Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
  5853. Converter := TbmpColorTableFormat.Create;
  5854. Converter.PixelSize := 0.5;
  5855. Converter.Format := Format;
  5856. Converter.Range := glBitmapColorRec($F, $F, $F, $0);
  5857. Converter.CreateColorTable;
  5858. end;
  5859. tfR3G3B2, tfLuminance8: begin
  5860. Info.biBitCount := 8;
  5861. Header.bfSize := Header.bfSize + 256 * SizeOf(Cardinal);
  5862. Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
  5863. Converter := TbmpColorTableFormat.Create;
  5864. Converter.PixelSize := 1;
  5865. Converter.Format := Format;
  5866. if (Format = tfR3G3B2) then begin
  5867. Converter.Range := glBitmapColorRec($7, $7, $3, $0);
  5868. Converter.Shift := glBitmapShiftRec(0, 3, 6, 0);
  5869. end else
  5870. Converter.Range := glBitmapColorRec($FF, $FF, $FF, $0);
  5871. Converter.CreateColorTable;
  5872. end;
  5873. tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
  5874. tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin
  5875. Info.biBitCount := 16;
  5876. Info.biCompression := BMP_COMP_BITFIELDS;
  5877. end;
  5878. tfBGR8, tfRGB8: begin
  5879. Info.biBitCount := 24;
  5880. end;
  5881. tfRGB10, tfRGB10A2, tfRGBA8,
  5882. tfBGR10, tfBGR10A2, tfBGRA8: begin
  5883. Info.biBitCount := 32;
  5884. Info.biCompression := BMP_COMP_BITFIELDS;
  5885. end;
  5886. else
  5887. raise EglBitmapUnsupportedFormat.Create(Format);
  5888. end;
  5889. Info.biXPelsPerMeter := 2835;
  5890. Info.biYPelsPerMeter := 2835;
  5891. // prepare bitmasks
  5892. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  5893. Header.bfSize := Header.bfSize + 4 * SizeOf(Cardinal);
  5894. Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
  5895. RedMask := FormatDesc.RedMask;
  5896. GreenMask := FormatDesc.GreenMask;
  5897. BlueMask := FormatDesc.BlueMask;
  5898. AlphaMask := FormatDesc.AlphaMask;
  5899. end;
  5900. // headers
  5901. aStream.Write(Header, SizeOf(Header));
  5902. aStream.Write(Info, SizeOf(Info));
  5903. // colortable
  5904. if Assigned(Converter) then
  5905. aStream.Write(Converter.ColorTable[0].b,
  5906. SizeOf(TbmpColorTableEnty) * Length(Converter.ColorTable));
  5907. // bitmasks
  5908. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  5909. aStream.Write(RedMask, SizeOf(Cardinal));
  5910. aStream.Write(GreenMask, SizeOf(Cardinal));
  5911. aStream.Write(BlueMask, SizeOf(Cardinal));
  5912. aStream.Write(AlphaMask, SizeOf(Cardinal));
  5913. end;
  5914. // image data
  5915. rbLineSize := Round(Info.biWidth * FormatDesc.PixelSize);
  5916. wbLineSize := Round(Info.biWidth * Info.biBitCount / 8);
  5917. Padding := GetLineWidth - wbLineSize;
  5918. PaddingBuff := 0;
  5919. pData := Data;
  5920. inc(pData, (Height-1) * rbLineSize);
  5921. // prepare row buffer. But only for RGB because RGBA supports color masks
  5922. // so it's possible to change color within the image.
  5923. if Assigned(Converter) then begin
  5924. FormatDesc.PreparePixel(Pixel);
  5925. GetMem(ConvertBuffer, wbLineSize);
  5926. SourceFD := FormatDesc.CreateMappingData;
  5927. DestFD := Converter.CreateMappingData;
  5928. end else
  5929. ConvertBuffer := nil;
  5930. try
  5931. for LineIdx := 0 to Height - 1 do begin
  5932. // preparing row
  5933. if Assigned(Converter) then begin
  5934. srcData := pData;
  5935. dstData := ConvertBuffer;
  5936. for PixelIdx := 0 to Info.biWidth-1 do begin
  5937. FormatDesc.Unmap(srcData, Pixel, SourceFD);
  5938. glBitmapConvertPixel(Pixel, FormatDesc, Converter);
  5939. Converter.Map(Pixel, dstData, DestFD);
  5940. end;
  5941. aStream.Write(ConvertBuffer^, wbLineSize);
  5942. end else begin
  5943. aStream.Write(pData^, rbLineSize);
  5944. end;
  5945. dec(pData, rbLineSize);
  5946. if (Padding > 0) then
  5947. aStream.Write(PaddingBuff, Padding);
  5948. end;
  5949. finally
  5950. // destroy row buffer
  5951. if Assigned(ConvertBuffer) then begin
  5952. FormatDesc.FreeMappingData(SourceFD);
  5953. Converter.FreeMappingData(DestFD);
  5954. FreeMem(ConvertBuffer);
  5955. end;
  5956. end;
  5957. finally
  5958. if Assigned(Converter) then
  5959. Converter.Free;
  5960. end;
  5961. end;
  5962. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5963. //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5964. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5965. type
  5966. TTGAHeader = packed record
  5967. ImageID: Byte;
  5968. ColorMapType: Byte;
  5969. ImageType: Byte;
  5970. //ColorMapSpec: Array[0..4] of Byte;
  5971. ColorMapStart: Word;
  5972. ColorMapLength: Word;
  5973. ColorMapEntrySize: Byte;
  5974. OrigX: Word;
  5975. OrigY: Word;
  5976. Width: Word;
  5977. Height: Word;
  5978. Bpp: Byte;
  5979. ImageDesc: Byte;
  5980. end;
  5981. const
  5982. TGA_UNCOMPRESSED_RGB = 2;
  5983. TGA_UNCOMPRESSED_GRAY = 3;
  5984. TGA_COMPRESSED_RGB = 10;
  5985. TGA_COMPRESSED_GRAY = 11;
  5986. TGA_NONE_COLOR_TABLE = 0;
  5987. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5988. function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
  5989. var
  5990. Header: TTGAHeader;
  5991. ImageData: System.PByte;
  5992. StartPosition: Int64;
  5993. PixelSize, LineSize: Integer;
  5994. tgaFormat: TglBitmapFormat;
  5995. FormatDesc: TFormatDescriptor;
  5996. Counter: packed record
  5997. X, Y: packed record
  5998. low, high, dir: Integer;
  5999. end;
  6000. end;
  6001. const
  6002. CACHE_SIZE = $4000;
  6003. ////////////////////////////////////////////////////////////////////////////////////////
  6004. procedure ReadUncompressed;
  6005. var
  6006. i, j: Integer;
  6007. buf, tmp1, tmp2: System.PByte;
  6008. begin
  6009. buf := nil;
  6010. if (Counter.X.dir < 0) then
  6011. GetMem(buf, LineSize);
  6012. try
  6013. while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
  6014. tmp1 := ImageData;
  6015. inc(tmp1, (Counter.Y.low * LineSize)); //pointer to LineStart
  6016. if (Counter.X.dir < 0) then begin //flip X
  6017. aStream.Read(buf^, LineSize);
  6018. tmp2 := buf;
  6019. inc(tmp2, LineSize - PixelSize); //pointer to last pixel in line
  6020. for i := 0 to Header.Width-1 do begin //for all pixels in line
  6021. for j := 0 to PixelSize-1 do begin //for all bytes in pixel
  6022. tmp1^ := tmp2^;
  6023. inc(tmp1);
  6024. inc(tmp2);
  6025. end;
  6026. dec(tmp2, 2*PixelSize); //move 2 backwards, because j-loop moved 1 forward
  6027. end;
  6028. end else
  6029. aStream.Read(tmp1^, LineSize);
  6030. inc(Counter.Y.low, Counter.Y.dir); //move to next line index
  6031. end;
  6032. finally
  6033. if Assigned(buf) then
  6034. FreeMem(buf);
  6035. end;
  6036. end;
  6037. ////////////////////////////////////////////////////////////////////////////////////////
  6038. procedure ReadCompressed;
  6039. /////////////////////////////////////////////////////////////////
  6040. var
  6041. TmpData: System.PByte;
  6042. LinePixelsRead: Integer;
  6043. procedure CheckLine;
  6044. begin
  6045. if (LinePixelsRead >= Header.Width) then begin
  6046. LinePixelsRead := 0;
  6047. inc(Counter.Y.low, Counter.Y.dir); //next line index
  6048. TmpData := ImageData;
  6049. inc(TmpData, Counter.Y.low * LineSize); //set line
  6050. if (Counter.X.dir < 0) then //if x flipped then
  6051. inc(TmpData, LineSize - PixelSize); //set last pixel
  6052. end;
  6053. end;
  6054. /////////////////////////////////////////////////////////////////
  6055. var
  6056. Cache: PByte;
  6057. CacheSize, CachePos: Integer;
  6058. procedure CachedRead(out Buffer; Count: Integer);
  6059. var
  6060. BytesRead: Integer;
  6061. begin
  6062. if (CachePos + Count > CacheSize) then begin
  6063. //if buffer overflow save non read bytes
  6064. BytesRead := 0;
  6065. if (CacheSize - CachePos > 0) then begin
  6066. BytesRead := CacheSize - CachePos;
  6067. Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
  6068. inc(CachePos, BytesRead);
  6069. end;
  6070. //load cache from file
  6071. CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
  6072. aStream.Read(Cache^, CacheSize);
  6073. CachePos := 0;
  6074. //read rest of requested bytes
  6075. if (Count - BytesRead > 0) then begin
  6076. Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
  6077. inc(CachePos, Count - BytesRead);
  6078. end;
  6079. end else begin
  6080. //if no buffer overflow just read the data
  6081. Move(PByteArray(Cache)^[CachePos], Buffer, Count);
  6082. inc(CachePos, Count);
  6083. end;
  6084. end;
  6085. procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
  6086. begin
  6087. case PixelSize of
  6088. 1: begin
  6089. aBuffer^ := aData^;
  6090. inc(aBuffer, Counter.X.dir);
  6091. end;
  6092. 2: begin
  6093. PWord(aBuffer)^ := PWord(aData)^;
  6094. inc(aBuffer, 2 * Counter.X.dir);
  6095. end;
  6096. 3: begin
  6097. PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
  6098. PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
  6099. PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
  6100. inc(aBuffer, 3 * Counter.X.dir);
  6101. end;
  6102. 4: begin
  6103. PCardinal(aBuffer)^ := PCardinal(aData)^;
  6104. inc(aBuffer, 4 * Counter.X.dir);
  6105. end;
  6106. end;
  6107. end;
  6108. var
  6109. TotalPixelsToRead, TotalPixelsRead: Integer;
  6110. Temp: Byte;
  6111. buf: array [0..3] of Byte; //1 pixel is max 32bit long
  6112. PixelRepeat: Boolean;
  6113. PixelsToRead, PixelCount: Integer;
  6114. begin
  6115. CacheSize := 0;
  6116. CachePos := 0;
  6117. TotalPixelsToRead := Header.Width * Header.Height;
  6118. TotalPixelsRead := 0;
  6119. LinePixelsRead := 0;
  6120. GetMem(Cache, CACHE_SIZE);
  6121. try
  6122. TmpData := ImageData;
  6123. inc(TmpData, Counter.Y.low * LineSize); //set line
  6124. if (Counter.X.dir < 0) then //if x flipped then
  6125. inc(TmpData, LineSize - PixelSize); //set last pixel
  6126. repeat
  6127. //read CommandByte
  6128. CachedRead(Temp, 1);
  6129. PixelRepeat := (Temp and $80) > 0;
  6130. PixelsToRead := (Temp and $7F) + 1;
  6131. inc(TotalPixelsRead, PixelsToRead);
  6132. if PixelRepeat then
  6133. CachedRead(buf[0], PixelSize);
  6134. while (PixelsToRead > 0) do begin
  6135. CheckLine;
  6136. PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
  6137. while (PixelCount > 0) do begin
  6138. if not PixelRepeat then
  6139. CachedRead(buf[0], PixelSize);
  6140. PixelToBuffer(@buf[0], TmpData);
  6141. inc(LinePixelsRead);
  6142. dec(PixelsToRead);
  6143. dec(PixelCount);
  6144. end;
  6145. end;
  6146. until (TotalPixelsRead >= TotalPixelsToRead);
  6147. finally
  6148. FreeMem(Cache);
  6149. end;
  6150. end;
  6151. function IsGrayFormat: Boolean;
  6152. begin
  6153. result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
  6154. end;
  6155. begin
  6156. result := false;
  6157. // reading header to test file and set cursor back to begin
  6158. StartPosition := aStream.Position;
  6159. aStream.Read(Header{%H-}, SizeOf(Header));
  6160. // no colormapped files
  6161. if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
  6162. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
  6163. begin
  6164. try
  6165. if Header.ImageID <> 0 then // skip image ID
  6166. aStream.Position := aStream.Position + Header.ImageID;
  6167. tgaFormat := tfEmpty;
  6168. case Header.Bpp of
  6169. 8: if IsGrayFormat then case (Header.ImageDesc and $F) of
  6170. 0: tgaFormat := tfLuminance8;
  6171. 8: tgaFormat := tfAlpha8;
  6172. end;
  6173. 16: if IsGrayFormat then case (Header.ImageDesc and $F) of
  6174. 0: tgaFormat := tfLuminance16;
  6175. 8: tgaFormat := tfLuminance8Alpha8;
  6176. end else case (Header.ImageDesc and $F) of
  6177. 0: tgaFormat := tfBGR5;
  6178. 1: tgaFormat := tfBGR5A1;
  6179. 4: tgaFormat := tfBGRA4;
  6180. end;
  6181. 24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  6182. 0: tgaFormat := tfBGR8;
  6183. end;
  6184. 32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  6185. 2: tgaFormat := tfBGR10A2;
  6186. 8: tgaFormat := tfBGRA8;
  6187. end;
  6188. end;
  6189. if (tgaFormat = tfEmpty) then
  6190. raise EglBitmap.Create('LoadTga - unsupported format');
  6191. FormatDesc := TFormatDescriptor.Get(tgaFormat);
  6192. PixelSize := FormatDesc.GetSize(1, 1);
  6193. LineSize := FormatDesc.GetSize(Header.Width, 1);
  6194. GetMem(ImageData, LineSize * Header.Height);
  6195. try
  6196. //column direction
  6197. if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
  6198. Counter.X.low := Header.Height-1;;
  6199. Counter.X.high := 0;
  6200. Counter.X.dir := -1;
  6201. end else begin
  6202. Counter.X.low := 0;
  6203. Counter.X.high := Header.Height-1;
  6204. Counter.X.dir := 1;
  6205. end;
  6206. // Row direction
  6207. if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
  6208. Counter.Y.low := 0;
  6209. Counter.Y.high := Header.Height-1;
  6210. Counter.Y.dir := 1;
  6211. end else begin
  6212. Counter.Y.low := Header.Height-1;;
  6213. Counter.Y.high := 0;
  6214. Counter.Y.dir := -1;
  6215. end;
  6216. // Read Image
  6217. case Header.ImageType of
  6218. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
  6219. ReadUncompressed;
  6220. TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
  6221. ReadCompressed;
  6222. end;
  6223. SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
  6224. result := true;
  6225. except
  6226. if Assigned(ImageData) then
  6227. FreeMem(ImageData);
  6228. raise;
  6229. end;
  6230. finally
  6231. aStream.Position := StartPosition;
  6232. end;
  6233. end
  6234. else aStream.Position := StartPosition;
  6235. end;
  6236. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6237. procedure TglBitmap.SaveTGA(const aStream: TStream);
  6238. var
  6239. Header: TTGAHeader;
  6240. LineSize, Size, x, y: Integer;
  6241. Pixel: TglBitmapPixelData;
  6242. LineBuf, SourceData, DestData: PByte;
  6243. SourceMD, DestMD: Pointer;
  6244. FormatDesc: TFormatDescriptor;
  6245. Converter: TFormatDescriptor;
  6246. begin
  6247. if not (ftTGA in FormatGetSupportedFiles(Format)) then
  6248. raise EglBitmapUnsupportedFormat.Create(Format);
  6249. //prepare header
  6250. FillChar(Header{%H-}, SizeOf(Header), 0);
  6251. //set ImageType
  6252. if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
  6253. tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
  6254. Header.ImageType := TGA_UNCOMPRESSED_GRAY
  6255. else
  6256. Header.ImageType := TGA_UNCOMPRESSED_RGB;
  6257. //set BitsPerPixel
  6258. if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
  6259. Header.Bpp := 8
  6260. else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
  6261. tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
  6262. Header.Bpp := 16
  6263. else if (Format in [tfBGR8, tfRGB8]) then
  6264. Header.Bpp := 24
  6265. else
  6266. Header.Bpp := 32;
  6267. //set AlphaBitCount
  6268. case Format of
  6269. tfRGB5A1, tfBGR5A1:
  6270. Header.ImageDesc := 1 and $F;
  6271. tfRGB10A2, tfBGR10A2:
  6272. Header.ImageDesc := 2 and $F;
  6273. tfRGBA4, tfBGRA4:
  6274. Header.ImageDesc := 4 and $F;
  6275. tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
  6276. Header.ImageDesc := 8 and $F;
  6277. end;
  6278. Header.Width := Width;
  6279. Header.Height := Height;
  6280. Header.ImageDesc := Header.ImageDesc or $20; //flip y
  6281. aStream.Write(Header, SizeOf(Header));
  6282. // convert RGB(A) to BGR(A)
  6283. Converter := nil;
  6284. FormatDesc := TFormatDescriptor.Get(Format);
  6285. Size := FormatDesc.GetSize(Dimension);
  6286. if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
  6287. if (FormatDesc.RGBInverted = tfEmpty) then
  6288. raise EglBitmap.Create('inverted RGB format is empty');
  6289. Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
  6290. if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
  6291. (Converter.PixelSize <> FormatDesc.PixelSize) then
  6292. raise EglBitmap.Create('invalid inverted RGB format');
  6293. end;
  6294. if Assigned(Converter) then begin
  6295. LineSize := FormatDesc.GetSize(Width, 1);
  6296. GetMem(LineBuf, LineSize);
  6297. SourceMD := FormatDesc.CreateMappingData;
  6298. DestMD := Converter.CreateMappingData;
  6299. try
  6300. SourceData := Data;
  6301. for y := 0 to Height-1 do begin
  6302. DestData := LineBuf;
  6303. for x := 0 to Width-1 do begin
  6304. FormatDesc.Unmap(SourceData, Pixel, SourceMD);
  6305. Converter.Map(Pixel, DestData, DestMD);
  6306. end;
  6307. aStream.Write(LineBuf^, LineSize);
  6308. end;
  6309. finally
  6310. FreeMem(LineBuf);
  6311. FormatDesc.FreeMappingData(SourceMD);
  6312. FormatDesc.FreeMappingData(DestMD);
  6313. end;
  6314. end else
  6315. aStream.Write(Data^, Size);
  6316. end;
  6317. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6318. //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6319. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6320. const
  6321. DDS_MAGIC: Cardinal = $20534444;
  6322. // DDS_header.dwFlags
  6323. DDSD_CAPS = $00000001;
  6324. DDSD_HEIGHT = $00000002;
  6325. DDSD_WIDTH = $00000004;
  6326. DDSD_PIXELFORMAT = $00001000;
  6327. // DDS_header.sPixelFormat.dwFlags
  6328. DDPF_ALPHAPIXELS = $00000001;
  6329. DDPF_ALPHA = $00000002;
  6330. DDPF_FOURCC = $00000004;
  6331. DDPF_RGB = $00000040;
  6332. DDPF_LUMINANCE = $00020000;
  6333. // DDS_header.sCaps.dwCaps1
  6334. DDSCAPS_TEXTURE = $00001000;
  6335. // DDS_header.sCaps.dwCaps2
  6336. DDSCAPS2_CUBEMAP = $00000200;
  6337. D3DFMT_DXT1 = $31545844;
  6338. D3DFMT_DXT3 = $33545844;
  6339. D3DFMT_DXT5 = $35545844;
  6340. type
  6341. TDDSPixelFormat = packed record
  6342. dwSize: Cardinal;
  6343. dwFlags: Cardinal;
  6344. dwFourCC: Cardinal;
  6345. dwRGBBitCount: Cardinal;
  6346. dwRBitMask: Cardinal;
  6347. dwGBitMask: Cardinal;
  6348. dwBBitMask: Cardinal;
  6349. dwABitMask: Cardinal;
  6350. end;
  6351. TDDSCaps = packed record
  6352. dwCaps1: Cardinal;
  6353. dwCaps2: Cardinal;
  6354. dwDDSX: Cardinal;
  6355. dwReserved: Cardinal;
  6356. end;
  6357. TDDSHeader = packed record
  6358. dwSize: Cardinal;
  6359. dwFlags: Cardinal;
  6360. dwHeight: Cardinal;
  6361. dwWidth: Cardinal;
  6362. dwPitchOrLinearSize: Cardinal;
  6363. dwDepth: Cardinal;
  6364. dwMipMapCount: Cardinal;
  6365. dwReserved: array[0..10] of Cardinal;
  6366. PixelFormat: TDDSPixelFormat;
  6367. Caps: TDDSCaps;
  6368. dwReserved2: Cardinal;
  6369. end;
  6370. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6371. function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
  6372. var
  6373. Header: TDDSHeader;
  6374. Converter: TbmpBitfieldFormat;
  6375. function GetDDSFormat: TglBitmapFormat;
  6376. var
  6377. fd: TFormatDescriptor;
  6378. i: Integer;
  6379. Range: TglBitmapColorRec;
  6380. match: Boolean;
  6381. begin
  6382. result := tfEmpty;
  6383. with Header.PixelFormat do begin
  6384. // Compresses
  6385. if ((dwFlags and DDPF_FOURCC) > 0) then begin
  6386. case Header.PixelFormat.dwFourCC of
  6387. D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
  6388. D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
  6389. D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
  6390. end;
  6391. end else if ((Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin
  6392. //find matching format
  6393. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  6394. fd := TFormatDescriptor.Get(result);
  6395. if fd.MaskMatch(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask) and
  6396. (8 * fd.PixelSize = dwRGBBitCount) then
  6397. exit;
  6398. end;
  6399. //find format with same Range
  6400. Range.r := dwRBitMask;
  6401. Range.g := dwGBitMask;
  6402. Range.b := dwBBitMask;
  6403. Range.a := dwABitMask;
  6404. for i := 0 to 3 do begin
  6405. while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do
  6406. Range.arr[i] := Range.arr[i] shr 1;
  6407. end;
  6408. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  6409. fd := TFormatDescriptor.Get(result);
  6410. match := true;
  6411. for i := 0 to 3 do
  6412. if (fd.Range.arr[i] <> Range.arr[i]) then begin
  6413. match := false;
  6414. break;
  6415. end;
  6416. if match then
  6417. break;
  6418. end;
  6419. //no format with same range found -> use default
  6420. if (result = tfEmpty) then begin
  6421. if (dwABitMask > 0) then
  6422. result := tfBGRA8
  6423. else
  6424. result := tfBGR8;
  6425. end;
  6426. Converter := TbmpBitfieldFormat.Create;
  6427. Converter.RedMask := dwRBitMask;
  6428. Converter.GreenMask := dwGBitMask;
  6429. Converter.BlueMask := dwBBitMask;
  6430. Converter.AlphaMask := dwABitMask;
  6431. Converter.PixelSize := dwRGBBitCount / 8;
  6432. end;
  6433. end;
  6434. end;
  6435. var
  6436. StreamPos: Int64;
  6437. x, y, LineSize, RowSize, Magic: Cardinal;
  6438. NewImage, TmpData, RowData, SrcData: System.PByte;
  6439. SourceMD, DestMD: Pointer;
  6440. Pixel: TglBitmapPixelData;
  6441. ddsFormat: TglBitmapFormat;
  6442. FormatDesc: TFormatDescriptor;
  6443. begin
  6444. result := false;
  6445. Converter := nil;
  6446. StreamPos := aStream.Position;
  6447. // Magic
  6448. aStream.Read(Magic{%H-}, sizeof(Magic));
  6449. if (Magic <> DDS_MAGIC) then begin
  6450. aStream.Position := StreamPos;
  6451. exit;
  6452. end;
  6453. //Header
  6454. aStream.Read(Header{%H-}, sizeof(Header));
  6455. if (Header.dwSize <> SizeOf(Header)) or
  6456. ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
  6457. (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
  6458. begin
  6459. aStream.Position := StreamPos;
  6460. exit;
  6461. end;
  6462. if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
  6463. raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
  6464. ddsFormat := GetDDSFormat;
  6465. try
  6466. if (ddsFormat = tfEmpty) then
  6467. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  6468. FormatDesc := TFormatDescriptor.Get(ddsFormat);
  6469. LineSize := Trunc(Header.dwWidth * FormatDesc.PixelSize);
  6470. GetMem(NewImage, Header.dwHeight * LineSize);
  6471. try
  6472. TmpData := NewImage;
  6473. //Converter needed
  6474. if Assigned(Converter) then begin
  6475. RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
  6476. GetMem(RowData, RowSize);
  6477. SourceMD := Converter.CreateMappingData;
  6478. DestMD := FormatDesc.CreateMappingData;
  6479. try
  6480. for y := 0 to Header.dwHeight-1 do begin
  6481. TmpData := NewImage;
  6482. inc(TmpData, y * LineSize);
  6483. SrcData := RowData;
  6484. aStream.Read(SrcData^, RowSize);
  6485. for x := 0 to Header.dwWidth-1 do begin
  6486. Converter.Unmap(SrcData, Pixel, SourceMD);
  6487. glBitmapConvertPixel(Pixel, Converter, FormatDesc);
  6488. FormatDesc.Map(Pixel, TmpData, DestMD);
  6489. end;
  6490. end;
  6491. finally
  6492. Converter.FreeMappingData(SourceMD);
  6493. FormatDesc.FreeMappingData(DestMD);
  6494. FreeMem(RowData);
  6495. end;
  6496. end else
  6497. // Compressed
  6498. if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
  6499. RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
  6500. for Y := 0 to Header.dwHeight-1 do begin
  6501. aStream.Read(TmpData^, RowSize);
  6502. Inc(TmpData, LineSize);
  6503. end;
  6504. end else
  6505. // Uncompressed
  6506. if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
  6507. RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
  6508. for Y := 0 to Header.dwHeight-1 do begin
  6509. aStream.Read(TmpData^, RowSize);
  6510. Inc(TmpData, LineSize);
  6511. end;
  6512. end else
  6513. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  6514. SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
  6515. result := true;
  6516. except
  6517. if Assigned(NewImage) then
  6518. FreeMem(NewImage);
  6519. raise;
  6520. end;
  6521. finally
  6522. FreeAndNil(Converter);
  6523. end;
  6524. end;
  6525. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6526. procedure TglBitmap.SaveDDS(const aStream: TStream);
  6527. var
  6528. Header: TDDSHeader;
  6529. FormatDesc: TFormatDescriptor;
  6530. begin
  6531. if not (ftDDS in FormatGetSupportedFiles(Format)) then
  6532. raise EglBitmapUnsupportedFormat.Create(Format);
  6533. FormatDesc := TFormatDescriptor.Get(Format);
  6534. // Generell
  6535. FillChar(Header{%H-}, SizeOf(Header), 0);
  6536. Header.dwSize := SizeOf(Header);
  6537. Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
  6538. Header.dwWidth := Max(1, Width);
  6539. Header.dwHeight := Max(1, Height);
  6540. // Caps
  6541. Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
  6542. // Pixelformat
  6543. Header.PixelFormat.dwSize := sizeof(Header);
  6544. if (FormatDesc.IsCompressed) then begin
  6545. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
  6546. case Format of
  6547. tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
  6548. tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
  6549. tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
  6550. end;
  6551. end else if (Format in [tfAlpha8, tfAlpha16]) then begin
  6552. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHA;
  6553. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6554. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6555. end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
  6556. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
  6557. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6558. Header.PixelFormat.dwRBitMask := FormatDesc.RedMask;
  6559. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6560. end else begin
  6561. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
  6562. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6563. Header.PixelFormat.dwRBitMask := FormatDesc.RedMask;
  6564. Header.PixelFormat.dwGBitMask := FormatDesc.GreenMask;
  6565. Header.PixelFormat.dwBBitMask := FormatDesc.BlueMask;
  6566. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6567. end;
  6568. if (FormatDesc.HasAlpha) then
  6569. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
  6570. aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
  6571. aStream.Write(Header, SizeOf(Header));
  6572. aStream.Write(Data^, FormatDesc.GetSize(Dimension));
  6573. end;
  6574. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6575. //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6576. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6577. procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  6578. const aWidth: Integer; const aHeight: Integer);
  6579. var
  6580. pTemp: pByte;
  6581. Size: Integer;
  6582. begin
  6583. if (aHeight > 1) then begin
  6584. Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
  6585. GetMem(pTemp, Size);
  6586. try
  6587. Move(aData^, pTemp^, Size);
  6588. FreeMem(aData);
  6589. aData := nil;
  6590. except
  6591. FreeMem(pTemp);
  6592. raise;
  6593. end;
  6594. end else
  6595. pTemp := aData;
  6596. inherited SetDataPointer(pTemp, aFormat, aWidth);
  6597. end;
  6598. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6599. function TglBitmap1D.FlipHorz: Boolean;
  6600. var
  6601. Col: Integer;
  6602. pTempDest, pDest, pSource: PByte;
  6603. begin
  6604. result := inherited FlipHorz;
  6605. if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
  6606. pSource := Data;
  6607. GetMem(pDest, fRowSize);
  6608. try
  6609. pTempDest := pDest;
  6610. Inc(pTempDest, fRowSize);
  6611. for Col := 0 to Width-1 do begin
  6612. dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
  6613. Move(pSource^, pTempDest^, fPixelSize);
  6614. Inc(pSource, fPixelSize);
  6615. end;
  6616. SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
  6617. result := true;
  6618. except
  6619. if Assigned(pDest) then
  6620. FreeMem(pDest);
  6621. raise;
  6622. end;
  6623. end;
  6624. end;
  6625. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6626. procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
  6627. var
  6628. FormatDesc: TFormatDescriptor;
  6629. begin
  6630. // Upload data
  6631. FormatDesc := TFormatDescriptor.Get(Format);
  6632. if FormatDesc.IsCompressed then
  6633. glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
  6634. else if aBuildWithGlu then
  6635. gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  6636. else
  6637. glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  6638. // Free Data
  6639. if (FreeDataAfterGenTexture) then
  6640. FreeData;
  6641. end;
  6642. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6643. procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
  6644. var
  6645. BuildWithGlu, TexRec: Boolean;
  6646. TexSize: Integer;
  6647. begin
  6648. if Assigned(Data) then begin
  6649. // Check Texture Size
  6650. if (aTestTextureSize) then begin
  6651. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  6652. if (Width > TexSize) then
  6653. raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  6654. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
  6655. (Target = GL_TEXTURE_RECTANGLE);
  6656. if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  6657. raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  6658. end;
  6659. CreateId;
  6660. SetupParameters(BuildWithGlu);
  6661. UploadData(BuildWithGlu);
  6662. glAreTexturesResident(1, @fID, @fIsResident);
  6663. end;
  6664. end;
  6665. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6666. procedure TglBitmap1D.AfterConstruction;
  6667. begin
  6668. inherited;
  6669. Target := GL_TEXTURE_1D;
  6670. end;
  6671. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6672. //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6673. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6674. function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
  6675. begin
  6676. if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
  6677. result := fLines[aIndex]
  6678. else
  6679. result := nil;
  6680. end;
  6681. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6682. procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  6683. const aWidth: Integer; const aHeight: Integer);
  6684. var
  6685. Idx, LineWidth: Integer;
  6686. begin
  6687. inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
  6688. if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
  6689. // Assigning Data
  6690. if Assigned(Data) then begin
  6691. SetLength(fLines, GetHeight);
  6692. LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
  6693. for Idx := 0 to GetHeight-1 do begin
  6694. fLines[Idx] := Data;
  6695. Inc(fLines[Idx], Idx * LineWidth);
  6696. end;
  6697. end
  6698. else SetLength(fLines, 0);
  6699. end else begin
  6700. SetLength(fLines, 0);
  6701. end;
  6702. end;
  6703. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6704. procedure TglBitmap2D.UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
  6705. var
  6706. FormatDesc: TFormatDescriptor;
  6707. begin
  6708. glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
  6709. FormatDesc := TFormatDescriptor.Get(Format);
  6710. if FormatDesc.IsCompressed then begin
  6711. glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
  6712. end else if aBuildWithGlu then begin
  6713. gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
  6714. FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  6715. end else begin
  6716. glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
  6717. FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  6718. end;
  6719. // Freigeben
  6720. if (FreeDataAfterGenTexture) then
  6721. FreeData;
  6722. end;
  6723. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6724. procedure TglBitmap2D.AfterConstruction;
  6725. begin
  6726. inherited;
  6727. Target := GL_TEXTURE_2D;
  6728. end;
  6729. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6730. procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  6731. var
  6732. Temp: pByte;
  6733. Size, w, h: Integer;
  6734. FormatDesc: TFormatDescriptor;
  6735. begin
  6736. FormatDesc := TFormatDescriptor.Get(Format);
  6737. if FormatDesc.IsCompressed then
  6738. raise EglBitmapUnsupportedFormat.Create(Format);
  6739. w := aRight - aLeft;
  6740. h := aBottom - aTop;
  6741. Size := FormatDesc.GetSize(w, h);
  6742. GetMem(Temp, Size);
  6743. try
  6744. glPixelStorei(GL_PACK_ALIGNMENT, 1);
  6745. glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  6746. SetDataPointer(Temp, Format, w, h); //be careful, Data could be freed by this method
  6747. FlipVert;
  6748. except
  6749. if Assigned(Temp) then
  6750. FreeMem(Temp);
  6751. raise;
  6752. end;
  6753. end;
  6754. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6755. procedure TglBitmap2D.GetDataFromTexture;
  6756. var
  6757. Temp: PByte;
  6758. TempWidth, TempHeight: Integer;
  6759. TempIntFormat: Cardinal;
  6760. IntFormat, f: TglBitmapFormat;
  6761. FormatDesc: TFormatDescriptor;
  6762. begin
  6763. Bind;
  6764. // Request Data
  6765. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH, @TempWidth);
  6766. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT, @TempHeight);
  6767. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
  6768. IntFormat := tfEmpty;
  6769. for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
  6770. FormatDesc := TFormatDescriptor.Get(f);
  6771. if (FormatDesc.glInternalFormat = TempIntFormat) then begin
  6772. IntFormat := FormatDesc.Format;
  6773. break;
  6774. end;
  6775. end;
  6776. // Getting data from OpenGL
  6777. FormatDesc := TFormatDescriptor.Get(IntFormat);
  6778. GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
  6779. try
  6780. if FormatDesc.IsCompressed then
  6781. glGetCompressedTexImage(Target, 0, Temp)
  6782. else
  6783. glGetTexImage(Target, 0, FormatDesc.glInternalFormat, FormatDesc.glDataFormat, Temp);
  6784. SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  6785. except
  6786. if Assigned(Temp) then
  6787. FreeMem(Temp);
  6788. raise;
  6789. end;
  6790. end;
  6791. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6792. procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
  6793. var
  6794. BuildWithGlu, PotTex, TexRec: Boolean;
  6795. TexSize: Integer;
  6796. begin
  6797. if Assigned(Data) then begin
  6798. // Check Texture Size
  6799. if (aTestTextureSize) then begin
  6800. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  6801. if ((Height > TexSize) or (Width > TexSize)) then
  6802. raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  6803. PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
  6804. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
  6805. if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  6806. raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  6807. end;
  6808. CreateId;
  6809. SetupParameters(BuildWithGlu);
  6810. UploadData(Target, BuildWithGlu);
  6811. glAreTexturesResident(1, @fID, @fIsResident);
  6812. end;
  6813. end;
  6814. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6815. function TglBitmap2D.FlipHorz: Boolean;
  6816. var
  6817. Col, Row: Integer;
  6818. TempDestData, DestData, SourceData: PByte;
  6819. ImgSize: Integer;
  6820. begin
  6821. result := inherited FlipHorz;
  6822. if Assigned(Data) then begin
  6823. SourceData := Data;
  6824. ImgSize := Height * fRowSize;
  6825. GetMem(DestData, ImgSize);
  6826. try
  6827. TempDestData := DestData;
  6828. Dec(TempDestData, fRowSize + fPixelSize);
  6829. for Row := 0 to Height -1 do begin
  6830. Inc(TempDestData, fRowSize * 2);
  6831. for Col := 0 to Width -1 do begin
  6832. Move(SourceData^, TempDestData^, fPixelSize);
  6833. Inc(SourceData, fPixelSize);
  6834. Dec(TempDestData, fPixelSize);
  6835. end;
  6836. end;
  6837. SetDataPointer(DestData, Format); //be careful, Data could be freed by this method
  6838. result := true;
  6839. except
  6840. if Assigned(DestData) then
  6841. FreeMem(DestData);
  6842. raise;
  6843. end;
  6844. end;
  6845. end;
  6846. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6847. function TglBitmap2D.FlipVert: Boolean;
  6848. var
  6849. Row: Integer;
  6850. TempDestData, DestData, SourceData: PByte;
  6851. begin
  6852. result := inherited FlipVert;
  6853. if Assigned(Data) then begin
  6854. SourceData := Data;
  6855. GetMem(DestData, Height * fRowSize);
  6856. try
  6857. TempDestData := DestData;
  6858. Inc(TempDestData, Width * (Height -1) * fPixelSize);
  6859. for Row := 0 to Height -1 do begin
  6860. Move(SourceData^, TempDestData^, fRowSize);
  6861. Dec(TempDestData, fRowSize);
  6862. Inc(SourceData, fRowSize);
  6863. end;
  6864. SetDataPointer(DestData, Format); //be careful, Data could be freed by this method
  6865. result := true;
  6866. except
  6867. if Assigned(DestData) then
  6868. FreeMem(DestData);
  6869. raise;
  6870. end;
  6871. end;
  6872. end;
  6873. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6874. //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6875. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6876. type
  6877. TMatrixItem = record
  6878. X, Y: Integer;
  6879. W: Single;
  6880. end;
  6881. PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
  6882. TglBitmapToNormalMapRec = Record
  6883. Scale: Single;
  6884. Heights: array of Single;
  6885. MatrixU : array of TMatrixItem;
  6886. MatrixV : array of TMatrixItem;
  6887. end;
  6888. const
  6889. ONE_OVER_255 = 1 / 255;
  6890. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6891. procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
  6892. var
  6893. Val: Single;
  6894. begin
  6895. with FuncRec do begin
  6896. Val :=
  6897. Source.Data.r * LUMINANCE_WEIGHT_R +
  6898. Source.Data.g * LUMINANCE_WEIGHT_G +
  6899. Source.Data.b * LUMINANCE_WEIGHT_B;
  6900. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
  6901. end;
  6902. end;
  6903. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6904. procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  6905. begin
  6906. with FuncRec do
  6907. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
  6908. end;
  6909. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6910. procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
  6911. type
  6912. TVec = Array[0..2] of Single;
  6913. var
  6914. Idx: Integer;
  6915. du, dv: Double;
  6916. Len: Single;
  6917. Vec: TVec;
  6918. function GetHeight(X, Y: Integer): Single;
  6919. begin
  6920. with FuncRec do begin
  6921. X := Max(0, Min(Size.X -1, X));
  6922. Y := Max(0, Min(Size.Y -1, Y));
  6923. result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
  6924. end;
  6925. end;
  6926. begin
  6927. with FuncRec do begin
  6928. with PglBitmapToNormalMapRec(Args)^ do begin
  6929. du := 0;
  6930. for Idx := Low(MatrixU) to High(MatrixU) do
  6931. du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
  6932. dv := 0;
  6933. for Idx := Low(MatrixU) to High(MatrixU) do
  6934. dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
  6935. Vec[0] := -du * Scale;
  6936. Vec[1] := -dv * Scale;
  6937. Vec[2] := 1;
  6938. end;
  6939. // Normalize
  6940. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  6941. if Len <> 0 then begin
  6942. Vec[0] := Vec[0] * Len;
  6943. Vec[1] := Vec[1] * Len;
  6944. Vec[2] := Vec[2] * Len;
  6945. end;
  6946. // Farbe zuweisem
  6947. Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
  6948. Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
  6949. Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
  6950. end;
  6951. end;
  6952. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6953. procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
  6954. var
  6955. Rec: TglBitmapToNormalMapRec;
  6956. procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
  6957. begin
  6958. if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
  6959. Matrix[Index].X := X;
  6960. Matrix[Index].Y := Y;
  6961. Matrix[Index].W := W;
  6962. end;
  6963. end;
  6964. begin
  6965. if TFormatDescriptor.Get(Format).IsCompressed then
  6966. raise EglBitmapUnsupportedFormat.Create(Format);
  6967. if aScale > 100 then
  6968. Rec.Scale := 100
  6969. else if aScale < -100 then
  6970. Rec.Scale := -100
  6971. else
  6972. Rec.Scale := aScale;
  6973. SetLength(Rec.Heights, Width * Height);
  6974. try
  6975. case aFunc of
  6976. nm4Samples: begin
  6977. SetLength(Rec.MatrixU, 2);
  6978. SetEntry(Rec.MatrixU, 0, -1, 0, -0.5);
  6979. SetEntry(Rec.MatrixU, 1, 1, 0, 0.5);
  6980. SetLength(Rec.MatrixV, 2);
  6981. SetEntry(Rec.MatrixV, 0, 0, 1, 0.5);
  6982. SetEntry(Rec.MatrixV, 1, 0, -1, -0.5);
  6983. end;
  6984. nmSobel: begin
  6985. SetLength(Rec.MatrixU, 6);
  6986. SetEntry(Rec.MatrixU, 0, -1, 1, -1.0);
  6987. SetEntry(Rec.MatrixU, 1, -1, 0, -2.0);
  6988. SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
  6989. SetEntry(Rec.MatrixU, 3, 1, 1, 1.0);
  6990. SetEntry(Rec.MatrixU, 4, 1, 0, 2.0);
  6991. SetEntry(Rec.MatrixU, 5, 1, -1, 1.0);
  6992. SetLength(Rec.MatrixV, 6);
  6993. SetEntry(Rec.MatrixV, 0, -1, 1, 1.0);
  6994. SetEntry(Rec.MatrixV, 1, 0, 1, 2.0);
  6995. SetEntry(Rec.MatrixV, 2, 1, 1, 1.0);
  6996. SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
  6997. SetEntry(Rec.MatrixV, 4, 0, -1, -2.0);
  6998. SetEntry(Rec.MatrixV, 5, 1, -1, -1.0);
  6999. end;
  7000. nm3x3: begin
  7001. SetLength(Rec.MatrixU, 6);
  7002. SetEntry(Rec.MatrixU, 0, -1, 1, -1/6);
  7003. SetEntry(Rec.MatrixU, 1, -1, 0, -1/6);
  7004. SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
  7005. SetEntry(Rec.MatrixU, 3, 1, 1, 1/6);
  7006. SetEntry(Rec.MatrixU, 4, 1, 0, 1/6);
  7007. SetEntry(Rec.MatrixU, 5, 1, -1, 1/6);
  7008. SetLength(Rec.MatrixV, 6);
  7009. SetEntry(Rec.MatrixV, 0, -1, 1, 1/6);
  7010. SetEntry(Rec.MatrixV, 1, 0, 1, 1/6);
  7011. SetEntry(Rec.MatrixV, 2, 1, 1, 1/6);
  7012. SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
  7013. SetEntry(Rec.MatrixV, 4, 0, -1, -1/6);
  7014. SetEntry(Rec.MatrixV, 5, 1, -1, -1/6);
  7015. end;
  7016. nm5x5: begin
  7017. SetLength(Rec.MatrixU, 20);
  7018. SetEntry(Rec.MatrixU, 0, -2, 2, -1 / 16);
  7019. SetEntry(Rec.MatrixU, 1, -1, 2, -1 / 10);
  7020. SetEntry(Rec.MatrixU, 2, 1, 2, 1 / 10);
  7021. SetEntry(Rec.MatrixU, 3, 2, 2, 1 / 16);
  7022. SetEntry(Rec.MatrixU, 4, -2, 1, -1 / 10);
  7023. SetEntry(Rec.MatrixU, 5, -1, 1, -1 / 8);
  7024. SetEntry(Rec.MatrixU, 6, 1, 1, 1 / 8);
  7025. SetEntry(Rec.MatrixU, 7, 2, 1, 1 / 10);
  7026. SetEntry(Rec.MatrixU, 8, -2, 0, -1 / 2.8);
  7027. SetEntry(Rec.MatrixU, 9, -1, 0, -0.5);
  7028. SetEntry(Rec.MatrixU, 10, 1, 0, 0.5);
  7029. SetEntry(Rec.MatrixU, 11, 2, 0, 1 / 2.8);
  7030. SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
  7031. SetEntry(Rec.MatrixU, 13, -1, -1, -1 / 8);
  7032. SetEntry(Rec.MatrixU, 14, 1, -1, 1 / 8);
  7033. SetEntry(Rec.MatrixU, 15, 2, -1, 1 / 10);
  7034. SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
  7035. SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
  7036. SetEntry(Rec.MatrixU, 18, 1, -2, 1 / 10);
  7037. SetEntry(Rec.MatrixU, 19, 2, -2, 1 / 16);
  7038. SetLength(Rec.MatrixV, 20);
  7039. SetEntry(Rec.MatrixV, 0, -2, 2, 1 / 16);
  7040. SetEntry(Rec.MatrixV, 1, -1, 2, 1 / 10);
  7041. SetEntry(Rec.MatrixV, 2, 0, 2, 0.25);
  7042. SetEntry(Rec.MatrixV, 3, 1, 2, 1 / 10);
  7043. SetEntry(Rec.MatrixV, 4, 2, 2, 1 / 16);
  7044. SetEntry(Rec.MatrixV, 5, -2, 1, 1 / 10);
  7045. SetEntry(Rec.MatrixV, 6, -1, 1, 1 / 8);
  7046. SetEntry(Rec.MatrixV, 7, 0, 1, 0.5);
  7047. SetEntry(Rec.MatrixV, 8, 1, 1, 1 / 8);
  7048. SetEntry(Rec.MatrixV, 9, 2, 1, 1 / 16);
  7049. SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
  7050. SetEntry(Rec.MatrixV, 11, -1, -1, -1 / 8);
  7051. SetEntry(Rec.MatrixV, 12, 0, -1, -0.5);
  7052. SetEntry(Rec.MatrixV, 13, 1, -1, -1 / 8);
  7053. SetEntry(Rec.MatrixV, 14, 2, -1, -1 / 10);
  7054. SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
  7055. SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
  7056. SetEntry(Rec.MatrixV, 17, 0, -2, -0.25);
  7057. SetEntry(Rec.MatrixV, 18, 1, -2, -1 / 10);
  7058. SetEntry(Rec.MatrixV, 19, 2, -2, -1 / 16);
  7059. end;
  7060. end;
  7061. // Daten Sammeln
  7062. if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
  7063. AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
  7064. else
  7065. AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
  7066. AddFunc(glBitmapToNormalMapFunc, false, @Rec);
  7067. finally
  7068. SetLength(Rec.Heights, 0);
  7069. end;
  7070. end;
  7071. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7072. //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7073. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7074. procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);
  7075. begin
  7076. Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
  7077. end;
  7078. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7079. procedure TglBitmapCubeMap.AfterConstruction;
  7080. begin
  7081. inherited;
  7082. if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
  7083. raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
  7084. SetWrap;
  7085. Target := GL_TEXTURE_CUBE_MAP;
  7086. fGenMode := GL_REFLECTION_MAP;
  7087. end;
  7088. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7089. procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);
  7090. var
  7091. BuildWithGlu: Boolean;
  7092. TexSize: Integer;
  7093. begin
  7094. if (aTestTextureSize) then begin
  7095. glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
  7096. if (Height > TexSize) or (Width > TexSize) then
  7097. raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
  7098. if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
  7099. raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
  7100. end;
  7101. if (ID = 0) then
  7102. CreateID;
  7103. SetupParameters(BuildWithGlu);
  7104. UploadData(aCubeTarget, BuildWithGlu);
  7105. end;
  7106. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7107. procedure TglBitmapCubeMap.Bind(const aEnableTexCoordsGen: Boolean; const aEnableTextureUnit: Boolean);
  7108. begin
  7109. inherited Bind (aEnableTextureUnit);
  7110. if aEnableTexCoordsGen then begin
  7111. glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
  7112. glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
  7113. glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
  7114. glEnable(GL_TEXTURE_GEN_S);
  7115. glEnable(GL_TEXTURE_GEN_T);
  7116. glEnable(GL_TEXTURE_GEN_R);
  7117. end;
  7118. end;
  7119. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7120. procedure TglBitmapCubeMap.Unbind(const aDisableTexCoordsGen: Boolean; const aDisableTextureUnit: Boolean);
  7121. begin
  7122. inherited Unbind(aDisableTextureUnit);
  7123. if aDisableTexCoordsGen then begin
  7124. glDisable(GL_TEXTURE_GEN_S);
  7125. glDisable(GL_TEXTURE_GEN_T);
  7126. glDisable(GL_TEXTURE_GEN_R);
  7127. end;
  7128. end;
  7129. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7130. //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7131. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7132. type
  7133. TVec = Array[0..2] of Single;
  7134. TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7135. PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
  7136. TglBitmapNormalMapRec = record
  7137. HalfSize : Integer;
  7138. Func: TglBitmapNormalMapGetVectorFunc;
  7139. end;
  7140. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7141. procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7142. begin
  7143. aVec[0] := aHalfSize;
  7144. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7145. aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
  7146. end;
  7147. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7148. procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7149. begin
  7150. aVec[0] := - aHalfSize;
  7151. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7152. aVec[2] := aPosition.X + 0.5 - aHalfSize;
  7153. end;
  7154. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7155. procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7156. begin
  7157. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7158. aVec[1] := aHalfSize;
  7159. aVec[2] := aPosition.Y + 0.5 - aHalfSize;
  7160. end;
  7161. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7162. procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7163. begin
  7164. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7165. aVec[1] := - aHalfSize;
  7166. aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
  7167. end;
  7168. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7169. procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7170. begin
  7171. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7172. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7173. aVec[2] := aHalfSize;
  7174. end;
  7175. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7176. procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7177. begin
  7178. aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
  7179. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7180. aVec[2] := - aHalfSize;
  7181. end;
  7182. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7183. procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
  7184. var
  7185. i: Integer;
  7186. Vec: TVec;
  7187. Len: Single;
  7188. begin
  7189. with FuncRec do begin
  7190. with PglBitmapNormalMapRec(Args)^ do begin
  7191. Func(Vec, Position, HalfSize);
  7192. // Normalize
  7193. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  7194. if Len <> 0 then begin
  7195. Vec[0] := Vec[0] * Len;
  7196. Vec[1] := Vec[1] * Len;
  7197. Vec[2] := Vec[2] * Len;
  7198. end;
  7199. // Scale Vector and AddVectro
  7200. Vec[0] := Vec[0] * 0.5 + 0.5;
  7201. Vec[1] := Vec[1] * 0.5 + 0.5;
  7202. Vec[2] := Vec[2] * 0.5 + 0.5;
  7203. end;
  7204. // Set Color
  7205. for i := 0 to 2 do
  7206. Dest.Data.arr[i] := Round(Vec[i] * 255);
  7207. end;
  7208. end;
  7209. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7210. procedure TglBitmapNormalMap.AfterConstruction;
  7211. begin
  7212. inherited;
  7213. fGenMode := GL_NORMAL_MAP;
  7214. end;
  7215. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7216. procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);
  7217. var
  7218. Rec: TglBitmapNormalMapRec;
  7219. SizeRec: TglBitmapPixelPosition;
  7220. begin
  7221. Rec.HalfSize := aSize div 2;
  7222. FreeDataAfterGenTexture := false;
  7223. SizeRec.Fields := [ffX, ffY];
  7224. SizeRec.X := aSize;
  7225. SizeRec.Y := aSize;
  7226. // Positive X
  7227. Rec.Func := glBitmapNormalMapPosX;
  7228. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7229. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);
  7230. // Negative X
  7231. Rec.Func := glBitmapNormalMapNegX;
  7232. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7233. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);
  7234. // Positive Y
  7235. Rec.Func := glBitmapNormalMapPosY;
  7236. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7237. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);
  7238. // Negative Y
  7239. Rec.Func := glBitmapNormalMapNegY;
  7240. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7241. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);
  7242. // Positive Z
  7243. Rec.Func := glBitmapNormalMapPosZ;
  7244. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7245. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);
  7246. // Negative Z
  7247. Rec.Func := glBitmapNormalMapNegZ;
  7248. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7249. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);
  7250. end;
  7251. initialization
  7252. glBitmapSetDefaultFormat (tfEmpty);
  7253. glBitmapSetDefaultMipmap (mmMipmap);
  7254. glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
  7255. glBitmapSetDefaultWrap (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
  7256. glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
  7257. glBitmapSetDefaultFreeDataAfterGenTexture(true);
  7258. glBitmapSetDefaultDeleteTextureOnFree (true);
  7259. TFormatDescriptor.Init;
  7260. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  7261. OpenGLInitialized := false;
  7262. InitOpenGLCS := TCriticalSection.Create;
  7263. {$ENDIF}
  7264. finalization
  7265. TFormatDescriptor.Finalize;
  7266. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  7267. FreeAndNil(InitOpenGLCS);
  7268. {$ENDIF}
  7269. end.