選択できるのは25トピックまでです。 トピックは、先頭が英数字で、英数字とダッシュ('-')を使用した35文字以内のものにしてください。

8212 行
283 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_VERSION = $1F02;
  357. GL_EXTENSIONS = $1F03;
  358. GL_TEXTURE_1D = $0DE0;
  359. GL_TEXTURE_2D = $0DE1;
  360. GL_TEXTURE_RECTANGLE = $84F5;
  361. GL_TEXTURE_WIDTH = $1000;
  362. GL_TEXTURE_HEIGHT = $1001;
  363. GL_TEXTURE_INTERNAL_FORMAT = $1003;
  364. GL_ALPHA = $1906;
  365. GL_ALPHA4 = $803B;
  366. GL_ALPHA8 = $803C;
  367. GL_ALPHA12 = $803D;
  368. GL_ALPHA16 = $803E;
  369. GL_LUMINANCE = $1909;
  370. GL_LUMINANCE4 = $803F;
  371. GL_LUMINANCE8 = $8040;
  372. GL_LUMINANCE12 = $8041;
  373. GL_LUMINANCE16 = $8042;
  374. GL_LUMINANCE_ALPHA = $190A;
  375. GL_LUMINANCE4_ALPHA4 = $8043;
  376. GL_LUMINANCE6_ALPHA2 = $8044;
  377. GL_LUMINANCE8_ALPHA8 = $8045;
  378. GL_LUMINANCE12_ALPHA4 = $8046;
  379. GL_LUMINANCE12_ALPHA12 = $8047;
  380. GL_LUMINANCE16_ALPHA16 = $8048;
  381. GL_RGB = $1907;
  382. GL_BGR = $80E0;
  383. GL_R3_G3_B2 = $2A10;
  384. GL_RGB4 = $804F;
  385. GL_RGB5 = $8050;
  386. GL_RGB565 = $8D62;
  387. GL_RGB8 = $8051;
  388. GL_RGB10 = $8052;
  389. GL_RGB12 = $8053;
  390. GL_RGB16 = $8054;
  391. GL_RGBA = $1908;
  392. GL_BGRA = $80E1;
  393. GL_RGBA2 = $8055;
  394. GL_RGBA4 = $8056;
  395. GL_RGB5_A1 = $8057;
  396. GL_RGBA8 = $8058;
  397. GL_RGB10_A2 = $8059;
  398. GL_RGBA12 = $805A;
  399. GL_RGBA16 = $805B;
  400. GL_DEPTH_COMPONENT = $1902;
  401. GL_DEPTH_COMPONENT16 = $81A5;
  402. GL_DEPTH_COMPONENT24 = $81A6;
  403. GL_DEPTH_COMPONENT32 = $81A7;
  404. GL_COMPRESSED_RGB = $84ED;
  405. GL_COMPRESSED_RGBA = $84EE;
  406. GL_COMPRESSED_RGB_S3TC_DXT1_EXT = $83F0;
  407. GL_COMPRESSED_RGBA_S3TC_DXT1_EXT = $83F1;
  408. GL_COMPRESSED_RGBA_S3TC_DXT3_EXT = $83F2;
  409. GL_COMPRESSED_RGBA_S3TC_DXT5_EXT = $83F3;
  410. GL_UNSIGNED_BYTE = $1401;
  411. GL_UNSIGNED_BYTE_3_3_2 = $8032;
  412. GL_UNSIGNED_BYTE_2_3_3_REV = $8362;
  413. GL_UNSIGNED_SHORT = $1403;
  414. GL_UNSIGNED_SHORT_5_6_5 = $8363;
  415. GL_UNSIGNED_SHORT_4_4_4_4 = $8033;
  416. GL_UNSIGNED_SHORT_5_5_5_1 = $8034;
  417. GL_UNSIGNED_SHORT_5_6_5_REV = $8364;
  418. GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;
  419. GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;
  420. GL_UNSIGNED_INT = $1405;
  421. GL_UNSIGNED_INT_8_8_8_8 = $8035;
  422. GL_UNSIGNED_INT_10_10_10_2 = $8036;
  423. GL_UNSIGNED_INT_8_8_8_8_REV = $8367;
  424. GL_UNSIGNED_INT_2_10_10_10_REV = $8368;
  425. { Texture Filter }
  426. GL_TEXTURE_MAG_FILTER = $2800;
  427. GL_TEXTURE_MIN_FILTER = $2801;
  428. GL_NEAREST = $2600;
  429. GL_NEAREST_MIPMAP_NEAREST = $2700;
  430. GL_NEAREST_MIPMAP_LINEAR = $2702;
  431. GL_LINEAR = $2601;
  432. GL_LINEAR_MIPMAP_NEAREST = $2701;
  433. GL_LINEAR_MIPMAP_LINEAR = $2703;
  434. { Texture Wrap }
  435. GL_TEXTURE_WRAP_S = $2802;
  436. GL_TEXTURE_WRAP_T = $2803;
  437. GL_TEXTURE_WRAP_R = $8072;
  438. GL_CLAMP = $2900;
  439. GL_REPEAT = $2901;
  440. GL_CLAMP_TO_EDGE = $812F;
  441. GL_CLAMP_TO_BORDER = $812D;
  442. GL_MIRRORED_REPEAT = $8370;
  443. { Other }
  444. GL_GENERATE_MIPMAP = $8191;
  445. GL_TEXTURE_BORDER_COLOR = $1004;
  446. GL_MAX_TEXTURE_SIZE = $0D33;
  447. GL_PACK_ALIGNMENT = $0D05;
  448. GL_UNPACK_ALIGNMENT = $0CF5;
  449. GL_TEXTURE_MAX_ANISOTROPY_EXT = $84FE;
  450. GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;
  451. {$IF DEFINED(GLB_WIN)}
  452. libglu = 'glu32.dll';
  453. libopengl = 'opengl32.dll';
  454. {$ELSEIF DEFINED(GLB_LINUX)}
  455. libglu = 'libGLU.so.1';
  456. libopengl = 'libGL.so.1';
  457. {$IFEND}
  458. type
  459. GLboolean = BYTEBOOL;
  460. GLint = Integer;
  461. GLsizei = Integer;
  462. GLuint = Cardinal;
  463. GLfloat = Single;
  464. GLenum = Cardinal;
  465. PGLvoid = Pointer;
  466. PGLboolean = ^GLboolean;
  467. PGLint = ^GLint;
  468. PGLuint = ^GLuint;
  469. PGLfloat = ^GLfloat;
  470. TglCompressedTexImage1D = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  471. 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}
  472. TglGetCompressedTexImage = procedure(target: GLenum; level: GLint; img: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  473. {$IF DEFINED(GLB_WIN)}
  474. TwglGetProcAddress = function (ProcName: PAnsiChar): Pointer; stdcall;
  475. {$ELSEIF DEFINED(GLB_LINUX)}
  476. TglXGetProcAddress = function(ProcName: PAnsiChar): Pointer; cdecl;
  477. TglXGetProcAddressARB = function(const name: PAnsiChar): pointer; cdecl;
  478. {$IFEND}
  479. {$IF DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
  480. TglEnable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  481. TglDisable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  482. TglGetString = function(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  483. TglGetIntegerv = procedure(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  484. TglTexParameteri = procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  485. TglTexParameterfv = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  486. TglGetTexParameteriv = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  487. TglGetTexParameterfv = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  488. TglGetTexLevelParameteriv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  489. TglGetTexLevelParameterfv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  490. TglGenTextures = procedure(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  491. TglBindTexture = procedure(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  492. TglDeleteTextures = procedure(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  493. TglAreTexturesResident = function(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  494. TglReadPixels = procedure(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  495. TglPixelStorei = procedure(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  496. 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}
  497. 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}
  498. TglGetTexImage = procedure(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  499. TgluBuild1DMipmaps = function(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  500. TgluBuild2DMipmaps = function(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  501. {$ELSEIF DEFINED(GLB_NATIVE_OGL_STATIC)}
  502. procedure glEnable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  503. procedure glDisable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  504. function glGetString(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  505. procedure glGetIntegerv(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  506. procedure glTexParameteri(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  507. procedure glTexParameterfv(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  508. procedure glGetTexParameteriv(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  509. procedure glGetTexParameterfv(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  510. procedure glGetTexLevelParameteriv(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  511. procedure glGetTexLevelParameterfv(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  512. procedure glGenTextures(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  513. procedure glBindTexture(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  514. procedure glDeleteTextures(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  515. function glAreTexturesResident(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  516. 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;
  517. procedure glPixelStorei(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  518. 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;
  519. 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;
  520. procedure glGetTexImage(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  521. function gluBuild1DMipmaps(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
  522. function gluBuild2DMipmaps(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
  523. {$IFEND}
  524. var
  525. GL_VERSION_1_2,
  526. GL_VERSION_1_3,
  527. GL_VERSION_1_4,
  528. GL_VERSION_2_0,
  529. GL_SGIS_generate_mipmap,
  530. GL_ARB_texture_border_clamp,
  531. GL_ARB_texture_mirrored_repeat,
  532. GL_ARB_texture_rectangle,
  533. GL_ARB_texture_non_power_of_two,
  534. GL_IBM_texture_mirrored_repeat,
  535. GL_NV_texture_rectangle,
  536. GL_EXT_texture_edge_clamp,
  537. GL_EXT_texture_rectangle,
  538. GL_EXT_texture_filter_anisotropic: Boolean;
  539. glCompressedTexImage1D: TglCompressedTexImage1D;
  540. glCompressedTexImage2D: TglCompressedTexImage2D;
  541. glGetCompressedTexImage: TglGetCompressedTexImage;
  542. {$IF DEFINED(GLB_WIN)}
  543. wglGetProcAddress: TwglGetProcAddress;
  544. {$ELSEIF DEFINED(GLB_LINUX)}
  545. glXGetProcAddress: TglXGetProcAddress;
  546. glXGetProcAddressARB: TglXGetProcAddress;
  547. {$IFEND}
  548. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  549. glEnable: TglEnable;
  550. glDisable: TglDisable;
  551. glGetString: TglGetString;
  552. glGetIntegerv: TglGetIntegerv;
  553. glTexParameteri: TglTexParameteri;
  554. glTexParameterfv: TglTexParameterfv;
  555. glGetTexParameteriv: TglGetTexParameteriv;
  556. glGetTexParameterfv: TglGetTexParameterfv;
  557. glGetTexLevelParameteriv: TglGetTexLevelParameteriv;
  558. glGetTexLevelParameterfv: TglGetTexLevelParameterfv;
  559. glGenTextures: TglGenTextures;
  560. glBindTexture: TglBindTexture;
  561. glDeleteTextures: TglDeleteTextures;
  562. glAreTexturesResident: TglAreTexturesResident;
  563. glReadPixels: TglReadPixels;
  564. glPixelStorei: TglPixelStorei;
  565. glTexImage1D: TglTexImage1D;
  566. glTexImage2D: TglTexImage2D;
  567. glGetTexImage: TglGetTexImage;
  568. gluBuild1DMipmaps: TgluBuild1DMipmaps;
  569. gluBuild2DMipmaps: TgluBuild2DMipmaps;
  570. {$ENDIF}
  571. {$ENDIF}
  572. type
  573. ////////////////////////////////////////////////////////////////////////////////////////////////////
  574. TglBitmapFormat = (
  575. tfEmpty = 0, //must be smallest value!
  576. tfAlpha4,
  577. tfAlpha8,
  578. tfAlpha12,
  579. tfAlpha16,
  580. tfLuminance4,
  581. tfLuminance8,
  582. tfLuminance12,
  583. tfLuminance16,
  584. tfLuminance4Alpha4,
  585. tfLuminance6Alpha2,
  586. tfLuminance8Alpha8,
  587. tfLuminance12Alpha4,
  588. tfLuminance12Alpha12,
  589. tfLuminance16Alpha16,
  590. tfR3G3B2,
  591. tfRGB4,
  592. tfR5G6B5,
  593. tfRGB5,
  594. tfRGB8,
  595. tfRGB10,
  596. tfRGB12,
  597. tfRGB16,
  598. tfRGBA2,
  599. tfRGBA4,
  600. tfRGB5A1,
  601. tfRGBA8,
  602. tfRGB10A2,
  603. tfRGBA12,
  604. tfRGBA16,
  605. tfBGR4,
  606. tfB5G6R5,
  607. tfBGR5,
  608. tfBGR8,
  609. tfBGR10,
  610. tfBGR12,
  611. tfBGR16,
  612. tfBGRA2,
  613. tfBGRA4,
  614. tfBGR5A1,
  615. tfBGRA8,
  616. tfBGR10A2,
  617. tfBGRA12,
  618. tfBGRA16,
  619. tfDepth16,
  620. tfDepth24,
  621. tfDepth32,
  622. tfS3tcDtx1RGBA,
  623. tfS3tcDtx3RGBA,
  624. tfS3tcDtx5RGBA
  625. );
  626. TglBitmapFileType = (
  627. {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG, {$ENDIF}
  628. {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
  629. ftDDS,
  630. ftTGA,
  631. ftBMP);
  632. TglBitmapFileTypes = set of TglBitmapFileType;
  633. TglBitmapMipMap = (
  634. mmNone,
  635. mmMipmap,
  636. mmMipmapGlu);
  637. TglBitmapNormalMapFunc = (
  638. nm4Samples,
  639. nmSobel,
  640. nm3x3,
  641. nm5x5);
  642. ////////////////////////////////////////////////////////////////////////////////////////////////////
  643. EglBitmapException = class(Exception);
  644. EglBitmapSizeToLargeException = class(EglBitmapException);
  645. EglBitmapNonPowerOfTwoException = class(EglBitmapException);
  646. EglBitmapUnsupportedFormat = class(EglBitmapException)
  647. constructor Create(const aFormat: TglBitmapFormat); overload;
  648. constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;
  649. end;
  650. ////////////////////////////////////////////////////////////////////////////////////////////////////
  651. TglBitmapColorRec = packed record
  652. case Integer of
  653. 0: (r, g, b, a: Cardinal);
  654. 1: (arr: array[0..3] of Cardinal);
  655. end;
  656. TglBitmapPixelData = packed record
  657. Data, Range: TglBitmapColorRec;
  658. Format: TglBitmapFormat;
  659. end;
  660. PglBitmapPixelData = ^TglBitmapPixelData;
  661. ////////////////////////////////////////////////////////////////////////////////////////////////////
  662. TglBitmapPixelPositionFields = set of (ffX, ffY);
  663. TglBitmapPixelPosition = record
  664. Fields : TglBitmapPixelPositionFields;
  665. X : Word;
  666. Y : Word;
  667. end;
  668. ////////////////////////////////////////////////////////////////////////////////////////////////////
  669. TglBitmap = class;
  670. TglBitmapFunctionRec = record
  671. Sender: TglBitmap;
  672. Size: TglBitmapPixelPosition;
  673. Position: TglBitmapPixelPosition;
  674. Source: TglBitmapPixelData;
  675. Dest: TglBitmapPixelData;
  676. Args: Pointer;
  677. end;
  678. TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
  679. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  680. TglBitmap = class
  681. protected
  682. fID: GLuint;
  683. fTarget: GLuint;
  684. fAnisotropic: Integer;
  685. fDeleteTextureOnFree: Boolean;
  686. fFreeDataAfterGenTexture: Boolean;
  687. fData: PByte;
  688. fIsResident: Boolean;
  689. fBorderColor: array[0..3] of Single;
  690. fDimension: TglBitmapPixelPosition;
  691. fMipMap: TglBitmapMipMap;
  692. fFormat: TglBitmapFormat;
  693. // Mapping
  694. fPixelSize: Integer;
  695. fRowSize: Integer;
  696. // Filtering
  697. fFilterMin: Cardinal;
  698. fFilterMag: Cardinal;
  699. // TexturWarp
  700. fWrapS: Cardinal;
  701. fWrapT: Cardinal;
  702. fWrapR: Cardinal;
  703. // CustomData
  704. fFilename: String;
  705. fCustomName: String;
  706. fCustomNameW: WideString;
  707. fCustomData: Pointer;
  708. //Getter
  709. function GetWidth: Integer; virtual;
  710. function GetHeight: Integer; virtual;
  711. function GetFileWidth: Integer; virtual;
  712. function GetFileHeight: Integer; virtual;
  713. //Setter
  714. procedure SetCustomData(const aValue: Pointer);
  715. procedure SetCustomName(const aValue: String);
  716. procedure SetCustomNameW(const aValue: WideString);
  717. procedure SetDeleteTextureOnFree(const aValue: Boolean);
  718. procedure SetFormat(const aValue: TglBitmapFormat);
  719. procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
  720. procedure SetID(const aValue: Cardinal);
  721. procedure SetMipMap(const aValue: TglBitmapMipMap);
  722. procedure SetTarget(const aValue: Cardinal);
  723. procedure SetAnisotropic(const aValue: Integer);
  724. procedure CreateID;
  725. procedure SetupParameters(out aBuildWithGlu: Boolean);
  726. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  727. const aWidth: Integer = -1; const aHeight: Integer = -1); virtual; //be careful, aData could be freed by this method
  728. procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
  729. function FlipHorz: Boolean; virtual;
  730. function FlipVert: Boolean; virtual;
  731. property Width: Integer read GetWidth;
  732. property Height: Integer read GetHeight;
  733. property FileWidth: Integer read GetFileWidth;
  734. property FileHeight: Integer read GetFileHeight;
  735. public
  736. //Properties
  737. property ID: Cardinal read fID write SetID;
  738. property Target: Cardinal read fTarget write SetTarget;
  739. property Format: TglBitmapFormat read fFormat write SetFormat;
  740. property MipMap: TglBitmapMipMap read fMipMap write SetMipMap;
  741. property Anisotropic: Integer read fAnisotropic write SetAnisotropic;
  742. property Filename: String read fFilename;
  743. property CustomName: String read fCustomName write SetCustomName;
  744. property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
  745. property CustomData: Pointer read fCustomData write SetCustomData;
  746. property DeleteTextureOnFree: Boolean read fDeleteTextureOnFree write SetDeleteTextureOnFree;
  747. property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
  748. property Dimension: TglBitmapPixelPosition read fDimension;
  749. property Data: PByte read fData;
  750. property IsResident: Boolean read fIsResident;
  751. procedure AfterConstruction; override;
  752. procedure BeforeDestruction; override;
  753. procedure PrepareResType(var aResource: String; var aResType: PChar);
  754. //Load
  755. procedure LoadFromFile(const aFilename: String);
  756. procedure LoadFromStream(const aStream: TStream); virtual;
  757. procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  758. const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
  759. procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
  760. procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  761. //Save
  762. procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  763. procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
  764. //Convert
  765. function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
  766. function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  767. const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
  768. public
  769. //Alpha & Co
  770. {$IFDEF GLB_SDL}
  771. function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  772. function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  773. function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  774. function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
  775. const aArgs: Pointer = nil): Boolean;
  776. {$ENDIF}
  777. {$IFDEF GLB_DELPHI}
  778. function AssignToBitmap(const aBitmap: TBitmap): Boolean;
  779. function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  780. function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  781. function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
  782. const aArgs: Pointer = nil): Boolean;
  783. {$ENDIF}
  784. {$IFDEF GLB_LAZARUS}
  785. function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  786. function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  787. function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  788. function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil;
  789. const aArgs: Pointer = nil): Boolean;
  790. {$ENDIF}
  791. function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil;
  792. const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  793. function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  794. const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  795. function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
  796. function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  797. function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  798. function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  799. function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
  800. function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
  801. function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
  802. function AddAlphaFromValue(const aAlpha: Byte): Boolean;
  803. function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  804. function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  805. function RemoveAlpha: Boolean; virtual;
  806. public
  807. //Common
  808. function Clone: TglBitmap;
  809. function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
  810. procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
  811. procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  812. procedure FreeData;
  813. //ColorFill
  814. procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
  815. procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
  816. procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
  817. //TexParameters
  818. procedure SetFilter(const aMin, aMag: Cardinal);
  819. procedure SetWrap(
  820. const S: Cardinal = GL_CLAMP_TO_EDGE;
  821. const T: Cardinal = GL_CLAMP_TO_EDGE;
  822. const R: Cardinal = GL_CLAMP_TO_EDGE);
  823. procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
  824. procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
  825. //Constructors
  826. constructor Create; overload;
  827. constructor Create(const aFileName: String); overload;
  828. constructor Create(const aStream: TStream); overload;
  829. constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat); overload;
  830. constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
  831. constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
  832. constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
  833. private
  834. {$IFDEF GLB_SUPPORT_PNG_READ} function LoadPNG(const aStream: TStream): Boolean; virtual; {$ENDIF}
  835. {$ifdef GLB_SUPPORT_PNG_WRITE} procedure SavePNG(const aStream: TStream); virtual; {$ENDIF}
  836. {$IFDEF GLB_SUPPORT_JPEG_READ} function LoadJPEG(const aStream: TStream): Boolean; virtual; {$ENDIF}
  837. {$IFDEF GLB_SUPPORT_JPEG_WRITE} procedure SaveJPEG(const aStream: TStream); virtual; {$ENDIF}
  838. function LoadBMP(const aStream: TStream): Boolean; virtual;
  839. procedure SaveBMP(const aStream: TStream); virtual;
  840. function LoadTGA(const aStream: TStream): Boolean; virtual;
  841. procedure SaveTGA(const aStream: TStream); virtual;
  842. function LoadDDS(const aStream: TStream): Boolean; virtual;
  843. procedure SaveDDS(const aStream: TStream); virtual;
  844. end;
  845. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  846. TglBitmap1D = class(TglBitmap)
  847. protected
  848. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  849. const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
  850. procedure UploadData(const aBuildWithGlu: Boolean);
  851. public
  852. property Width;
  853. procedure AfterConstruction; override;
  854. function FlipHorz: Boolean; override;
  855. procedure GenTexture(const aTestTextureSize: Boolean = true); override;
  856. end;
  857. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  858. TglBitmap2D = class(TglBitmap)
  859. protected
  860. fLines: array of PByte;
  861. function GetScanline(const aIndex: Integer): Pointer;
  862. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  863. const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
  864. procedure UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
  865. public
  866. property Width;
  867. property Height;
  868. property Scanline[const aIndex: Integer]: Pointer read GetScanline;
  869. procedure AfterConstruction; override;
  870. procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  871. procedure GetDataFromTexture;
  872. procedure GenTexture(const aTestTextureSize: Boolean = true); override;
  873. function FlipHorz: Boolean; override;
  874. function FlipVert: Boolean; override;
  875. procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
  876. const aScale: Single = 2; const aUseAlpha: Boolean = false);
  877. end;
  878. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  879. TglBitmapCubeMap = class(TglBitmap2D)
  880. protected
  881. fGenMode: Integer;
  882. procedure GenTexture(const aTestTextureSize: Boolean = true); reintroduce;
  883. public
  884. procedure AfterConstruction; override;
  885. procedure GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean = true);
  886. procedure Bind(const aEnableTexCoordsGen: Boolean = true; const aEnableTextureUnit: Boolean = true); reintroduce; virtual;
  887. procedure Unbind(const aDisableTexCoordsGen: Boolean = true; const aDisableTextureUnit: Boolean = true); reintroduce; virtual;
  888. end;
  889. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  890. TglBitmapNormalMap = class(TglBitmapCubeMap)
  891. public
  892. procedure AfterConstruction; override;
  893. procedure GenerateNormalMap(const aSize: Integer = 32; const aTestTextureSize: Boolean = true);
  894. end;
  895. const
  896. NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
  897. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  898. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  899. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  900. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  901. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  902. procedure glBitmapSetDefaultWrap(
  903. const S: Cardinal = GL_CLAMP_TO_EDGE;
  904. const T: Cardinal = GL_CLAMP_TO_EDGE;
  905. const R: Cardinal = GL_CLAMP_TO_EDGE);
  906. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  907. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  908. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  909. function glBitmapGetDefaultFormat: TglBitmapFormat;
  910. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  911. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  912. function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
  913. function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
  914. function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
  915. var
  916. glBitmapDefaultDeleteTextureOnFree: Boolean;
  917. glBitmapDefaultFreeDataAfterGenTextures: Boolean;
  918. glBitmapDefaultFormat: TglBitmapFormat;
  919. glBitmapDefaultMipmap: TglBitmapMipMap;
  920. glBitmapDefaultFilterMin: Cardinal;
  921. glBitmapDefaultFilterMag: Cardinal;
  922. glBitmapDefaultWrapS: Cardinal;
  923. glBitmapDefaultWrapT: Cardinal;
  924. glBitmapDefaultWrapR: Cardinal;
  925. {$IFDEF GLB_DELPHI}
  926. function CreateGrayPalette: HPALETTE;
  927. {$ENDIF}
  928. implementation
  929. uses
  930. Math, syncobjs, typinfo;
  931. type
  932. {$IFNDEF fpc}
  933. QWord = System.UInt64;
  934. PQWord = ^QWord;
  935. PtrInt = Longint;
  936. PtrUInt = DWord;
  937. {$ENDIF}
  938. ////////////////////////////////////////////////////////////////////////////////////////////////////
  939. TShiftRec = packed record
  940. case Integer of
  941. 0: (r, g, b, a: Byte);
  942. 1: (arr: array[0..3] of Byte);
  943. end;
  944. TFormatDescriptor = class(TObject)
  945. private
  946. function GetRedMask: QWord;
  947. function GetGreenMask: QWord;
  948. function GetBlueMask: QWord;
  949. function GetAlphaMask: QWord;
  950. protected
  951. fFormat: TglBitmapFormat;
  952. fWithAlpha: TglBitmapFormat;
  953. fWithoutAlpha: TglBitmapFormat;
  954. fRGBInverted: TglBitmapFormat;
  955. fUncompressed: TglBitmapFormat;
  956. fPixelSize: Single;
  957. fIsCompressed: Boolean;
  958. fRange: TglBitmapColorRec;
  959. fShift: TShiftRec;
  960. fglFormat: Cardinal;
  961. fglInternalFormat: Cardinal;
  962. fglDataFormat: Cardinal;
  963. function GetComponents: Integer; virtual;
  964. public
  965. property Format: TglBitmapFormat read fFormat;
  966. property WithAlpha: TglBitmapFormat read fWithAlpha;
  967. property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;
  968. property RGBInverted: TglBitmapFormat read fRGBInverted;
  969. property Components: Integer read GetComponents;
  970. property PixelSize: Single read fPixelSize;
  971. property IsCompressed: Boolean read fIsCompressed;
  972. property glFormat: Cardinal read fglFormat;
  973. property glInternalFormat: Cardinal read fglInternalFormat;
  974. property glDataFormat: Cardinal read fglDataFormat;
  975. property Range: TglBitmapColorRec read fRange;
  976. property Shift: TShiftRec read fShift;
  977. property RedMask: QWord read GetRedMask;
  978. property GreenMask: QWord read GetGreenMask;
  979. property BlueMask: QWord read GetBlueMask;
  980. property AlphaMask: QWord read GetAlphaMask;
  981. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
  982. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
  983. function GetSize(const aSize: TglBitmapPixelPosition): Integer; overload; virtual;
  984. function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
  985. function CreateMappingData: Pointer; virtual;
  986. procedure FreeMappingData(var aMappingData: Pointer); virtual;
  987. function IsEmpty: Boolean; virtual;
  988. function HasAlpha: Boolean; virtual;
  989. function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean; virtual;
  990. procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
  991. constructor Create; virtual;
  992. public
  993. class procedure Init;
  994. class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  995. class function GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  996. class procedure Clear;
  997. class procedure Finalize;
  998. end;
  999. TFormatDescriptorClass = class of TFormatDescriptor;
  1000. TfdEmpty = class(TFormatDescriptor);
  1001. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1002. TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1003. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1004. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1005. constructor Create; override;
  1006. end;
  1007. TfdLuminance_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1008. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1009. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1010. constructor Create; override;
  1011. end;
  1012. TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1013. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1014. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1015. constructor Create; override;
  1016. end;
  1017. TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte
  1018. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1019. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1020. constructor Create; override;
  1021. end;
  1022. TfdRGB_UB3 = class(TFormatDescriptor) //3* unsigned byte
  1023. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1024. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1025. constructor Create; override;
  1026. end;
  1027. TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
  1028. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1029. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1030. constructor Create; override;
  1031. end;
  1032. TfdRGBA_UB4 = class(TfdRGB_UB3) //4* unsigned byte
  1033. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1034. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1035. constructor Create; override;
  1036. end;
  1037. TfdBGRA_UB4 = class(TfdBGR_UB3) //4* unsigned byte (inverse)
  1038. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1039. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1040. constructor Create; override;
  1041. end;
  1042. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1043. TfdAlpha_US1 = class(TFormatDescriptor) //1* unsigned short
  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_US1 = class(TFormatDescriptor) //1* unsigned short
  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_US1 = class(TFormatDescriptor) //1* unsigned short
  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. TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short
  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. TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short
  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. TfdRGB_US3 = class(TFormatDescriptor) //3* unsigned short
  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. TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)
  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. TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
  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. TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
  1084. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1085. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1086. constructor Create; override;
  1087. end;
  1088. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1089. TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int
  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. TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int
  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. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1100. TfdAlpha4 = class(TfdAlpha_UB1)
  1101. constructor Create; override;
  1102. end;
  1103. TfdAlpha8 = class(TfdAlpha_UB1)
  1104. constructor Create; override;
  1105. end;
  1106. TfdAlpha12 = class(TfdAlpha_US1)
  1107. constructor Create; override;
  1108. end;
  1109. TfdAlpha16 = class(TfdAlpha_US1)
  1110. constructor Create; override;
  1111. end;
  1112. TfdLuminance4 = class(TfdLuminance_UB1)
  1113. constructor Create; override;
  1114. end;
  1115. TfdLuminance8 = class(TfdLuminance_UB1)
  1116. constructor Create; override;
  1117. end;
  1118. TfdLuminance12 = class(TfdLuminance_US1)
  1119. constructor Create; override;
  1120. end;
  1121. TfdLuminance16 = class(TfdLuminance_US1)
  1122. constructor Create; override;
  1123. end;
  1124. TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
  1125. constructor Create; override;
  1126. end;
  1127. TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
  1128. constructor Create; override;
  1129. end;
  1130. TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
  1131. constructor Create; override;
  1132. end;
  1133. TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
  1134. constructor Create; override;
  1135. end;
  1136. TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)
  1137. constructor Create; override;
  1138. end;
  1139. TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
  1140. constructor Create; override;
  1141. end;
  1142. TfdR3G3B2 = class(TfdUniversal_UB1)
  1143. constructor Create; override;
  1144. end;
  1145. TfdRGB4 = class(TfdUniversal_US1)
  1146. constructor Create; override;
  1147. end;
  1148. TfdR5G6B5 = class(TfdUniversal_US1)
  1149. constructor Create; override;
  1150. end;
  1151. TfdRGB5 = class(TfdUniversal_US1)
  1152. constructor Create; override;
  1153. end;
  1154. TfdRGB8 = class(TfdRGB_UB3)
  1155. constructor Create; override;
  1156. end;
  1157. TfdRGB10 = class(TfdUniversal_UI1)
  1158. constructor Create; override;
  1159. end;
  1160. TfdRGB12 = class(TfdRGB_US3)
  1161. constructor Create; override;
  1162. end;
  1163. TfdRGB16 = class(TfdRGB_US3)
  1164. constructor Create; override;
  1165. end;
  1166. TfdRGBA2 = class(TfdRGBA_UB4)
  1167. constructor Create; override;
  1168. end;
  1169. TfdRGBA4 = class(TfdUniversal_US1)
  1170. constructor Create; override;
  1171. end;
  1172. TfdRGB5A1 = class(TfdUniversal_US1)
  1173. constructor Create; override;
  1174. end;
  1175. TfdRGBA8 = class(TfdRGBA_UB4)
  1176. constructor Create; override;
  1177. end;
  1178. TfdRGB10A2 = class(TfdUniversal_UI1)
  1179. constructor Create; override;
  1180. end;
  1181. TfdRGBA12 = class(TfdRGBA_US4)
  1182. constructor Create; override;
  1183. end;
  1184. TfdRGBA16 = class(TfdRGBA_US4)
  1185. constructor Create; override;
  1186. end;
  1187. TfdBGR4 = class(TfdUniversal_US1)
  1188. constructor Create; override;
  1189. end;
  1190. TfdB5G6R5 = class(TfdUniversal_US1)
  1191. constructor Create; override;
  1192. end;
  1193. TfdBGR5 = class(TfdUniversal_US1)
  1194. constructor Create; override;
  1195. end;
  1196. TfdBGR8 = class(TfdBGR_UB3)
  1197. constructor Create; override;
  1198. end;
  1199. TfdBGR10 = class(TfdUniversal_UI1)
  1200. constructor Create; override;
  1201. end;
  1202. TfdBGR12 = class(TfdBGR_US3)
  1203. constructor Create; override;
  1204. end;
  1205. TfdBGR16 = class(TfdBGR_US3)
  1206. constructor Create; override;
  1207. end;
  1208. TfdBGRA2 = class(TfdBGRA_UB4)
  1209. constructor Create; override;
  1210. end;
  1211. TfdBGRA4 = class(TfdUniversal_US1)
  1212. constructor Create; override;
  1213. end;
  1214. TfdBGR5A1 = class(TfdUniversal_US1)
  1215. constructor Create; override;
  1216. end;
  1217. TfdBGRA8 = class(TfdBGRA_UB4)
  1218. constructor Create; override;
  1219. end;
  1220. TfdBGR10A2 = class(TfdUniversal_UI1)
  1221. constructor Create; override;
  1222. end;
  1223. TfdBGRA12 = class(TfdBGRA_US4)
  1224. constructor Create; override;
  1225. end;
  1226. TfdBGRA16 = class(TfdBGRA_US4)
  1227. constructor Create; override;
  1228. end;
  1229. TfdDepth16 = class(TfdDepth_US1)
  1230. constructor Create; override;
  1231. end;
  1232. TfdDepth24 = class(TfdDepth_UI1)
  1233. constructor Create; override;
  1234. end;
  1235. TfdDepth32 = class(TfdDepth_UI1)
  1236. constructor Create; override;
  1237. end;
  1238. TfdS3tcDtx1RGBA = class(TFormatDescriptor)
  1239. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1240. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1241. constructor Create; override;
  1242. end;
  1243. TfdS3tcDtx3RGBA = class(TFormatDescriptor)
  1244. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1245. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1246. constructor Create; override;
  1247. end;
  1248. TfdS3tcDtx5RGBA = class(TFormatDescriptor)
  1249. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1250. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1251. constructor Create; override;
  1252. end;
  1253. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1254. TbmpBitfieldFormat = class(TFormatDescriptor)
  1255. private
  1256. procedure SetRedMask (const aValue: QWord);
  1257. procedure SetGreenMask(const aValue: QWord);
  1258. procedure SetBlueMask (const aValue: QWord);
  1259. procedure SetAlphaMask(const aValue: QWord);
  1260. procedure Update(aMask: QWord; out aRange: Cardinal; out aShift: Byte);
  1261. public
  1262. property RedMask: QWord read GetRedMask write SetRedMask;
  1263. property GreenMask: QWord read GetGreenMask write SetGreenMask;
  1264. property BlueMask: QWord read GetBlueMask write SetBlueMask;
  1265. property AlphaMask: QWord read GetAlphaMask write SetAlphaMask;
  1266. property PixelSize: Single read fPixelSize write fPixelSize;
  1267. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1268. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1269. end;
  1270. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1271. TbmpColorTableEnty = packed record
  1272. b, g, r, a: Byte;
  1273. end;
  1274. TbmpColorTable = array of TbmpColorTableEnty;
  1275. TbmpColorTableFormat = class(TFormatDescriptor)
  1276. private
  1277. fColorTable: TbmpColorTable;
  1278. public
  1279. property PixelSize: Single read fPixelSize write fPixelSize;
  1280. property ColorTable: TbmpColorTable read fColorTable write fColorTable;
  1281. property Range: TglBitmapColorRec read fRange write fRange;
  1282. property Shift: TShiftRec read fShift write fShift;
  1283. property Format: TglBitmapFormat read fFormat write fFormat;
  1284. procedure CreateColorTable;
  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. destructor Destroy; override;
  1288. end;
  1289. const
  1290. LUMINANCE_WEIGHT_R = 0.30;
  1291. LUMINANCE_WEIGHT_G = 0.59;
  1292. LUMINANCE_WEIGHT_B = 0.11;
  1293. ALPHA_WEIGHT_R = 0.30;
  1294. ALPHA_WEIGHT_G = 0.59;
  1295. ALPHA_WEIGHT_B = 0.11;
  1296. DEPTH_WEIGHT_R = 0.333333333;
  1297. DEPTH_WEIGHT_G = 0.333333333;
  1298. DEPTH_WEIGHT_B = 0.333333333;
  1299. UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
  1300. FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
  1301. TfdEmpty,
  1302. TfdAlpha4,
  1303. TfdAlpha8,
  1304. TfdAlpha12,
  1305. TfdAlpha16,
  1306. TfdLuminance4,
  1307. TfdLuminance8,
  1308. TfdLuminance12,
  1309. TfdLuminance16,
  1310. TfdLuminance4Alpha4,
  1311. TfdLuminance6Alpha2,
  1312. TfdLuminance8Alpha8,
  1313. TfdLuminance12Alpha4,
  1314. TfdLuminance12Alpha12,
  1315. TfdLuminance16Alpha16,
  1316. TfdR3G3B2,
  1317. TfdRGB4,
  1318. TfdR5G6B5,
  1319. TfdRGB5,
  1320. TfdRGB8,
  1321. TfdRGB10,
  1322. TfdRGB12,
  1323. TfdRGB16,
  1324. TfdRGBA2,
  1325. TfdRGBA4,
  1326. TfdRGB5A1,
  1327. TfdRGBA8,
  1328. TfdRGB10A2,
  1329. TfdRGBA12,
  1330. TfdRGBA16,
  1331. TfdBGR4,
  1332. TfdB5G6R5,
  1333. TfdBGR5,
  1334. TfdBGR8,
  1335. TfdBGR10,
  1336. TfdBGR12,
  1337. TfdBGR16,
  1338. TfdBGRA2,
  1339. TfdBGRA4,
  1340. TfdBGR5A1,
  1341. TfdBGRA8,
  1342. TfdBGR10A2,
  1343. TfdBGRA12,
  1344. TfdBGRA16,
  1345. TfdDepth16,
  1346. TfdDepth24,
  1347. TfdDepth32,
  1348. TfdS3tcDtx1RGBA,
  1349. TfdS3tcDtx3RGBA,
  1350. TfdS3tcDtx5RGBA
  1351. );
  1352. var
  1353. FormatDescriptorCS: TCriticalSection;
  1354. FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
  1355. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1356. constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
  1357. begin
  1358. inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1359. end;
  1360. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1361. constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
  1362. begin
  1363. inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1364. end;
  1365. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1366. function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
  1367. begin
  1368. result.Fields := [];
  1369. if X >= 0 then
  1370. result.Fields := result.Fields + [ffX];
  1371. if Y >= 0 then
  1372. result.Fields := result.Fields + [ffY];
  1373. result.X := Max(0, X);
  1374. result.Y := Max(0, Y);
  1375. end;
  1376. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1377. function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
  1378. begin
  1379. result.r := r;
  1380. result.g := g;
  1381. result.b := b;
  1382. result.a := a;
  1383. end;
  1384. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1385. function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
  1386. var
  1387. i: Integer;
  1388. begin
  1389. result := false;
  1390. for i := 0 to high(r1.arr) do
  1391. if (r1.arr[i] <> r2.arr[i]) then
  1392. exit;
  1393. result := true;
  1394. end;
  1395. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1396. function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
  1397. begin
  1398. result.r := r;
  1399. result.g := g;
  1400. result.b := b;
  1401. result.a := a;
  1402. end;
  1403. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1404. function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
  1405. begin
  1406. result := [];
  1407. if (aFormat in [
  1408. //4 bbp
  1409. tfLuminance4,
  1410. //8bpp
  1411. tfR3G3B2, tfLuminance8,
  1412. //16bpp
  1413. tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
  1414. tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,
  1415. //24bpp
  1416. tfBGR8, tfRGB8,
  1417. //32bpp
  1418. tfRGB10, tfRGB10A2, tfRGBA8,
  1419. tfBGR10, tfBGR10A2, tfBGRA8]) then
  1420. result := result + [ftBMP];
  1421. if (aFormat in [
  1422. //8 bpp
  1423. tfLuminance8, tfAlpha8,
  1424. //16 bpp
  1425. tfLuminance16, tfLuminance8Alpha8,
  1426. tfRGB5, tfRGB5A1, tfRGBA4,
  1427. tfBGR5, tfBGR5A1, tfBGRA4,
  1428. //24 bpp
  1429. tfRGB8, tfBGR8,
  1430. //32 bpp
  1431. tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
  1432. result := result + [ftTGA];
  1433. if (aFormat in [
  1434. //8 bpp
  1435. tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,
  1436. tfR3G3B2, tfRGBA2, tfBGRA2,
  1437. //16 bpp
  1438. tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,
  1439. tfRGB4, tfR5G6B5, tfRGB5, tfRGBA4, tfRGB5A1,
  1440. tfBGR4, tfB5G6R5, tfBGR5, tfBGRA4, tfBGR5A1,
  1441. //24 bpp
  1442. tfRGB8, tfBGR8,
  1443. //32 bbp
  1444. tfLuminance16Alpha16,
  1445. tfRGBA8, tfRGB10A2,
  1446. tfBGRA8, tfBGR10A2,
  1447. //compressed
  1448. tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then
  1449. result := result + [ftDDS];
  1450. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  1451. if aFormat in [
  1452. tfAlpha8, tfLuminance8, tfLuminance8Alpha8,
  1453. tfRGB8, tfRGBA8,
  1454. tfBGR8, tfBGRA8] then
  1455. result := result + [ftPNG];
  1456. {$ENDIF}
  1457. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  1458. if aFormat in [tfAlpha8, tfLuminance8, tfRGB8, tfBGR8] then
  1459. result := result + [ftJPEG];
  1460. {$ENDIF}
  1461. end;
  1462. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1463. function IsPowerOfTwo(aNumber: Integer): Boolean;
  1464. begin
  1465. while (aNumber and 1) = 0 do
  1466. aNumber := aNumber shr 1;
  1467. result := aNumber = 1;
  1468. end;
  1469. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1470. function GetTopMostBit(aBitSet: QWord): Integer;
  1471. begin
  1472. result := 0;
  1473. while aBitSet > 0 do begin
  1474. inc(result);
  1475. aBitSet := aBitSet shr 1;
  1476. end;
  1477. end;
  1478. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1479. function CountSetBits(aBitSet: QWord): Integer;
  1480. begin
  1481. result := 0;
  1482. while aBitSet > 0 do begin
  1483. if (aBitSet and 1) = 1 then
  1484. inc(result);
  1485. aBitSet := aBitSet shr 1;
  1486. end;
  1487. end;
  1488. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1489. function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1490. begin
  1491. result := Trunc(
  1492. LUMINANCE_WEIGHT_R * aPixel.Data.r +
  1493. LUMINANCE_WEIGHT_G * aPixel.Data.g +
  1494. LUMINANCE_WEIGHT_B * aPixel.Data.b);
  1495. end;
  1496. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1497. function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1498. begin
  1499. result := Trunc(
  1500. DEPTH_WEIGHT_R * aPixel.Data.r +
  1501. DEPTH_WEIGHT_G * aPixel.Data.g +
  1502. DEPTH_WEIGHT_B * aPixel.Data.b);
  1503. end;
  1504. {$IFDEF GLB_NATIVE_OGL}
  1505. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1506. //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1507. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1508. var
  1509. GL_LibHandle: Pointer = nil;
  1510. function glbGetProcAddress(aProcName: PChar; aLibHandle: Pointer = nil): Pointer;
  1511. begin
  1512. if not Assigned(aLibHandle) then
  1513. aLibHandle := GL_LibHandle;
  1514. {$IF DEFINED(GLB_WIN)}
  1515. result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
  1516. if Assigned(result) then
  1517. exit;
  1518. if Assigned(wglGetProcAddress) then
  1519. result := wglGetProcAddress(aProcName);
  1520. {$ELSEIF DEFINED(GLB_LINUX)}
  1521. if Assigned(glXGetProcAddress) then begin
  1522. result := glXGetProcAddress(aProcName);
  1523. if Assigned(result) then
  1524. exit;
  1525. end;
  1526. if Assigned(glXGetProcAddressARB) then begin
  1527. result := glXGetProcAddressARB(aProcName);
  1528. if Assigned(result) then
  1529. exit;
  1530. end;
  1531. result := dlsym(aLibHandle, aProcName);
  1532. {$IFEND}
  1533. if not Assigned(result) then
  1534. raise EglBitmapException.Create('unable to load procedure form library: ' + aProcName);
  1535. end;
  1536. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  1537. var
  1538. GLU_LibHandle: Pointer = nil;
  1539. OpenGLInitialized: Boolean;
  1540. InitOpenGLCS: TCriticalSection;
  1541. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1542. procedure glbInitOpenGL;
  1543. ////////////////////////////////////////////////////////////////////////////////
  1544. function glbLoadLibrary(const aName: PChar): Pointer;
  1545. begin
  1546. {$IF DEFINED(GLB_WIN)}
  1547. result := {%H-}Pointer(LoadLibrary(aName));
  1548. {$ELSEIF DEFINED(GLB_LINUX)}
  1549. result := dlopen(Name, RTLD_LAZY);
  1550. {$ELSE}
  1551. result := nil;
  1552. {$IFEND}
  1553. end;
  1554. ////////////////////////////////////////////////////////////////////////////////
  1555. function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
  1556. begin
  1557. result := false;
  1558. if not Assigned(aLibHandle) then
  1559. exit;
  1560. {$IF DEFINED(GLB_WIN)}
  1561. Result := FreeLibrary({%H-}HINST(aLibHandle));
  1562. {$ELSEIF DEFINED(GLB_LINUX)}
  1563. Result := dlclose(aLibHandle) = 0;
  1564. {$IFEND}
  1565. end;
  1566. begin
  1567. if Assigned(GL_LibHandle) then
  1568. glbFreeLibrary(GL_LibHandle);
  1569. if Assigned(GLU_LibHandle) then
  1570. glbFreeLibrary(GLU_LibHandle);
  1571. GL_LibHandle := glbLoadLibrary(libopengl);
  1572. if not Assigned(GL_LibHandle) then
  1573. raise EglBitmapException.Create('unable to load library: ' + libopengl);
  1574. GLU_LibHandle := glbLoadLibrary(libglu);
  1575. if not Assigned(GLU_LibHandle) then
  1576. raise EglBitmapException.Create('unable to load library: ' + libglu);
  1577. try
  1578. {$IF DEFINED(GLB_WIN)}
  1579. wglGetProcAddress := glbGetProcAddress('wglGetProcAddress');
  1580. {$ELSEIF DEFINED(GLB_LINUX)}
  1581. glXGetProcAddress := glbGetProcAddress('glXGetProcAddress');
  1582. glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB');
  1583. {$IFEND}
  1584. glEnable := glbGetProcAddress('glEnable');
  1585. glDisable := glbGetProcAddress('glDisable');
  1586. glGetString := glbGetProcAddress('glGetString');
  1587. glGetIntegerv := glbGetProcAddress('glGetIntegerv');
  1588. glTexParameteri := glbGetProcAddress('glTexParameteri');
  1589. glTexParameterfv := glbGetProcAddress('glTexParameterfv');
  1590. glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
  1591. glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
  1592. glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
  1593. glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
  1594. glGenTextures := glbGetProcAddress('glGenTextures');
  1595. glBindTexture := glbGetProcAddress('glBindTexture');
  1596. glDeleteTextures := glbGetProcAddress('glDeleteTextures');
  1597. glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
  1598. glReadPixels := glbGetProcAddress('glReadPixels');
  1599. glPixelStorei := glbGetProcAddress('glPixelStorei');
  1600. glTexImage1D := glbGetProcAddress('glTexImage1D');
  1601. glTexImage2D := glbGetProcAddress('glTexImage2D');
  1602. glGetTexImage := glbGetProcAddress('glGetTexImage');
  1603. gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
  1604. gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
  1605. finally
  1606. glbFreeLibrary(GL_LibHandle);
  1607. glbFreeLibrary(GLU_LibHandle);
  1608. end;
  1609. end;
  1610. {$ENDIF}
  1611. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1612. procedure glbReadOpenGLExtensions;
  1613. var
  1614. Buffer: AnsiString;
  1615. MajorVersion, MinorVersion: Integer;
  1616. ///////////////////////////////////////////////////////////////////////////////////////////
  1617. procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
  1618. var
  1619. Separator: Integer;
  1620. begin
  1621. aMinor := 0;
  1622. aMajor := 0;
  1623. Separator := Pos(AnsiString('.'), aBuffer);
  1624. if (Separator > 1) and (Separator < Length(aBuffer)) and
  1625. (aBuffer[Separator - 1] in ['0'..'9']) and
  1626. (aBuffer[Separator + 1] in ['0'..'9']) then begin
  1627. Dec(Separator);
  1628. while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
  1629. Dec(Separator);
  1630. Delete(aBuffer, 1, Separator);
  1631. Separator := Pos(AnsiString('.'), aBuffer) + 1;
  1632. while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
  1633. Inc(Separator);
  1634. Delete(aBuffer, Separator, 255);
  1635. Separator := Pos(AnsiString('.'), aBuffer);
  1636. aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
  1637. aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
  1638. end;
  1639. end;
  1640. ///////////////////////////////////////////////////////////////////////////////////////////
  1641. function CheckExtension(const Extension: AnsiString): Boolean;
  1642. var
  1643. ExtPos: Integer;
  1644. begin
  1645. ExtPos := Pos(Extension, Buffer);
  1646. result := ExtPos > 0;
  1647. if result then
  1648. result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
  1649. end;
  1650. begin
  1651. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  1652. InitOpenGLCS.Enter;
  1653. try
  1654. if not OpenGLInitialized then begin
  1655. glbInitOpenGL;
  1656. OpenGLInitialized := true;
  1657. end;
  1658. finally
  1659. InitOpenGLCS.Leave;
  1660. end;
  1661. {$ENDIF}
  1662. // Version
  1663. Buffer := glGetString(GL_VERSION);
  1664. TrimVersionString(Buffer, MajorVersion, MinorVersion);
  1665. GL_VERSION_1_2 := false;
  1666. GL_VERSION_1_3 := false;
  1667. GL_VERSION_1_4 := false;
  1668. GL_VERSION_2_0 := false;
  1669. if MajorVersion = 1 then begin
  1670. if MinorVersion >= 2 then
  1671. GL_VERSION_1_2 := true;
  1672. if MinorVersion >= 3 then
  1673. GL_VERSION_1_3 := true;
  1674. if MinorVersion >= 4 then
  1675. GL_VERSION_1_4 := true;
  1676. end else if MajorVersion >= 2 then begin
  1677. GL_VERSION_1_2 := true;
  1678. GL_VERSION_1_3 := true;
  1679. GL_VERSION_1_4 := true;
  1680. GL_VERSION_2_0 := true;
  1681. end;
  1682. // Extensions
  1683. Buffer := glGetString(GL_EXTENSIONS);
  1684. GL_ARB_texture_border_clamp := CheckExtension('GL_ARB_texture_border_clamp');
  1685. GL_ARB_texture_non_power_of_two := CheckExtension('GL_ARB_texture_non_power_of_two');
  1686. GL_ARB_texture_rectangle := CheckExtension('GL_ARB_texture_rectangle');
  1687. GL_ARB_texture_mirrored_repeat := CheckExtension('GL_ARB_texture_mirrored_repeat');
  1688. GL_EXT_texture_edge_clamp := CheckExtension('GL_EXT_texture_edge_clamp');
  1689. GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
  1690. GL_EXT_texture_rectangle := CheckExtension('GL_EXT_texture_rectangle');
  1691. GL_NV_texture_rectangle := CheckExtension('GL_NV_texture_rectangle');
  1692. GL_IBM_texture_mirrored_repeat := CheckExtension('GL_IBM_texture_mirrored_repeat');
  1693. GL_SGIS_generate_mipmap := CheckExtension('GL_SGIS_generate_mipmap');
  1694. if GL_VERSION_1_3 then begin
  1695. glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1D');
  1696. glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2D');
  1697. glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
  1698. end else begin
  1699. glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1DARB');
  1700. glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2DARB');
  1701. glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB');
  1702. end;
  1703. end;
  1704. {$ENDIF}
  1705. {$IFDEF GLB_SDL_IMAGE}
  1706. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1707. // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1708. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1709. function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
  1710. begin
  1711. result := TStream(context^.unknown.data1).Seek(offset, whence);
  1712. end;
  1713. function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
  1714. begin
  1715. result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
  1716. end;
  1717. function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
  1718. begin
  1719. result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
  1720. end;
  1721. function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
  1722. begin
  1723. result := 0;
  1724. end;
  1725. function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
  1726. begin
  1727. result := SDL_AllocRW;
  1728. if result = nil then
  1729. raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
  1730. result^.seek := glBitmapRWseek;
  1731. result^.read := glBitmapRWread;
  1732. result^.write := glBitmapRWwrite;
  1733. result^.close := glBitmapRWclose;
  1734. result^.unknown.data1 := Stream;
  1735. end;
  1736. {$ENDIF}
  1737. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1738. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1739. begin
  1740. glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
  1741. end;
  1742. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1743. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1744. begin
  1745. glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
  1746. end;
  1747. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1748. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1749. begin
  1750. glBitmapDefaultMipmap := aValue;
  1751. end;
  1752. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1753. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1754. begin
  1755. glBitmapDefaultFormat := aFormat;
  1756. end;
  1757. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1758. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1759. begin
  1760. glBitmapDefaultFilterMin := aMin;
  1761. glBitmapDefaultFilterMag := aMag;
  1762. end;
  1763. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1764. procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
  1765. begin
  1766. glBitmapDefaultWrapS := S;
  1767. glBitmapDefaultWrapT := T;
  1768. glBitmapDefaultWrapR := R;
  1769. end;
  1770. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1771. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1772. begin
  1773. result := glBitmapDefaultDeleteTextureOnFree;
  1774. end;
  1775. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1776. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1777. begin
  1778. result := glBitmapDefaultFreeDataAfterGenTextures;
  1779. end;
  1780. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1781. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1782. begin
  1783. result := glBitmapDefaultMipmap;
  1784. end;
  1785. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1786. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1787. begin
  1788. result := glBitmapDefaultFormat;
  1789. end;
  1790. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1791. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  1792. begin
  1793. aMin := glBitmapDefaultFilterMin;
  1794. aMag := glBitmapDefaultFilterMag;
  1795. end;
  1796. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1797. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  1798. begin
  1799. S := glBitmapDefaultWrapS;
  1800. T := glBitmapDefaultWrapT;
  1801. R := glBitmapDefaultWrapR;
  1802. end;
  1803. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1804. //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1805. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1806. function TFormatDescriptor.GetRedMask: QWord;
  1807. begin
  1808. result := fRange.r shl fShift.r;
  1809. end;
  1810. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1811. function TFormatDescriptor.GetGreenMask: QWord;
  1812. begin
  1813. result := fRange.g shl fShift.g;
  1814. end;
  1815. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1816. function TFormatDescriptor.GetBlueMask: QWord;
  1817. begin
  1818. result := fRange.b shl fShift.b;
  1819. end;
  1820. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1821. function TFormatDescriptor.GetAlphaMask: QWord;
  1822. begin
  1823. result := fRange.a shl fShift.a;
  1824. end;
  1825. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1826. function TFormatDescriptor.GetComponents: Integer;
  1827. var
  1828. i: Integer;
  1829. begin
  1830. result := 0;
  1831. for i := 0 to 3 do
  1832. if (fRange.arr[i] > 0) then
  1833. inc(result);
  1834. end;
  1835. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1836. function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
  1837. var
  1838. w, h: Integer;
  1839. begin
  1840. if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
  1841. w := Max(1, aSize.X);
  1842. h := Max(1, aSize.Y);
  1843. result := GetSize(w, h);
  1844. end else
  1845. result := 0;
  1846. end;
  1847. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1848. function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
  1849. begin
  1850. result := 0;
  1851. if (aWidth <= 0) or (aHeight <= 0) then
  1852. exit;
  1853. result := Ceil(aWidth * aHeight * fPixelSize);
  1854. end;
  1855. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1856. function TFormatDescriptor.CreateMappingData: Pointer;
  1857. begin
  1858. result := nil;
  1859. end;
  1860. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1861. procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
  1862. begin
  1863. //DUMMY
  1864. end;
  1865. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1866. function TFormatDescriptor.IsEmpty: Boolean;
  1867. begin
  1868. result := (fFormat = tfEmpty);
  1869. end;
  1870. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1871. function TFormatDescriptor.HasAlpha: Boolean;
  1872. begin
  1873. result := (fRange.a > 0);
  1874. end;
  1875. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1876. function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean;
  1877. begin
  1878. result := false;
  1879. if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
  1880. raise EglBitmapException.Create('FormatCheckFormat - All Masks are 0');
  1881. if (aRedMask <> RedMask) then
  1882. exit;
  1883. if (aGreenMask <> GreenMask) then
  1884. exit;
  1885. if (aBlueMask <> BlueMask) then
  1886. exit;
  1887. if (aAlphaMask <> AlphaMask) then
  1888. exit;
  1889. result := true;
  1890. end;
  1891. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1892. procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
  1893. begin
  1894. FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
  1895. aPixel.Data := fRange;
  1896. aPixel.Range := fRange;
  1897. aPixel.Format := fFormat;
  1898. end;
  1899. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1900. constructor TFormatDescriptor.Create;
  1901. begin
  1902. inherited Create;
  1903. fFormat := tfEmpty;
  1904. fWithAlpha := tfEmpty;
  1905. fWithoutAlpha := tfEmpty;
  1906. fRGBInverted := tfEmpty;
  1907. fUncompressed := tfEmpty;
  1908. fPixelSize := 0.0;
  1909. fIsCompressed := false;
  1910. fglFormat := 0;
  1911. fglInternalFormat := 0;
  1912. fglDataFormat := 0;
  1913. FillChar(fRange, 0, SizeOf(fRange));
  1914. FillChar(fShift, 0, SizeOf(fShift));
  1915. end;
  1916. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1917. //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1918. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1919. procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1920. begin
  1921. aData^ := aPixel.Data.a;
  1922. inc(aData);
  1923. end;
  1924. procedure TfdAlpha_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1925. begin
  1926. aPixel.Data.r := 0;
  1927. aPixel.Data.g := 0;
  1928. aPixel.Data.b := 0;
  1929. aPixel.Data.a := aData^;
  1930. inc(aData);
  1931. end;
  1932. constructor TfdAlpha_UB1.Create;
  1933. begin
  1934. inherited Create;
  1935. fPixelSize := 1.0;
  1936. fRange.a := $FF;
  1937. fglFormat := GL_ALPHA;
  1938. fglDataFormat := GL_UNSIGNED_BYTE;
  1939. end;
  1940. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1941. //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1942. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1943. procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1944. begin
  1945. aData^ := LuminanceWeight(aPixel);
  1946. inc(aData);
  1947. end;
  1948. procedure TfdLuminance_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1949. begin
  1950. aPixel.Data.r := aData^;
  1951. aPixel.Data.g := aData^;
  1952. aPixel.Data.b := aData^;
  1953. aPixel.Data.a := 0;
  1954. inc(aData);
  1955. end;
  1956. constructor TfdLuminance_UB1.Create;
  1957. begin
  1958. inherited Create;
  1959. fPixelSize := 1.0;
  1960. fRange.r := $FF;
  1961. fRange.g := $FF;
  1962. fRange.b := $FF;
  1963. fglFormat := GL_LUMINANCE;
  1964. fglDataFormat := GL_UNSIGNED_BYTE;
  1965. end;
  1966. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1967. //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1968. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1969. procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1970. var
  1971. i: Integer;
  1972. begin
  1973. aData^ := 0;
  1974. for i := 0 to 3 do
  1975. if (fRange.arr[i] > 0) then
  1976. aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  1977. inc(aData);
  1978. end;
  1979. procedure TfdUniversal_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1980. var
  1981. i: Integer;
  1982. begin
  1983. for i := 0 to 3 do
  1984. aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
  1985. inc(aData);
  1986. end;
  1987. constructor TfdUniversal_UB1.Create;
  1988. begin
  1989. inherited Create;
  1990. fPixelSize := 1.0;
  1991. end;
  1992. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1993. //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1994. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1995. procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1996. begin
  1997. inherited Map(aPixel, aData, aMapData);
  1998. aData^ := aPixel.Data.a;
  1999. inc(aData);
  2000. end;
  2001. procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2002. begin
  2003. inherited Unmap(aData, aPixel, aMapData);
  2004. aPixel.Data.a := aData^;
  2005. inc(aData);
  2006. end;
  2007. constructor TfdLuminanceAlpha_UB2.Create;
  2008. begin
  2009. inherited Create;
  2010. fPixelSize := 2.0;
  2011. fRange.a := $FF;
  2012. fShift.a := 8;
  2013. fglFormat := GL_LUMINANCE_ALPHA;
  2014. fglDataFormat := GL_UNSIGNED_BYTE;
  2015. end;
  2016. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2017. //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2018. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2019. procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2020. begin
  2021. aData^ := aPixel.Data.r;
  2022. inc(aData);
  2023. aData^ := aPixel.Data.g;
  2024. inc(aData);
  2025. aData^ := aPixel.Data.b;
  2026. inc(aData);
  2027. end;
  2028. procedure TfdRGB_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2029. begin
  2030. aPixel.Data.r := aData^;
  2031. inc(aData);
  2032. aPixel.Data.g := aData^;
  2033. inc(aData);
  2034. aPixel.Data.b := aData^;
  2035. inc(aData);
  2036. aPixel.Data.a := 0;
  2037. end;
  2038. constructor TfdRGB_UB3.Create;
  2039. begin
  2040. inherited Create;
  2041. fPixelSize := 3.0;
  2042. fRange.r := $FF;
  2043. fRange.g := $FF;
  2044. fRange.b := $FF;
  2045. fShift.r := 0;
  2046. fShift.g := 8;
  2047. fShift.b := 16;
  2048. fglFormat := GL_RGB;
  2049. fglDataFormat := GL_UNSIGNED_BYTE;
  2050. end;
  2051. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2052. //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2053. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2054. procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2055. begin
  2056. aData^ := aPixel.Data.b;
  2057. inc(aData);
  2058. aData^ := aPixel.Data.g;
  2059. inc(aData);
  2060. aData^ := aPixel.Data.r;
  2061. inc(aData);
  2062. end;
  2063. procedure TfdBGR_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2064. begin
  2065. aPixel.Data.b := aData^;
  2066. inc(aData);
  2067. aPixel.Data.g := aData^;
  2068. inc(aData);
  2069. aPixel.Data.r := aData^;
  2070. inc(aData);
  2071. aPixel.Data.a := 0;
  2072. end;
  2073. constructor TfdBGR_UB3.Create;
  2074. begin
  2075. fPixelSize := 3.0;
  2076. fRange.r := $FF;
  2077. fRange.g := $FF;
  2078. fRange.b := $FF;
  2079. fShift.r := 16;
  2080. fShift.g := 8;
  2081. fShift.b := 0;
  2082. fglFormat := GL_BGR;
  2083. fglDataFormat := GL_UNSIGNED_BYTE;
  2084. end;
  2085. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2086. //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2087. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2088. procedure TfdRGBA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2089. begin
  2090. inherited Map(aPixel, aData, aMapData);
  2091. aData^ := aPixel.Data.a;
  2092. inc(aData);
  2093. end;
  2094. procedure TfdRGBA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2095. begin
  2096. inherited Unmap(aData, aPixel, aMapData);
  2097. aPixel.Data.a := aData^;
  2098. inc(aData);
  2099. end;
  2100. constructor TfdRGBA_UB4.Create;
  2101. begin
  2102. inherited Create;
  2103. fPixelSize := 4.0;
  2104. fRange.a := $FF;
  2105. fShift.a := 24;
  2106. fglFormat := GL_RGBA;
  2107. fglDataFormat := GL_UNSIGNED_BYTE;
  2108. end;
  2109. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2110. //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2111. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2112. procedure TfdBGRA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2113. begin
  2114. inherited Map(aPixel, aData, aMapData);
  2115. aData^ := aPixel.Data.a;
  2116. inc(aData);
  2117. end;
  2118. procedure TfdBGRA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2119. begin
  2120. inherited Unmap(aData, aPixel, aMapData);
  2121. aPixel.Data.a := aData^;
  2122. inc(aData);
  2123. end;
  2124. constructor TfdBGRA_UB4.Create;
  2125. begin
  2126. inherited Create;
  2127. fPixelSize := 4.0;
  2128. fRange.a := $FF;
  2129. fShift.a := 24;
  2130. fglFormat := GL_BGRA;
  2131. fglDataFormat := GL_UNSIGNED_BYTE;
  2132. end;
  2133. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2134. //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2135. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2136. procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2137. begin
  2138. PWord(aData)^ := aPixel.Data.a;
  2139. inc(aData, 2);
  2140. end;
  2141. procedure TfdAlpha_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2142. begin
  2143. aPixel.Data.r := 0;
  2144. aPixel.Data.g := 0;
  2145. aPixel.Data.b := 0;
  2146. aPixel.Data.a := PWord(aData)^;
  2147. inc(aData, 2);
  2148. end;
  2149. constructor TfdAlpha_US1.Create;
  2150. begin
  2151. inherited Create;
  2152. fPixelSize := 2.0;
  2153. fRange.a := $FFFF;
  2154. fglFormat := GL_ALPHA;
  2155. fglDataFormat := GL_UNSIGNED_SHORT;
  2156. end;
  2157. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2158. //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2159. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2160. procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2161. begin
  2162. PWord(aData)^ := LuminanceWeight(aPixel);
  2163. inc(aData, 2);
  2164. end;
  2165. procedure TfdLuminance_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2166. begin
  2167. aPixel.Data.r := PWord(aData)^;
  2168. aPixel.Data.g := PWord(aData)^;
  2169. aPixel.Data.b := PWord(aData)^;
  2170. aPixel.Data.a := 0;
  2171. inc(aData, 2);
  2172. end;
  2173. constructor TfdLuminance_US1.Create;
  2174. begin
  2175. inherited Create;
  2176. fPixelSize := 2.0;
  2177. fRange.r := $FFFF;
  2178. fRange.g := $FFFF;
  2179. fRange.b := $FFFF;
  2180. fglFormat := GL_LUMINANCE;
  2181. fglDataFormat := GL_UNSIGNED_SHORT;
  2182. end;
  2183. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2184. //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2185. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2186. procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2187. var
  2188. i: Integer;
  2189. begin
  2190. PWord(aData)^ := 0;
  2191. for i := 0 to 3 do
  2192. if (fRange.arr[i] > 0) then
  2193. PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2194. inc(aData, 2);
  2195. end;
  2196. procedure TfdUniversal_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2197. var
  2198. i: Integer;
  2199. begin
  2200. for i := 0 to 3 do
  2201. aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
  2202. inc(aData, 2);
  2203. end;
  2204. constructor TfdUniversal_US1.Create;
  2205. begin
  2206. inherited Create;
  2207. fPixelSize := 2.0;
  2208. end;
  2209. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2210. //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2211. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2212. procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2213. begin
  2214. PWord(aData)^ := DepthWeight(aPixel);
  2215. inc(aData, 2);
  2216. end;
  2217. procedure TfdDepth_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2218. begin
  2219. aPixel.Data.r := PWord(aData)^;
  2220. aPixel.Data.g := PWord(aData)^;
  2221. aPixel.Data.b := PWord(aData)^;
  2222. aPixel.Data.a := 0;
  2223. inc(aData, 2);
  2224. end;
  2225. constructor TfdDepth_US1.Create;
  2226. begin
  2227. inherited Create;
  2228. fPixelSize := 2.0;
  2229. fRange.r := $FFFF;
  2230. fRange.g := $FFFF;
  2231. fRange.b := $FFFF;
  2232. fglFormat := GL_DEPTH_COMPONENT;
  2233. fglDataFormat := GL_UNSIGNED_SHORT;
  2234. end;
  2235. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2236. //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2237. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2238. procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2239. begin
  2240. inherited Map(aPixel, aData, aMapData);
  2241. PWord(aData)^ := aPixel.Data.a;
  2242. inc(aData, 2);
  2243. end;
  2244. procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2245. begin
  2246. inherited Unmap(aData, aPixel, aMapData);
  2247. aPixel.Data.a := PWord(aData)^;
  2248. inc(aData, 2);
  2249. end;
  2250. constructor TfdLuminanceAlpha_US2.Create;
  2251. begin
  2252. inherited Create;
  2253. fPixelSize := 4.0;
  2254. fRange.a := $FFFF;
  2255. fShift.a := 16;
  2256. fglFormat := GL_LUMINANCE_ALPHA;
  2257. fglDataFormat := GL_UNSIGNED_SHORT;
  2258. end;
  2259. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2260. //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2261. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2262. procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2263. begin
  2264. PWord(aData)^ := aPixel.Data.r;
  2265. inc(aData, 2);
  2266. PWord(aData)^ := aPixel.Data.g;
  2267. inc(aData, 2);
  2268. PWord(aData)^ := aPixel.Data.b;
  2269. inc(aData, 2);
  2270. end;
  2271. procedure TfdRGB_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2272. begin
  2273. aPixel.Data.r := PWord(aData)^;
  2274. inc(aData, 2);
  2275. aPixel.Data.g := PWord(aData)^;
  2276. inc(aData, 2);
  2277. aPixel.Data.b := PWord(aData)^;
  2278. inc(aData, 2);
  2279. aPixel.Data.a := 0;
  2280. end;
  2281. constructor TfdRGB_US3.Create;
  2282. begin
  2283. inherited Create;
  2284. fPixelSize := 6.0;
  2285. fRange.r := $FFFF;
  2286. fRange.g := $FFFF;
  2287. fRange.b := $FFFF;
  2288. fShift.r := 0;
  2289. fShift.g := 16;
  2290. fShift.b := 32;
  2291. fglFormat := GL_RGB;
  2292. fglDataFormat := GL_UNSIGNED_SHORT;
  2293. end;
  2294. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2295. //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2296. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2297. procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2298. begin
  2299. PWord(aData)^ := aPixel.Data.b;
  2300. inc(aData, 2);
  2301. PWord(aData)^ := aPixel.Data.g;
  2302. inc(aData, 2);
  2303. PWord(aData)^ := aPixel.Data.r;
  2304. inc(aData, 2);
  2305. end;
  2306. procedure TfdBGR_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2307. begin
  2308. aPixel.Data.b := PWord(aData)^;
  2309. inc(aData, 2);
  2310. aPixel.Data.g := PWord(aData)^;
  2311. inc(aData, 2);
  2312. aPixel.Data.r := PWord(aData)^;
  2313. inc(aData, 2);
  2314. aPixel.Data.a := 0;
  2315. end;
  2316. constructor TfdBGR_US3.Create;
  2317. begin
  2318. inherited Create;
  2319. fPixelSize := 6.0;
  2320. fRange.r := $FFFF;
  2321. fRange.g := $FFFF;
  2322. fRange.b := $FFFF;
  2323. fShift.r := 32;
  2324. fShift.g := 16;
  2325. fShift.b := 0;
  2326. fglFormat := GL_BGR;
  2327. fglDataFormat := GL_UNSIGNED_SHORT;
  2328. end;
  2329. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2330. //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2331. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2332. procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2333. begin
  2334. inherited Map(aPixel, aData, aMapData);
  2335. PWord(aData)^ := aPixel.Data.a;
  2336. inc(aData, 2);
  2337. end;
  2338. procedure TfdRGBA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2339. begin
  2340. inherited Unmap(aData, aPixel, aMapData);
  2341. aPixel.Data.a := PWord(aData)^;
  2342. inc(aData, 2);
  2343. end;
  2344. constructor TfdRGBA_US4.Create;
  2345. begin
  2346. inherited Create;
  2347. fPixelSize := 8.0;
  2348. fRange.a := $FFFF;
  2349. fShift.a := 48;
  2350. fglFormat := GL_RGBA;
  2351. fglDataFormat := GL_UNSIGNED_SHORT;
  2352. end;
  2353. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2354. //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2355. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2356. procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2357. begin
  2358. inherited Map(aPixel, aData, aMapData);
  2359. PWord(aData)^ := aPixel.Data.a;
  2360. inc(aData, 2);
  2361. end;
  2362. procedure TfdBGRA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2363. begin
  2364. inherited Unmap(aData, aPixel, aMapData);
  2365. aPixel.Data.a := PWord(aData)^;
  2366. inc(aData, 2);
  2367. end;
  2368. constructor TfdBGRA_US4.Create;
  2369. begin
  2370. inherited Create;
  2371. fPixelSize := 8.0;
  2372. fRange.a := $FFFF;
  2373. fShift.a := 48;
  2374. fglFormat := GL_BGRA;
  2375. fglDataFormat := GL_UNSIGNED_SHORT;
  2376. end;
  2377. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2378. //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2379. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2380. procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2381. var
  2382. i: Integer;
  2383. begin
  2384. PCardinal(aData)^ := 0;
  2385. for i := 0 to 3 do
  2386. if (fRange.arr[i] > 0) then
  2387. PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2388. inc(aData, 4);
  2389. end;
  2390. procedure TfdUniversal_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2391. var
  2392. i: Integer;
  2393. begin
  2394. for i := 0 to 3 do
  2395. aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
  2396. inc(aData, 2);
  2397. end;
  2398. constructor TfdUniversal_UI1.Create;
  2399. begin
  2400. inherited Create;
  2401. fPixelSize := 4.0;
  2402. end;
  2403. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2404. //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2405. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2406. procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2407. begin
  2408. PCardinal(aData)^ := DepthWeight(aPixel);
  2409. inc(aData, 4);
  2410. end;
  2411. procedure TfdDepth_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2412. begin
  2413. aPixel.Data.r := PCardinal(aData)^;
  2414. aPixel.Data.g := PCardinal(aData)^;
  2415. aPixel.Data.b := PCardinal(aData)^;
  2416. aPixel.Data.a := 0;
  2417. inc(aData, 4);
  2418. end;
  2419. constructor TfdDepth_UI1.Create;
  2420. begin
  2421. inherited Create;
  2422. fPixelSize := 4.0;
  2423. fRange.r := $FFFFFFFF;
  2424. fRange.g := $FFFFFFFF;
  2425. fRange.b := $FFFFFFFF;
  2426. fglFormat := GL_DEPTH_COMPONENT;
  2427. fglDataFormat := GL_UNSIGNED_INT;
  2428. end;
  2429. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2430. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2431. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2432. constructor TfdAlpha4.Create;
  2433. begin
  2434. inherited Create;
  2435. fFormat := tfAlpha4;
  2436. fWithAlpha := tfAlpha4;
  2437. fglInternalFormat := GL_ALPHA4;
  2438. end;
  2439. constructor TfdAlpha8.Create;
  2440. begin
  2441. inherited Create;
  2442. fFormat := tfAlpha8;
  2443. fWithAlpha := tfAlpha8;
  2444. fglInternalFormat := GL_ALPHA8;
  2445. end;
  2446. constructor TfdAlpha12.Create;
  2447. begin
  2448. inherited Create;
  2449. fFormat := tfAlpha12;
  2450. fWithAlpha := tfAlpha12;
  2451. fglInternalFormat := GL_ALPHA12;
  2452. end;
  2453. constructor TfdAlpha16.Create;
  2454. begin
  2455. inherited Create;
  2456. fFormat := tfAlpha16;
  2457. fWithAlpha := tfAlpha16;
  2458. fglInternalFormat := GL_ALPHA16;
  2459. end;
  2460. constructor TfdLuminance4.Create;
  2461. begin
  2462. inherited Create;
  2463. fFormat := tfLuminance4;
  2464. fWithAlpha := tfLuminance4Alpha4;
  2465. fWithoutAlpha := tfLuminance4;
  2466. fglInternalFormat := GL_LUMINANCE4;
  2467. end;
  2468. constructor TfdLuminance8.Create;
  2469. begin
  2470. inherited Create;
  2471. fFormat := tfLuminance8;
  2472. fWithAlpha := tfLuminance8Alpha8;
  2473. fWithoutAlpha := tfLuminance8;
  2474. fglInternalFormat := GL_LUMINANCE8;
  2475. end;
  2476. constructor TfdLuminance12.Create;
  2477. begin
  2478. inherited Create;
  2479. fFormat := tfLuminance12;
  2480. fWithAlpha := tfLuminance12Alpha12;
  2481. fWithoutAlpha := tfLuminance12;
  2482. fglInternalFormat := GL_LUMINANCE12;
  2483. end;
  2484. constructor TfdLuminance16.Create;
  2485. begin
  2486. inherited Create;
  2487. fFormat := tfLuminance16;
  2488. fWithAlpha := tfLuminance16Alpha16;
  2489. fWithoutAlpha := tfLuminance16;
  2490. fglInternalFormat := GL_LUMINANCE16;
  2491. end;
  2492. constructor TfdLuminance4Alpha4.Create;
  2493. begin
  2494. inherited Create;
  2495. fFormat := tfLuminance4Alpha4;
  2496. fWithAlpha := tfLuminance4Alpha4;
  2497. fWithoutAlpha := tfLuminance4;
  2498. fglInternalFormat := GL_LUMINANCE4_ALPHA4;
  2499. end;
  2500. constructor TfdLuminance6Alpha2.Create;
  2501. begin
  2502. inherited Create;
  2503. fFormat := tfLuminance6Alpha2;
  2504. fWithAlpha := tfLuminance6Alpha2;
  2505. fWithoutAlpha := tfLuminance8;
  2506. fglInternalFormat := GL_LUMINANCE6_ALPHA2;
  2507. end;
  2508. constructor TfdLuminance8Alpha8.Create;
  2509. begin
  2510. inherited Create;
  2511. fFormat := tfLuminance8Alpha8;
  2512. fWithAlpha := tfLuminance8Alpha8;
  2513. fWithoutAlpha := tfLuminance8;
  2514. fglInternalFormat := GL_LUMINANCE8_ALPHA8;
  2515. end;
  2516. constructor TfdLuminance12Alpha4.Create;
  2517. begin
  2518. inherited Create;
  2519. fFormat := tfLuminance12Alpha4;
  2520. fWithAlpha := tfLuminance12Alpha4;
  2521. fWithoutAlpha := tfLuminance12;
  2522. fglInternalFormat := GL_LUMINANCE12_ALPHA4;
  2523. end;
  2524. constructor TfdLuminance12Alpha12.Create;
  2525. begin
  2526. inherited Create;
  2527. fFormat := tfLuminance12Alpha12;
  2528. fWithAlpha := tfLuminance12Alpha12;
  2529. fWithoutAlpha := tfLuminance12;
  2530. fglInternalFormat := GL_LUMINANCE12_ALPHA12;
  2531. end;
  2532. constructor TfdLuminance16Alpha16.Create;
  2533. begin
  2534. inherited Create;
  2535. fFormat := tfLuminance16Alpha16;
  2536. fWithAlpha := tfLuminance16Alpha16;
  2537. fWithoutAlpha := tfLuminance16;
  2538. fglInternalFormat := GL_LUMINANCE16_ALPHA16;
  2539. end;
  2540. constructor TfdR3G3B2.Create;
  2541. begin
  2542. inherited Create;
  2543. fFormat := tfR3G3B2;
  2544. fWithAlpha := tfRGBA2;
  2545. fWithoutAlpha := tfR3G3B2;
  2546. fRange.r := $7;
  2547. fRange.g := $7;
  2548. fRange.b := $3;
  2549. fShift.r := 0;
  2550. fShift.g := 3;
  2551. fShift.b := 6;
  2552. fglFormat := GL_RGB;
  2553. fglInternalFormat := GL_R3_G3_B2;
  2554. fglDataFormat := GL_UNSIGNED_BYTE_2_3_3_REV;
  2555. end;
  2556. constructor TfdRGB4.Create;
  2557. begin
  2558. inherited Create;
  2559. fFormat := tfRGB4;
  2560. fWithAlpha := tfRGBA4;
  2561. fWithoutAlpha := tfRGB4;
  2562. fRGBInverted := tfBGR4;
  2563. fRange.r := $F;
  2564. fRange.g := $F;
  2565. fRange.b := $F;
  2566. fShift.r := 0;
  2567. fShift.g := 4;
  2568. fShift.b := 8;
  2569. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2570. fglInternalFormat := GL_RGB4;
  2571. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2572. end;
  2573. constructor TfdR5G6B5.Create;
  2574. begin
  2575. inherited Create;
  2576. fFormat := tfR5G6B5;
  2577. fWithAlpha := tfRGBA4;
  2578. fWithoutAlpha := tfR5G6B5;
  2579. fRGBInverted := tfB5G6R5;
  2580. fRange.r := $1F;
  2581. fRange.g := $3F;
  2582. fRange.b := $1F;
  2583. fShift.r := 0;
  2584. fShift.g := 5;
  2585. fShift.b := 11;
  2586. fglFormat := GL_RGB;
  2587. fglInternalFormat := GL_RGB565;
  2588. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5_REV;
  2589. end;
  2590. constructor TfdRGB5.Create;
  2591. begin
  2592. inherited Create;
  2593. fFormat := tfRGB5;
  2594. fWithAlpha := tfRGB5A1;
  2595. fWithoutAlpha := tfRGB5;
  2596. fRGBInverted := tfBGR5;
  2597. fRange.r := $1F;
  2598. fRange.g := $1F;
  2599. fRange.b := $1F;
  2600. fShift.r := 0;
  2601. fShift.g := 5;
  2602. fShift.b := 10;
  2603. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2604. fglInternalFormat := GL_RGB5;
  2605. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2606. end;
  2607. constructor TfdRGB8.Create;
  2608. begin
  2609. inherited Create;
  2610. fFormat := tfRGB8;
  2611. fWithAlpha := tfRGBA8;
  2612. fWithoutAlpha := tfRGB8;
  2613. fRGBInverted := tfBGR8;
  2614. fglInternalFormat := GL_RGB8;
  2615. end;
  2616. constructor TfdRGB10.Create;
  2617. begin
  2618. inherited Create;
  2619. fFormat := tfRGB10;
  2620. fWithAlpha := tfRGB10A2;
  2621. fWithoutAlpha := tfRGB10;
  2622. fRGBInverted := tfBGR10;
  2623. fRange.r := $3FF;
  2624. fRange.g := $3FF;
  2625. fRange.b := $3FF;
  2626. fShift.r := 0;
  2627. fShift.g := 10;
  2628. fShift.b := 20;
  2629. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2630. fglInternalFormat := GL_RGB10;
  2631. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2632. end;
  2633. constructor TfdRGB12.Create;
  2634. begin
  2635. inherited Create;
  2636. fFormat := tfRGB12;
  2637. fWithAlpha := tfRGBA12;
  2638. fWithoutAlpha := tfRGB12;
  2639. fRGBInverted := tfBGR12;
  2640. fglInternalFormat := GL_RGB12;
  2641. end;
  2642. constructor TfdRGB16.Create;
  2643. begin
  2644. inherited Create;
  2645. fFormat := tfRGB16;
  2646. fWithAlpha := tfRGBA16;
  2647. fWithoutAlpha := tfRGB16;
  2648. fRGBInverted := tfBGR16;
  2649. fglInternalFormat := GL_RGB16;
  2650. end;
  2651. constructor TfdRGBA2.Create;
  2652. begin
  2653. inherited Create;
  2654. fFormat := tfRGBA2;
  2655. fWithAlpha := tfRGBA2;
  2656. fWithoutAlpha := tfR3G3B2;
  2657. fRGBInverted := tfBGRA2;
  2658. fglInternalFormat := GL_RGBA2;
  2659. end;
  2660. constructor TfdRGBA4.Create;
  2661. begin
  2662. inherited Create;
  2663. fFormat := tfRGBA4;
  2664. fWithAlpha := tfRGBA4;
  2665. fWithoutAlpha := tfRGB4;
  2666. fRGBInverted := tfBGRA4;
  2667. fRange.r := $F;
  2668. fRange.g := $F;
  2669. fRange.b := $F;
  2670. fRange.a := $F;
  2671. fShift.r := 0;
  2672. fShift.g := 4;
  2673. fShift.b := 8;
  2674. fShift.a := 12;
  2675. fglFormat := GL_RGBA;
  2676. fglInternalFormat := GL_RGBA4;
  2677. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2678. end;
  2679. constructor TfdRGB5A1.Create;
  2680. begin
  2681. inherited Create;
  2682. fFormat := tfRGB5A1;
  2683. fWithAlpha := tfRGB5A1;
  2684. fWithoutAlpha := tfRGB5;
  2685. fRGBInverted := tfBGR5A1;
  2686. fRange.r := $1F;
  2687. fRange.g := $1F;
  2688. fRange.b := $1F;
  2689. fRange.a := $01;
  2690. fShift.r := 0;
  2691. fShift.g := 5;
  2692. fShift.b := 10;
  2693. fShift.a := 15;
  2694. fglFormat := GL_RGBA;
  2695. fglInternalFormat := GL_RGB5_A1;
  2696. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2697. end;
  2698. constructor TfdRGBA8.Create;
  2699. begin
  2700. inherited Create;
  2701. fFormat := tfRGBA8;
  2702. fWithAlpha := tfRGBA8;
  2703. fWithoutAlpha := tfRGB8;
  2704. fRGBInverted := tfBGRA8;
  2705. fglInternalFormat := GL_RGBA8;
  2706. end;
  2707. constructor TfdRGB10A2.Create;
  2708. begin
  2709. inherited Create;
  2710. fFormat := tfRGB10A2;
  2711. fWithAlpha := tfRGB10A2;
  2712. fWithoutAlpha := tfRGB10;
  2713. fRGBInverted := tfBGR10A2;
  2714. fRange.r := $3FF;
  2715. fRange.g := $3FF;
  2716. fRange.b := $3FF;
  2717. fRange.a := $003;
  2718. fShift.r := 0;
  2719. fShift.g := 10;
  2720. fShift.b := 20;
  2721. fShift.a := 30;
  2722. fglFormat := GL_RGBA;
  2723. fglInternalFormat := GL_RGB10_A2;
  2724. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2725. end;
  2726. constructor TfdRGBA12.Create;
  2727. begin
  2728. inherited Create;
  2729. fFormat := tfRGBA12;
  2730. fWithAlpha := tfRGBA12;
  2731. fWithoutAlpha := tfRGB12;
  2732. fRGBInverted := tfBGRA12;
  2733. fglInternalFormat := GL_RGBA12;
  2734. end;
  2735. constructor TfdRGBA16.Create;
  2736. begin
  2737. inherited Create;
  2738. fFormat := tfRGBA16;
  2739. fWithAlpha := tfRGBA16;
  2740. fWithoutAlpha := tfRGB16;
  2741. fRGBInverted := tfBGRA16;
  2742. fglInternalFormat := GL_RGBA16;
  2743. end;
  2744. constructor TfdBGR4.Create;
  2745. begin
  2746. inherited Create;
  2747. fPixelSize := 2.0;
  2748. fFormat := tfBGR4;
  2749. fWithAlpha := tfBGRA4;
  2750. fWithoutAlpha := tfBGR4;
  2751. fRGBInverted := tfRGB4;
  2752. fRange.r := $F;
  2753. fRange.g := $F;
  2754. fRange.b := $F;
  2755. fRange.a := $0;
  2756. fShift.r := 8;
  2757. fShift.g := 4;
  2758. fShift.b := 0;
  2759. fShift.a := 0;
  2760. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2761. fglInternalFormat := GL_RGB4;
  2762. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2763. end;
  2764. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2765. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2766. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2767. constructor TfdB5G6R5.Create;
  2768. begin
  2769. inherited Create;
  2770. fFormat := tfB5G6R5;
  2771. fWithAlpha := tfBGRA4;
  2772. fWithoutAlpha := tfB5G6R5;
  2773. fRGBInverted := tfR5G6B5;
  2774. fRange.r := $1F;
  2775. fRange.g := $3F;
  2776. fRange.b := $1F;
  2777. fShift.r := 11;
  2778. fShift.g := 5;
  2779. fShift.b := 0;
  2780. fglFormat := GL_RGB; //B5G6R5 is only possible as R5G6B5 -> use reverted dataformat
  2781. fglInternalFormat := GL_RGB8;
  2782. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5;
  2783. end;
  2784. constructor TfdBGR5.Create;
  2785. begin
  2786. inherited Create;
  2787. fPixelSize := 2.0;
  2788. fFormat := tfBGR5;
  2789. fWithAlpha := tfBGR5A1;
  2790. fWithoutAlpha := tfBGR5;
  2791. fRGBInverted := tfRGB5;
  2792. fRange.r := $1F;
  2793. fRange.g := $1F;
  2794. fRange.b := $1F;
  2795. fRange.a := $00;
  2796. fShift.r := 10;
  2797. fShift.g := 5;
  2798. fShift.b := 0;
  2799. fShift.a := 0;
  2800. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2801. fglInternalFormat := GL_RGB5;
  2802. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2803. end;
  2804. constructor TfdBGR8.Create;
  2805. begin
  2806. inherited Create;
  2807. fFormat := tfBGR8;
  2808. fWithAlpha := tfBGRA8;
  2809. fWithoutAlpha := tfBGR8;
  2810. fRGBInverted := tfRGB8;
  2811. fglInternalFormat := GL_RGB8;
  2812. end;
  2813. constructor TfdBGR10.Create;
  2814. begin
  2815. inherited Create;
  2816. fFormat := tfBGR10;
  2817. fWithAlpha := tfBGR10A2;
  2818. fWithoutAlpha := tfBGR10;
  2819. fRGBInverted := tfRGB10;
  2820. fRange.r := $3FF;
  2821. fRange.g := $3FF;
  2822. fRange.b := $3FF;
  2823. fRange.a := $000;
  2824. fShift.r := 20;
  2825. fShift.g := 10;
  2826. fShift.b := 0;
  2827. fShift.a := 0;
  2828. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2829. fglInternalFormat := GL_RGB10;
  2830. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2831. end;
  2832. constructor TfdBGR12.Create;
  2833. begin
  2834. inherited Create;
  2835. fFormat := tfBGR12;
  2836. fWithAlpha := tfBGRA12;
  2837. fWithoutAlpha := tfBGR12;
  2838. fRGBInverted := tfRGB12;
  2839. fglInternalFormat := GL_RGB12;
  2840. end;
  2841. constructor TfdBGR16.Create;
  2842. begin
  2843. inherited Create;
  2844. fFormat := tfBGR16;
  2845. fWithAlpha := tfBGRA16;
  2846. fWithoutAlpha := tfBGR16;
  2847. fRGBInverted := tfRGB16;
  2848. fglInternalFormat := GL_RGB16;
  2849. end;
  2850. constructor TfdBGRA2.Create;
  2851. begin
  2852. inherited Create;
  2853. fFormat := tfBGRA2;
  2854. fWithAlpha := tfBGRA4;
  2855. fWithoutAlpha := tfBGR4;
  2856. fRGBInverted := tfRGBA2;
  2857. fglInternalFormat := GL_RGBA2;
  2858. end;
  2859. constructor TfdBGRA4.Create;
  2860. begin
  2861. inherited Create;
  2862. fFormat := tfBGRA4;
  2863. fWithAlpha := tfBGRA4;
  2864. fWithoutAlpha := tfBGR4;
  2865. fRGBInverted := tfRGBA4;
  2866. fRange.r := $F;
  2867. fRange.g := $F;
  2868. fRange.b := $F;
  2869. fRange.a := $F;
  2870. fShift.r := 8;
  2871. fShift.g := 4;
  2872. fShift.b := 0;
  2873. fShift.a := 12;
  2874. fglFormat := GL_BGRA;
  2875. fglInternalFormat := GL_RGBA4;
  2876. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2877. end;
  2878. constructor TfdBGR5A1.Create;
  2879. begin
  2880. inherited Create;
  2881. fFormat := tfBGR5A1;
  2882. fWithAlpha := tfBGR5A1;
  2883. fWithoutAlpha := tfBGR5;
  2884. fRGBInverted := tfRGB5A1;
  2885. fRange.r := $1F;
  2886. fRange.g := $1F;
  2887. fRange.b := $1F;
  2888. fRange.a := $01;
  2889. fShift.r := 10;
  2890. fShift.g := 5;
  2891. fShift.b := 0;
  2892. fShift.a := 15;
  2893. fglFormat := GL_BGRA;
  2894. fglInternalFormat := GL_RGB5_A1;
  2895. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2896. end;
  2897. constructor TfdBGRA8.Create;
  2898. begin
  2899. inherited Create;
  2900. fFormat := tfBGRA8;
  2901. fWithAlpha := tfBGRA8;
  2902. fWithoutAlpha := tfBGR8;
  2903. fRGBInverted := tfRGBA8;
  2904. fglInternalFormat := GL_RGBA8;
  2905. end;
  2906. constructor TfdBGR10A2.Create;
  2907. begin
  2908. inherited Create;
  2909. fFormat := tfBGR10A2;
  2910. fWithAlpha := tfBGR10A2;
  2911. fWithoutAlpha := tfBGR10;
  2912. fRGBInverted := tfRGB10A2;
  2913. fRange.r := $3FF;
  2914. fRange.g := $3FF;
  2915. fRange.b := $3FF;
  2916. fRange.a := $003;
  2917. fShift.r := 20;
  2918. fShift.g := 10;
  2919. fShift.b := 0;
  2920. fShift.a := 30;
  2921. fglFormat := GL_BGRA;
  2922. fglInternalFormat := GL_RGB10_A2;
  2923. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2924. end;
  2925. constructor TfdBGRA12.Create;
  2926. begin
  2927. inherited Create;
  2928. fFormat := tfBGRA12;
  2929. fWithAlpha := tfBGRA12;
  2930. fWithoutAlpha := tfBGR12;
  2931. fRGBInverted := tfRGBA12;
  2932. fglInternalFormat := GL_RGBA12;
  2933. end;
  2934. constructor TfdBGRA16.Create;
  2935. begin
  2936. inherited Create;
  2937. fFormat := tfBGRA16;
  2938. fWithAlpha := tfBGRA16;
  2939. fWithoutAlpha := tfBGR16;
  2940. fRGBInverted := tfRGBA16;
  2941. fglInternalFormat := GL_RGBA16;
  2942. end;
  2943. constructor TfdDepth16.Create;
  2944. begin
  2945. inherited Create;
  2946. fFormat := tfDepth16;
  2947. fWithAlpha := tfEmpty;
  2948. fWithoutAlpha := tfDepth16;
  2949. fglInternalFormat := GL_DEPTH_COMPONENT16;
  2950. end;
  2951. constructor TfdDepth24.Create;
  2952. begin
  2953. inherited Create;
  2954. fFormat := tfDepth24;
  2955. fWithAlpha := tfEmpty;
  2956. fWithoutAlpha := tfDepth24;
  2957. fglInternalFormat := GL_DEPTH_COMPONENT24;
  2958. end;
  2959. constructor TfdDepth32.Create;
  2960. begin
  2961. inherited Create;
  2962. fFormat := tfDepth32;
  2963. fWithAlpha := tfEmpty;
  2964. fWithoutAlpha := tfDepth32;
  2965. fglInternalFormat := GL_DEPTH_COMPONENT32;
  2966. end;
  2967. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2968. //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2969. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2970. procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2971. begin
  2972. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  2973. end;
  2974. procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2975. begin
  2976. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  2977. end;
  2978. constructor TfdS3tcDtx1RGBA.Create;
  2979. begin
  2980. inherited Create;
  2981. fFormat := tfS3tcDtx1RGBA;
  2982. fWithAlpha := tfS3tcDtx1RGBA;
  2983. fUncompressed := tfRGB5A1;
  2984. fPixelSize := 0.5;
  2985. fIsCompressed := true;
  2986. fglFormat := GL_COMPRESSED_RGBA;
  2987. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
  2988. fglDataFormat := GL_UNSIGNED_BYTE;
  2989. end;
  2990. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2991. //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2992. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2993. procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2994. begin
  2995. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  2996. end;
  2997. procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2998. begin
  2999. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  3000. end;
  3001. constructor TfdS3tcDtx3RGBA.Create;
  3002. begin
  3003. inherited Create;
  3004. fFormat := tfS3tcDtx3RGBA;
  3005. fWithAlpha := tfS3tcDtx3RGBA;
  3006. fUncompressed := tfRGBA8;
  3007. fPixelSize := 1.0;
  3008. fIsCompressed := true;
  3009. fglFormat := GL_COMPRESSED_RGBA;
  3010. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
  3011. fglDataFormat := GL_UNSIGNED_BYTE;
  3012. end;
  3013. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3014. //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3015. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3016. procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3017. begin
  3018. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  3019. end;
  3020. procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3021. begin
  3022. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  3023. end;
  3024. constructor TfdS3tcDtx5RGBA.Create;
  3025. begin
  3026. inherited Create;
  3027. fFormat := tfS3tcDtx3RGBA;
  3028. fWithAlpha := tfS3tcDtx3RGBA;
  3029. fUncompressed := tfRGBA8;
  3030. fPixelSize := 1.0;
  3031. fIsCompressed := true;
  3032. fglFormat := GL_COMPRESSED_RGBA;
  3033. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
  3034. fglDataFormat := GL_UNSIGNED_BYTE;
  3035. end;
  3036. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3037. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3038. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3039. class procedure TFormatDescriptor.Init;
  3040. begin
  3041. if not Assigned(FormatDescriptorCS) then
  3042. FormatDescriptorCS := TCriticalSection.Create;
  3043. end;
  3044. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3045. class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3046. begin
  3047. FormatDescriptorCS.Enter;
  3048. try
  3049. result := FormatDescriptors[aFormat];
  3050. if not Assigned(result) then begin
  3051. result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
  3052. FormatDescriptors[aFormat] := result;
  3053. end;
  3054. finally
  3055. FormatDescriptorCS.Leave;
  3056. end;
  3057. end;
  3058. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3059. class function TFormatDescriptor.GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3060. begin
  3061. result := Get(Get(aFormat).WithAlpha);
  3062. end;
  3063. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3064. class procedure TFormatDescriptor.Clear;
  3065. var
  3066. f: TglBitmapFormat;
  3067. begin
  3068. FormatDescriptorCS.Enter;
  3069. try
  3070. for f := low(FormatDescriptors) to high(FormatDescriptors) do
  3071. FreeAndNil(FormatDescriptors[f]);
  3072. finally
  3073. FormatDescriptorCS.Leave;
  3074. end;
  3075. end;
  3076. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3077. class procedure TFormatDescriptor.Finalize;
  3078. begin
  3079. Clear;
  3080. FreeAndNil(FormatDescriptorCS);
  3081. end;
  3082. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3083. //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3084. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3085. procedure TbmpBitfieldFormat.SetRedMask(const aValue: QWord);
  3086. begin
  3087. Update(aValue, fRange.r, fShift.r);
  3088. end;
  3089. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3090. procedure TbmpBitfieldFormat.SetGreenMask(const aValue: QWord);
  3091. begin
  3092. Update(aValue, fRange.g, fShift.g);
  3093. end;
  3094. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3095. procedure TbmpBitfieldFormat.SetBlueMask(const aValue: QWord);
  3096. begin
  3097. Update(aValue, fRange.b, fShift.b);
  3098. end;
  3099. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3100. procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: QWord);
  3101. begin
  3102. Update(aValue, fRange.a, fShift.a);
  3103. end;
  3104. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3105. procedure TbmpBitfieldFormat.Update(aMask: QWord; out aRange: Cardinal; out
  3106. aShift: Byte);
  3107. begin
  3108. aShift := 0;
  3109. aRange := 0;
  3110. if (aMask = 0) then
  3111. exit;
  3112. while (aMask > 0) and ((aMask and 1) = 0) do begin
  3113. inc(aShift);
  3114. aMask := aMask shr 1;
  3115. end;
  3116. aRange := 1;
  3117. while (aMask > 0) do begin
  3118. aRange := aRange shl 1;
  3119. aMask := aMask shr 1;
  3120. end;
  3121. dec(aRange);
  3122. fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
  3123. end;
  3124. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3125. procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3126. var
  3127. data: QWord;
  3128. s: Integer;
  3129. begin
  3130. data :=
  3131. ((aPixel.Data.r and fRange.r) shl fShift.r) or
  3132. ((aPixel.Data.g and fRange.g) shl fShift.g) or
  3133. ((aPixel.Data.b and fRange.b) shl fShift.b) or
  3134. ((aPixel.Data.a and fRange.a) shl fShift.a);
  3135. s := Round(fPixelSize);
  3136. case s of
  3137. 1: aData^ := data;
  3138. 2: PWord(aData)^ := data;
  3139. 4: PCardinal(aData)^ := data;
  3140. 8: PQWord(aData)^ := data;
  3141. else
  3142. raise EglBitmapException.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
  3143. end;
  3144. inc(aData, s);
  3145. end;
  3146. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3147. procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3148. var
  3149. data: QWord;
  3150. s, i: Integer;
  3151. begin
  3152. s := Round(fPixelSize);
  3153. case s of
  3154. 1: data := aData^;
  3155. 2: data := PWord(aData)^;
  3156. 4: data := PCardinal(aData)^;
  3157. 8: data := PQWord(aData)^;
  3158. else
  3159. raise EglBitmapException.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
  3160. end;
  3161. for i := 0 to 3 do
  3162. aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
  3163. inc(aData, s);
  3164. end;
  3165. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3166. //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3167. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3168. procedure TbmpColorTableFormat.CreateColorTable;
  3169. var
  3170. i: Integer;
  3171. begin
  3172. if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
  3173. raise EglBitmapException.Create(UNSUPPORTED_FORMAT);
  3174. if (Format = tfLuminance4) then
  3175. SetLength(fColorTable, 16)
  3176. else
  3177. SetLength(fColorTable, 256);
  3178. case Format of
  3179. tfLuminance4: begin
  3180. for i := 0 to High(fColorTable) do begin
  3181. fColorTable[i].r := 16 * i;
  3182. fColorTable[i].g := 16 * i;
  3183. fColorTable[i].b := 16 * i;
  3184. fColorTable[i].a := 0;
  3185. end;
  3186. end;
  3187. tfLuminance8: begin
  3188. for i := 0 to High(fColorTable) do begin
  3189. fColorTable[i].r := i;
  3190. fColorTable[i].g := i;
  3191. fColorTable[i].b := i;
  3192. fColorTable[i].a := 0;
  3193. end;
  3194. end;
  3195. tfR3G3B2: begin
  3196. for i := 0 to High(fColorTable) do begin
  3197. fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
  3198. fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
  3199. fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
  3200. fColorTable[i].a := 0;
  3201. end;
  3202. end;
  3203. end;
  3204. end;
  3205. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3206. procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3207. var
  3208. d: Byte;
  3209. begin
  3210. if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
  3211. raise EglBitmapException.Create(UNSUPPORTED_FORMAT);
  3212. case Format of
  3213. tfLuminance4: begin
  3214. if (aMapData = nil) then
  3215. aData^ := 0;
  3216. d := LuminanceWeight(aPixel) and Range.r;
  3217. aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData)));
  3218. inc(PByte(aMapData), 4);
  3219. if ({%H-}PtrUInt(aMapData) >= 8) then begin
  3220. inc(aData);
  3221. aMapData := nil;
  3222. end;
  3223. end;
  3224. tfLuminance8: begin
  3225. aData^ := LuminanceWeight(aPixel) and Range.r;
  3226. inc(aData);
  3227. end;
  3228. tfR3G3B2: begin
  3229. aData^ := Round(
  3230. ((aPixel.Data.r and Range.r) shl Shift.r) or
  3231. ((aPixel.Data.g and Range.g) shl Shift.g) or
  3232. ((aPixel.Data.b and Range.b) shl Shift.b));
  3233. inc(aData);
  3234. end;
  3235. end;
  3236. end;
  3237. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3238. procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3239. var
  3240. idx: QWord;
  3241. s: Integer;
  3242. bits: Byte;
  3243. f: Single;
  3244. begin
  3245. s := Trunc(fPixelSize);
  3246. f := fPixelSize - s;
  3247. bits := Round(8 * f);
  3248. case s of
  3249. 0: idx := (aData^ shr (8 - bits - {%H-}PtrInt(aMapData))) and ((1 shl bits) - 1);
  3250. 1: idx := aData^;
  3251. 2: idx := PWord(aData)^;
  3252. 4: idx := PCardinal(aData)^;
  3253. 8: idx := PQWord(aData)^;
  3254. else
  3255. raise EglBitmapException.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
  3256. end;
  3257. if (idx >= Length(fColorTable)) then
  3258. raise EglBitmapException.CreateFmt('invalid color index: %d', [idx]);
  3259. with fColorTable[idx] do begin
  3260. aPixel.Data.r := r;
  3261. aPixel.Data.g := g;
  3262. aPixel.Data.b := b;
  3263. aPixel.Data.a := a;
  3264. end;
  3265. inc(PByte(aMapData), bits);
  3266. if ({%H-}PtrUInt(aMapData) >= 8) then begin
  3267. inc(aData, 1);
  3268. dec(PByte(aMapData), 8);
  3269. end;
  3270. inc(aData, s);
  3271. end;
  3272. destructor TbmpColorTableFormat.Destroy;
  3273. begin
  3274. SetLength(fColorTable, 0);
  3275. inherited Destroy;
  3276. end;
  3277. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3278. //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3279. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3280. procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
  3281. var
  3282. i: Integer;
  3283. begin
  3284. for i := 0 to 3 do begin
  3285. if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
  3286. if (aSourceFD.Range.arr[i] > 0) then
  3287. aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
  3288. else
  3289. aPixel.Data.arr[i] := aDestFD.Range.arr[i];
  3290. end;
  3291. end;
  3292. end;
  3293. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3294. procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
  3295. begin
  3296. with aFuncRec do begin
  3297. if (Source.Range.r > 0) then
  3298. Dest.Data.r := Source.Data.r;
  3299. if (Source.Range.g > 0) then
  3300. Dest.Data.g := Source.Data.g;
  3301. if (Source.Range.b > 0) then
  3302. Dest.Data.b := Source.Data.b;
  3303. if (Source.Range.a > 0) then
  3304. Dest.Data.a := Source.Data.a;
  3305. end;
  3306. end;
  3307. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3308. procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3309. var
  3310. i: Integer;
  3311. begin
  3312. with aFuncRec do begin
  3313. for i := 0 to 3 do
  3314. if (Source.Range.arr[i] > 0) then
  3315. Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
  3316. end;
  3317. end;
  3318. type
  3319. TShiftData = packed record
  3320. case Integer of
  3321. 0: (r, g, b, a: SmallInt);
  3322. 1: (arr: array[0..3] of SmallInt);
  3323. end;
  3324. PShiftData = ^TShiftData;
  3325. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3326. procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3327. var
  3328. i: Integer;
  3329. begin
  3330. with aFuncRec do
  3331. for i := 0 to 3 do
  3332. if (Source.Range.arr[i] > 0) then
  3333. Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
  3334. end;
  3335. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3336. procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
  3337. begin
  3338. with aFuncRec do begin
  3339. Dest.Data := Source.Data;
  3340. if ({%H-}PtrUInt(Args) and $1 > 0) then begin
  3341. Dest.Data.r := Dest.Data.r xor Dest.Range.r;
  3342. Dest.Data.g := Dest.Data.g xor Dest.Range.g;
  3343. Dest.Data.b := Dest.Data.b xor Dest.Range.b;
  3344. end;
  3345. if ({%H-}PtrUInt(Args) and $2 > 0) then begin
  3346. Dest.Data.a := Dest.Data.a xor Dest.Range.a;
  3347. end;
  3348. end;
  3349. end;
  3350. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3351. procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
  3352. var
  3353. i: Integer;
  3354. begin
  3355. with aFuncRec do begin
  3356. for i := 0 to 3 do
  3357. Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
  3358. end;
  3359. end;
  3360. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3361. procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3362. var
  3363. Temp: Single;
  3364. begin
  3365. with FuncRec do begin
  3366. if (FuncRec.Args = nil) then begin //source has no alpha
  3367. Temp :=
  3368. Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
  3369. Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
  3370. Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
  3371. Dest.Data.a := Round(Dest.Range.a * Temp);
  3372. end else
  3373. Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
  3374. end;
  3375. end;
  3376. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3377. procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3378. type
  3379. PglBitmapPixelData = ^TglBitmapPixelData;
  3380. begin
  3381. with FuncRec do begin
  3382. Dest.Data.r := Source.Data.r;
  3383. Dest.Data.g := Source.Data.g;
  3384. Dest.Data.b := Source.Data.b;
  3385. with PglBitmapPixelData(Args)^ do
  3386. if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
  3387. (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
  3388. (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
  3389. Dest.Data.a := 0
  3390. else
  3391. Dest.Data.a := Dest.Range.a;
  3392. end;
  3393. end;
  3394. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3395. procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3396. begin
  3397. with FuncRec do begin
  3398. Dest.Data.r := Source.Data.r;
  3399. Dest.Data.g := Source.Data.g;
  3400. Dest.Data.b := Source.Data.b;
  3401. Dest.Data.a := PCardinal(Args)^;
  3402. end;
  3403. end;
  3404. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3405. procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
  3406. type
  3407. PRGBPix = ^TRGBPix;
  3408. TRGBPix = array [0..2] of byte;
  3409. var
  3410. Temp: Byte;
  3411. begin
  3412. while aWidth > 0 do begin
  3413. Temp := PRGBPix(aData)^[0];
  3414. PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
  3415. PRGBPix(aData)^[2] := Temp;
  3416. if aHasAlpha then
  3417. Inc(aData, 4)
  3418. else
  3419. Inc(aData, 3);
  3420. dec(aWidth);
  3421. end;
  3422. end;
  3423. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3424. //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3425. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3426. function TglBitmap.GetWidth: Integer;
  3427. begin
  3428. if (ffX in fDimension.Fields) then
  3429. result := fDimension.X
  3430. else
  3431. result := -1;
  3432. end;
  3433. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3434. function TglBitmap.GetHeight: Integer;
  3435. begin
  3436. if (ffY in fDimension.Fields) then
  3437. result := fDimension.Y
  3438. else
  3439. result := -1;
  3440. end;
  3441. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3442. function TglBitmap.GetFileWidth: Integer;
  3443. begin
  3444. result := Max(1, Width);
  3445. end;
  3446. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3447. function TglBitmap.GetFileHeight: Integer;
  3448. begin
  3449. result := Max(1, Height);
  3450. end;
  3451. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3452. procedure TglBitmap.SetCustomData(const aValue: Pointer);
  3453. begin
  3454. if fCustomData = aValue then
  3455. exit;
  3456. fCustomData := aValue;
  3457. end;
  3458. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3459. procedure TglBitmap.SetCustomName(const aValue: String);
  3460. begin
  3461. if fCustomName = aValue then
  3462. exit;
  3463. fCustomName := aValue;
  3464. end;
  3465. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3466. procedure TglBitmap.SetCustomNameW(const aValue: WideString);
  3467. begin
  3468. if fCustomNameW = aValue then
  3469. exit;
  3470. fCustomNameW := aValue;
  3471. end;
  3472. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3473. procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
  3474. begin
  3475. if fDeleteTextureOnFree = aValue then
  3476. exit;
  3477. fDeleteTextureOnFree := aValue;
  3478. end;
  3479. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3480. procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
  3481. begin
  3482. if fFormat = aValue then
  3483. exit;
  3484. if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
  3485. raise EglBitmapUnsupportedFormat.Create(Format);
  3486. SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
  3487. end;
  3488. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3489. procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
  3490. begin
  3491. if fFreeDataAfterGenTexture = aValue then
  3492. exit;
  3493. fFreeDataAfterGenTexture := aValue;
  3494. end;
  3495. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3496. procedure TglBitmap.SetID(const aValue: Cardinal);
  3497. begin
  3498. if fID = aValue then
  3499. exit;
  3500. fID := aValue;
  3501. end;
  3502. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3503. procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
  3504. begin
  3505. if fMipMap = aValue then
  3506. exit;
  3507. fMipMap := aValue;
  3508. end;
  3509. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3510. procedure TglBitmap.SetTarget(const aValue: Cardinal);
  3511. begin
  3512. if fTarget = aValue then
  3513. exit;
  3514. fTarget := aValue;
  3515. end;
  3516. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3517. procedure TglBitmap.SetAnisotropic(const aValue: Integer);
  3518. var
  3519. MaxAnisotropic: Integer;
  3520. begin
  3521. fAnisotropic := aValue;
  3522. if (ID > 0) then begin
  3523. if GL_EXT_texture_filter_anisotropic then begin
  3524. if fAnisotropic > 0 then begin
  3525. Bind(false);
  3526. glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
  3527. if aValue > MaxAnisotropic then
  3528. fAnisotropic := MaxAnisotropic;
  3529. glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
  3530. end;
  3531. end else begin
  3532. fAnisotropic := 0;
  3533. end;
  3534. end;
  3535. end;
  3536. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3537. procedure TglBitmap.CreateID;
  3538. begin
  3539. if (ID <> 0) then
  3540. glDeleteTextures(1, @fID);
  3541. glGenTextures(1, @fID);
  3542. Bind(false);
  3543. end;
  3544. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3545. procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
  3546. begin
  3547. // Set Up Parameters
  3548. SetWrap(fWrapS, fWrapT, fWrapR);
  3549. SetFilter(fFilterMin, fFilterMag);
  3550. SetAnisotropic(fAnisotropic);
  3551. SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
  3552. // Mip Maps Generation Mode
  3553. aBuildWithGlu := false;
  3554. if (MipMap = mmMipmap) then begin
  3555. if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
  3556. glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
  3557. else
  3558. aBuildWithGlu := true;
  3559. end else if (MipMap = mmMipmapGlu) then
  3560. aBuildWithGlu := true;
  3561. end;
  3562. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3563. procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  3564. const aWidth: Integer; const aHeight: Integer);
  3565. var
  3566. s: Single;
  3567. begin
  3568. if (Data <> aData) then begin
  3569. if (Assigned(Data)) then
  3570. FreeMem(Data);
  3571. fData := aData;
  3572. end;
  3573. FillChar(fDimension, SizeOf(fDimension), 0);
  3574. if not Assigned(fData) then begin
  3575. fFormat := tfEmpty;
  3576. fPixelSize := 0;
  3577. fRowSize := 0;
  3578. end else begin
  3579. if aWidth <> -1 then begin
  3580. fDimension.Fields := fDimension.Fields + [ffX];
  3581. fDimension.X := aWidth;
  3582. end;
  3583. if aHeight <> -1 then begin
  3584. fDimension.Fields := fDimension.Fields + [ffY];
  3585. fDimension.Y := aHeight;
  3586. end;
  3587. s := TFormatDescriptor.Get(aFormat).PixelSize;
  3588. fFormat := aFormat;
  3589. fPixelSize := Ceil(s);
  3590. fRowSize := Ceil(s * aWidth);
  3591. end;
  3592. end;
  3593. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3594. function TglBitmap.FlipHorz: Boolean;
  3595. begin
  3596. result := false;
  3597. end;
  3598. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3599. function TglBitmap.FlipVert: Boolean;
  3600. begin
  3601. result := false;
  3602. end;
  3603. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3604. //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3605. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3606. procedure TglBitmap.AfterConstruction;
  3607. begin
  3608. inherited AfterConstruction;
  3609. fID := 0;
  3610. fTarget := 0;
  3611. fIsResident := false;
  3612. fFormat := glBitmapGetDefaultFormat;
  3613. fMipMap := glBitmapDefaultMipmap;
  3614. fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
  3615. fDeleteTextureOnFree := glBitmapGetDefaultDeleteTextureOnFree;
  3616. glBitmapGetDefaultFilter (fFilterMin, fFilterMag);
  3617. glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
  3618. end;
  3619. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3620. procedure TglBitmap.BeforeDestruction;
  3621. var
  3622. NewData: PByte;
  3623. begin
  3624. NewData := nil;
  3625. SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
  3626. if (fID > 0) and fDeleteTextureOnFree then
  3627. glDeleteTextures(1, @fID);
  3628. inherited BeforeDestruction;
  3629. end;
  3630. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3631. procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
  3632. var
  3633. TempPos: Integer;
  3634. begin
  3635. if not Assigned(aResType) then begin
  3636. TempPos := Pos('.', aResource);
  3637. aResType := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
  3638. aResource := UpperCase(Copy(aResource, 0, TempPos -1));
  3639. end;
  3640. end;
  3641. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3642. procedure TglBitmap.LoadFromFile(const aFilename: String);
  3643. var
  3644. fs: TFileStream;
  3645. begin
  3646. if not FileExists(aFilename) then
  3647. raise EglBitmapException.Create('file does not exist: ' + aFilename);
  3648. fFilename := aFilename;
  3649. fs := TFileStream.Create(fFilename, fmOpenRead);
  3650. try
  3651. fs.Position := 0;
  3652. LoadFromStream(fs);
  3653. finally
  3654. fs.Free;
  3655. end;
  3656. end;
  3657. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3658. procedure TglBitmap.LoadFromStream(const aStream: TStream);
  3659. begin
  3660. {$IFDEF GLB_SUPPORT_PNG_READ}
  3661. if not LoadPNG(aStream) then
  3662. {$ENDIF}
  3663. {$IFDEF GLB_SUPPORT_JPEG_READ}
  3664. if not LoadJPEG(aStream) then
  3665. {$ENDIF}
  3666. if not LoadDDS(aStream) then
  3667. if not LoadTGA(aStream) then
  3668. if not LoadBMP(aStream) then
  3669. raise EglBitmapException.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
  3670. end;
  3671. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3672. procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  3673. const aFormat: TglBitmapFormat; const aArgs: Pointer);
  3674. var
  3675. tmpData: PByte;
  3676. size: Integer;
  3677. begin
  3678. size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  3679. GetMem(tmpData, size);
  3680. try
  3681. FillChar(tmpData^, size, #$FF);
  3682. SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  3683. except
  3684. if Assigned(tmpData) then
  3685. FreeMem(tmpData);
  3686. raise;
  3687. end;
  3688. AddFunc(Self, aFunc, false, Format, aArgs);
  3689. end;
  3690. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3691. procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
  3692. var
  3693. rs: TResourceStream;
  3694. begin
  3695. PrepareResType(aResource, aResType);
  3696. rs := TResourceStream.Create(aInstance, aResource, aResType);
  3697. try
  3698. LoadFromStream(rs);
  3699. finally
  3700. rs.Free;
  3701. end;
  3702. end;
  3703. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3704. procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  3705. var
  3706. rs: TResourceStream;
  3707. begin
  3708. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  3709. try
  3710. LoadFromStream(rs);
  3711. finally
  3712. rs.Free;
  3713. end;
  3714. end;
  3715. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3716. procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  3717. var
  3718. fs: TFileStream;
  3719. begin
  3720. fs := TFileStream.Create(aFileName, fmCreate);
  3721. try
  3722. fs.Position := 0;
  3723. SaveToStream(fs, aFileType);
  3724. finally
  3725. fs.Free;
  3726. end;
  3727. end;
  3728. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3729. procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
  3730. begin
  3731. case aFileType of
  3732. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  3733. ftPNG: SavePNG(aStream);
  3734. {$ENDIF}
  3735. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  3736. ftJPEG: SaveJPEG(aStream);
  3737. {$ENDIF}
  3738. ftDDS: SaveDDS(aStream);
  3739. ftTGA: SaveTGA(aStream);
  3740. ftBMP: SaveBMP(aStream);
  3741. end;
  3742. end;
  3743. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3744. function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
  3745. begin
  3746. result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
  3747. end;
  3748. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3749. function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  3750. const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
  3751. var
  3752. DestData, TmpData, SourceData: pByte;
  3753. TempHeight, TempWidth: Integer;
  3754. SourceFD, DestFD: TFormatDescriptor;
  3755. SourceMD, DestMD: Pointer;
  3756. FuncRec: TglBitmapFunctionRec;
  3757. begin
  3758. Assert(Assigned(Data));
  3759. Assert(Assigned(aSource));
  3760. Assert(Assigned(aSource.Data));
  3761. result := false;
  3762. if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
  3763. SourceFD := TFormatDescriptor.Get(aSource.Format);
  3764. DestFD := TFormatDescriptor.Get(aFormat);
  3765. if (SourceFD.IsCompressed) then
  3766. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
  3767. if (DestFD.IsCompressed) then
  3768. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
  3769. // inkompatible Formats so CreateTemp
  3770. if (SourceFD.PixelSize <> DestFD.PixelSize) then
  3771. aCreateTemp := true;
  3772. // Values
  3773. TempHeight := Max(1, aSource.Height);
  3774. TempWidth := Max(1, aSource.Width);
  3775. FuncRec.Sender := Self;
  3776. FuncRec.Args := aArgs;
  3777. TmpData := nil;
  3778. if aCreateTemp then begin
  3779. GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
  3780. DestData := TmpData;
  3781. end else
  3782. DestData := Data;
  3783. try
  3784. SourceFD.PreparePixel(FuncRec.Source);
  3785. DestFD.PreparePixel (FuncRec.Dest);
  3786. SourceMD := SourceFD.CreateMappingData;
  3787. DestMD := DestFD.CreateMappingData;
  3788. FuncRec.Size := aSource.Dimension;
  3789. FuncRec.Position.Fields := FuncRec.Size.Fields;
  3790. try
  3791. SourceData := aSource.Data;
  3792. FuncRec.Position.Y := 0;
  3793. while FuncRec.Position.Y < TempHeight do begin
  3794. FuncRec.Position.X := 0;
  3795. while FuncRec.Position.X < TempWidth do begin
  3796. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  3797. aFunc(FuncRec);
  3798. DestFD.Map(FuncRec.Dest, DestData, DestMD);
  3799. inc(FuncRec.Position.X);
  3800. end;
  3801. inc(FuncRec.Position.Y);
  3802. end;
  3803. // Updating Image or InternalFormat
  3804. if aCreateTemp then
  3805. SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method
  3806. else if (aFormat <> fFormat) then
  3807. Format := aFormat;
  3808. result := true;
  3809. finally
  3810. SourceFD.FreeMappingData(SourceMD);
  3811. DestFD.FreeMappingData(DestMD);
  3812. end;
  3813. except
  3814. if aCreateTemp and Assigned(TmpData) then
  3815. FreeMem(TmpData);
  3816. raise;
  3817. end;
  3818. end;
  3819. end;
  3820. {$IFDEF GLB_SDL}
  3821. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3822. function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  3823. var
  3824. Row, RowSize: Integer;
  3825. SourceData, TmpData: PByte;
  3826. TempDepth: Integer;
  3827. FormatDesc: TFormatDescriptor;
  3828. function GetRowPointer(Row: Integer): pByte;
  3829. begin
  3830. result := aSurface.pixels;
  3831. Inc(result, Row * RowSize);
  3832. end;
  3833. begin
  3834. result := false;
  3835. FormatDesc := TFormatDescriptor.Get(Format);
  3836. if FormatDesc.IsCompressed then
  3837. raise EglBitmapUnsupportedFormat.Create(Format);
  3838. if Assigned(Data) then begin
  3839. case Trunc(FormatDesc.PixelSize) of
  3840. 1: TempDepth := 8;
  3841. 2: TempDepth := 16;
  3842. 3: TempDepth := 24;
  3843. 4: TempDepth := 32;
  3844. else
  3845. raise EglBitmapUnsupportedFormat.Create(Format);
  3846. end;
  3847. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
  3848. FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
  3849. SourceData := Data;
  3850. RowSize := FormatDesc.GetSize(FileWidth, 1);
  3851. for Row := 0 to FileHeight-1 do begin
  3852. TmpData := GetRowPointer(Row);
  3853. if Assigned(TmpData) then begin
  3854. Move(SourceData^, TmpData^, RowSize);
  3855. inc(SourceData, RowSize);
  3856. end;
  3857. end;
  3858. result := true;
  3859. end;
  3860. end;
  3861. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3862. function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  3863. var
  3864. pSource, pData, pTempData: PByte;
  3865. Row, RowSize, TempWidth, TempHeight: Integer;
  3866. IntFormat: TglBitmapFormat;
  3867. FormatDesc: TFormatDescriptor;
  3868. function GetRowPointer(Row: Integer): pByte;
  3869. begin
  3870. result := aSurface^.pixels;
  3871. Inc(result, Row * RowSize);
  3872. end;
  3873. begin
  3874. result := false;
  3875. if (Assigned(aSurface)) then begin
  3876. with aSurface^.format^ do begin
  3877. for IntFormat := High(TglBitmapFormat) to Low(TglBitmapFormat) do begin
  3878. FormatDesc := TFormatDescriptor.Get(IntFormat);
  3879. if (FormatDesc.MaskMatch(RMask, GMask, BMask, AMask)) then
  3880. break;
  3881. end;
  3882. if (IntFormat = tfEmpty) then
  3883. raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
  3884. end;
  3885. TempWidth := aSurface^.w;
  3886. TempHeight := aSurface^.h;
  3887. RowSize := FormatDesc.GetSize(TempWidth, 1);
  3888. GetMem(pData, TempHeight * RowSize);
  3889. try
  3890. pTempData := pData;
  3891. for Row := 0 to TempHeight -1 do begin
  3892. pSource := GetRowPointer(Row);
  3893. if (Assigned(pSource)) then begin
  3894. Move(pSource^, pTempData^, RowSize);
  3895. Inc(pTempData, RowSize);
  3896. end;
  3897. end;
  3898. SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  3899. result := true;
  3900. except
  3901. if Assigned(pData) then
  3902. FreeMem(pData);
  3903. raise;
  3904. end;
  3905. end;
  3906. end;
  3907. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3908. function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  3909. var
  3910. Row, Col, AlphaInterleave: Integer;
  3911. pSource, pDest: PByte;
  3912. function GetRowPointer(Row: Integer): pByte;
  3913. begin
  3914. result := aSurface.pixels;
  3915. Inc(result, Row * Width);
  3916. end;
  3917. begin
  3918. result := false;
  3919. if Assigned(Data) then begin
  3920. if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
  3921. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
  3922. AlphaInterleave := 0;
  3923. case Format of
  3924. tfLuminance8Alpha8:
  3925. AlphaInterleave := 1;
  3926. tfBGRA8, tfRGBA8:
  3927. AlphaInterleave := 3;
  3928. end;
  3929. pSource := Data;
  3930. for Row := 0 to Height -1 do begin
  3931. pDest := GetRowPointer(Row);
  3932. if Assigned(pDest) then begin
  3933. for Col := 0 to Width -1 do begin
  3934. Inc(pSource, AlphaInterleave);
  3935. pDest^ := pSource^;
  3936. Inc(pDest);
  3937. Inc(pSource);
  3938. end;
  3939. end;
  3940. end;
  3941. result := true;
  3942. end;
  3943. end;
  3944. end;
  3945. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3946. function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  3947. var
  3948. bmp: TglBitmap2D;
  3949. begin
  3950. bmp := TglBitmap2D.Create;
  3951. try
  3952. bmp.AssignFromSurface(aSurface);
  3953. result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
  3954. finally
  3955. bmp.Free;
  3956. end;
  3957. end;
  3958. {$ENDIF}
  3959. {$IFDEF GLB_DELPHI}
  3960. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3961. function CreateGrayPalette: HPALETTE;
  3962. var
  3963. Idx: Integer;
  3964. Pal: PLogPalette;
  3965. begin
  3966. GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
  3967. Pal.palVersion := $300;
  3968. Pal.palNumEntries := 256;
  3969. for Idx := 0 to Pal.palNumEntries - 1 do begin
  3970. Pal.palPalEntry[Idx].peRed := Idx;
  3971. Pal.palPalEntry[Idx].peGreen := Idx;
  3972. Pal.palPalEntry[Idx].peBlue := Idx;
  3973. Pal.palPalEntry[Idx].peFlags := 0;
  3974. end;
  3975. Result := CreatePalette(Pal^);
  3976. FreeMem(Pal);
  3977. end;
  3978. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3979. function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
  3980. var
  3981. Row: Integer;
  3982. pSource, pData: PByte;
  3983. begin
  3984. result := false;
  3985. if Assigned(Data) then begin
  3986. if Assigned(aBitmap) then begin
  3987. aBitmap.Width := Width;
  3988. aBitmap.Height := Height;
  3989. case Format of
  3990. tfAlpha8, tfLuminance8: begin
  3991. aBitmap.PixelFormat := pf8bit;
  3992. aBitmap.Palette := CreateGrayPalette;
  3993. end;
  3994. tfRGB5A1:
  3995. aBitmap.PixelFormat := pf15bit;
  3996. tfR5G6B5:
  3997. aBitmap.PixelFormat := pf16bit;
  3998. tfRGB8, tfBGR8:
  3999. aBitmap.PixelFormat := pf24bit;
  4000. tfRGBA8, tfBGRA8:
  4001. aBitmap.PixelFormat := pf32bit;
  4002. else
  4003. raise EglBitmapException.Create('AssignToBitmap - Invalid Pixelformat.');
  4004. end;
  4005. pSource := Data;
  4006. for Row := 0 to FileHeight -1 do begin
  4007. pData := aBitmap.Scanline[Row];
  4008. Move(pSource^, pData^, fRowSize);
  4009. Inc(pSource, fRowSize);
  4010. if (Format in [tfRGB8, tfRGBA8]) then // swap RGB(A) to BGR(A)
  4011. SwapRGB(pData, FileWidth, Format = tfRGBA8);
  4012. end;
  4013. result := true;
  4014. end;
  4015. end;
  4016. end;
  4017. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4018. function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  4019. var
  4020. pSource, pData, pTempData: PByte;
  4021. Row, RowSize, TempWidth, TempHeight: Integer;
  4022. IntFormat: TglBitmapFormat;
  4023. begin
  4024. result := false;
  4025. if (Assigned(aBitmap)) then begin
  4026. case aBitmap.PixelFormat of
  4027. pf8bit:
  4028. IntFormat := tfLuminance8;
  4029. pf15bit:
  4030. IntFormat := tfRGB5A1;
  4031. pf16bit:
  4032. IntFormat := tfR5G6B5;
  4033. pf24bit:
  4034. IntFormat := tfBGR8;
  4035. pf32bit:
  4036. IntFormat := tfBGRA8;
  4037. else
  4038. raise EglBitmapException.Create('AssignFromBitmap - Invalid Pixelformat.');
  4039. end;
  4040. TempWidth := aBitmap.Width;
  4041. TempHeight := aBitmap.Height;
  4042. RowSize := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
  4043. GetMem(pData, TempHeight * RowSize);
  4044. try
  4045. pTempData := pData;
  4046. for Row := 0 to TempHeight -1 do begin
  4047. pSource := aBitmap.Scanline[Row];
  4048. if (Assigned(pSource)) then begin
  4049. Move(pSource^, pTempData^, RowSize);
  4050. Inc(pTempData, RowSize);
  4051. end;
  4052. end;
  4053. SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  4054. result := true;
  4055. except
  4056. if Assigned(pData) then
  4057. FreeMem(pData);
  4058. raise;
  4059. end;
  4060. end;
  4061. end;
  4062. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4063. function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  4064. var
  4065. Row, Col, AlphaInterleave: Integer;
  4066. pSource, pDest: PByte;
  4067. begin
  4068. result := false;
  4069. if Assigned(Data) then begin
  4070. if (Format in [tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8]) then begin
  4071. if Assigned(aBitmap) then begin
  4072. aBitmap.PixelFormat := pf8bit;
  4073. aBitmap.Palette := CreateGrayPalette;
  4074. aBitmap.Width := Width;
  4075. aBitmap.Height := Height;
  4076. case Format of
  4077. tfLuminance8Alpha8:
  4078. AlphaInterleave := 1;
  4079. tfRGBA8, tfBGRA8:
  4080. AlphaInterleave := 3;
  4081. else
  4082. AlphaInterleave := 0;
  4083. end;
  4084. // Copy Data
  4085. pSource := Data;
  4086. for Row := 0 to Height -1 do begin
  4087. pDest := aBitmap.Scanline[Row];
  4088. if Assigned(pDest) then begin
  4089. for Col := 0 to Width -1 do begin
  4090. Inc(pSource, AlphaInterleave);
  4091. pDest^ := pSource^;
  4092. Inc(pDest);
  4093. Inc(pSource);
  4094. end;
  4095. end;
  4096. end;
  4097. result := true;
  4098. end;
  4099. end;
  4100. end;
  4101. end;
  4102. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4103. function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4104. var
  4105. tex: TglBitmap2D;
  4106. begin
  4107. tex := TglBitmap2D.Create;
  4108. try
  4109. tex.AssignFromBitmap(ABitmap);
  4110. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4111. finally
  4112. tex.Free;
  4113. end;
  4114. end;
  4115. {$ENDIF}
  4116. {$IFDEF GLB_LAZARUS}
  4117. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4118. function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4119. var
  4120. rid: TRawImageDescription;
  4121. FormatDesc: TFormatDescriptor;
  4122. begin
  4123. result := false;
  4124. if not Assigned(aImage) or (Format = tfEmpty) then
  4125. exit;
  4126. FormatDesc := TFormatDescriptor.Get(Format);
  4127. if FormatDesc.IsCompressed then
  4128. exit;
  4129. FillChar(rid{%H-}, SizeOf(rid), 0);
  4130. if (Format in [
  4131. tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
  4132. tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
  4133. tfLuminance4Alpha4, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16]) then
  4134. rid.Format := ricfGray
  4135. else
  4136. rid.Format := ricfRGBA;
  4137. rid.Width := Width;
  4138. rid.Height := Height;
  4139. rid.Depth := CountSetBits(FormatDesc.Range.r or FormatDesc.Range.g or FormatDesc.Range.b or FormatDesc.Range.a);
  4140. rid.BitOrder := riboBitsInOrder;
  4141. rid.ByteOrder := riboLSBFirst;
  4142. rid.LineOrder := riloTopToBottom;
  4143. rid.LineEnd := rileTight;
  4144. rid.BitsPerPixel := Round(8 * FormatDesc.PixelSize);
  4145. rid.RedPrec := CountSetBits(FormatDesc.Range.r);
  4146. rid.GreenPrec := CountSetBits(FormatDesc.Range.g);
  4147. rid.BluePrec := CountSetBits(FormatDesc.Range.b);
  4148. rid.AlphaPrec := CountSetBits(FormatDesc.Range.a);
  4149. rid.RedShift := FormatDesc.Shift.r;
  4150. rid.GreenShift := FormatDesc.Shift.g;
  4151. rid.BlueShift := FormatDesc.Shift.b;
  4152. rid.AlphaShift := FormatDesc.Shift.a;
  4153. rid.MaskBitsPerPixel := 0;
  4154. rid.PaletteColorCount := 0;
  4155. aImage.DataDescription := rid;
  4156. aImage.CreateData;
  4157. Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
  4158. result := true;
  4159. end;
  4160. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4161. function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4162. var
  4163. f: TglBitmapFormat;
  4164. FormatDesc: TFormatDescriptor;
  4165. ImageData: PByte;
  4166. ImageSize: Integer;
  4167. begin
  4168. result := false;
  4169. if not Assigned(aImage) then
  4170. exit;
  4171. for f := High(f) downto Low(f) do begin
  4172. FormatDesc := TFormatDescriptor.Get(f);
  4173. with aImage.DataDescription do
  4174. if FormatDesc.MaskMatch(
  4175. (QWord(1 shl RedPrec )-1) shl RedShift,
  4176. (QWord(1 shl GreenPrec)-1) shl GreenShift,
  4177. (QWord(1 shl BluePrec )-1) shl BlueShift,
  4178. (QWord(1 shl AlphaPrec)-1) shl AlphaShift) then
  4179. break;
  4180. end;
  4181. if (f = tfEmpty) then
  4182. exit;
  4183. ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
  4184. ImageData := GetMem(ImageSize);
  4185. try
  4186. Move(aImage.PixelData^, ImageData^, (aImage.Width * aImage.Height * aImage.DataDescription.BitsPerPixel) shr 3);
  4187. SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method
  4188. except
  4189. if Assigned(ImageData) then
  4190. FreeMem(ImageData);
  4191. raise;
  4192. end;
  4193. result := true;
  4194. end;
  4195. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4196. function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4197. var
  4198. rid: TRawImageDescription;
  4199. FormatDesc: TFormatDescriptor;
  4200. Pixel: TglBitmapPixelData;
  4201. x, y: Integer;
  4202. srcMD: Pointer;
  4203. src, dst: PByte;
  4204. begin
  4205. result := false;
  4206. if not Assigned(aImage) or (Format = tfEmpty) then
  4207. exit;
  4208. FormatDesc := TFormatDescriptor.Get(Format);
  4209. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  4210. exit;
  4211. FillChar(rid{%H-}, SizeOf(rid), 0);
  4212. rid.Format := ricfGray;
  4213. rid.Width := Width;
  4214. rid.Height := Height;
  4215. rid.Depth := CountSetBits(FormatDesc.Range.a);
  4216. rid.BitOrder := riboBitsInOrder;
  4217. rid.ByteOrder := riboLSBFirst;
  4218. rid.LineOrder := riloTopToBottom;
  4219. rid.LineEnd := rileTight;
  4220. rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
  4221. rid.RedPrec := CountSetBits(FormatDesc.Range.a);
  4222. rid.GreenPrec := 0;
  4223. rid.BluePrec := 0;
  4224. rid.AlphaPrec := 0;
  4225. rid.RedShift := 0;
  4226. rid.GreenShift := 0;
  4227. rid.BlueShift := 0;
  4228. rid.AlphaShift := 0;
  4229. rid.MaskBitsPerPixel := 0;
  4230. rid.PaletteColorCount := 0;
  4231. aImage.DataDescription := rid;
  4232. aImage.CreateData;
  4233. srcMD := FormatDesc.CreateMappingData;
  4234. try
  4235. FormatDesc.PreparePixel(Pixel);
  4236. src := Data;
  4237. dst := aImage.PixelData;
  4238. for y := 0 to Height-1 do
  4239. for x := 0 to Width-1 do begin
  4240. FormatDesc.Unmap(src, Pixel, srcMD);
  4241. case rid.BitsPerPixel of
  4242. 8: begin
  4243. dst^ := Pixel.Data.a;
  4244. inc(dst);
  4245. end;
  4246. 16: begin
  4247. PWord(dst)^ := Pixel.Data.a;
  4248. inc(dst, 2);
  4249. end;
  4250. 24: begin
  4251. PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
  4252. PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
  4253. PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
  4254. inc(dst, 3);
  4255. end;
  4256. 32: begin
  4257. PCardinal(dst)^ := Pixel.Data.a;
  4258. inc(dst, 4);
  4259. end;
  4260. else
  4261. raise EglBitmapUnsupportedFormat.Create(Format);
  4262. end;
  4263. end;
  4264. finally
  4265. FormatDesc.FreeMappingData(srcMD);
  4266. end;
  4267. result := true;
  4268. end;
  4269. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4270. function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4271. var
  4272. tex: TglBitmap2D;
  4273. begin
  4274. tex := TglBitmap2D.Create;
  4275. try
  4276. tex.AssignFromLazIntfImage(aImage);
  4277. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4278. finally
  4279. tex.Free;
  4280. end;
  4281. end;
  4282. {$ENDIF}
  4283. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4284. function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
  4285. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4286. var
  4287. rs: TResourceStream;
  4288. begin
  4289. PrepareResType(aResource, aResType);
  4290. rs := TResourceStream.Create(aInstance, aResource, aResType);
  4291. try
  4292. result := AddAlphaFromStream(rs, aFunc, aArgs);
  4293. finally
  4294. rs.Free;
  4295. end;
  4296. end;
  4297. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4298. function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  4299. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4300. var
  4301. rs: TResourceStream;
  4302. begin
  4303. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  4304. try
  4305. result := AddAlphaFromStream(rs, aFunc, aArgs);
  4306. finally
  4307. rs.Free;
  4308. end;
  4309. end;
  4310. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4311. function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4312. begin
  4313. if TFormatDescriptor.Get(Format).IsCompressed then
  4314. raise EglBitmapUnsupportedFormat.Create(Format);
  4315. result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
  4316. end;
  4317. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4318. function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4319. var
  4320. FS: TFileStream;
  4321. begin
  4322. FS := TFileStream.Create(FileName, fmOpenRead);
  4323. try
  4324. result := AddAlphaFromStream(FS, aFunc, aArgs);
  4325. finally
  4326. FS.Free;
  4327. end;
  4328. end;
  4329. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4330. function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4331. var
  4332. tex: TglBitmap2D;
  4333. begin
  4334. tex := TglBitmap2D.Create(aStream);
  4335. try
  4336. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4337. finally
  4338. tex.Free;
  4339. end;
  4340. end;
  4341. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4342. function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4343. var
  4344. DestData, DestData2, SourceData: pByte;
  4345. TempHeight, TempWidth: Integer;
  4346. SourceFD, DestFD: TFormatDescriptor;
  4347. SourceMD, DestMD, DestMD2: Pointer;
  4348. FuncRec: TglBitmapFunctionRec;
  4349. begin
  4350. result := false;
  4351. Assert(Assigned(Data));
  4352. Assert(Assigned(aBitmap));
  4353. Assert(Assigned(aBitmap.Data));
  4354. if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
  4355. result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
  4356. SourceFD := TFormatDescriptor.Get(aBitmap.Format);
  4357. DestFD := TFormatDescriptor.Get(Format);
  4358. if not Assigned(aFunc) then begin
  4359. aFunc := glBitmapAlphaFunc;
  4360. FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
  4361. end else
  4362. FuncRec.Args := aArgs;
  4363. // Values
  4364. TempHeight := aBitmap.FileHeight;
  4365. TempWidth := aBitmap.FileWidth;
  4366. FuncRec.Sender := Self;
  4367. FuncRec.Size := Dimension;
  4368. FuncRec.Position.Fields := FuncRec.Size.Fields;
  4369. DestData := Data;
  4370. DestData2 := Data;
  4371. SourceData := aBitmap.Data;
  4372. // Mapping
  4373. SourceFD.PreparePixel(FuncRec.Source);
  4374. DestFD.PreparePixel (FuncRec.Dest);
  4375. SourceMD := SourceFD.CreateMappingData;
  4376. DestMD := DestFD.CreateMappingData;
  4377. DestMD2 := DestFD.CreateMappingData;
  4378. try
  4379. FuncRec.Position.Y := 0;
  4380. while FuncRec.Position.Y < TempHeight do begin
  4381. FuncRec.Position.X := 0;
  4382. while FuncRec.Position.X < TempWidth do begin
  4383. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  4384. DestFD.Unmap (DestData, FuncRec.Dest, DestMD);
  4385. aFunc(FuncRec);
  4386. DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
  4387. inc(FuncRec.Position.X);
  4388. end;
  4389. inc(FuncRec.Position.Y);
  4390. end;
  4391. finally
  4392. SourceFD.FreeMappingData(SourceMD);
  4393. DestFD.FreeMappingData(DestMD);
  4394. DestFD.FreeMappingData(DestMD2);
  4395. end;
  4396. end;
  4397. end;
  4398. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4399. function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
  4400. begin
  4401. result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
  4402. end;
  4403. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4404. function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
  4405. var
  4406. PixelData: TglBitmapPixelData;
  4407. begin
  4408. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4409. result := AddAlphaFromColorKeyFloat(
  4410. aRed / PixelData.Range.r,
  4411. aGreen / PixelData.Range.g,
  4412. aBlue / PixelData.Range.b,
  4413. aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
  4414. end;
  4415. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4416. function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
  4417. var
  4418. values: array[0..2] of Single;
  4419. tmp: Cardinal;
  4420. i: Integer;
  4421. PixelData: TglBitmapPixelData;
  4422. begin
  4423. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4424. with PixelData do begin
  4425. values[0] := aRed;
  4426. values[1] := aGreen;
  4427. values[2] := aBlue;
  4428. for i := 0 to 2 do begin
  4429. tmp := Trunc(Range.arr[i] * aDeviation);
  4430. Data.arr[i] := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
  4431. Range.arr[i] := Max(0, Trunc(Range.arr[i] * values[i] - tmp));
  4432. end;
  4433. Data.a := 0;
  4434. Range.a := 0;
  4435. end;
  4436. result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
  4437. end;
  4438. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4439. function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
  4440. begin
  4441. result := AddAlphaFromValueFloat(aAlpha / $FF);
  4442. end;
  4443. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4444. function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  4445. var
  4446. PixelData: TglBitmapPixelData;
  4447. begin
  4448. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4449. result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
  4450. end;
  4451. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4452. function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  4453. var
  4454. PixelData: TglBitmapPixelData;
  4455. begin
  4456. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4457. with PixelData do
  4458. Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
  4459. result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
  4460. end;
  4461. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4462. function TglBitmap.RemoveAlpha: Boolean;
  4463. var
  4464. FormatDesc: TFormatDescriptor;
  4465. begin
  4466. result := false;
  4467. FormatDesc := TFormatDescriptor.Get(Format);
  4468. if Assigned(Data) then begin
  4469. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  4470. raise EglBitmapUnsupportedFormat.Create(Format);
  4471. result := ConvertTo(FormatDesc.WithoutAlpha);
  4472. end;
  4473. end;
  4474. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4475. function TglBitmap.Clone: TglBitmap;
  4476. var
  4477. Temp: TglBitmap;
  4478. TempPtr: PByte;
  4479. Size: Integer;
  4480. begin
  4481. result := nil;
  4482. Temp := (ClassType.Create as TglBitmap);
  4483. try
  4484. // copy texture data if assigned
  4485. if Assigned(Data) then begin
  4486. Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
  4487. GetMem(TempPtr, Size);
  4488. try
  4489. Move(Data^, TempPtr^, Size);
  4490. Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
  4491. except
  4492. if Assigned(TempPtr) then
  4493. FreeMem(TempPtr);
  4494. raise;
  4495. end;
  4496. end else begin
  4497. TempPtr := nil;
  4498. Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
  4499. end;
  4500. // copy properties
  4501. Temp.fID := ID;
  4502. Temp.fTarget := Target;
  4503. Temp.fFormat := Format;
  4504. Temp.fMipMap := MipMap;
  4505. Temp.fAnisotropic := Anisotropic;
  4506. Temp.fBorderColor := fBorderColor;
  4507. Temp.fDeleteTextureOnFree := DeleteTextureOnFree;
  4508. Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
  4509. Temp.fFilterMin := fFilterMin;
  4510. Temp.fFilterMag := fFilterMag;
  4511. Temp.fWrapS := fWrapS;
  4512. Temp.fWrapT := fWrapT;
  4513. Temp.fWrapR := fWrapR;
  4514. Temp.fFilename := fFilename;
  4515. Temp.fCustomName := fCustomName;
  4516. Temp.fCustomNameW := fCustomNameW;
  4517. Temp.fCustomData := fCustomData;
  4518. result := Temp;
  4519. except
  4520. FreeAndNil(Temp);
  4521. raise;
  4522. end;
  4523. end;
  4524. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4525. function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
  4526. var
  4527. SourceFD, DestFD: TFormatDescriptor;
  4528. SourcePD, DestPD: TglBitmapPixelData;
  4529. ShiftData: TShiftData;
  4530. function CanCopyDirect: Boolean;
  4531. begin
  4532. result :=
  4533. ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  4534. ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  4535. ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  4536. ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  4537. end;
  4538. function CanShift: Boolean;
  4539. begin
  4540. result :=
  4541. ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  4542. ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  4543. ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  4544. ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  4545. end;
  4546. function GetShift(aSource, aDest: Cardinal) : ShortInt;
  4547. begin
  4548. result := 0;
  4549. while (aSource > aDest) and (aSource > 0) do begin
  4550. inc(result);
  4551. aSource := aSource shr 1;
  4552. end;
  4553. end;
  4554. begin
  4555. if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
  4556. SourceFD := TFormatDescriptor.Get(Format);
  4557. DestFD := TFormatDescriptor.Get(aFormat);
  4558. SourceFD.PreparePixel(SourcePD);
  4559. DestFD.PreparePixel (DestPD);
  4560. if CanCopyDirect then
  4561. result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
  4562. else if CanShift then begin
  4563. ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
  4564. ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
  4565. ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
  4566. ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
  4567. result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
  4568. end else
  4569. result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
  4570. end else
  4571. result := true;
  4572. end;
  4573. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4574. procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
  4575. begin
  4576. if aUseRGB or aUseAlpha then
  4577. AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
  4578. ((PtrInt(aUseAlpha) and 1) shl 1) or
  4579. (PtrInt(aUseRGB) and 1) ));
  4580. end;
  4581. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4582. procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  4583. begin
  4584. fBorderColor[0] := aRed;
  4585. fBorderColor[1] := aGreen;
  4586. fBorderColor[2] := aBlue;
  4587. fBorderColor[3] := aAlpha;
  4588. if (ID > 0) then begin
  4589. Bind(false);
  4590. glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
  4591. end;
  4592. end;
  4593. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4594. procedure TglBitmap.FreeData;
  4595. var
  4596. TempPtr: PByte;
  4597. begin
  4598. TempPtr := nil;
  4599. SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method
  4600. end;
  4601. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4602. procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
  4603. const aAlpha: Byte);
  4604. begin
  4605. FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
  4606. end;
  4607. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4608. procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
  4609. var
  4610. PixelData: TglBitmapPixelData;
  4611. begin
  4612. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4613. FillWithColorFloat(
  4614. aRed / PixelData.Range.r,
  4615. aGreen / PixelData.Range.g,
  4616. aBlue / PixelData.Range.b,
  4617. aAlpha / PixelData.Range.a);
  4618. end;
  4619. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4620. procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
  4621. var
  4622. PixelData: TglBitmapPixelData;
  4623. begin
  4624. TFormatDescriptor.Get(Format).PreparePixel(PixelData);
  4625. with PixelData do begin
  4626. Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
  4627. Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
  4628. Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
  4629. Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
  4630. end;
  4631. AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
  4632. end;
  4633. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4634. procedure TglBitmap.SetFilter(const aMin, aMag: Cardinal);
  4635. begin
  4636. //check MIN filter
  4637. case aMin of
  4638. GL_NEAREST:
  4639. fFilterMin := GL_NEAREST;
  4640. GL_LINEAR:
  4641. fFilterMin := GL_LINEAR;
  4642. GL_NEAREST_MIPMAP_NEAREST:
  4643. fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
  4644. GL_LINEAR_MIPMAP_NEAREST:
  4645. fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
  4646. GL_NEAREST_MIPMAP_LINEAR:
  4647. fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
  4648. GL_LINEAR_MIPMAP_LINEAR:
  4649. fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
  4650. else
  4651. raise EglBitmapException.Create('SetFilter - Unknow MIN filter.');
  4652. end;
  4653. //check MAG filter
  4654. case aMag of
  4655. GL_NEAREST:
  4656. fFilterMag := GL_NEAREST;
  4657. GL_LINEAR:
  4658. fFilterMag := GL_LINEAR;
  4659. else
  4660. raise EglBitmapException.Create('SetFilter - Unknow MAG filter.');
  4661. end;
  4662. //apply filter
  4663. if (ID > 0) then begin
  4664. Bind(false);
  4665. glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
  4666. if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
  4667. case fFilterMin of
  4668. GL_NEAREST, GL_LINEAR:
  4669. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  4670. GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
  4671. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
  4672. GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
  4673. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
  4674. end;
  4675. end else
  4676. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  4677. end;
  4678. end;
  4679. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4680. procedure TglBitmap.SetWrap(const S: Cardinal; const T: Cardinal; const R: Cardinal);
  4681. procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
  4682. begin
  4683. case aValue of
  4684. GL_CLAMP:
  4685. aTarget := GL_CLAMP;
  4686. GL_REPEAT:
  4687. aTarget := GL_REPEAT;
  4688. GL_CLAMP_TO_EDGE: begin
  4689. if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
  4690. aTarget := GL_CLAMP_TO_EDGE
  4691. else
  4692. aTarget := GL_CLAMP;
  4693. end;
  4694. GL_CLAMP_TO_BORDER: begin
  4695. if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
  4696. aTarget := GL_CLAMP_TO_BORDER
  4697. else
  4698. aTarget := GL_CLAMP;
  4699. end;
  4700. GL_MIRRORED_REPEAT: begin
  4701. if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
  4702. aTarget := GL_MIRRORED_REPEAT
  4703. else
  4704. raise EglBitmapException.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
  4705. end;
  4706. else
  4707. raise EglBitmapException.Create('SetWrap - Unknow Texturewrap (S).');
  4708. end;
  4709. end;
  4710. begin
  4711. CheckAndSetWrap(S, fWrapS);
  4712. CheckAndSetWrap(T, fWrapT);
  4713. CheckAndSetWrap(R, fWrapR);
  4714. if (ID > 0) then begin
  4715. Bind(false);
  4716. glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
  4717. glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
  4718. glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
  4719. end;
  4720. end;
  4721. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4722. procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
  4723. begin
  4724. if aEnableTextureUnit then
  4725. glEnable(Target);
  4726. if (ID > 0) then
  4727. glBindTexture(Target, ID);
  4728. end;
  4729. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4730. procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
  4731. begin
  4732. if aDisableTextureUnit then
  4733. glDisable(Target);
  4734. glBindTexture(Target, 0);
  4735. end;
  4736. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4737. constructor TglBitmap.Create;
  4738. begin
  4739. if (ClassType = TglBitmap) then
  4740. raise EglBitmapException.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
  4741. {$IFDEF GLB_NATIVE_OGL}
  4742. glbReadOpenGLExtensions;
  4743. {$ENDIF}
  4744. inherited Create;
  4745. end;
  4746. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4747. constructor TglBitmap.Create(const aFileName: String);
  4748. begin
  4749. Create;
  4750. LoadFromFile(FileName);
  4751. end;
  4752. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4753. constructor TglBitmap.Create(const aStream: TStream);
  4754. begin
  4755. Create;
  4756. LoadFromStream(aStream);
  4757. end;
  4758. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4759. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat);
  4760. var
  4761. Image: PByte;
  4762. ImageSize: Integer;
  4763. begin
  4764. Create;
  4765. ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  4766. GetMem(Image, ImageSize);
  4767. try
  4768. FillChar(Image^, ImageSize, #$FF);
  4769. SetDataPointer(Image, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  4770. except
  4771. if Assigned(Image) then
  4772. FreeMem(Image);
  4773. raise;
  4774. end;
  4775. end;
  4776. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4777. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat;
  4778. const aFunc: TglBitmapFunction; const aArgs: Pointer);
  4779. begin
  4780. Create;
  4781. LoadFromFunc(aSize, aFunc, aFormat, aArgs);
  4782. end;
  4783. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4784. constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
  4785. begin
  4786. Create;
  4787. LoadFromResource(aInstance, aResource, aResType);
  4788. end;
  4789. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4790. constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  4791. begin
  4792. Create;
  4793. LoadFromResourceID(aInstance, aResourceID, aResType);
  4794. end;
  4795. {$IFDEF GLB_SUPPORT_PNG_READ}
  4796. {$IF DEFINED(GLB_SDL_IMAGE)}
  4797. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4798. //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4799. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4800. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  4801. var
  4802. Surface: PSDL_Surface;
  4803. RWops: PSDL_RWops;
  4804. begin
  4805. result := false;
  4806. RWops := glBitmapCreateRWops(aStream);
  4807. try
  4808. if IMG_isPNG(RWops) > 0 then begin
  4809. Surface := IMG_LoadPNG_RW(RWops);
  4810. try
  4811. AssignFromSurface(Surface);
  4812. result := true;
  4813. finally
  4814. SDL_FreeSurface(Surface);
  4815. end;
  4816. end;
  4817. finally
  4818. SDL_FreeRW(RWops);
  4819. end;
  4820. end;
  4821. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  4822. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4823. procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  4824. begin
  4825. TStream(png_get_io_ptr(png)).Read(buffer^, size);
  4826. end;
  4827. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4828. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  4829. var
  4830. StreamPos: Int64;
  4831. signature: array [0..7] of byte;
  4832. png: png_structp;
  4833. png_info: png_infop;
  4834. TempHeight, TempWidth: Integer;
  4835. Format: TglBitmapFormat;
  4836. png_data: pByte;
  4837. png_rows: array of pByte;
  4838. Row, LineSize: Integer;
  4839. begin
  4840. result := false;
  4841. if not init_libPNG then
  4842. raise Exception.Create('LoadPNG - unable to initialize libPNG.');
  4843. try
  4844. // signature
  4845. StreamPos := aStream.Position;
  4846. aStream.Read(signature{%H-}, 8);
  4847. aStream.Position := StreamPos;
  4848. if png_check_sig(@signature, 8) <> 0 then begin
  4849. // png read struct
  4850. png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  4851. if png = nil then
  4852. raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
  4853. // png info
  4854. png_info := png_create_info_struct(png);
  4855. if png_info = nil then begin
  4856. png_destroy_read_struct(@png, nil, nil);
  4857. raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
  4858. end;
  4859. // set read callback
  4860. png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
  4861. // read informations
  4862. png_read_info(png, png_info);
  4863. // size
  4864. TempHeight := png_get_image_height(png, png_info);
  4865. TempWidth := png_get_image_width(png, png_info);
  4866. // format
  4867. case png_get_color_type(png, png_info) of
  4868. PNG_COLOR_TYPE_GRAY:
  4869. Format := tfLuminance8;
  4870. PNG_COLOR_TYPE_GRAY_ALPHA:
  4871. Format := tfLuminance8Alpha8;
  4872. PNG_COLOR_TYPE_RGB:
  4873. Format := tfRGB8;
  4874. PNG_COLOR_TYPE_RGB_ALPHA:
  4875. Format := tfRGBA8;
  4876. else
  4877. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  4878. end;
  4879. // cut upper 8 bit from 16 bit formats
  4880. if png_get_bit_depth(png, png_info) > 8 then
  4881. png_set_strip_16(png);
  4882. // expand bitdepth smaller than 8
  4883. if png_get_bit_depth(png, png_info) < 8 then
  4884. png_set_expand(png);
  4885. // allocating mem for scanlines
  4886. LineSize := png_get_rowbytes(png, png_info);
  4887. GetMem(png_data, TempHeight * LineSize);
  4888. try
  4889. SetLength(png_rows, TempHeight);
  4890. for Row := Low(png_rows) to High(png_rows) do begin
  4891. png_rows[Row] := png_data;
  4892. Inc(png_rows[Row], Row * LineSize);
  4893. end;
  4894. // read complete image into scanlines
  4895. png_read_image(png, @png_rows[0]);
  4896. // read end
  4897. png_read_end(png, png_info);
  4898. // destroy read struct
  4899. png_destroy_read_struct(@png, @png_info, nil);
  4900. SetLength(png_rows, 0);
  4901. // set new data
  4902. SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
  4903. result := true;
  4904. except
  4905. if Assigned(png_data) then
  4906. FreeMem(png_data);
  4907. raise;
  4908. end;
  4909. end;
  4910. finally
  4911. quit_libPNG;
  4912. end;
  4913. end;
  4914. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  4915. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4916. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  4917. var
  4918. StreamPos: Int64;
  4919. Png: TPNGObject;
  4920. Header: String[8];
  4921. Row, Col, PixSize, LineSize: Integer;
  4922. NewImage, pSource, pDest, pAlpha: pByte;
  4923. PngFormat: TglBitmapFormat;
  4924. FormatDesc: TFormatDescriptor;
  4925. const
  4926. PngHeader: String[8] = #137#80#78#71#13#10#26#10;
  4927. begin
  4928. result := false;
  4929. StreamPos := aStream.Position;
  4930. aStream.Read(Header[0], SizeOf(Header));
  4931. aStream.Position := StreamPos;
  4932. {Test if the header matches}
  4933. if Header = PngHeader then begin
  4934. Png := TPNGObject.Create;
  4935. try
  4936. Png.LoadFromStream(aStream);
  4937. case Png.Header.ColorType of
  4938. COLOR_GRAYSCALE:
  4939. PngFormat := tfLuminance8;
  4940. COLOR_GRAYSCALEALPHA:
  4941. PngFormat := tfLuminance8Alpha8;
  4942. COLOR_RGB:
  4943. PngFormat := tfBGR8;
  4944. COLOR_RGBALPHA:
  4945. PngFormat := tfBGRA8;
  4946. else
  4947. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  4948. end;
  4949. FormatDesc := TFormatDescriptor.Get(PngFormat);
  4950. PixSize := Round(FormatDesc.PixelSize);
  4951. LineSize := FormatDesc.GetSize(Png.Header.Width, 1);
  4952. GetMem(NewImage, LineSize * Integer(Png.Header.Height));
  4953. try
  4954. pDest := NewImage;
  4955. case Png.Header.ColorType of
  4956. COLOR_RGB, COLOR_GRAYSCALE:
  4957. begin
  4958. for Row := 0 to Png.Height -1 do begin
  4959. Move (Png.Scanline[Row]^, pDest^, LineSize);
  4960. Inc(pDest, LineSize);
  4961. end;
  4962. end;
  4963. COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
  4964. begin
  4965. PixSize := PixSize -1;
  4966. for Row := 0 to Png.Height -1 do begin
  4967. pSource := Png.Scanline[Row];
  4968. pAlpha := pByte(Png.AlphaScanline[Row]);
  4969. for Col := 0 to Png.Width -1 do begin
  4970. Move (pSource^, pDest^, PixSize);
  4971. Inc(pSource, PixSize);
  4972. Inc(pDest, PixSize);
  4973. pDest^ := pAlpha^;
  4974. inc(pAlpha);
  4975. Inc(pDest);
  4976. end;
  4977. end;
  4978. end;
  4979. else
  4980. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  4981. end;
  4982. SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
  4983. result := true;
  4984. except
  4985. if Assigned(NewImage) then
  4986. FreeMem(NewImage);
  4987. raise;
  4988. end;
  4989. finally
  4990. Png.Free;
  4991. end;
  4992. end;
  4993. end;
  4994. {$IFEND}
  4995. {$ENDIF}
  4996. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  4997. {$IFDEF GLB_LIB_PNG}
  4998. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4999. procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  5000. begin
  5001. TStream(png_get_io_ptr(png)).Write(buffer^, size);
  5002. end;
  5003. {$ENDIF}
  5004. {$IF DEFINED(GLB_LIB_PNG)}
  5005. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5006. procedure TglBitmap.SavePNG(const aStream: TStream);
  5007. var
  5008. png: png_structp;
  5009. png_info: png_infop;
  5010. png_rows: array of pByte;
  5011. LineSize: Integer;
  5012. ColorType: Integer;
  5013. Row: Integer;
  5014. FormatDesc: TFormatDescriptor;
  5015. begin
  5016. if not (ftPNG in FormatGetSupportedFiles(Format)) then
  5017. raise EglBitmapUnsupportedFormat.Create(Format);
  5018. if not init_libPNG then
  5019. raise Exception.Create('unable to initialize libPNG.');
  5020. try
  5021. case Format of
  5022. tfAlpha8, tfLuminance8:
  5023. ColorType := PNG_COLOR_TYPE_GRAY;
  5024. tfLuminance8Alpha8:
  5025. ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
  5026. tfBGR8, tfRGB8:
  5027. ColorType := PNG_COLOR_TYPE_RGB;
  5028. tfBGRA8, tfRGBA8:
  5029. ColorType := PNG_COLOR_TYPE_RGBA;
  5030. else
  5031. raise EglBitmapUnsupportedFormat.Create(Format);
  5032. end;
  5033. FormatDesc := TFormatDescriptor.Get(Format);
  5034. LineSize := FormatDesc.GetSize(Width, 1);
  5035. // creating array for scanline
  5036. SetLength(png_rows, Height);
  5037. try
  5038. for Row := 0 to Height - 1 do begin
  5039. png_rows[Row] := Data;
  5040. Inc(png_rows[Row], Row * LineSize)
  5041. end;
  5042. // write struct
  5043. png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  5044. if png = nil then
  5045. raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
  5046. // create png info
  5047. png_info := png_create_info_struct(png);
  5048. if png_info = nil then begin
  5049. png_destroy_write_struct(@png, nil);
  5050. raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
  5051. end;
  5052. // set read callback
  5053. png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
  5054. // set compression
  5055. png_set_compression_level(png, 6);
  5056. if Format in [tfBGR8, tfBGRA8] then
  5057. png_set_bgr(png);
  5058. png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
  5059. png_write_info(png, png_info);
  5060. png_write_image(png, @png_rows[0]);
  5061. png_write_end(png, png_info);
  5062. png_destroy_write_struct(@png, @png_info);
  5063. finally
  5064. SetLength(png_rows, 0);
  5065. end;
  5066. finally
  5067. quit_libPNG;
  5068. end;
  5069. end;
  5070. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  5071. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5072. procedure TglBitmap.SavePNG(const aStream: TStream);
  5073. var
  5074. Png: TPNGObject;
  5075. pSource, pDest: pByte;
  5076. X, Y, PixSize: Integer;
  5077. ColorType: Cardinal;
  5078. Alpha: Boolean;
  5079. pTemp: pByte;
  5080. Temp: Byte;
  5081. begin
  5082. if not (ftPNG in FormatGetSupportedFiles (Format)) then
  5083. raise EglBitmapUnsupportedFormat.Create(Format);
  5084. case Format of
  5085. tfAlpha8, tfLuminance8: begin
  5086. ColorType := COLOR_GRAYSCALE;
  5087. PixSize := 1;
  5088. Alpha := false;
  5089. end;
  5090. tfLuminance8Alpha8: begin
  5091. ColorType := COLOR_GRAYSCALEALPHA;
  5092. PixSize := 1;
  5093. Alpha := true;
  5094. end;
  5095. tfBGR8, tfRGB8: begin
  5096. ColorType := COLOR_RGB;
  5097. PixSize := 3;
  5098. Alpha := false;
  5099. end;
  5100. tfBGRA8, tfRGBA8: begin
  5101. ColorType := COLOR_RGBALPHA;
  5102. PixSize := 3;
  5103. Alpha := true
  5104. end;
  5105. else
  5106. raise EglBitmapUnsupportedFormat.Create(Format);
  5107. end;
  5108. Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
  5109. try
  5110. // Copy ImageData
  5111. pSource := Data;
  5112. for Y := 0 to Height -1 do begin
  5113. pDest := png.ScanLine[Y];
  5114. for X := 0 to Width -1 do begin
  5115. Move(pSource^, pDest^, PixSize);
  5116. Inc(pDest, PixSize);
  5117. Inc(pSource, PixSize);
  5118. if Alpha then begin
  5119. png.AlphaScanline[Y]^[X] := pSource^;
  5120. Inc(pSource);
  5121. end;
  5122. end;
  5123. // convert RGB line to BGR
  5124. if Format in [tfRGB8, tfRGBA8] then begin
  5125. pTemp := png.ScanLine[Y];
  5126. for X := 0 to Width -1 do begin
  5127. Temp := pByteArray(pTemp)^[0];
  5128. pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
  5129. pByteArray(pTemp)^[2] := Temp;
  5130. Inc(pTemp, 3);
  5131. end;
  5132. end;
  5133. end;
  5134. // Save to Stream
  5135. Png.CompressionLevel := 6;
  5136. Png.SaveToStream(aStream);
  5137. finally
  5138. FreeAndNil(Png);
  5139. end;
  5140. end;
  5141. {$IFEND}
  5142. {$ENDIF}
  5143. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5144. //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5145. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5146. {$IFDEF GLB_LIB_JPEG}
  5147. type
  5148. glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
  5149. glBitmap_libJPEG_source_mgr = record
  5150. pub: jpeg_source_mgr;
  5151. SrcStream: TStream;
  5152. SrcBuffer: array [1..4096] of byte;
  5153. end;
  5154. glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
  5155. glBitmap_libJPEG_dest_mgr = record
  5156. pub: jpeg_destination_mgr;
  5157. DestStream: TStream;
  5158. DestBuffer: array [1..4096] of byte;
  5159. end;
  5160. procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
  5161. begin
  5162. //DUMMY
  5163. end;
  5164. procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
  5165. begin
  5166. //DUMMY
  5167. end;
  5168. procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
  5169. begin
  5170. //DUMMY
  5171. end;
  5172. procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
  5173. begin
  5174. //DUMMY
  5175. end;
  5176. procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
  5177. begin
  5178. //DUMMY
  5179. end;
  5180. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5181. function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
  5182. var
  5183. src: glBitmap_libJPEG_source_mgr_ptr;
  5184. bytes: integer;
  5185. begin
  5186. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  5187. bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
  5188. if (bytes <= 0) then begin
  5189. src^.SrcBuffer[1] := $FF;
  5190. src^.SrcBuffer[2] := JPEG_EOI;
  5191. bytes := 2;
  5192. end;
  5193. src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
  5194. src^.pub.bytes_in_buffer := bytes;
  5195. result := true;
  5196. end;
  5197. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5198. procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
  5199. var
  5200. src: glBitmap_libJPEG_source_mgr_ptr;
  5201. begin
  5202. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  5203. if num_bytes > 0 then begin
  5204. // wanted byte isn't in buffer so set stream position and read buffer
  5205. if num_bytes > src^.pub.bytes_in_buffer then begin
  5206. src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
  5207. src^.pub.fill_input_buffer(cinfo);
  5208. end else begin
  5209. // wanted byte is in buffer so only skip
  5210. inc(src^.pub.next_input_byte, num_bytes);
  5211. dec(src^.pub.bytes_in_buffer, num_bytes);
  5212. end;
  5213. end;
  5214. end;
  5215. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5216. function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
  5217. var
  5218. dest: glBitmap_libJPEG_dest_mgr_ptr;
  5219. begin
  5220. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  5221. if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
  5222. // write complete buffer
  5223. dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
  5224. // reset buffer
  5225. dest^.pub.next_output_byte := @dest^.DestBuffer[1];
  5226. dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
  5227. end;
  5228. result := true;
  5229. end;
  5230. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5231. procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
  5232. var
  5233. Idx: Integer;
  5234. dest: glBitmap_libJPEG_dest_mgr_ptr;
  5235. begin
  5236. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  5237. for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
  5238. // check for endblock
  5239. if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
  5240. // write endblock
  5241. dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
  5242. // leave
  5243. break;
  5244. end else
  5245. dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
  5246. end;
  5247. end;
  5248. {$ENDIF}
  5249. {$IFDEF GLB_SUPPORT_JPEG_READ}
  5250. {$IF DEFINED(GLB_SDL_IMAGE)}
  5251. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5252. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5253. var
  5254. Surface: PSDL_Surface;
  5255. RWops: PSDL_RWops;
  5256. begin
  5257. result := false;
  5258. RWops := glBitmapCreateRWops(aStream);
  5259. try
  5260. if IMG_isJPG(RWops) > 0 then begin
  5261. Surface := IMG_LoadJPG_RW(RWops);
  5262. try
  5263. AssignFromSurface(Surface);
  5264. result := true;
  5265. finally
  5266. SDL_FreeSurface(Surface);
  5267. end;
  5268. end;
  5269. finally
  5270. SDL_FreeRW(RWops);
  5271. end;
  5272. end;
  5273. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  5274. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5275. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5276. var
  5277. StreamPos: Int64;
  5278. Temp: array[0..1]of Byte;
  5279. jpeg: jpeg_decompress_struct;
  5280. jpeg_err: jpeg_error_mgr;
  5281. IntFormat: TglBitmapFormat;
  5282. pImage: pByte;
  5283. TempHeight, TempWidth: Integer;
  5284. pTemp: pByte;
  5285. Row: Integer;
  5286. FormatDesc: TFormatDescriptor;
  5287. begin
  5288. result := false;
  5289. if not init_libJPEG then
  5290. raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
  5291. try
  5292. // reading first two bytes to test file and set cursor back to begin
  5293. StreamPos := aStream.Position;
  5294. aStream.Read({%H-}Temp[0], 2);
  5295. aStream.Position := StreamPos;
  5296. // if Bitmap then read file.
  5297. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  5298. FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
  5299. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  5300. // error managment
  5301. jpeg.err := jpeg_std_error(@jpeg_err);
  5302. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  5303. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  5304. // decompression struct
  5305. jpeg_create_decompress(@jpeg);
  5306. // allocation space for streaming methods
  5307. jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
  5308. // seeting up custom functions
  5309. with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
  5310. pub.init_source := glBitmap_libJPEG_init_source;
  5311. pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
  5312. pub.skip_input_data := glBitmap_libJPEG_skip_input_data;
  5313. pub.resync_to_restart := jpeg_resync_to_restart; // use default method
  5314. pub.term_source := glBitmap_libJPEG_term_source;
  5315. pub.bytes_in_buffer := 0; // forces fill_input_buffer on first read
  5316. pub.next_input_byte := nil; // until buffer loaded
  5317. SrcStream := aStream;
  5318. end;
  5319. // set global decoding state
  5320. jpeg.global_state := DSTATE_START;
  5321. // read header of jpeg
  5322. jpeg_read_header(@jpeg, false);
  5323. // setting output parameter
  5324. case jpeg.jpeg_color_space of
  5325. JCS_GRAYSCALE:
  5326. begin
  5327. jpeg.out_color_space := JCS_GRAYSCALE;
  5328. IntFormat := tfLuminance8;
  5329. end;
  5330. else
  5331. jpeg.out_color_space := JCS_RGB;
  5332. IntFormat := tfRGB8;
  5333. end;
  5334. // reading image
  5335. jpeg_start_decompress(@jpeg);
  5336. TempHeight := jpeg.output_height;
  5337. TempWidth := jpeg.output_width;
  5338. FormatDesc := TFormatDescriptor.Get(IntFormat);
  5339. // creating new image
  5340. GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
  5341. try
  5342. pTemp := pImage;
  5343. for Row := 0 to TempHeight -1 do begin
  5344. jpeg_read_scanlines(@jpeg, @pTemp, 1);
  5345. Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
  5346. end;
  5347. // finish decompression
  5348. jpeg_finish_decompress(@jpeg);
  5349. // destroy decompression
  5350. jpeg_destroy_decompress(@jpeg);
  5351. SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  5352. result := true;
  5353. except
  5354. if Assigned(pImage) then
  5355. FreeMem(pImage);
  5356. raise;
  5357. end;
  5358. end;
  5359. finally
  5360. quit_libJPEG;
  5361. end;
  5362. end;
  5363. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  5364. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5365. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5366. var
  5367. bmp: TBitmap;
  5368. jpg: TJPEGImage;
  5369. StreamPos: Int64;
  5370. Temp: array[0..1]of Byte;
  5371. begin
  5372. result := false;
  5373. // reading first two bytes to test file and set cursor back to begin
  5374. StreamPos := aStream.Position;
  5375. aStream.Read(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. bmp := TBitmap.Create;
  5380. try
  5381. jpg := TJPEGImage.Create;
  5382. try
  5383. jpg.LoadFromStream(aStream);
  5384. bmp.Assign(jpg);
  5385. result := AssignFromBitmap(bmp);
  5386. finally
  5387. jpg.Free;
  5388. end;
  5389. finally
  5390. bmp.Free;
  5391. end;
  5392. end;
  5393. end;
  5394. {$IFEND}
  5395. {$ENDIF}
  5396. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  5397. {$IF DEFINED(GLB_LIB_JPEG)}
  5398. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5399. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  5400. var
  5401. jpeg: jpeg_compress_struct;
  5402. jpeg_err: jpeg_error_mgr;
  5403. Row: Integer;
  5404. pTemp, pTemp2: pByte;
  5405. procedure CopyRow(pDest, pSource: pByte);
  5406. var
  5407. X: Integer;
  5408. begin
  5409. for X := 0 to Width - 1 do begin
  5410. pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
  5411. pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
  5412. pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
  5413. Inc(pDest, 3);
  5414. Inc(pSource, 3);
  5415. end;
  5416. end;
  5417. begin
  5418. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  5419. raise EglBitmapUnsupportedFormat.Create(Format);
  5420. if not init_libJPEG then
  5421. raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
  5422. try
  5423. FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
  5424. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  5425. // error managment
  5426. jpeg.err := jpeg_std_error(@jpeg_err);
  5427. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  5428. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  5429. // compression struct
  5430. jpeg_create_compress(@jpeg);
  5431. // allocation space for streaming methods
  5432. jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
  5433. // seeting up custom functions
  5434. with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
  5435. pub.init_destination := glBitmap_libJPEG_init_destination;
  5436. pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
  5437. pub.term_destination := glBitmap_libJPEG_term_destination;
  5438. pub.next_output_byte := @DestBuffer[1];
  5439. pub.free_in_buffer := Length(DestBuffer);
  5440. DestStream := aStream;
  5441. end;
  5442. // very important state
  5443. jpeg.global_state := CSTATE_START;
  5444. jpeg.image_width := Width;
  5445. jpeg.image_height := Height;
  5446. case Format of
  5447. tfAlpha8, tfLuminance8: begin
  5448. jpeg.input_components := 1;
  5449. jpeg.in_color_space := JCS_GRAYSCALE;
  5450. end;
  5451. tfRGB8, tfBGR8: begin
  5452. jpeg.input_components := 3;
  5453. jpeg.in_color_space := JCS_RGB;
  5454. end;
  5455. end;
  5456. jpeg_set_defaults(@jpeg);
  5457. jpeg_set_quality(@jpeg, 95, true);
  5458. jpeg_start_compress(@jpeg, true);
  5459. pTemp := Data;
  5460. if Format = tfBGR8 then
  5461. GetMem(pTemp2, fRowSize)
  5462. else
  5463. pTemp2 := pTemp;
  5464. try
  5465. for Row := 0 to jpeg.image_height -1 do begin
  5466. // prepare row
  5467. if Format = tfBGR8 then
  5468. CopyRow(pTemp2, pTemp)
  5469. else
  5470. pTemp2 := pTemp;
  5471. // write row
  5472. jpeg_write_scanlines(@jpeg, @pTemp2, 1);
  5473. inc(pTemp, fRowSize);
  5474. end;
  5475. finally
  5476. // free memory
  5477. if Format = tfBGR8 then
  5478. FreeMem(pTemp2);
  5479. end;
  5480. jpeg_finish_compress(@jpeg);
  5481. jpeg_destroy_compress(@jpeg);
  5482. finally
  5483. quit_libJPEG;
  5484. end;
  5485. end;
  5486. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  5487. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5488. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  5489. var
  5490. Bmp: TBitmap;
  5491. Jpg: TJPEGImage;
  5492. begin
  5493. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  5494. raise EglBitmapUnsupportedFormat.Create(Format);
  5495. Bmp := TBitmap.Create;
  5496. try
  5497. Jpg := TJPEGImage.Create;
  5498. try
  5499. AssignToBitmap(Bmp);
  5500. if (Format in [tfAlpha8, tfLuminance8]) then begin
  5501. Jpg.Grayscale := true;
  5502. Jpg.PixelFormat := jf8Bit;
  5503. end;
  5504. Jpg.Assign(Bmp);
  5505. Jpg.SaveToStream(aStream);
  5506. finally
  5507. FreeAndNil(Jpg);
  5508. end;
  5509. finally
  5510. FreeAndNil(Bmp);
  5511. end;
  5512. end;
  5513. {$IFEND}
  5514. {$ENDIF}
  5515. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5516. //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5517. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5518. const
  5519. BMP_MAGIC = $4D42;
  5520. BMP_COMP_RGB = 0;
  5521. BMP_COMP_RLE8 = 1;
  5522. BMP_COMP_RLE4 = 2;
  5523. BMP_COMP_BITFIELDS = 3;
  5524. type
  5525. TBMPHeader = packed record
  5526. bfType: Word;
  5527. bfSize: Cardinal;
  5528. bfReserved1: Word;
  5529. bfReserved2: Word;
  5530. bfOffBits: Cardinal;
  5531. end;
  5532. TBMPInfo = packed record
  5533. biSize: Cardinal;
  5534. biWidth: Longint;
  5535. biHeight: Longint;
  5536. biPlanes: Word;
  5537. biBitCount: Word;
  5538. biCompression: Cardinal;
  5539. biSizeImage: Cardinal;
  5540. biXPelsPerMeter: Longint;
  5541. biYPelsPerMeter: Longint;
  5542. biClrUsed: Cardinal;
  5543. biClrImportant: Cardinal;
  5544. end;
  5545. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5546. function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
  5547. //////////////////////////////////////////////////////////////////////////////////////////////////
  5548. function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapColorRec): TglBitmapFormat;
  5549. begin
  5550. result := tfEmpty;
  5551. aStream.Read(aInfo{%H-}, SizeOf(aInfo));
  5552. FillChar(aMask{%H-}, SizeOf(aMask), 0);
  5553. //Read Compression
  5554. case aInfo.biCompression of
  5555. BMP_COMP_RLE4,
  5556. BMP_COMP_RLE8: begin
  5557. raise EglBitmapException.Create('RLE compression is not supported');
  5558. end;
  5559. BMP_COMP_BITFIELDS: begin
  5560. if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
  5561. aStream.Read(aMask.r, SizeOf(aMask.r));
  5562. aStream.Read(aMask.g, SizeOf(aMask.g));
  5563. aStream.Read(aMask.b, SizeOf(aMask.b));
  5564. aStream.Read(aMask.a, SizeOf(aMask.a));
  5565. end else
  5566. raise EglBitmapException.Create('Bitfields are only supported for 16bit and 32bit formats');
  5567. end;
  5568. end;
  5569. //get suitable format
  5570. case aInfo.biBitCount of
  5571. 8: result := tfLuminance8;
  5572. 16: result := tfBGR5;
  5573. 24: result := tfBGR8;
  5574. 32: result := tfBGRA8;
  5575. end;
  5576. end;
  5577. function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
  5578. var
  5579. i, c: Integer;
  5580. ColorTable: TbmpColorTable;
  5581. begin
  5582. result := nil;
  5583. if (aInfo.biBitCount >= 16) then
  5584. exit;
  5585. aFormat := tfLuminance8;
  5586. c := aInfo.biClrUsed;
  5587. if (c = 0) then
  5588. c := 1 shl aInfo.biBitCount;
  5589. SetLength(ColorTable, c);
  5590. for i := 0 to c-1 do begin
  5591. aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
  5592. if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
  5593. aFormat := tfRGB8;
  5594. end;
  5595. result := TbmpColorTableFormat.Create;
  5596. result.PixelSize := aInfo.biBitCount / 8;
  5597. result.ColorTable := ColorTable;
  5598. result.Range := glBitmapColorRec($FF, $FF, $FF, $00);
  5599. end;
  5600. //////////////////////////////////////////////////////////////////////////////////////////////////
  5601. function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
  5602. const aInfo: TBMPInfo): TbmpBitfieldFormat;
  5603. var
  5604. TmpFormat: TglBitmapFormat;
  5605. FormatDesc: TFormatDescriptor;
  5606. begin
  5607. result := nil;
  5608. if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
  5609. for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  5610. FormatDesc := TFormatDescriptor.Get(TmpFormat);
  5611. if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
  5612. aFormat := FormatDesc.Format;
  5613. exit;
  5614. end;
  5615. end;
  5616. if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
  5617. aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
  5618. if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
  5619. aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
  5620. result := TbmpBitfieldFormat.Create;
  5621. result.PixelSize := aInfo.biBitCount / 8;
  5622. result.RedMask := aMask.r;
  5623. result.GreenMask := aMask.g;
  5624. result.BlueMask := aMask.b;
  5625. result.AlphaMask := aMask.a;
  5626. end;
  5627. end;
  5628. var
  5629. //simple types
  5630. StartPos: Int64;
  5631. ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
  5632. PaddingBuff: Cardinal;
  5633. LineBuf, ImageData, TmpData: PByte;
  5634. SourceMD, DestMD: Pointer;
  5635. BmpFormat: TglBitmapFormat;
  5636. //records
  5637. Mask: TglBitmapColorRec;
  5638. Header: TBMPHeader;
  5639. Info: TBMPInfo;
  5640. //classes
  5641. SpecialFormat: TFormatDescriptor;
  5642. FormatDesc: TFormatDescriptor;
  5643. //////////////////////////////////////////////////////////////////////////////////////////////////
  5644. procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
  5645. var
  5646. i: Integer;
  5647. Pixel: TglBitmapPixelData;
  5648. begin
  5649. aStream.Read(aLineBuf^, rbLineSize);
  5650. SpecialFormat.PreparePixel(Pixel);
  5651. for i := 0 to Info.biWidth-1 do begin
  5652. SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
  5653. glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
  5654. FormatDesc.Map(Pixel, aData, DestMD);
  5655. end;
  5656. end;
  5657. begin
  5658. result := false;
  5659. BmpFormat := tfEmpty;
  5660. SpecialFormat := nil;
  5661. LineBuf := nil;
  5662. SourceMD := nil;
  5663. DestMD := nil;
  5664. // Header
  5665. StartPos := aStream.Position;
  5666. aStream.Read(Header{%H-}, SizeOf(Header));
  5667. if Header.bfType = BMP_MAGIC then begin
  5668. try try
  5669. BmpFormat := ReadInfo(Info, Mask);
  5670. SpecialFormat := ReadColorTable(BmpFormat, Info);
  5671. if not Assigned(SpecialFormat) then
  5672. SpecialFormat := CheckBitfields(BmpFormat, Mask, Info);
  5673. aStream.Position := StartPos + Header.bfOffBits;
  5674. if (BmpFormat <> tfEmpty) then begin
  5675. FormatDesc := TFormatDescriptor.Get(BmpFormat);
  5676. rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
  5677. wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
  5678. Padding := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
  5679. //get Memory
  5680. DestMD := FormatDesc.CreateMappingData;
  5681. ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
  5682. GetMem(ImageData, ImageSize);
  5683. if Assigned(SpecialFormat) then begin
  5684. GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
  5685. SourceMD := SpecialFormat.CreateMappingData;
  5686. end;
  5687. //read Data
  5688. try try
  5689. FillChar(ImageData^, ImageSize, $FF);
  5690. TmpData := ImageData;
  5691. if (Info.biHeight > 0) then
  5692. Inc(TmpData, wbLineSize * (Info.biHeight-1));
  5693. for i := 0 to Abs(Info.biHeight)-1 do begin
  5694. if Assigned(SpecialFormat) then
  5695. SpecialFormatReadLine(TmpData, LineBuf) //if is special format read and convert data
  5696. else
  5697. aStream.Read(TmpData^, wbLineSize); //else only read data
  5698. if (Info.biHeight > 0) then
  5699. dec(TmpData, wbLineSize)
  5700. else
  5701. inc(TmpData, wbLineSize);
  5702. aStream.Read(PaddingBuff{%H-}, Padding);
  5703. end;
  5704. SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
  5705. result := true;
  5706. finally
  5707. if Assigned(LineBuf) then
  5708. FreeMem(LineBuf);
  5709. if Assigned(SourceMD) then
  5710. SpecialFormat.FreeMappingData(SourceMD);
  5711. FormatDesc.FreeMappingData(DestMD);
  5712. end;
  5713. except
  5714. if Assigned(ImageData) then
  5715. FreeMem(ImageData);
  5716. raise;
  5717. end;
  5718. end else
  5719. raise EglBitmapException.Create('LoadBMP - No suitable format found');
  5720. except
  5721. aStream.Position := StartPos;
  5722. raise;
  5723. end;
  5724. finally
  5725. FreeAndNil(SpecialFormat);
  5726. end;
  5727. end
  5728. else aStream.Position := StartPos;
  5729. end;
  5730. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5731. procedure TglBitmap.SaveBMP(const aStream: TStream);
  5732. var
  5733. Header: TBMPHeader;
  5734. Info: TBMPInfo;
  5735. Converter: TbmpColorTableFormat;
  5736. FormatDesc: TFormatDescriptor;
  5737. SourceFD, DestFD: Pointer;
  5738. pData, srcData, dstData, ConvertBuffer: pByte;
  5739. Pixel: TglBitmapPixelData;
  5740. ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
  5741. RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
  5742. PaddingBuff: Cardinal;
  5743. function GetLineWidth : Integer;
  5744. begin
  5745. result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
  5746. end;
  5747. begin
  5748. if not (ftBMP in FormatGetSupportedFiles(Format)) then
  5749. raise EglBitmapUnsupportedFormat.Create(Format);
  5750. Converter := nil;
  5751. FormatDesc := TFormatDescriptor.Get(Format);
  5752. ImageSize := FormatDesc.GetSize(Dimension);
  5753. FillChar(Header{%H-}, SizeOf(Header), 0);
  5754. Header.bfType := BMP_MAGIC;
  5755. Header.bfSize := SizeOf(Header) + SizeOf(Info) + ImageSize;
  5756. Header.bfReserved1 := 0;
  5757. Header.bfReserved2 := 0;
  5758. Header.bfOffBits := SizeOf(Header) + SizeOf(Info);
  5759. FillChar(Info{%H-}, SizeOf(Info), 0);
  5760. Info.biSize := SizeOf(Info);
  5761. Info.biWidth := Width;
  5762. Info.biHeight := Height;
  5763. Info.biPlanes := 1;
  5764. Info.biCompression := BMP_COMP_RGB;
  5765. Info.biSizeImage := ImageSize;
  5766. try
  5767. case Format of
  5768. tfLuminance4: begin
  5769. Info.biBitCount := 4;
  5770. Header.bfSize := Header.bfSize + 16 * SizeOf(Cardinal);
  5771. Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
  5772. Converter := TbmpColorTableFormat.Create;
  5773. Converter.PixelSize := 0.5;
  5774. Converter.Format := Format;
  5775. Converter.Range := glBitmapColorRec($F, $F, $F, $0);
  5776. Converter.CreateColorTable;
  5777. end;
  5778. tfR3G3B2, tfLuminance8: begin
  5779. Info.biBitCount := 8;
  5780. Header.bfSize := Header.bfSize + 256 * SizeOf(Cardinal);
  5781. Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
  5782. Converter := TbmpColorTableFormat.Create;
  5783. Converter.PixelSize := 1;
  5784. Converter.Format := Format;
  5785. if (Format = tfR3G3B2) then begin
  5786. Converter.Range := glBitmapColorRec($7, $7, $3, $0);
  5787. Converter.Shift := glBitmapShiftRec(0, 3, 6, 0);
  5788. end else
  5789. Converter.Range := glBitmapColorRec($FF, $FF, $FF, $0);
  5790. Converter.CreateColorTable;
  5791. end;
  5792. tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
  5793. tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin
  5794. Info.biBitCount := 16;
  5795. Info.biCompression := BMP_COMP_BITFIELDS;
  5796. end;
  5797. tfBGR8, tfRGB8: begin
  5798. Info.biBitCount := 24;
  5799. end;
  5800. tfRGB10, tfRGB10A2, tfRGBA8,
  5801. tfBGR10, tfBGR10A2, tfBGRA8: begin
  5802. Info.biBitCount := 32;
  5803. Info.biCompression := BMP_COMP_BITFIELDS;
  5804. end;
  5805. else
  5806. raise EglBitmapUnsupportedFormat.Create(Format);
  5807. end;
  5808. Info.biXPelsPerMeter := 2835;
  5809. Info.biYPelsPerMeter := 2835;
  5810. // prepare bitmasks
  5811. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  5812. Header.bfSize := Header.bfSize + 4 * SizeOf(Cardinal);
  5813. Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
  5814. RedMask := FormatDesc.RedMask;
  5815. GreenMask := FormatDesc.GreenMask;
  5816. BlueMask := FormatDesc.BlueMask;
  5817. AlphaMask := FormatDesc.AlphaMask;
  5818. end;
  5819. // headers
  5820. aStream.Write(Header, SizeOf(Header));
  5821. aStream.Write(Info, SizeOf(Info));
  5822. // colortable
  5823. if Assigned(Converter) then
  5824. aStream.Write(Converter.ColorTable[0].b,
  5825. SizeOf(TbmpColorTableEnty) * Length(Converter.ColorTable));
  5826. // bitmasks
  5827. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  5828. aStream.Write(RedMask, SizeOf(Cardinal));
  5829. aStream.Write(GreenMask, SizeOf(Cardinal));
  5830. aStream.Write(BlueMask, SizeOf(Cardinal));
  5831. aStream.Write(AlphaMask, SizeOf(Cardinal));
  5832. end;
  5833. // image data
  5834. rbLineSize := Round(Info.biWidth * FormatDesc.PixelSize);
  5835. wbLineSize := Round(Info.biWidth * Info.biBitCount / 8);
  5836. Padding := GetLineWidth - wbLineSize;
  5837. PaddingBuff := 0;
  5838. pData := Data;
  5839. inc(pData, (Height-1) * rbLineSize);
  5840. // prepare row buffer. But only for RGB because RGBA supports color masks
  5841. // so it's possible to change color within the image.
  5842. if Assigned(Converter) then begin
  5843. FormatDesc.PreparePixel(Pixel);
  5844. GetMem(ConvertBuffer, wbLineSize);
  5845. SourceFD := FormatDesc.CreateMappingData;
  5846. DestFD := Converter.CreateMappingData;
  5847. end else
  5848. ConvertBuffer := nil;
  5849. try
  5850. for LineIdx := 0 to Height - 1 do begin
  5851. // preparing row
  5852. if Assigned(Converter) then begin
  5853. srcData := pData;
  5854. dstData := ConvertBuffer;
  5855. for PixelIdx := 0 to Info.biWidth-1 do begin
  5856. FormatDesc.Unmap(srcData, Pixel, SourceFD);
  5857. glBitmapConvertPixel(Pixel, FormatDesc, Converter);
  5858. Converter.Map(Pixel, dstData, DestFD);
  5859. end;
  5860. aStream.Write(ConvertBuffer^, wbLineSize);
  5861. end else begin
  5862. aStream.Write(pData^, rbLineSize);
  5863. end;
  5864. dec(pData, rbLineSize);
  5865. if (Padding > 0) then
  5866. aStream.Write(PaddingBuff, Padding);
  5867. end;
  5868. finally
  5869. // destroy row buffer
  5870. if Assigned(ConvertBuffer) then begin
  5871. FormatDesc.FreeMappingData(SourceFD);
  5872. Converter.FreeMappingData(DestFD);
  5873. FreeMem(ConvertBuffer);
  5874. end;
  5875. end;
  5876. finally
  5877. if Assigned(Converter) then
  5878. Converter.Free;
  5879. end;
  5880. end;
  5881. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5882. //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5883. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5884. type
  5885. TTGAHeader = packed record
  5886. ImageID: Byte;
  5887. ColorMapType: Byte;
  5888. ImageType: Byte;
  5889. //ColorMapSpec: Array[0..4] of Byte;
  5890. ColorMapStart: Word;
  5891. ColorMapLength: Word;
  5892. ColorMapEntrySize: Byte;
  5893. OrigX: Word;
  5894. OrigY: Word;
  5895. Width: Word;
  5896. Height: Word;
  5897. Bpp: Byte;
  5898. ImageDesc: Byte;
  5899. end;
  5900. const
  5901. TGA_UNCOMPRESSED_RGB = 2;
  5902. TGA_UNCOMPRESSED_GRAY = 3;
  5903. TGA_COMPRESSED_RGB = 10;
  5904. TGA_COMPRESSED_GRAY = 11;
  5905. TGA_NONE_COLOR_TABLE = 0;
  5906. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5907. function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
  5908. var
  5909. Header: TTGAHeader;
  5910. ImageData: System.PByte;
  5911. StartPosition: Int64;
  5912. PixelSize, LineSize: Integer;
  5913. tgaFormat: TglBitmapFormat;
  5914. FormatDesc: TFormatDescriptor;
  5915. Counter: packed record
  5916. X, Y: packed record
  5917. low, high, dir: Integer;
  5918. end;
  5919. end;
  5920. const
  5921. CACHE_SIZE = $4000;
  5922. ////////////////////////////////////////////////////////////////////////////////////////
  5923. procedure ReadUncompressed;
  5924. var
  5925. i, j: Integer;
  5926. buf, tmp1, tmp2: System.PByte;
  5927. begin
  5928. buf := nil;
  5929. if (Counter.X.dir < 0) then
  5930. GetMem(buf, LineSize);
  5931. try
  5932. while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
  5933. tmp1 := ImageData;
  5934. inc(tmp1, (Counter.Y.low * LineSize)); //pointer to LineStart
  5935. if (Counter.X.dir < 0) then begin //flip X
  5936. aStream.Read(buf^, LineSize);
  5937. tmp2 := buf;
  5938. inc(tmp2, LineSize - PixelSize); //pointer to last pixel in line
  5939. for i := 0 to Header.Width-1 do begin //for all pixels in line
  5940. for j := 0 to PixelSize-1 do begin //for all bytes in pixel
  5941. tmp1^ := tmp2^;
  5942. inc(tmp1);
  5943. inc(tmp2);
  5944. end;
  5945. dec(tmp2, 2*PixelSize); //move 2 backwards, because j-loop moved 1 forward
  5946. end;
  5947. end else
  5948. aStream.Read(tmp1^, LineSize);
  5949. inc(Counter.Y.low, Counter.Y.dir); //move to next line index
  5950. end;
  5951. finally
  5952. if Assigned(buf) then
  5953. FreeMem(buf);
  5954. end;
  5955. end;
  5956. ////////////////////////////////////////////////////////////////////////////////////////
  5957. procedure ReadCompressed;
  5958. /////////////////////////////////////////////////////////////////
  5959. var
  5960. TmpData: System.PByte;
  5961. LinePixelsRead: Integer;
  5962. procedure CheckLine;
  5963. begin
  5964. if (LinePixelsRead >= Header.Width) then begin
  5965. LinePixelsRead := 0;
  5966. inc(Counter.Y.low, Counter.Y.dir); //next line index
  5967. TmpData := ImageData;
  5968. inc(TmpData, Counter.Y.low * LineSize); //set line
  5969. if (Counter.X.dir < 0) then //if x flipped then
  5970. inc(TmpData, LineSize - PixelSize); //set last pixel
  5971. end;
  5972. end;
  5973. /////////////////////////////////////////////////////////////////
  5974. var
  5975. Cache: PByte;
  5976. CacheSize, CachePos: Integer;
  5977. procedure CachedRead(out Buffer; Count: Integer);
  5978. var
  5979. BytesRead: Integer;
  5980. begin
  5981. if (CachePos + Count > CacheSize) then begin
  5982. //if buffer overflow save non read bytes
  5983. BytesRead := 0;
  5984. if (CacheSize - CachePos > 0) then begin
  5985. BytesRead := CacheSize - CachePos;
  5986. Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
  5987. inc(CachePos, BytesRead);
  5988. end;
  5989. //load cache from file
  5990. CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
  5991. aStream.Read(Cache^, CacheSize);
  5992. CachePos := 0;
  5993. //read rest of requested bytes
  5994. if (Count - BytesRead > 0) then begin
  5995. Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
  5996. inc(CachePos, Count - BytesRead);
  5997. end;
  5998. end else begin
  5999. //if no buffer overflow just read the data
  6000. Move(PByteArray(Cache)^[CachePos], Buffer, Count);
  6001. inc(CachePos, Count);
  6002. end;
  6003. end;
  6004. procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
  6005. begin
  6006. case PixelSize of
  6007. 1: begin
  6008. aBuffer^ := aData^;
  6009. inc(aBuffer, Counter.X.dir);
  6010. end;
  6011. 2: begin
  6012. PWord(aBuffer)^ := PWord(aData)^;
  6013. inc(aBuffer, 2 * Counter.X.dir);
  6014. end;
  6015. 3: begin
  6016. PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
  6017. PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
  6018. PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
  6019. inc(aBuffer, 3 * Counter.X.dir);
  6020. end;
  6021. 4: begin
  6022. PCardinal(aBuffer)^ := PCardinal(aData)^;
  6023. inc(aBuffer, 4 * Counter.X.dir);
  6024. end;
  6025. end;
  6026. end;
  6027. var
  6028. TotalPixelsToRead, TotalPixelsRead: Integer;
  6029. Temp: Byte;
  6030. buf: array [0..3] of Byte; //1 pixel is max 32bit long
  6031. PixelRepeat: Boolean;
  6032. PixelsToRead, PixelCount: Integer;
  6033. begin
  6034. CacheSize := 0;
  6035. CachePos := 0;
  6036. TotalPixelsToRead := Header.Width * Header.Height;
  6037. TotalPixelsRead := 0;
  6038. LinePixelsRead := 0;
  6039. GetMem(Cache, CACHE_SIZE);
  6040. try
  6041. TmpData := ImageData;
  6042. inc(TmpData, Counter.Y.low * LineSize); //set line
  6043. if (Counter.X.dir < 0) then //if x flipped then
  6044. inc(TmpData, LineSize - PixelSize); //set last pixel
  6045. repeat
  6046. //read CommandByte
  6047. CachedRead(Temp, 1);
  6048. PixelRepeat := (Temp and $80) > 0;
  6049. PixelsToRead := (Temp and $7F) + 1;
  6050. inc(TotalPixelsRead, PixelsToRead);
  6051. if PixelRepeat then
  6052. CachedRead(buf[0], PixelSize);
  6053. while (PixelsToRead > 0) do begin
  6054. CheckLine;
  6055. PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
  6056. while (PixelCount > 0) do begin
  6057. if not PixelRepeat then
  6058. CachedRead(buf[0], PixelSize);
  6059. PixelToBuffer(@buf[0], TmpData);
  6060. inc(LinePixelsRead);
  6061. dec(PixelsToRead);
  6062. dec(PixelCount);
  6063. end;
  6064. end;
  6065. until (TotalPixelsRead >= TotalPixelsToRead);
  6066. finally
  6067. FreeMem(Cache);
  6068. end;
  6069. end;
  6070. function IsGrayFormat: Boolean;
  6071. begin
  6072. result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
  6073. end;
  6074. begin
  6075. result := false;
  6076. // reading header to test file and set cursor back to begin
  6077. StartPosition := aStream.Position;
  6078. aStream.Read(Header{%H-}, SizeOf(Header));
  6079. // no colormapped files
  6080. if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
  6081. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
  6082. begin
  6083. try
  6084. if Header.ImageID <> 0 then // skip image ID
  6085. aStream.Position := aStream.Position + Header.ImageID;
  6086. tgaFormat := tfEmpty;
  6087. case Header.Bpp of
  6088. 8: if IsGrayFormat then case (Header.ImageDesc and $F) of
  6089. 0: tgaFormat := tfLuminance8;
  6090. 8: tgaFormat := tfAlpha8;
  6091. end;
  6092. 16: if IsGrayFormat then case (Header.ImageDesc and $F) of
  6093. 0: tgaFormat := tfLuminance16;
  6094. 8: tgaFormat := tfLuminance8Alpha8;
  6095. end else case (Header.ImageDesc and $F) of
  6096. 0: tgaFormat := tfBGR5;
  6097. 1: tgaFormat := tfBGR5A1;
  6098. 4: tgaFormat := tfBGRA4;
  6099. end;
  6100. 24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  6101. 0: tgaFormat := tfBGR8;
  6102. end;
  6103. 32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  6104. 2: tgaFormat := tfBGR10A2;
  6105. 8: tgaFormat := tfBGRA8;
  6106. end;
  6107. end;
  6108. if (tgaFormat = tfEmpty) then
  6109. raise EglBitmapException.Create('LoadTga - unsupported format');
  6110. FormatDesc := TFormatDescriptor.Get(tgaFormat);
  6111. PixelSize := FormatDesc.GetSize(1, 1);
  6112. LineSize := FormatDesc.GetSize(Header.Width, 1);
  6113. GetMem(ImageData, LineSize * Header.Height);
  6114. try
  6115. //column direction
  6116. if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
  6117. Counter.X.low := Header.Height-1;;
  6118. Counter.X.high := 0;
  6119. Counter.X.dir := -1;
  6120. end else begin
  6121. Counter.X.low := 0;
  6122. Counter.X.high := Header.Height-1;
  6123. Counter.X.dir := 1;
  6124. end;
  6125. // Row direction
  6126. if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
  6127. Counter.Y.low := 0;
  6128. Counter.Y.high := Header.Height-1;
  6129. Counter.Y.dir := 1;
  6130. end else begin
  6131. Counter.Y.low := Header.Height-1;;
  6132. Counter.Y.high := 0;
  6133. Counter.Y.dir := -1;
  6134. end;
  6135. // Read Image
  6136. case Header.ImageType of
  6137. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
  6138. ReadUncompressed;
  6139. TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
  6140. ReadCompressed;
  6141. end;
  6142. SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
  6143. result := true;
  6144. except
  6145. if Assigned(ImageData) then
  6146. FreeMem(ImageData);
  6147. raise;
  6148. end;
  6149. finally
  6150. aStream.Position := StartPosition;
  6151. end;
  6152. end
  6153. else aStream.Position := StartPosition;
  6154. end;
  6155. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6156. procedure TglBitmap.SaveTGA(const aStream: TStream);
  6157. var
  6158. Header: TTGAHeader;
  6159. LineSize, Size, x, y: Integer;
  6160. Pixel: TglBitmapPixelData;
  6161. LineBuf, SourceData, DestData: PByte;
  6162. SourceMD, DestMD: Pointer;
  6163. FormatDesc: TFormatDescriptor;
  6164. Converter: TFormatDescriptor;
  6165. begin
  6166. if not (ftTGA in FormatGetSupportedFiles(Format)) then
  6167. raise EglBitmapUnsupportedFormat.Create(Format);
  6168. //prepare header
  6169. FillChar(Header{%H-}, SizeOf(Header), 0);
  6170. //set ImageType
  6171. if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
  6172. tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
  6173. Header.ImageType := TGA_UNCOMPRESSED_GRAY
  6174. else
  6175. Header.ImageType := TGA_UNCOMPRESSED_RGB;
  6176. //set BitsPerPixel
  6177. if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
  6178. Header.Bpp := 8
  6179. else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
  6180. tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
  6181. Header.Bpp := 16
  6182. else if (Format in [tfBGR8, tfRGB8]) then
  6183. Header.Bpp := 24
  6184. else
  6185. Header.Bpp := 32;
  6186. //set AlphaBitCount
  6187. case Format of
  6188. tfRGB5A1, tfBGR5A1:
  6189. Header.ImageDesc := 1 and $F;
  6190. tfRGB10A2, tfBGR10A2:
  6191. Header.ImageDesc := 2 and $F;
  6192. tfRGBA4, tfBGRA4:
  6193. Header.ImageDesc := 4 and $F;
  6194. tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
  6195. Header.ImageDesc := 8 and $F;
  6196. end;
  6197. Header.Width := Width;
  6198. Header.Height := Height;
  6199. Header.ImageDesc := Header.ImageDesc or $20; //flip y
  6200. aStream.Write(Header, SizeOf(Header));
  6201. // convert RGB(A) to BGR(A)
  6202. Converter := nil;
  6203. FormatDesc := TFormatDescriptor.Get(Format);
  6204. Size := FormatDesc.GetSize(Dimension);
  6205. if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
  6206. if (FormatDesc.RGBInverted = tfEmpty) then
  6207. raise EglBitmapException.Create('inverted RGB format is empty');
  6208. Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
  6209. if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
  6210. (Converter.PixelSize <> FormatDesc.PixelSize) then
  6211. raise EglBitmapException.Create('invalid inverted RGB format');
  6212. end;
  6213. if Assigned(Converter) then begin
  6214. LineSize := FormatDesc.GetSize(Width, 1);
  6215. GetMem(LineBuf, LineSize);
  6216. SourceMD := FormatDesc.CreateMappingData;
  6217. DestMD := Converter.CreateMappingData;
  6218. try
  6219. SourceData := Data;
  6220. for y := 0 to Height-1 do begin
  6221. DestData := LineBuf;
  6222. for x := 0 to Width-1 do begin
  6223. FormatDesc.Unmap(SourceData, Pixel, SourceMD);
  6224. Converter.Map(Pixel, DestData, DestMD);
  6225. end;
  6226. aStream.Write(LineBuf^, LineSize);
  6227. end;
  6228. finally
  6229. FreeMem(LineBuf);
  6230. FormatDesc.FreeMappingData(SourceMD);
  6231. FormatDesc.FreeMappingData(DestMD);
  6232. end;
  6233. end else
  6234. aStream.Write(Data^, Size);
  6235. end;
  6236. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6237. //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6238. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6239. const
  6240. DDS_MAGIC: Cardinal = $20534444;
  6241. // DDS_header.dwFlags
  6242. DDSD_CAPS = $00000001;
  6243. DDSD_HEIGHT = $00000002;
  6244. DDSD_WIDTH = $00000004;
  6245. DDSD_PIXELFORMAT = $00001000;
  6246. // DDS_header.sPixelFormat.dwFlags
  6247. DDPF_ALPHAPIXELS = $00000001;
  6248. DDPF_ALPHA = $00000002;
  6249. DDPF_FOURCC = $00000004;
  6250. DDPF_RGB = $00000040;
  6251. DDPF_LUMINANCE = $00020000;
  6252. // DDS_header.sCaps.dwCaps1
  6253. DDSCAPS_TEXTURE = $00001000;
  6254. // DDS_header.sCaps.dwCaps2
  6255. DDSCAPS2_CUBEMAP = $00000200;
  6256. D3DFMT_DXT1 = $31545844;
  6257. D3DFMT_DXT3 = $33545844;
  6258. D3DFMT_DXT5 = $35545844;
  6259. type
  6260. TDDSPixelFormat = packed record
  6261. dwSize: Cardinal;
  6262. dwFlags: Cardinal;
  6263. dwFourCC: Cardinal;
  6264. dwRGBBitCount: Cardinal;
  6265. dwRBitMask: Cardinal;
  6266. dwGBitMask: Cardinal;
  6267. dwBBitMask: Cardinal;
  6268. dwABitMask: Cardinal;
  6269. end;
  6270. TDDSCaps = packed record
  6271. dwCaps1: Cardinal;
  6272. dwCaps2: Cardinal;
  6273. dwDDSX: Cardinal;
  6274. dwReserved: Cardinal;
  6275. end;
  6276. TDDSHeader = packed record
  6277. dwSize: Cardinal;
  6278. dwFlags: Cardinal;
  6279. dwHeight: Cardinal;
  6280. dwWidth: Cardinal;
  6281. dwPitchOrLinearSize: Cardinal;
  6282. dwDepth: Cardinal;
  6283. dwMipMapCount: Cardinal;
  6284. dwReserved: array[0..10] of Cardinal;
  6285. PixelFormat: TDDSPixelFormat;
  6286. Caps: TDDSCaps;
  6287. dwReserved2: Cardinal;
  6288. end;
  6289. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6290. function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
  6291. var
  6292. Header: TDDSHeader;
  6293. Converter: TbmpBitfieldFormat;
  6294. function GetDDSFormat: TglBitmapFormat;
  6295. var
  6296. fd: TFormatDescriptor;
  6297. i: Integer;
  6298. Range: TglBitmapColorRec;
  6299. match: Boolean;
  6300. begin
  6301. result := tfEmpty;
  6302. with Header.PixelFormat do begin
  6303. // Compresses
  6304. if ((dwFlags and DDPF_FOURCC) > 0) then begin
  6305. case Header.PixelFormat.dwFourCC of
  6306. D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
  6307. D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
  6308. D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
  6309. end;
  6310. end else if ((Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin
  6311. //find matching format
  6312. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  6313. fd := TFormatDescriptor.Get(result);
  6314. if fd.MaskMatch(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask) and
  6315. (8 * fd.PixelSize = dwRGBBitCount) then
  6316. exit;
  6317. end;
  6318. //find format with same Range
  6319. Range.r := dwRBitMask;
  6320. Range.g := dwGBitMask;
  6321. Range.b := dwBBitMask;
  6322. Range.a := dwABitMask;
  6323. for i := 0 to 3 do begin
  6324. while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do
  6325. Range.arr[i] := Range.arr[i] shr 1;
  6326. end;
  6327. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  6328. fd := TFormatDescriptor.Get(result);
  6329. match := true;
  6330. for i := 0 to 3 do
  6331. if (fd.Range.arr[i] <> Range.arr[i]) then begin
  6332. match := false;
  6333. break;
  6334. end;
  6335. if match then
  6336. break;
  6337. end;
  6338. //no format with same range found -> use default
  6339. if (result = tfEmpty) then begin
  6340. if (dwABitMask > 0) then
  6341. result := tfBGRA8
  6342. else
  6343. result := tfBGR8;
  6344. end;
  6345. Converter := TbmpBitfieldFormat.Create;
  6346. Converter.RedMask := dwRBitMask;
  6347. Converter.GreenMask := dwGBitMask;
  6348. Converter.BlueMask := dwBBitMask;
  6349. Converter.AlphaMask := dwABitMask;
  6350. Converter.PixelSize := dwRGBBitCount / 8;
  6351. end;
  6352. end;
  6353. end;
  6354. var
  6355. StreamPos: Int64;
  6356. x, y, LineSize, RowSize, Magic: Cardinal;
  6357. NewImage, TmpData, RowData, SrcData: System.PByte;
  6358. SourceMD, DestMD: Pointer;
  6359. Pixel: TglBitmapPixelData;
  6360. ddsFormat: TglBitmapFormat;
  6361. FormatDesc: TFormatDescriptor;
  6362. begin
  6363. result := false;
  6364. Converter := nil;
  6365. StreamPos := aStream.Position;
  6366. // Magic
  6367. aStream.Read(Magic{%H-}, sizeof(Magic));
  6368. if (Magic <> DDS_MAGIC) then begin
  6369. aStream.Position := StreamPos;
  6370. exit;
  6371. end;
  6372. //Header
  6373. aStream.Read(Header{%H-}, sizeof(Header));
  6374. if (Header.dwSize <> SizeOf(Header)) or
  6375. ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
  6376. (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
  6377. begin
  6378. aStream.Position := StreamPos;
  6379. exit;
  6380. end;
  6381. if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
  6382. raise EglBitmapException.Create('LoadDDS - CubeMaps are not supported');
  6383. ddsFormat := GetDDSFormat;
  6384. try
  6385. if (ddsFormat = tfEmpty) then
  6386. raise EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');
  6387. FormatDesc := TFormatDescriptor.Get(ddsFormat);
  6388. LineSize := Trunc(Header.dwWidth * FormatDesc.PixelSize);
  6389. GetMem(NewImage, Header.dwHeight * LineSize);
  6390. try
  6391. TmpData := NewImage;
  6392. //Converter needed
  6393. if Assigned(Converter) then begin
  6394. RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
  6395. GetMem(RowData, RowSize);
  6396. SourceMD := Converter.CreateMappingData;
  6397. DestMD := FormatDesc.CreateMappingData;
  6398. try
  6399. for y := 0 to Header.dwHeight-1 do begin
  6400. TmpData := NewImage;
  6401. inc(TmpData, y * LineSize);
  6402. SrcData := RowData;
  6403. aStream.Read(SrcData^, RowSize);
  6404. for x := 0 to Header.dwWidth-1 do begin
  6405. Converter.Unmap(SrcData, Pixel, SourceMD);
  6406. glBitmapConvertPixel(Pixel, Converter, FormatDesc);
  6407. FormatDesc.Map(Pixel, TmpData, DestMD);
  6408. end;
  6409. end;
  6410. finally
  6411. Converter.FreeMappingData(SourceMD);
  6412. FormatDesc.FreeMappingData(DestMD);
  6413. FreeMem(RowData);
  6414. end;
  6415. end else
  6416. // Compressed
  6417. if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
  6418. RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
  6419. for Y := 0 to Header.dwHeight-1 do begin
  6420. aStream.Read(TmpData^, RowSize);
  6421. Inc(TmpData, LineSize);
  6422. end;
  6423. end else
  6424. // Uncompressed
  6425. if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
  6426. RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
  6427. for Y := 0 to Header.dwHeight-1 do begin
  6428. aStream.Read(TmpData^, RowSize);
  6429. Inc(TmpData, LineSize);
  6430. end;
  6431. end else
  6432. raise EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');
  6433. SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
  6434. result := true;
  6435. except
  6436. if Assigned(NewImage) then
  6437. FreeMem(NewImage);
  6438. raise;
  6439. end;
  6440. finally
  6441. FreeAndNil(Converter);
  6442. end;
  6443. end;
  6444. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6445. procedure TglBitmap.SaveDDS(const aStream: TStream);
  6446. var
  6447. Header: TDDSHeader;
  6448. FormatDesc: TFormatDescriptor;
  6449. begin
  6450. if not (ftDDS in FormatGetSupportedFiles(Format)) then
  6451. raise EglBitmapUnsupportedFormat.Create(Format);
  6452. FormatDesc := TFormatDescriptor.Get(Format);
  6453. // Generell
  6454. FillChar(Header{%H-}, SizeOf(Header), 0);
  6455. Header.dwSize := SizeOf(Header);
  6456. Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
  6457. Header.dwWidth := Max(1, Width);
  6458. Header.dwHeight := Max(1, Height);
  6459. // Caps
  6460. Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
  6461. // Pixelformat
  6462. Header.PixelFormat.dwSize := sizeof(Header);
  6463. if (FormatDesc.IsCompressed) then begin
  6464. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
  6465. case Format of
  6466. tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
  6467. tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
  6468. tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
  6469. end;
  6470. end else if (Format in [tfAlpha8, tfAlpha16]) then begin
  6471. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHA;
  6472. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6473. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6474. end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
  6475. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
  6476. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6477. Header.PixelFormat.dwRBitMask := FormatDesc.RedMask;
  6478. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6479. end else begin
  6480. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
  6481. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6482. Header.PixelFormat.dwRBitMask := FormatDesc.RedMask;
  6483. Header.PixelFormat.dwGBitMask := FormatDesc.GreenMask;
  6484. Header.PixelFormat.dwBBitMask := FormatDesc.BlueMask;
  6485. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6486. end;
  6487. if (FormatDesc.HasAlpha) then
  6488. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
  6489. aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
  6490. aStream.Write(Header, SizeOf(Header));
  6491. aStream.Write(Data^, FormatDesc.GetSize(Dimension));
  6492. end;
  6493. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6494. //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6495. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6496. procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  6497. const aWidth: Integer; const aHeight: Integer);
  6498. var
  6499. pTemp: pByte;
  6500. Size: Integer;
  6501. begin
  6502. if (aHeight > 1) then begin
  6503. Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
  6504. GetMem(pTemp, Size);
  6505. try
  6506. Move(aData^, pTemp^, Size);
  6507. FreeMem(aData);
  6508. aData := nil;
  6509. except
  6510. FreeMem(pTemp);
  6511. raise;
  6512. end;
  6513. end else
  6514. pTemp := aData;
  6515. inherited SetDataPointer(pTemp, aFormat, aWidth);
  6516. end;
  6517. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6518. function TglBitmap1D.FlipHorz: Boolean;
  6519. var
  6520. Col: Integer;
  6521. pTempDest, pDest, pSource: PByte;
  6522. begin
  6523. result := inherited FlipHorz;
  6524. if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
  6525. pSource := Data;
  6526. GetMem(pDest, fRowSize);
  6527. try
  6528. pTempDest := pDest;
  6529. Inc(pTempDest, fRowSize);
  6530. for Col := 0 to Width-1 do begin
  6531. dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
  6532. Move(pSource^, pTempDest^, fPixelSize);
  6533. Inc(pSource, fPixelSize);
  6534. end;
  6535. SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
  6536. result := true;
  6537. except
  6538. if Assigned(pDest) then
  6539. FreeMem(pDest);
  6540. raise;
  6541. end;
  6542. end;
  6543. end;
  6544. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6545. procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
  6546. var
  6547. FormatDesc: TFormatDescriptor;
  6548. begin
  6549. // Upload data
  6550. FormatDesc := TFormatDescriptor.Get(Format);
  6551. if FormatDesc.IsCompressed then
  6552. glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
  6553. else if aBuildWithGlu then
  6554. gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  6555. else
  6556. glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  6557. // Free Data
  6558. if (FreeDataAfterGenTexture) then
  6559. FreeData;
  6560. end;
  6561. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6562. procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
  6563. var
  6564. BuildWithGlu, TexRec: Boolean;
  6565. TexSize: Integer;
  6566. begin
  6567. if Assigned(Data) then begin
  6568. // Check Texture Size
  6569. if (aTestTextureSize) then begin
  6570. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  6571. if (Width > TexSize) then
  6572. raise EglBitmapSizeToLargeException.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  6573. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
  6574. (Target = GL_TEXTURE_RECTANGLE_ARB);
  6575. if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  6576. raise EglBitmapNonPowerOfTwoException.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  6577. end;
  6578. CreateId;
  6579. SetupParameters(BuildWithGlu);
  6580. UploadData(BuildWithGlu);
  6581. glAreTexturesResident(1, @fID, @fIsResident);
  6582. end;
  6583. end;
  6584. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6585. procedure TglBitmap1D.AfterConstruction;
  6586. begin
  6587. inherited;
  6588. Target := GL_TEXTURE_1D;
  6589. end;
  6590. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6591. //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6592. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6593. function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
  6594. begin
  6595. if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
  6596. result := fLines[aIndex]
  6597. else
  6598. result := nil;
  6599. end;
  6600. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6601. procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  6602. const aWidth: Integer; const aHeight: Integer);
  6603. var
  6604. Idx, LineWidth: Integer;
  6605. begin
  6606. inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
  6607. if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
  6608. // Assigning Data
  6609. if Assigned(Data) then begin
  6610. SetLength(fLines, GetHeight);
  6611. LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
  6612. for Idx := 0 to GetHeight-1 do begin
  6613. fLines[Idx] := Data;
  6614. Inc(fLines[Idx], Idx * LineWidth);
  6615. end;
  6616. end
  6617. else SetLength(fLines, 0);
  6618. end else begin
  6619. SetLength(fLines, 0);
  6620. end;
  6621. end;
  6622. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6623. procedure TglBitmap2D.UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);
  6624. var
  6625. FormatDesc: TFormatDescriptor;
  6626. begin
  6627. glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
  6628. FormatDesc := TFormatDescriptor.Get(Format);
  6629. if FormatDesc.IsCompressed then begin
  6630. glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
  6631. end else if aBuildWithGlu then begin
  6632. gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
  6633. FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  6634. end else begin
  6635. glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
  6636. FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  6637. end;
  6638. // Freigeben
  6639. if (FreeDataAfterGenTexture) then
  6640. FreeData;
  6641. end;
  6642. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6643. procedure TglBitmap2D.AfterConstruction;
  6644. begin
  6645. inherited;
  6646. Target := GL_TEXTURE_2D;
  6647. end;
  6648. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6649. procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  6650. var
  6651. Temp: pByte;
  6652. Size, w, h: Integer;
  6653. FormatDesc: TFormatDescriptor;
  6654. begin
  6655. FormatDesc := TFormatDescriptor.Get(Format);
  6656. if FormatDesc.IsCompressed then
  6657. raise EglBitmapUnsupportedFormat.Create(Format);
  6658. w := aRight - aLeft;
  6659. h := aBottom - aTop;
  6660. Size := FormatDesc.GetSize(w, h);
  6661. GetMem(Temp, Size);
  6662. try
  6663. glPixelStorei(GL_PACK_ALIGNMENT, 1);
  6664. glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  6665. SetDataPointer(Temp, Format, w, h); //be careful, Data could be freed by this method
  6666. FlipVert;
  6667. except
  6668. if Assigned(Temp) then
  6669. FreeMem(Temp);
  6670. raise;
  6671. end;
  6672. end;
  6673. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6674. procedure TglBitmap2D.GetDataFromTexture;
  6675. var
  6676. Temp: PByte;
  6677. TempWidth, TempHeight: Integer;
  6678. TempIntFormat: Cardinal;
  6679. IntFormat, f: TglBitmapFormat;
  6680. FormatDesc: TFormatDescriptor;
  6681. begin
  6682. Bind;
  6683. // Request Data
  6684. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH, @TempWidth);
  6685. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT, @TempHeight);
  6686. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
  6687. IntFormat := tfEmpty;
  6688. for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
  6689. FormatDesc := TFormatDescriptor.Get(f);
  6690. if (FormatDesc.glInternalFormat = TempIntFormat) then begin
  6691. IntFormat := FormatDesc.Format;
  6692. break;
  6693. end;
  6694. end;
  6695. // Getting data from OpenGL
  6696. FormatDesc := TFormatDescriptor.Get(IntFormat);
  6697. GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
  6698. try
  6699. if FormatDesc.IsCompressed then
  6700. glGetCompressedTexImage(Target, 0, Temp)
  6701. else
  6702. glGetTexImage(Target, 0, FormatDesc.glInternalFormat, FormatDesc.glDataFormat, Temp);
  6703. SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  6704. except
  6705. if Assigned(Temp) then
  6706. FreeMem(Temp);
  6707. raise;
  6708. end;
  6709. end;
  6710. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6711. procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
  6712. var
  6713. BuildWithGlu, PotTex, TexRec: Boolean;
  6714. TexSize: Integer;
  6715. begin
  6716. if Assigned(Data) then begin
  6717. // Check Texture Size
  6718. if (aTestTextureSize) then begin
  6719. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  6720. if ((Height > TexSize) or (Width > TexSize)) then
  6721. raise EglBitmapSizeToLargeException.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  6722. PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
  6723. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
  6724. if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  6725. raise EglBitmapNonPowerOfTwoException.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  6726. end;
  6727. CreateId;
  6728. SetupParameters(BuildWithGlu);
  6729. UploadData(Target, BuildWithGlu);
  6730. glAreTexturesResident(1, @fID, @fIsResident);
  6731. end;
  6732. end;
  6733. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6734. function TglBitmap2D.FlipHorz: Boolean;
  6735. var
  6736. Col, Row: Integer;
  6737. TempDestData, DestData, SourceData: PByte;
  6738. ImgSize: Integer;
  6739. begin
  6740. result := inherited FlipHorz;
  6741. if Assigned(Data) then begin
  6742. SourceData := Data;
  6743. ImgSize := Height * fRowSize;
  6744. GetMem(DestData, ImgSize);
  6745. try
  6746. TempDestData := DestData;
  6747. Dec(TempDestData, fRowSize + fPixelSize);
  6748. for Row := 0 to Height -1 do begin
  6749. Inc(TempDestData, fRowSize * 2);
  6750. for Col := 0 to Width -1 do begin
  6751. Move(SourceData^, TempDestData^, fPixelSize);
  6752. Inc(SourceData, fPixelSize);
  6753. Dec(TempDestData, fPixelSize);
  6754. end;
  6755. end;
  6756. SetDataPointer(DestData, Format); //be careful, Data could be freed by this method
  6757. result := true;
  6758. except
  6759. if Assigned(DestData) then
  6760. FreeMem(DestData);
  6761. raise;
  6762. end;
  6763. end;
  6764. end;
  6765. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6766. function TglBitmap2D.FlipVert: Boolean;
  6767. var
  6768. Row: Integer;
  6769. TempDestData, DestData, SourceData: PByte;
  6770. begin
  6771. result := inherited FlipVert;
  6772. if Assigned(Data) then begin
  6773. SourceData := Data;
  6774. GetMem(DestData, Height * fRowSize);
  6775. try
  6776. TempDestData := DestData;
  6777. Inc(TempDestData, Width * (Height -1) * fPixelSize);
  6778. for Row := 0 to Height -1 do begin
  6779. Move(SourceData^, TempDestData^, fRowSize);
  6780. Dec(TempDestData, fRowSize);
  6781. Inc(SourceData, fRowSize);
  6782. end;
  6783. SetDataPointer(DestData, Format); //be careful, Data could be freed by this method
  6784. result := true;
  6785. except
  6786. if Assigned(DestData) then
  6787. FreeMem(DestData);
  6788. raise;
  6789. end;
  6790. end;
  6791. end;
  6792. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6793. //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6794. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6795. type
  6796. TMatrixItem = record
  6797. X, Y: Integer;
  6798. W: Single;
  6799. end;
  6800. PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
  6801. TglBitmapToNormalMapRec = Record
  6802. Scale: Single;
  6803. Heights: array of Single;
  6804. MatrixU : array of TMatrixItem;
  6805. MatrixV : array of TMatrixItem;
  6806. end;
  6807. const
  6808. ONE_OVER_255 = 1 / 255;
  6809. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6810. procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
  6811. var
  6812. Val: Single;
  6813. begin
  6814. with FuncRec do begin
  6815. Val :=
  6816. Source.Data.r * LUMINANCE_WEIGHT_R +
  6817. Source.Data.g * LUMINANCE_WEIGHT_G +
  6818. Source.Data.b * LUMINANCE_WEIGHT_B;
  6819. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
  6820. end;
  6821. end;
  6822. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6823. procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  6824. begin
  6825. with FuncRec do
  6826. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
  6827. end;
  6828. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6829. procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
  6830. type
  6831. TVec = Array[0..2] of Single;
  6832. var
  6833. Idx: Integer;
  6834. du, dv: Double;
  6835. Len: Single;
  6836. Vec: TVec;
  6837. function GetHeight(X, Y: Integer): Single;
  6838. begin
  6839. with FuncRec do begin
  6840. X := Max(0, Min(Size.X -1, X));
  6841. Y := Max(0, Min(Size.Y -1, Y));
  6842. result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
  6843. end;
  6844. end;
  6845. begin
  6846. with FuncRec do begin
  6847. with PglBitmapToNormalMapRec(Args)^ do begin
  6848. du := 0;
  6849. for Idx := Low(MatrixU) to High(MatrixU) do
  6850. du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
  6851. dv := 0;
  6852. for Idx := Low(MatrixU) to High(MatrixU) do
  6853. dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
  6854. Vec[0] := -du * Scale;
  6855. Vec[1] := -dv * Scale;
  6856. Vec[2] := 1;
  6857. end;
  6858. // Normalize
  6859. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  6860. if Len <> 0 then begin
  6861. Vec[0] := Vec[0] * Len;
  6862. Vec[1] := Vec[1] * Len;
  6863. Vec[2] := Vec[2] * Len;
  6864. end;
  6865. // Farbe zuweisem
  6866. Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
  6867. Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
  6868. Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
  6869. end;
  6870. end;
  6871. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6872. procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
  6873. var
  6874. Rec: TglBitmapToNormalMapRec;
  6875. procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
  6876. begin
  6877. if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
  6878. Matrix[Index].X := X;
  6879. Matrix[Index].Y := Y;
  6880. Matrix[Index].W := W;
  6881. end;
  6882. end;
  6883. begin
  6884. if TFormatDescriptor.Get(Format).IsCompressed then
  6885. raise EglBitmapUnsupportedFormat.Create(Format);
  6886. if aScale > 100 then
  6887. Rec.Scale := 100
  6888. else if aScale < -100 then
  6889. Rec.Scale := -100
  6890. else
  6891. Rec.Scale := aScale;
  6892. SetLength(Rec.Heights, Width * Height);
  6893. try
  6894. case aFunc of
  6895. nm4Samples: begin
  6896. SetLength(Rec.MatrixU, 2);
  6897. SetEntry(Rec.MatrixU, 0, -1, 0, -0.5);
  6898. SetEntry(Rec.MatrixU, 1, 1, 0, 0.5);
  6899. SetLength(Rec.MatrixV, 2);
  6900. SetEntry(Rec.MatrixV, 0, 0, 1, 0.5);
  6901. SetEntry(Rec.MatrixV, 1, 0, -1, -0.5);
  6902. end;
  6903. nmSobel: begin
  6904. SetLength(Rec.MatrixU, 6);
  6905. SetEntry(Rec.MatrixU, 0, -1, 1, -1.0);
  6906. SetEntry(Rec.MatrixU, 1, -1, 0, -2.0);
  6907. SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
  6908. SetEntry(Rec.MatrixU, 3, 1, 1, 1.0);
  6909. SetEntry(Rec.MatrixU, 4, 1, 0, 2.0);
  6910. SetEntry(Rec.MatrixU, 5, 1, -1, 1.0);
  6911. SetLength(Rec.MatrixV, 6);
  6912. SetEntry(Rec.MatrixV, 0, -1, 1, 1.0);
  6913. SetEntry(Rec.MatrixV, 1, 0, 1, 2.0);
  6914. SetEntry(Rec.MatrixV, 2, 1, 1, 1.0);
  6915. SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
  6916. SetEntry(Rec.MatrixV, 4, 0, -1, -2.0);
  6917. SetEntry(Rec.MatrixV, 5, 1, -1, -1.0);
  6918. end;
  6919. nm3x3: begin
  6920. SetLength(Rec.MatrixU, 6);
  6921. SetEntry(Rec.MatrixU, 0, -1, 1, -1/6);
  6922. SetEntry(Rec.MatrixU, 1, -1, 0, -1/6);
  6923. SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
  6924. SetEntry(Rec.MatrixU, 3, 1, 1, 1/6);
  6925. SetEntry(Rec.MatrixU, 4, 1, 0, 1/6);
  6926. SetEntry(Rec.MatrixU, 5, 1, -1, 1/6);
  6927. SetLength(Rec.MatrixV, 6);
  6928. SetEntry(Rec.MatrixV, 0, -1, 1, 1/6);
  6929. SetEntry(Rec.MatrixV, 1, 0, 1, 1/6);
  6930. SetEntry(Rec.MatrixV, 2, 1, 1, 1/6);
  6931. SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
  6932. SetEntry(Rec.MatrixV, 4, 0, -1, -1/6);
  6933. SetEntry(Rec.MatrixV, 5, 1, -1, -1/6);
  6934. end;
  6935. nm5x5: begin
  6936. SetLength(Rec.MatrixU, 20);
  6937. SetEntry(Rec.MatrixU, 0, -2, 2, -1 / 16);
  6938. SetEntry(Rec.MatrixU, 1, -1, 2, -1 / 10);
  6939. SetEntry(Rec.MatrixU, 2, 1, 2, 1 / 10);
  6940. SetEntry(Rec.MatrixU, 3, 2, 2, 1 / 16);
  6941. SetEntry(Rec.MatrixU, 4, -2, 1, -1 / 10);
  6942. SetEntry(Rec.MatrixU, 5, -1, 1, -1 / 8);
  6943. SetEntry(Rec.MatrixU, 6, 1, 1, 1 / 8);
  6944. SetEntry(Rec.MatrixU, 7, 2, 1, 1 / 10);
  6945. SetEntry(Rec.MatrixU, 8, -2, 0, -1 / 2.8);
  6946. SetEntry(Rec.MatrixU, 9, -1, 0, -0.5);
  6947. SetEntry(Rec.MatrixU, 10, 1, 0, 0.5);
  6948. SetEntry(Rec.MatrixU, 11, 2, 0, 1 / 2.8);
  6949. SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
  6950. SetEntry(Rec.MatrixU, 13, -1, -1, -1 / 8);
  6951. SetEntry(Rec.MatrixU, 14, 1, -1, 1 / 8);
  6952. SetEntry(Rec.MatrixU, 15, 2, -1, 1 / 10);
  6953. SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
  6954. SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
  6955. SetEntry(Rec.MatrixU, 18, 1, -2, 1 / 10);
  6956. SetEntry(Rec.MatrixU, 19, 2, -2, 1 / 16);
  6957. SetLength(Rec.MatrixV, 20);
  6958. SetEntry(Rec.MatrixV, 0, -2, 2, 1 / 16);
  6959. SetEntry(Rec.MatrixV, 1, -1, 2, 1 / 10);
  6960. SetEntry(Rec.MatrixV, 2, 0, 2, 0.25);
  6961. SetEntry(Rec.MatrixV, 3, 1, 2, 1 / 10);
  6962. SetEntry(Rec.MatrixV, 4, 2, 2, 1 / 16);
  6963. SetEntry(Rec.MatrixV, 5, -2, 1, 1 / 10);
  6964. SetEntry(Rec.MatrixV, 6, -1, 1, 1 / 8);
  6965. SetEntry(Rec.MatrixV, 7, 0, 1, 0.5);
  6966. SetEntry(Rec.MatrixV, 8, 1, 1, 1 / 8);
  6967. SetEntry(Rec.MatrixV, 9, 2, 1, 1 / 16);
  6968. SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
  6969. SetEntry(Rec.MatrixV, 11, -1, -1, -1 / 8);
  6970. SetEntry(Rec.MatrixV, 12, 0, -1, -0.5);
  6971. SetEntry(Rec.MatrixV, 13, 1, -1, -1 / 8);
  6972. SetEntry(Rec.MatrixV, 14, 2, -1, -1 / 10);
  6973. SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
  6974. SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
  6975. SetEntry(Rec.MatrixV, 17, 0, -2, -0.25);
  6976. SetEntry(Rec.MatrixV, 18, 1, -2, -1 / 10);
  6977. SetEntry(Rec.MatrixV, 19, 2, -2, -1 / 16);
  6978. end;
  6979. end;
  6980. // Daten Sammeln
  6981. if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
  6982. AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
  6983. else
  6984. AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
  6985. AddFunc(glBitmapToNormalMapFunc, false, @Rec);
  6986. finally
  6987. SetLength(Rec.Heights, 0);
  6988. end;
  6989. end;
  6990. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6991. //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6992. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6993. procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);
  6994. begin
  6995. Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
  6996. end;
  6997. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6998. procedure TglBitmapCubeMap.AfterConstruction;
  6999. begin
  7000. inherited;
  7001. if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
  7002. raise EglBitmapException.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
  7003. SetWrap;
  7004. Target := GL_TEXTURE_CUBE_MAP;
  7005. fGenMode := GL_REFLECTION_MAP;
  7006. end;
  7007. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7008. procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);
  7009. var
  7010. BuildWithGlu: Boolean;
  7011. TexSize: Integer;
  7012. begin
  7013. if (aTestTextureSize) then begin
  7014. glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
  7015. if (Height > TexSize) or (Width > TexSize) then
  7016. raise EglBitmapSizeToLargeException.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
  7017. if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
  7018. raise EglBitmapNonPowerOfTwoException.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
  7019. end;
  7020. if (ID = 0) then
  7021. CreateID;
  7022. SetupParameters(BuildWithGlu);
  7023. UploadData(aCubeTarget, BuildWithGlu);
  7024. end;
  7025. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7026. procedure TglBitmapCubeMap.Bind(const aEnableTexCoordsGen: Boolean; const aEnableTextureUnit: Boolean);
  7027. begin
  7028. inherited Bind (aEnableTextureUnit);
  7029. if aEnableTexCoordsGen then begin
  7030. glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
  7031. glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
  7032. glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
  7033. glEnable(GL_TEXTURE_GEN_S);
  7034. glEnable(GL_TEXTURE_GEN_T);
  7035. glEnable(GL_TEXTURE_GEN_R);
  7036. end;
  7037. end;
  7038. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7039. procedure TglBitmapCubeMap.Unbind(const aDisableTexCoordsGen: Boolean; const aDisableTextureUnit: Boolean);
  7040. begin
  7041. inherited Unbind(aDisableTextureUnit);
  7042. if aDisableTexCoordsGen then begin
  7043. glDisable(GL_TEXTURE_GEN_S);
  7044. glDisable(GL_TEXTURE_GEN_T);
  7045. glDisable(GL_TEXTURE_GEN_R);
  7046. end;
  7047. end;
  7048. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7049. //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7050. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7051. type
  7052. TVec = Array[0..2] of Single;
  7053. TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7054. PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
  7055. TglBitmapNormalMapRec = record
  7056. HalfSize : Integer;
  7057. Func: TglBitmapNormalMapGetVectorFunc;
  7058. end;
  7059. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7060. procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7061. begin
  7062. aVec[0] := aHalfSize;
  7063. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7064. aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
  7065. end;
  7066. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7067. procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7068. begin
  7069. aVec[0] := - aHalfSize;
  7070. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7071. aVec[2] := aPosition.X + 0.5 - aHalfSize;
  7072. end;
  7073. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7074. procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7075. begin
  7076. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7077. aVec[1] := aHalfSize;
  7078. aVec[2] := aPosition.Y + 0.5 - aHalfSize;
  7079. end;
  7080. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7081. procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7082. begin
  7083. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7084. aVec[1] := - aHalfSize;
  7085. aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
  7086. end;
  7087. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7088. procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7089. begin
  7090. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7091. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7092. aVec[2] := aHalfSize;
  7093. end;
  7094. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7095. procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7096. begin
  7097. aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
  7098. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7099. aVec[2] := - aHalfSize;
  7100. end;
  7101. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7102. procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
  7103. var
  7104. i: Integer;
  7105. Vec: TVec;
  7106. Len: Single;
  7107. begin
  7108. with FuncRec do begin
  7109. with PglBitmapNormalMapRec(Args)^ do begin
  7110. Func(Vec, Position, HalfSize);
  7111. // Normalize
  7112. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  7113. if Len <> 0 then begin
  7114. Vec[0] := Vec[0] * Len;
  7115. Vec[1] := Vec[1] * Len;
  7116. Vec[2] := Vec[2] * Len;
  7117. end;
  7118. // Scale Vector and AddVectro
  7119. Vec[0] := Vec[0] * 0.5 + 0.5;
  7120. Vec[1] := Vec[1] * 0.5 + 0.5;
  7121. Vec[2] := Vec[2] * 0.5 + 0.5;
  7122. end;
  7123. // Set Color
  7124. for i := 0 to 2 do
  7125. Dest.Data.arr[i] := Round(Vec[i] * 255);
  7126. end;
  7127. end;
  7128. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7129. procedure TglBitmapNormalMap.AfterConstruction;
  7130. begin
  7131. inherited;
  7132. fGenMode := GL_NORMAL_MAP;
  7133. end;
  7134. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7135. procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);
  7136. var
  7137. Rec: TglBitmapNormalMapRec;
  7138. SizeRec: TglBitmapPixelPosition;
  7139. begin
  7140. Rec.HalfSize := aSize div 2;
  7141. FreeDataAfterGenTexture := false;
  7142. SizeRec.Fields := [ffX, ffY];
  7143. SizeRec.X := aSize;
  7144. SizeRec.Y := aSize;
  7145. // Positive X
  7146. Rec.Func := glBitmapNormalMapPosX;
  7147. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7148. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);
  7149. // Negative X
  7150. Rec.Func := glBitmapNormalMapNegX;
  7151. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7152. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);
  7153. // Positive Y
  7154. Rec.Func := glBitmapNormalMapPosY;
  7155. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7156. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);
  7157. // Negative Y
  7158. Rec.Func := glBitmapNormalMapNegY;
  7159. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7160. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);
  7161. // Positive Z
  7162. Rec.Func := glBitmapNormalMapPosZ;
  7163. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7164. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);
  7165. // Negative Z
  7166. Rec.Func := glBitmapNormalMapNegZ;
  7167. LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);
  7168. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);
  7169. end;
  7170. initialization
  7171. glBitmapSetDefaultFormat(tfEmpty);
  7172. glBitmapSetDefaultMipmap(mmMipmap);
  7173. glBitmapSetDefaultFilter(GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
  7174. glBitmapSetDefaultWrap (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
  7175. glBitmapSetDefaultFreeDataAfterGenTexture(true);
  7176. glBitmapSetDefaultDeleteTextureOnFree (true);
  7177. TFormatDescriptor.Init;
  7178. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  7179. OpenGLInitialized := false;
  7180. InitOpenGLCS := TCriticalSection.Create;
  7181. {$ENDIF}
  7182. finalization
  7183. TFormatDescriptor.Finalize;
  7184. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  7185. FreeAndNil(InitOpenGLCS);
  7186. {$ENDIF}
  7187. end.