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

8247 lines
280 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. // Bildeinstellungen
  861. fLines: array of PByte;
  862. function GetScanline(const aIndex: Integer): Pointer;
  863. procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  864. const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
  865. procedure UploadData(const aBuildWithGlu: Boolean);
  866. public
  867. property Width;
  868. property Height;
  869. property Scanline[const aIndex: Integer]: Pointer read GetScanline;
  870. procedure AfterConstruction; override;
  871. procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  872. procedure GetDataFromTexture;
  873. procedure GenTexture(const aTestTextureSize: Boolean = true); override;
  874. function FlipHorz: Boolean; override;
  875. function FlipVert: Boolean; override;
  876. procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
  877. const aScale: Single = 2; const aUseAlpha: Boolean = false);
  878. end;
  879. (* TODO
  880. TglBitmapCubeMap = class(TglBitmap2D)
  881. protected
  882. fGenMode: Integer;
  883. // Hide GenTexture
  884. procedure GenTexture(TestTextureSize: Boolean = true); reintroduce;
  885. public
  886. procedure AfterConstruction; override;
  887. procedure GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean = true);
  888. procedure Unbind(DisableTexCoordsGen: Boolean = true; DisableTextureUnit: Boolean = true); reintroduce; virtual;
  889. procedure Bind(EnableTexCoordsGen: Boolean = true; EnableTextureUnit: Boolean = true); reintroduce; virtual;
  890. end;
  891. TglBitmapNormalMap = class(TglBitmapCubeMap)
  892. public
  893. procedure AfterConstruction; override;
  894. procedure GenerateNormalMap(Size: Integer = 32; TestTextureSize: Boolean = true);
  895. end;
  896. *)
  897. const
  898. NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
  899. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  900. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  901. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  902. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  903. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  904. procedure glBitmapSetDefaultWrap(
  905. const S: Cardinal = GL_CLAMP_TO_EDGE;
  906. const T: Cardinal = GL_CLAMP_TO_EDGE;
  907. const R: Cardinal = GL_CLAMP_TO_EDGE);
  908. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  909. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  910. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  911. function glBitmapGetDefaultFormat: TglBitmapFormat;
  912. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  913. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  914. function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
  915. function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
  916. function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
  917. var
  918. glBitmapDefaultDeleteTextureOnFree: Boolean;
  919. glBitmapDefaultFreeDataAfterGenTextures: Boolean;
  920. glBitmapDefaultFormat: TglBitmapFormat;
  921. glBitmapDefaultMipmap: TglBitmapMipMap;
  922. glBitmapDefaultFilterMin: Cardinal;
  923. glBitmapDefaultFilterMag: Cardinal;
  924. glBitmapDefaultWrapS: Cardinal;
  925. glBitmapDefaultWrapT: Cardinal;
  926. glBitmapDefaultWrapR: Cardinal;
  927. {$IFDEF GLB_DELPHI}
  928. function CreateGrayPalette: HPALETTE;
  929. {$ENDIF}
  930. implementation
  931. uses
  932. Math, syncobjs, typinfo;
  933. type
  934. {$IFNDEF fpc}
  935. QWord = System.UInt64;
  936. PQWord = ^QWord;
  937. PtrInt = Longint;
  938. PtrUInt = DWord;
  939. {$ENDIF}
  940. ////////////////////////////////////////////////////////////////////////////////////////////////////
  941. TShiftRec = packed record
  942. case Integer of
  943. 0: (r, g, b, a: Byte);
  944. 1: (arr: array[0..3] of Byte);
  945. end;
  946. TFormatDescriptor = class(TObject)
  947. private
  948. function GetRedMask: QWord;
  949. function GetGreenMask: QWord;
  950. function GetBlueMask: QWord;
  951. function GetAlphaMask: QWord;
  952. protected
  953. fFormat: TglBitmapFormat;
  954. fWithAlpha: TglBitmapFormat;
  955. fWithoutAlpha: TglBitmapFormat;
  956. fRGBInverted: TglBitmapFormat;
  957. fUncompressed: TglBitmapFormat;
  958. fPixelSize: Single;
  959. fIsCompressed: Boolean;
  960. fRange: TglBitmapColorRec;
  961. fShift: TShiftRec;
  962. fglFormat: Cardinal;
  963. fglInternalFormat: Cardinal;
  964. fglDataFormat: Cardinal;
  965. function GetComponents: Integer; virtual;
  966. public
  967. property Format: TglBitmapFormat read fFormat;
  968. property WithAlpha: TglBitmapFormat read fWithAlpha;
  969. property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;
  970. property RGBInverted: TglBitmapFormat read fRGBInverted;
  971. property Components: Integer read GetComponents;
  972. property PixelSize: Single read fPixelSize;
  973. property IsCompressed: Boolean read fIsCompressed;
  974. property glFormat: Cardinal read fglFormat;
  975. property glInternalFormat: Cardinal read fglInternalFormat;
  976. property glDataFormat: Cardinal read fglDataFormat;
  977. property Range: TglBitmapColorRec read fRange;
  978. property Shift: TShiftRec read fShift;
  979. property RedMask: QWord read GetRedMask;
  980. property GreenMask: QWord read GetGreenMask;
  981. property BlueMask: QWord read GetBlueMask;
  982. property AlphaMask: QWord read GetAlphaMask;
  983. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
  984. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
  985. function GetSize(const aSize: TglBitmapPixelPosition): Integer; overload; virtual;
  986. function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
  987. function CreateMappingData: Pointer; virtual;
  988. procedure FreeMappingData(var aMappingData: Pointer); virtual;
  989. function IsEmpty: Boolean; virtual;
  990. function HasAlpha: Boolean; virtual;
  991. function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean; virtual;
  992. procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
  993. constructor Create; virtual;
  994. public
  995. class procedure Init;
  996. class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  997. class function GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  998. class procedure Clear;
  999. class procedure Finalize;
  1000. end;
  1001. TFormatDescriptorClass = class of TFormatDescriptor;
  1002. TfdEmpty = class(TFormatDescriptor);
  1003. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1004. TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1005. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1006. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1007. constructor Create; override;
  1008. end;
  1009. TfdLuminance_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1010. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1011. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1012. constructor Create; override;
  1013. end;
  1014. TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1015. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1016. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1017. constructor Create; override;
  1018. end;
  1019. TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte
  1020. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1021. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1022. constructor Create; override;
  1023. end;
  1024. TfdRGB_UB3 = class(TFormatDescriptor) //3* unsigned byte
  1025. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1026. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1027. constructor Create; override;
  1028. end;
  1029. TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
  1030. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1031. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1032. constructor Create; override;
  1033. end;
  1034. TfdRGBA_UB4 = class(TfdRGB_UB3) //4* unsigned byte
  1035. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1036. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1037. constructor Create; override;
  1038. end;
  1039. TfdBGRA_UB4 = class(TfdBGR_UB3) //4* unsigned byte (inverse)
  1040. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1041. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1042. constructor Create; override;
  1043. end;
  1044. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1045. TfdAlpha_US1 = class(TFormatDescriptor) //1* unsigned short
  1046. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1047. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1048. constructor Create; override;
  1049. end;
  1050. TfdLuminance_US1 = class(TFormatDescriptor) //1* unsigned short
  1051. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1052. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1053. constructor Create; override;
  1054. end;
  1055. TfdUniversal_US1 = class(TFormatDescriptor) //1* unsigned short
  1056. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1057. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1058. constructor Create; override;
  1059. end;
  1060. TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short
  1061. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1062. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1063. constructor Create; override;
  1064. end;
  1065. TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short
  1066. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1067. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1068. constructor Create; override;
  1069. end;
  1070. TfdRGB_US3 = class(TFormatDescriptor) //3* unsigned short
  1071. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1072. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1073. constructor Create; override;
  1074. end;
  1075. TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)
  1076. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1077. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1078. constructor Create; override;
  1079. end;
  1080. TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
  1081. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1082. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1083. constructor Create; override;
  1084. end;
  1085. TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
  1086. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1087. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1088. constructor Create; override;
  1089. end;
  1090. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1091. TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int
  1092. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1093. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1094. constructor Create; override;
  1095. end;
  1096. TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int
  1097. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1098. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1099. constructor Create; override;
  1100. end;
  1101. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1102. TfdAlpha4 = class(TfdAlpha_UB1)
  1103. constructor Create; override;
  1104. end;
  1105. TfdAlpha8 = class(TfdAlpha_UB1)
  1106. constructor Create; override;
  1107. end;
  1108. TfdAlpha12 = class(TfdAlpha_US1)
  1109. constructor Create; override;
  1110. end;
  1111. TfdAlpha16 = class(TfdAlpha_US1)
  1112. constructor Create; override;
  1113. end;
  1114. TfdLuminance4 = class(TfdLuminance_UB1)
  1115. constructor Create; override;
  1116. end;
  1117. TfdLuminance8 = class(TfdLuminance_UB1)
  1118. constructor Create; override;
  1119. end;
  1120. TfdLuminance12 = class(TfdLuminance_US1)
  1121. constructor Create; override;
  1122. end;
  1123. TfdLuminance16 = class(TfdLuminance_US1)
  1124. constructor Create; override;
  1125. end;
  1126. TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
  1127. constructor Create; override;
  1128. end;
  1129. TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
  1130. constructor Create; override;
  1131. end;
  1132. TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
  1133. constructor Create; override;
  1134. end;
  1135. TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
  1136. constructor Create; override;
  1137. end;
  1138. TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)
  1139. constructor Create; override;
  1140. end;
  1141. TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
  1142. constructor Create; override;
  1143. end;
  1144. TfdR3G3B2 = class(TfdUniversal_UB1)
  1145. constructor Create; override;
  1146. end;
  1147. TfdRGB4 = class(TfdUniversal_US1)
  1148. constructor Create; override;
  1149. end;
  1150. TfdR5G6B5 = class(TfdUniversal_US1)
  1151. constructor Create; override;
  1152. end;
  1153. TfdRGB5 = class(TfdUniversal_US1)
  1154. constructor Create; override;
  1155. end;
  1156. TfdRGB8 = class(TfdRGB_UB3)
  1157. constructor Create; override;
  1158. end;
  1159. TfdRGB10 = class(TfdUniversal_UI1)
  1160. constructor Create; override;
  1161. end;
  1162. TfdRGB12 = class(TfdRGB_US3)
  1163. constructor Create; override;
  1164. end;
  1165. TfdRGB16 = class(TfdRGB_US3)
  1166. constructor Create; override;
  1167. end;
  1168. TfdRGBA2 = class(TfdRGBA_UB4)
  1169. constructor Create; override;
  1170. end;
  1171. TfdRGBA4 = class(TfdUniversal_US1)
  1172. constructor Create; override;
  1173. end;
  1174. TfdRGB5A1 = class(TfdUniversal_US1)
  1175. constructor Create; override;
  1176. end;
  1177. TfdRGBA8 = class(TfdRGBA_UB4)
  1178. constructor Create; override;
  1179. end;
  1180. TfdRGB10A2 = class(TfdUniversal_UI1)
  1181. constructor Create; override;
  1182. end;
  1183. TfdRGBA12 = class(TfdRGBA_US4)
  1184. constructor Create; override;
  1185. end;
  1186. TfdRGBA16 = class(TfdRGBA_US4)
  1187. constructor Create; override;
  1188. end;
  1189. TfdBGR4 = class(TfdUniversal_US1)
  1190. constructor Create; override;
  1191. end;
  1192. TfdB5G6R5 = class(TfdUniversal_US1)
  1193. constructor Create; override;
  1194. end;
  1195. TfdBGR5 = class(TfdUniversal_US1)
  1196. constructor Create; override;
  1197. end;
  1198. TfdBGR8 = class(TfdBGR_UB3)
  1199. constructor Create; override;
  1200. end;
  1201. TfdBGR10 = class(TfdUniversal_UI1)
  1202. constructor Create; override;
  1203. end;
  1204. TfdBGR12 = class(TfdBGR_US3)
  1205. constructor Create; override;
  1206. end;
  1207. TfdBGR16 = class(TfdBGR_US3)
  1208. constructor Create; override;
  1209. end;
  1210. TfdBGRA2 = class(TfdBGRA_UB4)
  1211. constructor Create; override;
  1212. end;
  1213. TfdBGRA4 = class(TfdUniversal_US1)
  1214. constructor Create; override;
  1215. end;
  1216. TfdBGR5A1 = class(TfdUniversal_US1)
  1217. constructor Create; override;
  1218. end;
  1219. TfdBGRA8 = class(TfdBGRA_UB4)
  1220. constructor Create; override;
  1221. end;
  1222. TfdBGR10A2 = class(TfdUniversal_UI1)
  1223. constructor Create; override;
  1224. end;
  1225. TfdBGRA12 = class(TfdBGRA_US4)
  1226. constructor Create; override;
  1227. end;
  1228. TfdBGRA16 = class(TfdBGRA_US4)
  1229. constructor Create; override;
  1230. end;
  1231. TfdDepth16 = class(TfdDepth_US1)
  1232. constructor Create; override;
  1233. end;
  1234. TfdDepth24 = class(TfdDepth_UI1)
  1235. constructor Create; override;
  1236. end;
  1237. TfdDepth32 = class(TfdDepth_UI1)
  1238. constructor Create; override;
  1239. end;
  1240. TfdS3tcDtx1RGBA = class(TFormatDescriptor)
  1241. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1242. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1243. constructor Create; override;
  1244. end;
  1245. TfdS3tcDtx3RGBA = class(TFormatDescriptor)
  1246. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1247. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1248. constructor Create; override;
  1249. end;
  1250. TfdS3tcDtx5RGBA = class(TFormatDescriptor)
  1251. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1252. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1253. constructor Create; override;
  1254. end;
  1255. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1256. TbmpBitfieldFormat = class(TFormatDescriptor)
  1257. private
  1258. procedure SetRedMask (const aValue: QWord);
  1259. procedure SetGreenMask(const aValue: QWord);
  1260. procedure SetBlueMask (const aValue: QWord);
  1261. procedure SetAlphaMask(const aValue: QWord);
  1262. procedure Update(aMask: QWord; out aRange: Cardinal; out aShift: Byte);
  1263. public
  1264. property RedMask: QWord read GetRedMask write SetRedMask;
  1265. property GreenMask: QWord read GetGreenMask write SetGreenMask;
  1266. property BlueMask: QWord read GetBlueMask write SetBlueMask;
  1267. property AlphaMask: QWord read GetAlphaMask write SetAlphaMask;
  1268. property PixelSize: Single read fPixelSize write fPixelSize;
  1269. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1270. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1271. end;
  1272. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1273. TbmpColorTableEnty = packed record
  1274. b, g, r, a: Byte;
  1275. end;
  1276. TbmpColorTable = array of TbmpColorTableEnty;
  1277. TbmpColorTableFormat = class(TFormatDescriptor)
  1278. private
  1279. fColorTable: TbmpColorTable;
  1280. public
  1281. property PixelSize: Single read fPixelSize write fPixelSize;
  1282. property ColorTable: TbmpColorTable read fColorTable write fColorTable;
  1283. property Range: TglBitmapColorRec read fRange write fRange;
  1284. property Shift: TShiftRec read fShift write fShift;
  1285. property Format: TglBitmapFormat read fFormat write fFormat;
  1286. procedure CreateColorTable;
  1287. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1288. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1289. destructor Destroy; override;
  1290. end;
  1291. const
  1292. LUMINANCE_WEIGHT_R = 0.30;
  1293. LUMINANCE_WEIGHT_G = 0.59;
  1294. LUMINANCE_WEIGHT_B = 0.11;
  1295. ALPHA_WEIGHT_R = 0.30;
  1296. ALPHA_WEIGHT_G = 0.59;
  1297. ALPHA_WEIGHT_B = 0.11;
  1298. DEPTH_WEIGHT_R = 0.333333333;
  1299. DEPTH_WEIGHT_G = 0.333333333;
  1300. DEPTH_WEIGHT_B = 0.333333333;
  1301. UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
  1302. FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
  1303. TfdEmpty,
  1304. TfdAlpha4,
  1305. TfdAlpha8,
  1306. TfdAlpha12,
  1307. TfdAlpha16,
  1308. TfdLuminance4,
  1309. TfdLuminance8,
  1310. TfdLuminance12,
  1311. TfdLuminance16,
  1312. TfdLuminance4Alpha4,
  1313. TfdLuminance6Alpha2,
  1314. TfdLuminance8Alpha8,
  1315. TfdLuminance12Alpha4,
  1316. TfdLuminance12Alpha12,
  1317. TfdLuminance16Alpha16,
  1318. TfdR3G3B2,
  1319. TfdRGB4,
  1320. TfdR5G6B5,
  1321. TfdRGB5,
  1322. TfdRGB8,
  1323. TfdRGB10,
  1324. TfdRGB12,
  1325. TfdRGB16,
  1326. TfdRGBA2,
  1327. TfdRGBA4,
  1328. TfdRGB5A1,
  1329. TfdRGBA8,
  1330. TfdRGB10A2,
  1331. TfdRGBA12,
  1332. TfdRGBA16,
  1333. TfdBGR4,
  1334. TfdB5G6R5,
  1335. TfdBGR5,
  1336. TfdBGR8,
  1337. TfdBGR10,
  1338. TfdBGR12,
  1339. TfdBGR16,
  1340. TfdBGRA2,
  1341. TfdBGRA4,
  1342. TfdBGR5A1,
  1343. TfdBGRA8,
  1344. TfdBGR10A2,
  1345. TfdBGRA12,
  1346. TfdBGRA16,
  1347. TfdDepth16,
  1348. TfdDepth24,
  1349. TfdDepth32,
  1350. TfdS3tcDtx1RGBA,
  1351. TfdS3tcDtx3RGBA,
  1352. TfdS3tcDtx5RGBA
  1353. );
  1354. var
  1355. FormatDescriptorCS: TCriticalSection;
  1356. FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
  1357. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1358. constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
  1359. begin
  1360. inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1361. end;
  1362. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1363. constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
  1364. begin
  1365. inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1366. end;
  1367. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1368. function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
  1369. begin
  1370. result.Fields := [];
  1371. if X >= 0 then
  1372. result.Fields := result.Fields + [ffX];
  1373. if Y >= 0 then
  1374. result.Fields := result.Fields + [ffY];
  1375. result.X := Max(0, X);
  1376. result.Y := Max(0, Y);
  1377. end;
  1378. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1379. function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
  1380. begin
  1381. result.r := r;
  1382. result.g := g;
  1383. result.b := b;
  1384. result.a := a;
  1385. end;
  1386. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1387. function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
  1388. var
  1389. i: Integer;
  1390. begin
  1391. result := false;
  1392. for i := 0 to high(r1.arr) do
  1393. if (r1.arr[i] <> r2.arr[i]) then
  1394. exit;
  1395. result := true;
  1396. end;
  1397. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1398. function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
  1399. begin
  1400. result.r := r;
  1401. result.g := g;
  1402. result.b := b;
  1403. result.a := a;
  1404. end;
  1405. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1406. function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
  1407. begin
  1408. result := [];
  1409. if (aFormat in [
  1410. //4 bbp
  1411. tfLuminance4,
  1412. //8bpp
  1413. tfR3G3B2, tfLuminance8,
  1414. //16bpp
  1415. tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
  1416. tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,
  1417. //24bpp
  1418. tfBGR8, tfRGB8,
  1419. //32bpp
  1420. tfRGB10, tfRGB10A2, tfRGBA8,
  1421. tfBGR10, tfBGR10A2, tfBGRA8]) then
  1422. result := result + [ftBMP];
  1423. if (aFormat in [
  1424. //8 bpp
  1425. tfLuminance8, tfAlpha8,
  1426. //16 bpp
  1427. tfLuminance16, tfLuminance8Alpha8,
  1428. tfRGB5, tfRGB5A1, tfRGBA4,
  1429. tfBGR5, tfBGR5A1, tfBGRA4,
  1430. //24 bpp
  1431. tfRGB8, tfBGR8,
  1432. //32 bpp
  1433. tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
  1434. result := result + [ftTGA];
  1435. if (aFormat in [
  1436. //8 bpp
  1437. tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,
  1438. tfR3G3B2, tfRGBA2, tfBGRA2,
  1439. //16 bpp
  1440. tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,
  1441. tfRGB4, tfR5G6B5, tfRGB5, tfRGBA4, tfRGB5A1,
  1442. tfBGR4, tfB5G6R5, tfBGR5, tfBGRA4, tfBGR5A1,
  1443. //24 bpp
  1444. tfRGB8, tfBGR8,
  1445. //32 bbp
  1446. tfLuminance16Alpha16,
  1447. tfRGBA8, tfRGB10A2,
  1448. tfBGRA8, tfBGR10A2,
  1449. //compressed
  1450. tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then
  1451. result := result + [ftDDS];
  1452. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  1453. if aFormat in [
  1454. tfAlpha8, tfLuminance8, tfLuminance8Alpha8,
  1455. tfRGB8, tfRGBA8,
  1456. tfBGR8, tfBGRA8] then
  1457. result := result + [ftPNG];
  1458. {$ENDIF}
  1459. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  1460. if aFormat in [tfAlpha8, tfLuminance8, tfRGB8, tfBGR8] then
  1461. result := result + [ftJPEG];
  1462. {$ENDIF}
  1463. end;
  1464. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1465. function IsPowerOfTwo(aNumber: Integer): Boolean;
  1466. begin
  1467. while (aNumber and 1) = 0 do
  1468. aNumber := aNumber shr 1;
  1469. result := aNumber = 1;
  1470. end;
  1471. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1472. function GetTopMostBit(aBitSet: QWord): Integer;
  1473. begin
  1474. result := 0;
  1475. while aBitSet > 0 do begin
  1476. inc(result);
  1477. aBitSet := aBitSet shr 1;
  1478. end;
  1479. end;
  1480. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1481. function CountSetBits(aBitSet: QWord): Integer;
  1482. begin
  1483. result := 0;
  1484. while aBitSet > 0 do begin
  1485. if (aBitSet and 1) = 1 then
  1486. inc(result);
  1487. aBitSet := aBitSet shr 1;
  1488. end;
  1489. end;
  1490. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1491. function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1492. begin
  1493. result := Trunc(
  1494. LUMINANCE_WEIGHT_R * aPixel.Data.r +
  1495. LUMINANCE_WEIGHT_G * aPixel.Data.g +
  1496. LUMINANCE_WEIGHT_B * aPixel.Data.b);
  1497. end;
  1498. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1499. function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1500. begin
  1501. result := Trunc(
  1502. DEPTH_WEIGHT_R * aPixel.Data.r +
  1503. DEPTH_WEIGHT_G * aPixel.Data.g +
  1504. DEPTH_WEIGHT_B * aPixel.Data.b);
  1505. end;
  1506. {$IFDEF GLB_NATIVE_OGL}
  1507. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1508. //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1509. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1510. var
  1511. GL_LibHandle: Pointer = nil;
  1512. function glbGetProcAddress(aProcName: PChar; aLibHandle: Pointer = nil): Pointer;
  1513. begin
  1514. if not Assigned(aLibHandle) then
  1515. aLibHandle := GL_LibHandle;
  1516. {$IF DEFINED(GLB_WIN)}
  1517. result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
  1518. if Assigned(result) then
  1519. exit;
  1520. if Assigned(wglGetProcAddress) then
  1521. result := wglGetProcAddress(aProcName);
  1522. {$ELSEIF DEFINED(GLB_LINUX)}
  1523. if Assigned(glXGetProcAddress) then begin
  1524. result := glXGetProcAddress(aProcName);
  1525. if Assigned(result) then
  1526. exit;
  1527. end;
  1528. if Assigned(glXGetProcAddressARB) then begin
  1529. result := glXGetProcAddressARB(aProcName);
  1530. if Assigned(result) then
  1531. exit;
  1532. end;
  1533. result := dlsym(aLibHandle, aProcName);
  1534. {$IFEND}
  1535. if not Assigned(result) then
  1536. raise EglBitmapException.Create('unable to load procedure form library: ' + aProcName);
  1537. end;
  1538. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  1539. var
  1540. GLU_LibHandle: Pointer = nil;
  1541. OpenGLInitialized: Boolean;
  1542. InitOpenGLCS: TCriticalSection;
  1543. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1544. procedure glbInitOpenGL;
  1545. ////////////////////////////////////////////////////////////////////////////////
  1546. function glbLoadLibrary(const aName: PChar): Pointer;
  1547. begin
  1548. {$IF DEFINED(GLB_WIN)}
  1549. result := {%H-}Pointer(LoadLibrary(aName));
  1550. {$ELSEIF DEFINED(GLB_LINUX)}
  1551. result := dlopen(Name, RTLD_LAZY);
  1552. {$ELSE}
  1553. result := nil;
  1554. {$IFEND}
  1555. end;
  1556. ////////////////////////////////////////////////////////////////////////////////
  1557. function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
  1558. begin
  1559. result := false;
  1560. if not Assigned(aLibHandle) then
  1561. exit;
  1562. {$IF DEFINED(GLB_WIN)}
  1563. Result := FreeLibrary({%H-}HINST(aLibHandle));
  1564. {$ELSEIF DEFINED(GLB_LINUX)}
  1565. Result := dlclose(aLibHandle) = 0;
  1566. {$IFEND}
  1567. end;
  1568. begin
  1569. if Assigned(GL_LibHandle) then
  1570. glbFreeLibrary(GL_LibHandle);
  1571. if Assigned(GLU_LibHandle) then
  1572. glbFreeLibrary(GLU_LibHandle);
  1573. GL_LibHandle := glbLoadLibrary(libopengl);
  1574. if not Assigned(GL_LibHandle) then
  1575. raise EglBitmapException.Create('unable to load library: ' + libopengl);
  1576. GLU_LibHandle := glbLoadLibrary(libglu);
  1577. if not Assigned(GLU_LibHandle) then
  1578. raise EglBitmapException.Create('unable to load library: ' + libglu);
  1579. try
  1580. {$IF DEFINED(GLB_WIN)}
  1581. wglGetProcAddress := glbGetProcAddress('wglGetProcAddress');
  1582. {$ELSEIF DEFINED(GLB_LINUX)}
  1583. glXGetProcAddress := glbGetProcAddress('glXGetProcAddress');
  1584. glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB');
  1585. {$IFEND}
  1586. glEnable := glbGetProcAddress('glEnable');
  1587. glDisable := glbGetProcAddress('glDisable');
  1588. glGetString := glbGetProcAddress('glGetString');
  1589. glGetIntegerv := glbGetProcAddress('glGetIntegerv');
  1590. glTexParameteri := glbGetProcAddress('glTexParameteri');
  1591. glTexParameterfv := glbGetProcAddress('glTexParameterfv');
  1592. glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
  1593. glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
  1594. glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
  1595. glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
  1596. glGenTextures := glbGetProcAddress('glGenTextures');
  1597. glBindTexture := glbGetProcAddress('glBindTexture');
  1598. glDeleteTextures := glbGetProcAddress('glDeleteTextures');
  1599. glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
  1600. glReadPixels := glbGetProcAddress('glReadPixels');
  1601. glPixelStorei := glbGetProcAddress('glPixelStorei');
  1602. glTexImage1D := glbGetProcAddress('glTexImage1D');
  1603. glTexImage2D := glbGetProcAddress('glTexImage2D');
  1604. glGetTexImage := glbGetProcAddress('glGetTexImage');
  1605. gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
  1606. gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
  1607. finally
  1608. glbFreeLibrary(GL_LibHandle);
  1609. glbFreeLibrary(GLU_LibHandle);
  1610. end;
  1611. end;
  1612. {$ENDIF}
  1613. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1614. procedure glbReadOpenGLExtensions;
  1615. var
  1616. Buffer: AnsiString;
  1617. MajorVersion, MinorVersion: Integer;
  1618. ///////////////////////////////////////////////////////////////////////////////////////////
  1619. procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
  1620. var
  1621. Separator: Integer;
  1622. begin
  1623. aMinor := 0;
  1624. aMajor := 0;
  1625. Separator := Pos(AnsiString('.'), aBuffer);
  1626. if (Separator > 1) and (Separator < Length(aBuffer)) and
  1627. (aBuffer[Separator - 1] in ['0'..'9']) and
  1628. (aBuffer[Separator + 1] in ['0'..'9']) then begin
  1629. Dec(Separator);
  1630. while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
  1631. Dec(Separator);
  1632. Delete(aBuffer, 1, Separator);
  1633. Separator := Pos(AnsiString('.'), aBuffer) + 1;
  1634. while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
  1635. Inc(Separator);
  1636. Delete(aBuffer, Separator, 255);
  1637. Separator := Pos(AnsiString('.'), aBuffer);
  1638. aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
  1639. aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
  1640. end;
  1641. end;
  1642. ///////////////////////////////////////////////////////////////////////////////////////////
  1643. function CheckExtension(const Extension: AnsiString): Boolean;
  1644. var
  1645. ExtPos: Integer;
  1646. begin
  1647. ExtPos := Pos(Extension, Buffer);
  1648. result := ExtPos > 0;
  1649. if result then
  1650. result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
  1651. end;
  1652. begin
  1653. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  1654. InitOpenGLCS.Enter;
  1655. try
  1656. if not OpenGLInitialized then begin
  1657. glbInitOpenGL;
  1658. OpenGLInitialized := true;
  1659. end;
  1660. finally
  1661. InitOpenGLCS.Leave;
  1662. end;
  1663. {$ENDIF}
  1664. // Version
  1665. Buffer := glGetString(GL_VERSION);
  1666. TrimVersionString(Buffer, MajorVersion, MinorVersion);
  1667. GL_VERSION_1_2 := false;
  1668. GL_VERSION_1_3 := false;
  1669. GL_VERSION_1_4 := false;
  1670. GL_VERSION_2_0 := false;
  1671. if MajorVersion = 1 then begin
  1672. if MinorVersion >= 2 then
  1673. GL_VERSION_1_2 := true;
  1674. if MinorVersion >= 3 then
  1675. GL_VERSION_1_3 := true;
  1676. if MinorVersion >= 4 then
  1677. GL_VERSION_1_4 := true;
  1678. end else if MajorVersion >= 2 then begin
  1679. GL_VERSION_1_2 := true;
  1680. GL_VERSION_1_3 := true;
  1681. GL_VERSION_1_4 := true;
  1682. GL_VERSION_2_0 := true;
  1683. end;
  1684. // Extensions
  1685. Buffer := glGetString(GL_EXTENSIONS);
  1686. GL_ARB_texture_border_clamp := CheckExtension('GL_ARB_texture_border_clamp');
  1687. GL_ARB_texture_non_power_of_two := CheckExtension('GL_ARB_texture_non_power_of_two');
  1688. GL_ARB_texture_rectangle := CheckExtension('GL_ARB_texture_rectangle');
  1689. GL_ARB_texture_mirrored_repeat := CheckExtension('GL_ARB_texture_mirrored_repeat');
  1690. GL_EXT_texture_edge_clamp := CheckExtension('GL_EXT_texture_edge_clamp');
  1691. GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
  1692. GL_EXT_texture_rectangle := CheckExtension('GL_EXT_texture_rectangle');
  1693. GL_NV_texture_rectangle := CheckExtension('GL_NV_texture_rectangle');
  1694. GL_IBM_texture_mirrored_repeat := CheckExtension('GL_IBM_texture_mirrored_repeat');
  1695. GL_SGIS_generate_mipmap := CheckExtension('GL_SGIS_generate_mipmap');
  1696. if GL_VERSION_1_3 then begin
  1697. glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1D');
  1698. glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2D');
  1699. glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
  1700. end else begin
  1701. glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1DARB');
  1702. glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2DARB');
  1703. glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB');
  1704. end;
  1705. end;
  1706. {$ENDIF}
  1707. {$IFDEF GLB_SDL_IMAGE}
  1708. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1709. // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1710. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1711. function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
  1712. begin
  1713. result := TStream(context^.unknown.data1).Seek(offset, whence);
  1714. end;
  1715. function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
  1716. begin
  1717. result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
  1718. end;
  1719. function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
  1720. begin
  1721. result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
  1722. end;
  1723. function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
  1724. begin
  1725. result := 0;
  1726. end;
  1727. function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
  1728. begin
  1729. result := SDL_AllocRW;
  1730. if result = nil then
  1731. raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
  1732. result^.seek := glBitmapRWseek;
  1733. result^.read := glBitmapRWread;
  1734. result^.write := glBitmapRWwrite;
  1735. result^.close := glBitmapRWclose;
  1736. result^.unknown.data1 := Stream;
  1737. end;
  1738. {$ENDIF}
  1739. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1740. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1741. begin
  1742. glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
  1743. end;
  1744. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1745. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1746. begin
  1747. glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
  1748. end;
  1749. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1750. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1751. begin
  1752. glBitmapDefaultMipmap := aValue;
  1753. end;
  1754. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1755. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1756. begin
  1757. glBitmapDefaultFormat := aFormat;
  1758. end;
  1759. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1760. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1761. begin
  1762. glBitmapDefaultFilterMin := aMin;
  1763. glBitmapDefaultFilterMag := aMag;
  1764. end;
  1765. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1766. procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
  1767. begin
  1768. glBitmapDefaultWrapS := S;
  1769. glBitmapDefaultWrapT := T;
  1770. glBitmapDefaultWrapR := R;
  1771. end;
  1772. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1773. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1774. begin
  1775. result := glBitmapDefaultDeleteTextureOnFree;
  1776. end;
  1777. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1778. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1779. begin
  1780. result := glBitmapDefaultFreeDataAfterGenTextures;
  1781. end;
  1782. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1783. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1784. begin
  1785. result := glBitmapDefaultMipmap;
  1786. end;
  1787. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1788. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1789. begin
  1790. result := glBitmapDefaultFormat;
  1791. end;
  1792. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1793. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  1794. begin
  1795. aMin := glBitmapDefaultFilterMin;
  1796. aMag := glBitmapDefaultFilterMag;
  1797. end;
  1798. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1799. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  1800. begin
  1801. S := glBitmapDefaultWrapS;
  1802. T := glBitmapDefaultWrapT;
  1803. R := glBitmapDefaultWrapR;
  1804. end;
  1805. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1806. //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1807. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1808. function TFormatDescriptor.GetRedMask: QWord;
  1809. begin
  1810. result := fRange.r shl fShift.r;
  1811. end;
  1812. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1813. function TFormatDescriptor.GetGreenMask: QWord;
  1814. begin
  1815. result := fRange.g shl fShift.g;
  1816. end;
  1817. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1818. function TFormatDescriptor.GetBlueMask: QWord;
  1819. begin
  1820. result := fRange.b shl fShift.b;
  1821. end;
  1822. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1823. function TFormatDescriptor.GetAlphaMask: QWord;
  1824. begin
  1825. result := fRange.a shl fShift.a;
  1826. end;
  1827. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1828. function TFormatDescriptor.GetComponents: Integer;
  1829. var
  1830. i: Integer;
  1831. begin
  1832. result := 0;
  1833. for i := 0 to 3 do
  1834. if (fRange.arr[i] > 0) then
  1835. inc(result);
  1836. end;
  1837. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1838. function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
  1839. var
  1840. w, h: Integer;
  1841. begin
  1842. if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
  1843. w := Max(1, aSize.X);
  1844. h := Max(1, aSize.Y);
  1845. result := GetSize(w, h);
  1846. end else
  1847. result := 0;
  1848. end;
  1849. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1850. function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
  1851. begin
  1852. result := 0;
  1853. if (aWidth <= 0) or (aHeight <= 0) then
  1854. exit;
  1855. result := Ceil(aWidth * aHeight * fPixelSize);
  1856. end;
  1857. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1858. function TFormatDescriptor.CreateMappingData: Pointer;
  1859. begin
  1860. result := nil;
  1861. end;
  1862. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1863. procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
  1864. begin
  1865. //DUMMY
  1866. end;
  1867. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1868. function TFormatDescriptor.IsEmpty: Boolean;
  1869. begin
  1870. result := (fFormat = tfEmpty);
  1871. end;
  1872. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1873. function TFormatDescriptor.HasAlpha: Boolean;
  1874. begin
  1875. result := (fRange.a > 0);
  1876. end;
  1877. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1878. function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean;
  1879. begin
  1880. result := false;
  1881. if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
  1882. raise EglBitmapException.Create('FormatCheckFormat - All Masks are 0');
  1883. if (aRedMask <> RedMask) then
  1884. exit;
  1885. if (aGreenMask <> GreenMask) then
  1886. exit;
  1887. if (aBlueMask <> BlueMask) then
  1888. exit;
  1889. if (aAlphaMask <> AlphaMask) then
  1890. exit;
  1891. result := true;
  1892. end;
  1893. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1894. procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
  1895. begin
  1896. FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
  1897. aPixel.Data := fRange;
  1898. aPixel.Range := fRange;
  1899. aPixel.Format := fFormat;
  1900. end;
  1901. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1902. constructor TFormatDescriptor.Create;
  1903. begin
  1904. inherited Create;
  1905. fFormat := tfEmpty;
  1906. fWithAlpha := tfEmpty;
  1907. fWithoutAlpha := tfEmpty;
  1908. fRGBInverted := tfEmpty;
  1909. fUncompressed := tfEmpty;
  1910. fPixelSize := 0.0;
  1911. fIsCompressed := false;
  1912. fglFormat := 0;
  1913. fglInternalFormat := 0;
  1914. fglDataFormat := 0;
  1915. FillChar(fRange, 0, SizeOf(fRange));
  1916. FillChar(fShift, 0, SizeOf(fShift));
  1917. end;
  1918. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1919. //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1920. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1921. procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1922. begin
  1923. aData^ := aPixel.Data.a;
  1924. inc(aData);
  1925. end;
  1926. procedure TfdAlpha_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1927. begin
  1928. aPixel.Data.r := 0;
  1929. aPixel.Data.g := 0;
  1930. aPixel.Data.b := 0;
  1931. aPixel.Data.a := aData^;
  1932. inc(aData);
  1933. end;
  1934. constructor TfdAlpha_UB1.Create;
  1935. begin
  1936. inherited Create;
  1937. fPixelSize := 1.0;
  1938. fRange.a := $FF;
  1939. fglFormat := GL_ALPHA;
  1940. fglDataFormat := GL_UNSIGNED_BYTE;
  1941. end;
  1942. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1943. //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1944. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1945. procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1946. begin
  1947. aData^ := LuminanceWeight(aPixel);
  1948. inc(aData);
  1949. end;
  1950. procedure TfdLuminance_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1951. begin
  1952. aPixel.Data.r := aData^;
  1953. aPixel.Data.g := aData^;
  1954. aPixel.Data.b := aData^;
  1955. aPixel.Data.a := 0;
  1956. inc(aData);
  1957. end;
  1958. constructor TfdLuminance_UB1.Create;
  1959. begin
  1960. inherited Create;
  1961. fPixelSize := 1.0;
  1962. fRange.r := $FF;
  1963. fRange.g := $FF;
  1964. fRange.b := $FF;
  1965. fglFormat := GL_LUMINANCE;
  1966. fglDataFormat := GL_UNSIGNED_BYTE;
  1967. end;
  1968. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1969. //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1970. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1971. procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1972. var
  1973. i: Integer;
  1974. begin
  1975. aData^ := 0;
  1976. for i := 0 to 3 do
  1977. if (fRange.arr[i] > 0) then
  1978. aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  1979. inc(aData);
  1980. end;
  1981. procedure TfdUniversal_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1982. var
  1983. i: Integer;
  1984. begin
  1985. for i := 0 to 3 do
  1986. aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
  1987. inc(aData);
  1988. end;
  1989. constructor TfdUniversal_UB1.Create;
  1990. begin
  1991. inherited Create;
  1992. fPixelSize := 1.0;
  1993. end;
  1994. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1995. //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1996. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1997. procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1998. begin
  1999. inherited Map(aPixel, aData, aMapData);
  2000. aData^ := aPixel.Data.a;
  2001. inc(aData);
  2002. end;
  2003. procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2004. begin
  2005. inherited Unmap(aData, aPixel, aMapData);
  2006. aPixel.Data.a := aData^;
  2007. inc(aData);
  2008. end;
  2009. constructor TfdLuminanceAlpha_UB2.Create;
  2010. begin
  2011. inherited Create;
  2012. fPixelSize := 2.0;
  2013. fRange.a := $FF;
  2014. fShift.a := 8;
  2015. fglFormat := GL_LUMINANCE_ALPHA;
  2016. fglDataFormat := GL_UNSIGNED_BYTE;
  2017. end;
  2018. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2019. //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2020. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2021. procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2022. begin
  2023. aData^ := aPixel.Data.r;
  2024. inc(aData);
  2025. aData^ := aPixel.Data.g;
  2026. inc(aData);
  2027. aData^ := aPixel.Data.b;
  2028. inc(aData);
  2029. end;
  2030. procedure TfdRGB_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2031. begin
  2032. aPixel.Data.r := aData^;
  2033. inc(aData);
  2034. aPixel.Data.g := aData^;
  2035. inc(aData);
  2036. aPixel.Data.b := aData^;
  2037. inc(aData);
  2038. aPixel.Data.a := 0;
  2039. end;
  2040. constructor TfdRGB_UB3.Create;
  2041. begin
  2042. inherited Create;
  2043. fPixelSize := 3.0;
  2044. fRange.r := $FF;
  2045. fRange.g := $FF;
  2046. fRange.b := $FF;
  2047. fShift.r := 0;
  2048. fShift.g := 8;
  2049. fShift.b := 16;
  2050. fglFormat := GL_RGB;
  2051. fglDataFormat := GL_UNSIGNED_BYTE;
  2052. end;
  2053. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2054. //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2055. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2056. procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2057. begin
  2058. aData^ := aPixel.Data.b;
  2059. inc(aData);
  2060. aData^ := aPixel.Data.g;
  2061. inc(aData);
  2062. aData^ := aPixel.Data.r;
  2063. inc(aData);
  2064. end;
  2065. procedure TfdBGR_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2066. begin
  2067. aPixel.Data.b := aData^;
  2068. inc(aData);
  2069. aPixel.Data.g := aData^;
  2070. inc(aData);
  2071. aPixel.Data.r := aData^;
  2072. inc(aData);
  2073. aPixel.Data.a := 0;
  2074. end;
  2075. constructor TfdBGR_UB3.Create;
  2076. begin
  2077. fPixelSize := 3.0;
  2078. fRange.r := $FF;
  2079. fRange.g := $FF;
  2080. fRange.b := $FF;
  2081. fShift.r := 16;
  2082. fShift.g := 8;
  2083. fShift.b := 0;
  2084. fglFormat := GL_BGR;
  2085. fglDataFormat := GL_UNSIGNED_BYTE;
  2086. end;
  2087. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2088. //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2089. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2090. procedure TfdRGBA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2091. begin
  2092. inherited Map(aPixel, aData, aMapData);
  2093. aData^ := aPixel.Data.a;
  2094. inc(aData);
  2095. end;
  2096. procedure TfdRGBA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2097. begin
  2098. inherited Unmap(aData, aPixel, aMapData);
  2099. aPixel.Data.a := aData^;
  2100. inc(aData);
  2101. end;
  2102. constructor TfdRGBA_UB4.Create;
  2103. begin
  2104. inherited Create;
  2105. fPixelSize := 4.0;
  2106. fRange.a := $FF;
  2107. fShift.a := 24;
  2108. fglFormat := GL_RGBA;
  2109. fglDataFormat := GL_UNSIGNED_BYTE;
  2110. end;
  2111. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2112. //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2113. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2114. procedure TfdBGRA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2115. begin
  2116. inherited Map(aPixel, aData, aMapData);
  2117. aData^ := aPixel.Data.a;
  2118. inc(aData);
  2119. end;
  2120. procedure TfdBGRA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2121. begin
  2122. inherited Unmap(aData, aPixel, aMapData);
  2123. aPixel.Data.a := aData^;
  2124. inc(aData);
  2125. end;
  2126. constructor TfdBGRA_UB4.Create;
  2127. begin
  2128. inherited Create;
  2129. fPixelSize := 4.0;
  2130. fRange.a := $FF;
  2131. fShift.a := 24;
  2132. fglFormat := GL_BGRA;
  2133. fglDataFormat := GL_UNSIGNED_BYTE;
  2134. end;
  2135. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2136. //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2137. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2138. procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2139. begin
  2140. PWord(aData)^ := aPixel.Data.a;
  2141. inc(aData, 2);
  2142. end;
  2143. procedure TfdAlpha_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2144. begin
  2145. aPixel.Data.r := 0;
  2146. aPixel.Data.g := 0;
  2147. aPixel.Data.b := 0;
  2148. aPixel.Data.a := PWord(aData)^;
  2149. inc(aData, 2);
  2150. end;
  2151. constructor TfdAlpha_US1.Create;
  2152. begin
  2153. inherited Create;
  2154. fPixelSize := 2.0;
  2155. fRange.a := $FFFF;
  2156. fglFormat := GL_ALPHA;
  2157. fglDataFormat := GL_UNSIGNED_SHORT;
  2158. end;
  2159. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2160. //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2161. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2162. procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2163. begin
  2164. PWord(aData)^ := LuminanceWeight(aPixel);
  2165. inc(aData, 2);
  2166. end;
  2167. procedure TfdLuminance_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2168. begin
  2169. aPixel.Data.r := PWord(aData)^;
  2170. aPixel.Data.g := PWord(aData)^;
  2171. aPixel.Data.b := PWord(aData)^;
  2172. aPixel.Data.a := 0;
  2173. inc(aData, 2);
  2174. end;
  2175. constructor TfdLuminance_US1.Create;
  2176. begin
  2177. inherited Create;
  2178. fPixelSize := 2.0;
  2179. fRange.r := $FFFF;
  2180. fRange.g := $FFFF;
  2181. fRange.b := $FFFF;
  2182. fglFormat := GL_LUMINANCE;
  2183. fglDataFormat := GL_UNSIGNED_SHORT;
  2184. end;
  2185. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2186. //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2187. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2188. procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2189. var
  2190. i: Integer;
  2191. begin
  2192. PWord(aData)^ := 0;
  2193. for i := 0 to 3 do
  2194. if (fRange.arr[i] > 0) then
  2195. PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2196. inc(aData, 2);
  2197. end;
  2198. procedure TfdUniversal_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2199. var
  2200. i: Integer;
  2201. begin
  2202. for i := 0 to 3 do
  2203. aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
  2204. inc(aData, 2);
  2205. end;
  2206. constructor TfdUniversal_US1.Create;
  2207. begin
  2208. inherited Create;
  2209. fPixelSize := 2.0;
  2210. end;
  2211. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2212. //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2213. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2214. procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2215. begin
  2216. PWord(aData)^ := DepthWeight(aPixel);
  2217. inc(aData, 2);
  2218. end;
  2219. procedure TfdDepth_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2220. begin
  2221. aPixel.Data.r := PWord(aData)^;
  2222. aPixel.Data.g := PWord(aData)^;
  2223. aPixel.Data.b := PWord(aData)^;
  2224. aPixel.Data.a := 0;
  2225. inc(aData, 2);
  2226. end;
  2227. constructor TfdDepth_US1.Create;
  2228. begin
  2229. inherited Create;
  2230. fPixelSize := 2.0;
  2231. fRange.r := $FFFF;
  2232. fRange.g := $FFFF;
  2233. fRange.b := $FFFF;
  2234. fglFormat := GL_DEPTH_COMPONENT;
  2235. fglDataFormat := GL_UNSIGNED_SHORT;
  2236. end;
  2237. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2238. //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2239. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2240. procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2241. begin
  2242. inherited Map(aPixel, aData, aMapData);
  2243. PWord(aData)^ := aPixel.Data.a;
  2244. inc(aData, 2);
  2245. end;
  2246. procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2247. begin
  2248. inherited Unmap(aData, aPixel, aMapData);
  2249. aPixel.Data.a := PWord(aData)^;
  2250. inc(aData, 2);
  2251. end;
  2252. constructor TfdLuminanceAlpha_US2.Create;
  2253. begin
  2254. inherited Create;
  2255. fPixelSize := 4.0;
  2256. fRange.a := $FFFF;
  2257. fShift.a := 16;
  2258. fglFormat := GL_LUMINANCE_ALPHA;
  2259. fglDataFormat := GL_UNSIGNED_SHORT;
  2260. end;
  2261. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2262. //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2263. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2264. procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2265. begin
  2266. PWord(aData)^ := aPixel.Data.r;
  2267. inc(aData, 2);
  2268. PWord(aData)^ := aPixel.Data.g;
  2269. inc(aData, 2);
  2270. PWord(aData)^ := aPixel.Data.b;
  2271. inc(aData, 2);
  2272. end;
  2273. procedure TfdRGB_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2274. begin
  2275. aPixel.Data.r := PWord(aData)^;
  2276. inc(aData, 2);
  2277. aPixel.Data.g := PWord(aData)^;
  2278. inc(aData, 2);
  2279. aPixel.Data.b := PWord(aData)^;
  2280. inc(aData, 2);
  2281. aPixel.Data.a := 0;
  2282. end;
  2283. constructor TfdRGB_US3.Create;
  2284. begin
  2285. inherited Create;
  2286. fPixelSize := 6.0;
  2287. fRange.r := $FFFF;
  2288. fRange.g := $FFFF;
  2289. fRange.b := $FFFF;
  2290. fShift.r := 0;
  2291. fShift.g := 16;
  2292. fShift.b := 32;
  2293. fglFormat := GL_RGB;
  2294. fglDataFormat := GL_UNSIGNED_SHORT;
  2295. end;
  2296. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2297. //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2298. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2299. procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2300. begin
  2301. PWord(aData)^ := aPixel.Data.b;
  2302. inc(aData, 2);
  2303. PWord(aData)^ := aPixel.Data.g;
  2304. inc(aData, 2);
  2305. PWord(aData)^ := aPixel.Data.r;
  2306. inc(aData, 2);
  2307. end;
  2308. procedure TfdBGR_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2309. begin
  2310. aPixel.Data.b := PWord(aData)^;
  2311. inc(aData, 2);
  2312. aPixel.Data.g := PWord(aData)^;
  2313. inc(aData, 2);
  2314. aPixel.Data.r := PWord(aData)^;
  2315. inc(aData, 2);
  2316. aPixel.Data.a := 0;
  2317. end;
  2318. constructor TfdBGR_US3.Create;
  2319. begin
  2320. inherited Create;
  2321. fPixelSize := 6.0;
  2322. fRange.r := $FFFF;
  2323. fRange.g := $FFFF;
  2324. fRange.b := $FFFF;
  2325. fShift.r := 32;
  2326. fShift.g := 16;
  2327. fShift.b := 0;
  2328. fglFormat := GL_BGR;
  2329. fglDataFormat := GL_UNSIGNED_SHORT;
  2330. end;
  2331. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2332. //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2333. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2334. procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2335. begin
  2336. inherited Map(aPixel, aData, aMapData);
  2337. PWord(aData)^ := aPixel.Data.a;
  2338. inc(aData, 2);
  2339. end;
  2340. procedure TfdRGBA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2341. begin
  2342. inherited Unmap(aData, aPixel, aMapData);
  2343. aPixel.Data.a := PWord(aData)^;
  2344. inc(aData, 2);
  2345. end;
  2346. constructor TfdRGBA_US4.Create;
  2347. begin
  2348. inherited Create;
  2349. fPixelSize := 8.0;
  2350. fRange.a := $FFFF;
  2351. fShift.a := 48;
  2352. fglFormat := GL_RGBA;
  2353. fglDataFormat := GL_UNSIGNED_SHORT;
  2354. end;
  2355. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2356. //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2357. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2358. procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2359. begin
  2360. inherited Map(aPixel, aData, aMapData);
  2361. PWord(aData)^ := aPixel.Data.a;
  2362. inc(aData, 2);
  2363. end;
  2364. procedure TfdBGRA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2365. begin
  2366. inherited Unmap(aData, aPixel, aMapData);
  2367. aPixel.Data.a := PWord(aData)^;
  2368. inc(aData, 2);
  2369. end;
  2370. constructor TfdBGRA_US4.Create;
  2371. begin
  2372. inherited Create;
  2373. fPixelSize := 8.0;
  2374. fRange.a := $FFFF;
  2375. fShift.a := 48;
  2376. fglFormat := GL_BGRA;
  2377. fglDataFormat := GL_UNSIGNED_SHORT;
  2378. end;
  2379. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2380. //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2381. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2382. procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2383. var
  2384. i: Integer;
  2385. begin
  2386. PCardinal(aData)^ := 0;
  2387. for i := 0 to 3 do
  2388. if (fRange.arr[i] > 0) then
  2389. PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2390. inc(aData, 4);
  2391. end;
  2392. procedure TfdUniversal_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2393. var
  2394. i: Integer;
  2395. begin
  2396. for i := 0 to 3 do
  2397. aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
  2398. inc(aData, 2);
  2399. end;
  2400. constructor TfdUniversal_UI1.Create;
  2401. begin
  2402. inherited Create;
  2403. fPixelSize := 4.0;
  2404. end;
  2405. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2406. //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2407. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2408. procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2409. begin
  2410. PCardinal(aData)^ := DepthWeight(aPixel);
  2411. inc(aData, 4);
  2412. end;
  2413. procedure TfdDepth_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2414. begin
  2415. aPixel.Data.r := PCardinal(aData)^;
  2416. aPixel.Data.g := PCardinal(aData)^;
  2417. aPixel.Data.b := PCardinal(aData)^;
  2418. aPixel.Data.a := 0;
  2419. inc(aData, 4);
  2420. end;
  2421. constructor TfdDepth_UI1.Create;
  2422. begin
  2423. inherited Create;
  2424. fPixelSize := 4.0;
  2425. fRange.r := $FFFFFFFF;
  2426. fRange.g := $FFFFFFFF;
  2427. fRange.b := $FFFFFFFF;
  2428. fglFormat := GL_DEPTH_COMPONENT;
  2429. fglDataFormat := GL_UNSIGNED_INT;
  2430. end;
  2431. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2432. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2433. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2434. constructor TfdAlpha4.Create;
  2435. begin
  2436. inherited Create;
  2437. fFormat := tfAlpha4;
  2438. fWithAlpha := tfAlpha4;
  2439. fglInternalFormat := GL_ALPHA4;
  2440. end;
  2441. constructor TfdAlpha8.Create;
  2442. begin
  2443. inherited Create;
  2444. fFormat := tfAlpha8;
  2445. fWithAlpha := tfAlpha8;
  2446. fglInternalFormat := GL_ALPHA8;
  2447. end;
  2448. constructor TfdAlpha12.Create;
  2449. begin
  2450. inherited Create;
  2451. fFormat := tfAlpha12;
  2452. fWithAlpha := tfAlpha12;
  2453. fglInternalFormat := GL_ALPHA12;
  2454. end;
  2455. constructor TfdAlpha16.Create;
  2456. begin
  2457. inherited Create;
  2458. fFormat := tfAlpha16;
  2459. fWithAlpha := tfAlpha16;
  2460. fglInternalFormat := GL_ALPHA16;
  2461. end;
  2462. constructor TfdLuminance4.Create;
  2463. begin
  2464. inherited Create;
  2465. fFormat := tfLuminance4;
  2466. fWithAlpha := tfLuminance4Alpha4;
  2467. fWithoutAlpha := tfLuminance4;
  2468. fglInternalFormat := GL_LUMINANCE4;
  2469. end;
  2470. constructor TfdLuminance8.Create;
  2471. begin
  2472. inherited Create;
  2473. fFormat := tfLuminance8;
  2474. fWithAlpha := tfLuminance8Alpha8;
  2475. fWithoutAlpha := tfLuminance8;
  2476. fglInternalFormat := GL_LUMINANCE8;
  2477. end;
  2478. constructor TfdLuminance12.Create;
  2479. begin
  2480. inherited Create;
  2481. fFormat := tfLuminance12;
  2482. fWithAlpha := tfLuminance12Alpha12;
  2483. fWithoutAlpha := tfLuminance12;
  2484. fglInternalFormat := GL_LUMINANCE12;
  2485. end;
  2486. constructor TfdLuminance16.Create;
  2487. begin
  2488. inherited Create;
  2489. fFormat := tfLuminance16;
  2490. fWithAlpha := tfLuminance16Alpha16;
  2491. fWithoutAlpha := tfLuminance16;
  2492. fglInternalFormat := GL_LUMINANCE16;
  2493. end;
  2494. constructor TfdLuminance4Alpha4.Create;
  2495. begin
  2496. inherited Create;
  2497. fFormat := tfLuminance4Alpha4;
  2498. fWithAlpha := tfLuminance4Alpha4;
  2499. fWithoutAlpha := tfLuminance4;
  2500. fglInternalFormat := GL_LUMINANCE4_ALPHA4;
  2501. end;
  2502. constructor TfdLuminance6Alpha2.Create;
  2503. begin
  2504. inherited Create;
  2505. fFormat := tfLuminance6Alpha2;
  2506. fWithAlpha := tfLuminance6Alpha2;
  2507. fWithoutAlpha := tfLuminance8;
  2508. fglInternalFormat := GL_LUMINANCE6_ALPHA2;
  2509. end;
  2510. constructor TfdLuminance8Alpha8.Create;
  2511. begin
  2512. inherited Create;
  2513. fFormat := tfLuminance8Alpha8;
  2514. fWithAlpha := tfLuminance8Alpha8;
  2515. fWithoutAlpha := tfLuminance8;
  2516. fglInternalFormat := GL_LUMINANCE8_ALPHA8;
  2517. end;
  2518. constructor TfdLuminance12Alpha4.Create;
  2519. begin
  2520. inherited Create;
  2521. fFormat := tfLuminance12Alpha4;
  2522. fWithAlpha := tfLuminance12Alpha4;
  2523. fWithoutAlpha := tfLuminance12;
  2524. fglInternalFormat := GL_LUMINANCE12_ALPHA4;
  2525. end;
  2526. constructor TfdLuminance12Alpha12.Create;
  2527. begin
  2528. inherited Create;
  2529. fFormat := tfLuminance12Alpha12;
  2530. fWithAlpha := tfLuminance12Alpha12;
  2531. fWithoutAlpha := tfLuminance12;
  2532. fglInternalFormat := GL_LUMINANCE12_ALPHA12;
  2533. end;
  2534. constructor TfdLuminance16Alpha16.Create;
  2535. begin
  2536. inherited Create;
  2537. fFormat := tfLuminance16Alpha16;
  2538. fWithAlpha := tfLuminance16Alpha16;
  2539. fWithoutAlpha := tfLuminance16;
  2540. fglInternalFormat := GL_LUMINANCE16_ALPHA16;
  2541. end;
  2542. constructor TfdR3G3B2.Create;
  2543. begin
  2544. inherited Create;
  2545. fFormat := tfR3G3B2;
  2546. fWithAlpha := tfRGBA2;
  2547. fWithoutAlpha := tfR3G3B2;
  2548. fRange.r := $7;
  2549. fRange.g := $7;
  2550. fRange.b := $3;
  2551. fShift.r := 0;
  2552. fShift.g := 3;
  2553. fShift.b := 6;
  2554. fglFormat := GL_RGB;
  2555. fglInternalFormat := GL_R3_G3_B2;
  2556. fglDataFormat := GL_UNSIGNED_BYTE_2_3_3_REV;
  2557. end;
  2558. constructor TfdRGB4.Create;
  2559. begin
  2560. inherited Create;
  2561. fFormat := tfRGB4;
  2562. fWithAlpha := tfRGBA4;
  2563. fWithoutAlpha := tfRGB4;
  2564. fRGBInverted := tfBGR4;
  2565. fRange.r := $F;
  2566. fRange.g := $F;
  2567. fRange.b := $F;
  2568. fShift.r := 0;
  2569. fShift.g := 4;
  2570. fShift.b := 8;
  2571. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2572. fglInternalFormat := GL_RGB4;
  2573. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2574. end;
  2575. constructor TfdR5G6B5.Create;
  2576. begin
  2577. inherited Create;
  2578. fFormat := tfR5G6B5;
  2579. fWithAlpha := tfRGBA4;
  2580. fWithoutAlpha := tfR5G6B5;
  2581. fRGBInverted := tfB5G6R5;
  2582. fRange.r := $1F;
  2583. fRange.g := $3F;
  2584. fRange.b := $1F;
  2585. fShift.r := 0;
  2586. fShift.g := 5;
  2587. fShift.b := 11;
  2588. fglFormat := GL_RGB;
  2589. fglInternalFormat := GL_RGB565;
  2590. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5_REV;
  2591. end;
  2592. constructor TfdRGB5.Create;
  2593. begin
  2594. inherited Create;
  2595. fFormat := tfRGB5;
  2596. fWithAlpha := tfRGB5A1;
  2597. fWithoutAlpha := tfRGB5;
  2598. fRGBInverted := tfBGR5;
  2599. fRange.r := $1F;
  2600. fRange.g := $1F;
  2601. fRange.b := $1F;
  2602. fShift.r := 0;
  2603. fShift.g := 5;
  2604. fShift.b := 10;
  2605. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2606. fglInternalFormat := GL_RGB5;
  2607. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2608. end;
  2609. constructor TfdRGB8.Create;
  2610. begin
  2611. inherited Create;
  2612. fFormat := tfRGB8;
  2613. fWithAlpha := tfRGBA8;
  2614. fWithoutAlpha := tfRGB8;
  2615. fRGBInverted := tfBGR8;
  2616. fglInternalFormat := GL_RGB8;
  2617. end;
  2618. constructor TfdRGB10.Create;
  2619. begin
  2620. inherited Create;
  2621. fFormat := tfRGB10;
  2622. fWithAlpha := tfRGB10A2;
  2623. fWithoutAlpha := tfRGB10;
  2624. fRGBInverted := tfBGR10;
  2625. fRange.r := $3FF;
  2626. fRange.g := $3FF;
  2627. fRange.b := $3FF;
  2628. fShift.r := 0;
  2629. fShift.g := 10;
  2630. fShift.b := 20;
  2631. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2632. fglInternalFormat := GL_RGB10;
  2633. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2634. end;
  2635. constructor TfdRGB12.Create;
  2636. begin
  2637. inherited Create;
  2638. fFormat := tfRGB12;
  2639. fWithAlpha := tfRGBA12;
  2640. fWithoutAlpha := tfRGB12;
  2641. fRGBInverted := tfBGR12;
  2642. fglInternalFormat := GL_RGB12;
  2643. end;
  2644. constructor TfdRGB16.Create;
  2645. begin
  2646. inherited Create;
  2647. fFormat := tfRGB16;
  2648. fWithAlpha := tfRGBA16;
  2649. fWithoutAlpha := tfRGB16;
  2650. fRGBInverted := tfBGR16;
  2651. fglInternalFormat := GL_RGB16;
  2652. end;
  2653. constructor TfdRGBA2.Create;
  2654. begin
  2655. inherited Create;
  2656. fFormat := tfRGBA2;
  2657. fWithAlpha := tfRGBA2;
  2658. fWithoutAlpha := tfR3G3B2;
  2659. fRGBInverted := tfBGRA2;
  2660. fglInternalFormat := GL_RGBA2;
  2661. end;
  2662. constructor TfdRGBA4.Create;
  2663. begin
  2664. inherited Create;
  2665. fFormat := tfRGBA4;
  2666. fWithAlpha := tfRGBA4;
  2667. fWithoutAlpha := tfRGB4;
  2668. fRGBInverted := tfBGRA4;
  2669. fRange.r := $F;
  2670. fRange.g := $F;
  2671. fRange.b := $F;
  2672. fRange.a := $F;
  2673. fShift.r := 0;
  2674. fShift.g := 4;
  2675. fShift.b := 8;
  2676. fShift.a := 12;
  2677. fglFormat := GL_RGBA;
  2678. fglInternalFormat := GL_RGBA4;
  2679. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2680. end;
  2681. constructor TfdRGB5A1.Create;
  2682. begin
  2683. inherited Create;
  2684. fFormat := tfRGB5A1;
  2685. fWithAlpha := tfRGB5A1;
  2686. fWithoutAlpha := tfRGB5;
  2687. fRGBInverted := tfBGR5A1;
  2688. fRange.r := $1F;
  2689. fRange.g := $1F;
  2690. fRange.b := $1F;
  2691. fRange.a := $01;
  2692. fShift.r := 0;
  2693. fShift.g := 5;
  2694. fShift.b := 10;
  2695. fShift.a := 15;
  2696. fglFormat := GL_RGBA;
  2697. fglInternalFormat := GL_RGB5_A1;
  2698. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2699. end;
  2700. constructor TfdRGBA8.Create;
  2701. begin
  2702. inherited Create;
  2703. fFormat := tfRGBA8;
  2704. fWithAlpha := tfRGBA8;
  2705. fWithoutAlpha := tfRGB8;
  2706. fRGBInverted := tfBGRA8;
  2707. fglInternalFormat := GL_RGBA8;
  2708. end;
  2709. constructor TfdRGB10A2.Create;
  2710. begin
  2711. inherited Create;
  2712. fFormat := tfRGB10A2;
  2713. fWithAlpha := tfRGB10A2;
  2714. fWithoutAlpha := tfRGB10;
  2715. fRGBInverted := tfBGR10A2;
  2716. fRange.r := $3FF;
  2717. fRange.g := $3FF;
  2718. fRange.b := $3FF;
  2719. fRange.a := $003;
  2720. fShift.r := 0;
  2721. fShift.g := 10;
  2722. fShift.b := 20;
  2723. fShift.a := 30;
  2724. fglFormat := GL_RGBA;
  2725. fglInternalFormat := GL_RGB10_A2;
  2726. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2727. end;
  2728. constructor TfdRGBA12.Create;
  2729. begin
  2730. inherited Create;
  2731. fFormat := tfRGBA12;
  2732. fWithAlpha := tfRGBA12;
  2733. fWithoutAlpha := tfRGB12;
  2734. fRGBInverted := tfBGRA12;
  2735. fglInternalFormat := GL_RGBA12;
  2736. end;
  2737. constructor TfdRGBA16.Create;
  2738. begin
  2739. inherited Create;
  2740. fFormat := tfRGBA16;
  2741. fWithAlpha := tfRGBA16;
  2742. fWithoutAlpha := tfRGB16;
  2743. fRGBInverted := tfBGRA16;
  2744. fglInternalFormat := GL_RGBA16;
  2745. end;
  2746. constructor TfdBGR4.Create;
  2747. begin
  2748. inherited Create;
  2749. fPixelSize := 2.0;
  2750. fFormat := tfBGR4;
  2751. fWithAlpha := tfBGRA4;
  2752. fWithoutAlpha := tfBGR4;
  2753. fRGBInverted := tfRGB4;
  2754. fRange.r := $F;
  2755. fRange.g := $F;
  2756. fRange.b := $F;
  2757. fRange.a := $0;
  2758. fShift.r := 8;
  2759. fShift.g := 4;
  2760. fShift.b := 0;
  2761. fShift.a := 0;
  2762. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2763. fglInternalFormat := GL_RGB4;
  2764. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2765. end;
  2766. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2767. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2768. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2769. constructor TfdB5G6R5.Create;
  2770. begin
  2771. inherited Create;
  2772. fFormat := tfB5G6R5;
  2773. fWithAlpha := tfBGRA4;
  2774. fWithoutAlpha := tfB5G6R5;
  2775. fRGBInverted := tfR5G6B5;
  2776. fRange.r := $1F;
  2777. fRange.g := $3F;
  2778. fRange.b := $1F;
  2779. fShift.r := 11;
  2780. fShift.g := 5;
  2781. fShift.b := 0;
  2782. fglFormat := GL_RGB; //B5G6R5 is only possible as R5G6B5 -> use reverted dataformat
  2783. fglInternalFormat := GL_RGB8;
  2784. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5;
  2785. end;
  2786. constructor TfdBGR5.Create;
  2787. begin
  2788. inherited Create;
  2789. fPixelSize := 2.0;
  2790. fFormat := tfBGR5;
  2791. fWithAlpha := tfBGR5A1;
  2792. fWithoutAlpha := tfBGR5;
  2793. fRGBInverted := tfRGB5;
  2794. fRange.r := $1F;
  2795. fRange.g := $1F;
  2796. fRange.b := $1F;
  2797. fRange.a := $00;
  2798. fShift.r := 10;
  2799. fShift.g := 5;
  2800. fShift.b := 0;
  2801. fShift.a := 0;
  2802. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2803. fglInternalFormat := GL_RGB5;
  2804. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2805. end;
  2806. constructor TfdBGR8.Create;
  2807. begin
  2808. inherited Create;
  2809. fFormat := tfBGR8;
  2810. fWithAlpha := tfBGRA8;
  2811. fWithoutAlpha := tfBGR8;
  2812. fRGBInverted := tfRGB8;
  2813. fglInternalFormat := GL_RGB8;
  2814. end;
  2815. constructor TfdBGR10.Create;
  2816. begin
  2817. inherited Create;
  2818. fFormat := tfBGR10;
  2819. fWithAlpha := tfBGR10A2;
  2820. fWithoutAlpha := tfBGR10;
  2821. fRGBInverted := tfRGB10;
  2822. fRange.r := $3FF;
  2823. fRange.g := $3FF;
  2824. fRange.b := $3FF;
  2825. fRange.a := $000;
  2826. fShift.r := 20;
  2827. fShift.g := 10;
  2828. fShift.b := 0;
  2829. fShift.a := 0;
  2830. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2831. fglInternalFormat := GL_RGB10;
  2832. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2833. end;
  2834. constructor TfdBGR12.Create;
  2835. begin
  2836. inherited Create;
  2837. fFormat := tfBGR12;
  2838. fWithAlpha := tfBGRA12;
  2839. fWithoutAlpha := tfBGR12;
  2840. fRGBInverted := tfRGB12;
  2841. fglInternalFormat := GL_RGB12;
  2842. end;
  2843. constructor TfdBGR16.Create;
  2844. begin
  2845. inherited Create;
  2846. fFormat := tfBGR16;
  2847. fWithAlpha := tfBGRA16;
  2848. fWithoutAlpha := tfBGR16;
  2849. fRGBInverted := tfRGB16;
  2850. fglInternalFormat := GL_RGB16;
  2851. end;
  2852. constructor TfdBGRA2.Create;
  2853. begin
  2854. inherited Create;
  2855. fFormat := tfBGRA2;
  2856. fWithAlpha := tfBGRA4;
  2857. fWithoutAlpha := tfBGR4;
  2858. fRGBInverted := tfRGBA2;
  2859. fglInternalFormat := GL_RGBA2;
  2860. end;
  2861. constructor TfdBGRA4.Create;
  2862. begin
  2863. inherited Create;
  2864. fFormat := tfBGRA4;
  2865. fWithAlpha := tfBGRA4;
  2866. fWithoutAlpha := tfBGR4;
  2867. fRGBInverted := tfRGBA4;
  2868. fRange.r := $F;
  2869. fRange.g := $F;
  2870. fRange.b := $F;
  2871. fRange.a := $F;
  2872. fShift.r := 8;
  2873. fShift.g := 4;
  2874. fShift.b := 0;
  2875. fShift.a := 12;
  2876. fglFormat := GL_BGRA;
  2877. fglInternalFormat := GL_RGBA4;
  2878. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2879. end;
  2880. constructor TfdBGR5A1.Create;
  2881. begin
  2882. inherited Create;
  2883. fFormat := tfBGR5A1;
  2884. fWithAlpha := tfBGR5A1;
  2885. fWithoutAlpha := tfBGR5;
  2886. fRGBInverted := tfRGB5A1;
  2887. fRange.r := $1F;
  2888. fRange.g := $1F;
  2889. fRange.b := $1F;
  2890. fRange.a := $01;
  2891. fShift.r := 10;
  2892. fShift.g := 5;
  2893. fShift.b := 0;
  2894. fShift.a := 15;
  2895. fglFormat := GL_BGRA;
  2896. fglInternalFormat := GL_RGB5_A1;
  2897. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2898. end;
  2899. constructor TfdBGRA8.Create;
  2900. begin
  2901. inherited Create;
  2902. fFormat := tfBGRA8;
  2903. fWithAlpha := tfBGRA8;
  2904. fWithoutAlpha := tfBGR8;
  2905. fRGBInverted := tfRGBA8;
  2906. fglInternalFormat := GL_RGBA8;
  2907. end;
  2908. constructor TfdBGR10A2.Create;
  2909. begin
  2910. inherited Create;
  2911. fFormat := tfBGR10A2;
  2912. fWithAlpha := tfBGR10A2;
  2913. fWithoutAlpha := tfBGR10;
  2914. fRGBInverted := tfRGB10A2;
  2915. fRange.r := $3FF;
  2916. fRange.g := $3FF;
  2917. fRange.b := $3FF;
  2918. fRange.a := $003;
  2919. fShift.r := 20;
  2920. fShift.g := 10;
  2921. fShift.b := 0;
  2922. fShift.a := 30;
  2923. fglFormat := GL_BGRA;
  2924. fglInternalFormat := GL_RGB10_A2;
  2925. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2926. end;
  2927. constructor TfdBGRA12.Create;
  2928. begin
  2929. inherited Create;
  2930. fFormat := tfBGRA12;
  2931. fWithAlpha := tfBGRA12;
  2932. fWithoutAlpha := tfBGR12;
  2933. fRGBInverted := tfRGBA12;
  2934. fglInternalFormat := GL_RGBA12;
  2935. end;
  2936. constructor TfdBGRA16.Create;
  2937. begin
  2938. inherited Create;
  2939. fFormat := tfBGRA16;
  2940. fWithAlpha := tfBGRA16;
  2941. fWithoutAlpha := tfBGR16;
  2942. fRGBInverted := tfRGBA16;
  2943. fglInternalFormat := GL_RGBA16;
  2944. end;
  2945. constructor TfdDepth16.Create;
  2946. begin
  2947. inherited Create;
  2948. fFormat := tfDepth16;
  2949. fWithAlpha := tfEmpty;
  2950. fWithoutAlpha := tfDepth16;
  2951. fglInternalFormat := GL_DEPTH_COMPONENT16;
  2952. end;
  2953. constructor TfdDepth24.Create;
  2954. begin
  2955. inherited Create;
  2956. fFormat := tfDepth24;
  2957. fWithAlpha := tfEmpty;
  2958. fWithoutAlpha := tfDepth24;
  2959. fglInternalFormat := GL_DEPTH_COMPONENT24;
  2960. end;
  2961. constructor TfdDepth32.Create;
  2962. begin
  2963. inherited Create;
  2964. fFormat := tfDepth32;
  2965. fWithAlpha := tfEmpty;
  2966. fWithoutAlpha := tfDepth32;
  2967. fglInternalFormat := GL_DEPTH_COMPONENT32;
  2968. end;
  2969. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2970. //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2971. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2972. procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2973. begin
  2974. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  2975. end;
  2976. procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2977. begin
  2978. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  2979. end;
  2980. constructor TfdS3tcDtx1RGBA.Create;
  2981. begin
  2982. inherited Create;
  2983. fFormat := tfS3tcDtx1RGBA;
  2984. fWithAlpha := tfS3tcDtx1RGBA;
  2985. fUncompressed := tfRGB5A1;
  2986. fPixelSize := 0.5;
  2987. fIsCompressed := true;
  2988. fglFormat := GL_COMPRESSED_RGBA;
  2989. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
  2990. fglDataFormat := GL_UNSIGNED_BYTE;
  2991. end;
  2992. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2993. //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2994. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2995. procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2996. begin
  2997. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  2998. end;
  2999. procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3000. begin
  3001. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  3002. end;
  3003. constructor TfdS3tcDtx3RGBA.Create;
  3004. begin
  3005. inherited Create;
  3006. fFormat := tfS3tcDtx3RGBA;
  3007. fWithAlpha := tfS3tcDtx3RGBA;
  3008. fUncompressed := tfRGBA8;
  3009. fPixelSize := 1.0;
  3010. fIsCompressed := true;
  3011. fglFormat := GL_COMPRESSED_RGBA;
  3012. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
  3013. fglDataFormat := GL_UNSIGNED_BYTE;
  3014. end;
  3015. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3016. //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3017. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3018. procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3019. begin
  3020. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  3021. end;
  3022. procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3023. begin
  3024. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  3025. end;
  3026. constructor TfdS3tcDtx5RGBA.Create;
  3027. begin
  3028. inherited Create;
  3029. fFormat := tfS3tcDtx3RGBA;
  3030. fWithAlpha := tfS3tcDtx3RGBA;
  3031. fUncompressed := tfRGBA8;
  3032. fPixelSize := 1.0;
  3033. fIsCompressed := true;
  3034. fglFormat := GL_COMPRESSED_RGBA;
  3035. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
  3036. fglDataFormat := GL_UNSIGNED_BYTE;
  3037. end;
  3038. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3039. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3040. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3041. class procedure TFormatDescriptor.Init;
  3042. begin
  3043. if not Assigned(FormatDescriptorCS) then
  3044. FormatDescriptorCS := TCriticalSection.Create;
  3045. end;
  3046. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3047. class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3048. begin
  3049. FormatDescriptorCS.Enter;
  3050. try
  3051. result := FormatDescriptors[aFormat];
  3052. if not Assigned(result) then begin
  3053. result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
  3054. FormatDescriptors[aFormat] := result;
  3055. end;
  3056. finally
  3057. FormatDescriptorCS.Leave;
  3058. end;
  3059. end;
  3060. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3061. class function TFormatDescriptor.GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3062. begin
  3063. result := Get(Get(aFormat).WithAlpha);
  3064. end;
  3065. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3066. class procedure TFormatDescriptor.Clear;
  3067. var
  3068. f: TglBitmapFormat;
  3069. begin
  3070. FormatDescriptorCS.Enter;
  3071. try
  3072. for f := low(FormatDescriptors) to high(FormatDescriptors) do
  3073. FreeAndNil(FormatDescriptors[f]);
  3074. finally
  3075. FormatDescriptorCS.Leave;
  3076. end;
  3077. end;
  3078. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3079. class procedure TFormatDescriptor.Finalize;
  3080. begin
  3081. Clear;
  3082. FreeAndNil(FormatDescriptorCS);
  3083. end;
  3084. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3085. //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3086. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3087. procedure TbmpBitfieldFormat.SetRedMask(const aValue: QWord);
  3088. begin
  3089. Update(aValue, fRange.r, fShift.r);
  3090. end;
  3091. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3092. procedure TbmpBitfieldFormat.SetGreenMask(const aValue: QWord);
  3093. begin
  3094. Update(aValue, fRange.g, fShift.g);
  3095. end;
  3096. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3097. procedure TbmpBitfieldFormat.SetBlueMask(const aValue: QWord);
  3098. begin
  3099. Update(aValue, fRange.b, fShift.b);
  3100. end;
  3101. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3102. procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: QWord);
  3103. begin
  3104. Update(aValue, fRange.a, fShift.a);
  3105. end;
  3106. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3107. procedure TbmpBitfieldFormat.Update(aMask: QWord; out aRange: Cardinal; out
  3108. aShift: Byte);
  3109. begin
  3110. aShift := 0;
  3111. aRange := 0;
  3112. if (aMask = 0) then
  3113. exit;
  3114. while (aMask > 0) and ((aMask and 1) = 0) do begin
  3115. inc(aShift);
  3116. aMask := aMask shr 1;
  3117. end;
  3118. aRange := 1;
  3119. while (aMask > 0) do begin
  3120. aRange := aRange shl 1;
  3121. aMask := aMask shr 1;
  3122. end;
  3123. dec(aRange);
  3124. fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
  3125. end;
  3126. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3127. procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3128. var
  3129. data: QWord;
  3130. s: Integer;
  3131. begin
  3132. data :=
  3133. ((aPixel.Data.r and fRange.r) shl fShift.r) or
  3134. ((aPixel.Data.g and fRange.g) shl fShift.g) or
  3135. ((aPixel.Data.b and fRange.b) shl fShift.b) or
  3136. ((aPixel.Data.a and fRange.a) shl fShift.a);
  3137. s := Round(fPixelSize);
  3138. case s of
  3139. 1: aData^ := data;
  3140. 2: PWord(aData)^ := data;
  3141. 4: PCardinal(aData)^ := data;
  3142. 8: PQWord(aData)^ := data;
  3143. else
  3144. raise EglBitmapException.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
  3145. end;
  3146. inc(aData, s);
  3147. end;
  3148. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3149. procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3150. var
  3151. data: QWord;
  3152. s, i: Integer;
  3153. begin
  3154. s := Round(fPixelSize);
  3155. case s of
  3156. 1: data := aData^;
  3157. 2: data := PWord(aData)^;
  3158. 4: data := PCardinal(aData)^;
  3159. 8: data := PQWord(aData)^;
  3160. else
  3161. raise EglBitmapException.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
  3162. end;
  3163. for i := 0 to 3 do
  3164. aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
  3165. inc(aData, s);
  3166. end;
  3167. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3168. //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3169. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3170. procedure TbmpColorTableFormat.CreateColorTable;
  3171. var
  3172. i: Integer;
  3173. begin
  3174. if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
  3175. raise EglBitmapException.Create(UNSUPPORTED_FORMAT);
  3176. if (Format = tfLuminance4) then
  3177. SetLength(fColorTable, 16)
  3178. else
  3179. SetLength(fColorTable, 256);
  3180. case Format of
  3181. tfLuminance4: begin
  3182. for i := 0 to High(fColorTable) do begin
  3183. fColorTable[i].r := 16 * i;
  3184. fColorTable[i].g := 16 * i;
  3185. fColorTable[i].b := 16 * i;
  3186. fColorTable[i].a := 0;
  3187. end;
  3188. end;
  3189. tfLuminance8: begin
  3190. for i := 0 to High(fColorTable) do begin
  3191. fColorTable[i].r := i;
  3192. fColorTable[i].g := i;
  3193. fColorTable[i].b := i;
  3194. fColorTable[i].a := 0;
  3195. end;
  3196. end;
  3197. tfR3G3B2: begin
  3198. for i := 0 to High(fColorTable) do begin
  3199. fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
  3200. fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
  3201. fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
  3202. fColorTable[i].a := 0;
  3203. end;
  3204. end;
  3205. end;
  3206. end;
  3207. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3208. procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3209. var
  3210. d: Byte;
  3211. begin
  3212. if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
  3213. raise EglBitmapException.Create(UNSUPPORTED_FORMAT);
  3214. case Format of
  3215. tfLuminance4: begin
  3216. if (aMapData = nil) then
  3217. aData^ := 0;
  3218. d := LuminanceWeight(aPixel) and Range.r;
  3219. aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData)));
  3220. inc(PByte(aMapData), 4);
  3221. if ({%H-}PtrUInt(aMapData) >= 8) then begin
  3222. inc(aData);
  3223. aMapData := nil;
  3224. end;
  3225. end;
  3226. tfLuminance8: begin
  3227. aData^ := LuminanceWeight(aPixel) and Range.r;
  3228. inc(aData);
  3229. end;
  3230. tfR3G3B2: begin
  3231. aData^ := Round(
  3232. ((aPixel.Data.r and Range.r) shl Shift.r) or
  3233. ((aPixel.Data.g and Range.g) shl Shift.g) or
  3234. ((aPixel.Data.b and Range.b) shl Shift.b));
  3235. inc(aData);
  3236. end;
  3237. end;
  3238. end;
  3239. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3240. procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3241. var
  3242. idx: QWord;
  3243. s: Integer;
  3244. bits: Byte;
  3245. f: Single;
  3246. begin
  3247. s := Trunc(fPixelSize);
  3248. f := fPixelSize - s;
  3249. bits := Round(8 * f);
  3250. case s of
  3251. 0: idx := (aData^ shr (8 - bits - {%H-}PtrInt(aMapData))) and ((1 shl bits) - 1);
  3252. 1: idx := aData^;
  3253. 2: idx := PWord(aData)^;
  3254. 4: idx := PCardinal(aData)^;
  3255. 8: idx := PQWord(aData)^;
  3256. else
  3257. raise EglBitmapException.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
  3258. end;
  3259. if (idx >= Length(fColorTable)) then
  3260. raise EglBitmapException.CreateFmt('invalid color index: %d', [idx]);
  3261. with fColorTable[idx] do begin
  3262. aPixel.Data.r := r;
  3263. aPixel.Data.g := g;
  3264. aPixel.Data.b := b;
  3265. aPixel.Data.a := a;
  3266. end;
  3267. inc(PByte(aMapData), bits);
  3268. if ({%H-}PtrUInt(aMapData) >= 8) then begin
  3269. inc(aData, 1);
  3270. dec(PByte(aMapData), 8);
  3271. end;
  3272. inc(aData, s);
  3273. end;
  3274. destructor TbmpColorTableFormat.Destroy;
  3275. begin
  3276. SetLength(fColorTable, 0);
  3277. inherited Destroy;
  3278. end;
  3279. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3280. //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3281. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3282. procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
  3283. var
  3284. i: Integer;
  3285. begin
  3286. for i := 0 to 3 do begin
  3287. if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
  3288. if (aSourceFD.Range.arr[i] > 0) then
  3289. aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
  3290. else
  3291. aPixel.Data.arr[i] := aDestFD.Range.arr[i];
  3292. end;
  3293. end;
  3294. end;
  3295. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3296. procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
  3297. begin
  3298. with aFuncRec do begin
  3299. if (Source.Range.r > 0) then
  3300. Dest.Data.r := Source.Data.r;
  3301. if (Source.Range.g > 0) then
  3302. Dest.Data.g := Source.Data.g;
  3303. if (Source.Range.b > 0) then
  3304. Dest.Data.b := Source.Data.b;
  3305. if (Source.Range.a > 0) then
  3306. Dest.Data.a := Source.Data.a;
  3307. end;
  3308. end;
  3309. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3310. procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3311. var
  3312. i: Integer;
  3313. begin
  3314. with aFuncRec do begin
  3315. for i := 0 to 3 do
  3316. if (Source.Range.arr[i] > 0) then
  3317. Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
  3318. end;
  3319. end;
  3320. type
  3321. TShiftData = packed record
  3322. case Integer of
  3323. 0: (r, g, b, a: SmallInt);
  3324. 1: (arr: array[0..3] of SmallInt);
  3325. end;
  3326. PShiftData = ^TShiftData;
  3327. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3328. procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3329. var
  3330. i: Integer;
  3331. begin
  3332. with aFuncRec do
  3333. for i := 0 to 3 do
  3334. if (Source.Range.arr[i] > 0) then
  3335. Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
  3336. end;
  3337. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3338. procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
  3339. begin
  3340. with aFuncRec do begin
  3341. Dest.Data := Source.Data;
  3342. if ({%H-}PtrUInt(Args) and $1 > 0) then begin
  3343. Dest.Data.r := Dest.Data.r xor Dest.Range.r;
  3344. Dest.Data.g := Dest.Data.g xor Dest.Range.g;
  3345. Dest.Data.b := Dest.Data.b xor Dest.Range.b;
  3346. end;
  3347. if ({%H-}PtrUInt(Args) and $2 > 0) then begin
  3348. Dest.Data.a := Dest.Data.a xor Dest.Range.a;
  3349. end;
  3350. end;
  3351. end;
  3352. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3353. procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
  3354. var
  3355. i: Integer;
  3356. begin
  3357. with aFuncRec do begin
  3358. for i := 0 to 3 do
  3359. Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
  3360. end;
  3361. end;
  3362. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3363. procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3364. var
  3365. Temp: Single;
  3366. begin
  3367. with FuncRec do begin
  3368. if (FuncRec.Args = nil) then begin //source has no alpha
  3369. Temp :=
  3370. Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
  3371. Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
  3372. Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
  3373. Dest.Data.a := Round(Dest.Range.a * Temp);
  3374. end else
  3375. Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
  3376. end;
  3377. end;
  3378. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3379. procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3380. type
  3381. PglBitmapPixelData = ^TglBitmapPixelData;
  3382. begin
  3383. with FuncRec do begin
  3384. Dest.Data.r := Source.Data.r;
  3385. Dest.Data.g := Source.Data.g;
  3386. Dest.Data.b := Source.Data.b;
  3387. with PglBitmapPixelData(Args)^ do
  3388. if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
  3389. (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
  3390. (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
  3391. Dest.Data.a := 0
  3392. else
  3393. Dest.Data.a := Dest.Range.a;
  3394. end;
  3395. end;
  3396. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3397. procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3398. begin
  3399. with FuncRec do begin
  3400. Dest.Data.r := Source.Data.r;
  3401. Dest.Data.g := Source.Data.g;
  3402. Dest.Data.b := Source.Data.b;
  3403. Dest.Data.a := PCardinal(Args)^;
  3404. end;
  3405. end;
  3406. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3407. procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
  3408. type
  3409. PRGBPix = ^TRGBPix;
  3410. TRGBPix = array [0..2] of byte;
  3411. var
  3412. Temp: Byte;
  3413. begin
  3414. while aWidth > 0 do begin
  3415. Temp := PRGBPix(aData)^[0];
  3416. PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
  3417. PRGBPix(aData)^[2] := Temp;
  3418. if aHasAlpha then
  3419. Inc(aData, 4)
  3420. else
  3421. Inc(aData, 3);
  3422. dec(aWidth);
  3423. end;
  3424. end;
  3425. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3426. //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3427. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3428. function TglBitmap.GetWidth: Integer;
  3429. begin
  3430. if (ffX in fDimension.Fields) then
  3431. result := fDimension.X
  3432. else
  3433. result := -1;
  3434. end;
  3435. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3436. function TglBitmap.GetHeight: Integer;
  3437. begin
  3438. if (ffY in fDimension.Fields) then
  3439. result := fDimension.Y
  3440. else
  3441. result := -1;
  3442. end;
  3443. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3444. function TglBitmap.GetFileWidth: Integer;
  3445. begin
  3446. result := Max(1, Width);
  3447. end;
  3448. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3449. function TglBitmap.GetFileHeight: Integer;
  3450. begin
  3451. result := Max(1, Height);
  3452. end;
  3453. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3454. procedure TglBitmap.SetCustomData(const aValue: Pointer);
  3455. begin
  3456. if fCustomData = aValue then
  3457. exit;
  3458. fCustomData := aValue;
  3459. end;
  3460. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3461. procedure TglBitmap.SetCustomName(const aValue: String);
  3462. begin
  3463. if fCustomName = aValue then
  3464. exit;
  3465. fCustomName := aValue;
  3466. end;
  3467. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3468. procedure TglBitmap.SetCustomNameW(const aValue: WideString);
  3469. begin
  3470. if fCustomNameW = aValue then
  3471. exit;
  3472. fCustomNameW := aValue;
  3473. end;
  3474. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3475. procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
  3476. begin
  3477. if fDeleteTextureOnFree = aValue then
  3478. exit;
  3479. fDeleteTextureOnFree := aValue;
  3480. end;
  3481. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3482. procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
  3483. begin
  3484. if fFormat = aValue then
  3485. exit;
  3486. if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
  3487. raise EglBitmapUnsupportedFormat.Create(Format);
  3488. SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method
  3489. end;
  3490. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3491. procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
  3492. begin
  3493. if fFreeDataAfterGenTexture = aValue then
  3494. exit;
  3495. fFreeDataAfterGenTexture := aValue;
  3496. end;
  3497. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3498. procedure TglBitmap.SetID(const aValue: Cardinal);
  3499. begin
  3500. if fID = aValue then
  3501. exit;
  3502. fID := aValue;
  3503. end;
  3504. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3505. procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
  3506. begin
  3507. if fMipMap = aValue then
  3508. exit;
  3509. fMipMap := aValue;
  3510. end;
  3511. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3512. procedure TglBitmap.SetTarget(const aValue: Cardinal);
  3513. begin
  3514. if fTarget = aValue then
  3515. exit;
  3516. fTarget := aValue;
  3517. end;
  3518. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3519. procedure TglBitmap.SetAnisotropic(const aValue: Integer);
  3520. var
  3521. MaxAnisotropic: Integer;
  3522. begin
  3523. fAnisotropic := aValue;
  3524. if (ID > 0) then begin
  3525. if GL_EXT_texture_filter_anisotropic then begin
  3526. if fAnisotropic > 0 then begin
  3527. Bind(false);
  3528. glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
  3529. if aValue > MaxAnisotropic then
  3530. fAnisotropic := MaxAnisotropic;
  3531. glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
  3532. end;
  3533. end else begin
  3534. fAnisotropic := 0;
  3535. end;
  3536. end;
  3537. end;
  3538. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3539. procedure TglBitmap.CreateID;
  3540. begin
  3541. if (ID <> 0) then
  3542. glDeleteTextures(1, @fID);
  3543. glGenTextures(1, @fID);
  3544. Bind(false);
  3545. end;
  3546. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3547. procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
  3548. begin
  3549. // Set Up Parameters
  3550. SetWrap(fWrapS, fWrapT, fWrapR);
  3551. SetFilter(fFilterMin, fFilterMag);
  3552. SetAnisotropic(fAnisotropic);
  3553. SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
  3554. // Mip Maps Generation Mode
  3555. aBuildWithGlu := false;
  3556. if (MipMap = mmMipmap) then begin
  3557. if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
  3558. glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
  3559. else
  3560. aBuildWithGlu := true;
  3561. end else if (MipMap = mmMipmapGlu) then
  3562. aBuildWithGlu := true;
  3563. end;
  3564. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3565. procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  3566. const aWidth: Integer; const aHeight: Integer);
  3567. var
  3568. s: Single;
  3569. begin
  3570. if (Data <> aData) then begin
  3571. if (Assigned(Data)) then
  3572. FreeMem(Data);
  3573. fData := aData;
  3574. end;
  3575. FillChar(fDimension, SizeOf(fDimension), 0);
  3576. if not Assigned(fData) then begin
  3577. fFormat := tfEmpty;
  3578. fPixelSize := 0;
  3579. fRowSize := 0;
  3580. end else begin
  3581. if aWidth <> -1 then begin
  3582. fDimension.Fields := fDimension.Fields + [ffX];
  3583. fDimension.X := aWidth;
  3584. end;
  3585. if aHeight <> -1 then begin
  3586. fDimension.Fields := fDimension.Fields + [ffY];
  3587. fDimension.Y := aHeight;
  3588. end;
  3589. s := TFormatDescriptor.Get(aFormat).PixelSize;
  3590. fFormat := aFormat;
  3591. fPixelSize := Ceil(s);
  3592. fRowSize := Ceil(s * aWidth);
  3593. end;
  3594. end;
  3595. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3596. function TglBitmap.FlipHorz: Boolean;
  3597. begin
  3598. result := false;
  3599. end;
  3600. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3601. function TglBitmap.FlipVert: Boolean;
  3602. begin
  3603. result := false;
  3604. end;
  3605. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3606. //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3607. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3608. procedure TglBitmap.AfterConstruction;
  3609. begin
  3610. inherited AfterConstruction;
  3611. fID := 0;
  3612. fTarget := 0;
  3613. fIsResident := false;
  3614. fFormat := glBitmapGetDefaultFormat;
  3615. fMipMap := glBitmapDefaultMipmap;
  3616. fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
  3617. fDeleteTextureOnFree := glBitmapGetDefaultDeleteTextureOnFree;
  3618. glBitmapGetDefaultFilter (fFilterMin, fFilterMag);
  3619. glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
  3620. end;
  3621. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3622. procedure TglBitmap.BeforeDestruction;
  3623. var
  3624. NewData: PByte;
  3625. begin
  3626. NewData := nil;
  3627. SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method
  3628. if (fID > 0) and fDeleteTextureOnFree then
  3629. glDeleteTextures(1, @fID);
  3630. inherited BeforeDestruction;
  3631. end;
  3632. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3633. procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
  3634. var
  3635. TempPos: Integer;
  3636. begin
  3637. if not Assigned(aResType) then begin
  3638. TempPos := Pos('.', aResource);
  3639. aResType := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
  3640. aResource := UpperCase(Copy(aResource, 0, TempPos -1));
  3641. end;
  3642. end;
  3643. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3644. procedure TglBitmap.LoadFromFile(const aFilename: String);
  3645. var
  3646. fs: TFileStream;
  3647. begin
  3648. if not FileExists(aFilename) then
  3649. raise EglBitmapException.Create('file does not exist: ' + aFilename);
  3650. fFilename := aFilename;
  3651. fs := TFileStream.Create(fFilename, fmOpenRead);
  3652. try
  3653. fs.Position := 0;
  3654. LoadFromStream(fs);
  3655. finally
  3656. fs.Free;
  3657. end;
  3658. end;
  3659. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3660. procedure TglBitmap.LoadFromStream(const aStream: TStream);
  3661. begin
  3662. {$IFDEF GLB_SUPPORT_PNG_READ}
  3663. if not LoadPNG(aStream) then
  3664. {$ENDIF}
  3665. {$IFDEF GLB_SUPPORT_JPEG_READ}
  3666. if not LoadJPEG(aStream) then
  3667. {$ENDIF}
  3668. if not LoadDDS(aStream) then
  3669. if not LoadTGA(aStream) then
  3670. if not LoadBMP(aStream) then
  3671. raise EglBitmapException.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
  3672. end;
  3673. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3674. procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  3675. const aFormat: TglBitmapFormat; const aArgs: Pointer);
  3676. var
  3677. tmpData: PByte;
  3678. size: Integer;
  3679. begin
  3680. size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  3681. GetMem(tmpData, size);
  3682. try
  3683. FillChar(tmpData^, size, #$FF);
  3684. SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  3685. except
  3686. if Assigned(tmpData) then
  3687. FreeMem(tmpData);
  3688. raise;
  3689. end;
  3690. AddFunc(Self, aFunc, false, Format, aArgs);
  3691. end;
  3692. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3693. procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
  3694. var
  3695. rs: TResourceStream;
  3696. begin
  3697. PrepareResType(aResource, aResType);
  3698. rs := TResourceStream.Create(aInstance, aResource, aResType);
  3699. try
  3700. LoadFromStream(rs);
  3701. finally
  3702. rs.Free;
  3703. end;
  3704. end;
  3705. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3706. procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  3707. var
  3708. rs: TResourceStream;
  3709. begin
  3710. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  3711. try
  3712. LoadFromStream(rs);
  3713. finally
  3714. rs.Free;
  3715. end;
  3716. end;
  3717. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3718. procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  3719. var
  3720. fs: TFileStream;
  3721. begin
  3722. fs := TFileStream.Create(aFileName, fmCreate);
  3723. try
  3724. fs.Position := 0;
  3725. SaveToStream(fs, aFileType);
  3726. finally
  3727. fs.Free;
  3728. end;
  3729. end;
  3730. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3731. procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
  3732. begin
  3733. case aFileType of
  3734. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  3735. ftPNG: SavePNG(aStream);
  3736. {$ENDIF}
  3737. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  3738. ftJPEG: SaveJPEG(aStream);
  3739. {$ENDIF}
  3740. ftDDS: SaveDDS(aStream);
  3741. ftTGA: SaveTGA(aStream);
  3742. ftBMP: SaveBMP(aStream);
  3743. end;
  3744. end;
  3745. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3746. function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
  3747. begin
  3748. result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
  3749. end;
  3750. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3751. function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  3752. const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
  3753. var
  3754. DestData, TmpData, SourceData: pByte;
  3755. TempHeight, TempWidth: Integer;
  3756. SourceFD, DestFD: TFormatDescriptor;
  3757. SourceMD, DestMD: Pointer;
  3758. FuncRec: TglBitmapFunctionRec;
  3759. begin
  3760. Assert(Assigned(Data));
  3761. Assert(Assigned(aSource));
  3762. Assert(Assigned(aSource.Data));
  3763. result := false;
  3764. if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
  3765. SourceFD := TFormatDescriptor.Get(aSource.Format);
  3766. DestFD := TFormatDescriptor.Get(aFormat);
  3767. if (SourceFD.IsCompressed) then
  3768. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
  3769. if (DestFD.IsCompressed) then
  3770. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
  3771. // inkompatible Formats so CreateTemp
  3772. if (SourceFD.PixelSize <> DestFD.PixelSize) then
  3773. aCreateTemp := true;
  3774. // Values
  3775. TempHeight := Max(1, aSource.Height);
  3776. TempWidth := Max(1, aSource.Width);
  3777. FuncRec.Sender := Self;
  3778. FuncRec.Args := aArgs;
  3779. TmpData := nil;
  3780. if aCreateTemp then begin
  3781. GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
  3782. DestData := TmpData;
  3783. end else
  3784. DestData := Data;
  3785. try
  3786. SourceFD.PreparePixel(FuncRec.Source);
  3787. DestFD.PreparePixel (FuncRec.Dest);
  3788. SourceMD := SourceFD.CreateMappingData;
  3789. DestMD := DestFD.CreateMappingData;
  3790. FuncRec.Size := aSource.Dimension;
  3791. FuncRec.Position.Fields := FuncRec.Size.Fields;
  3792. try
  3793. SourceData := aSource.Data;
  3794. FuncRec.Position.Y := 0;
  3795. while FuncRec.Position.Y < TempHeight do begin
  3796. FuncRec.Position.X := 0;
  3797. while FuncRec.Position.X < TempWidth do begin
  3798. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  3799. aFunc(FuncRec);
  3800. DestFD.Map(FuncRec.Dest, DestData, DestMD);
  3801. inc(FuncRec.Position.X);
  3802. end;
  3803. inc(FuncRec.Position.Y);
  3804. end;
  3805. // Updating Image or InternalFormat
  3806. if aCreateTemp then
  3807. SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method
  3808. else if (aFormat <> fFormat) then
  3809. Format := aFormat;
  3810. result := true;
  3811. finally
  3812. SourceFD.FreeMappingData(SourceMD);
  3813. DestFD.FreeMappingData(DestMD);
  3814. end;
  3815. except
  3816. if aCreateTemp and Assigned(TmpData) then
  3817. FreeMem(TmpData);
  3818. raise;
  3819. end;
  3820. end;
  3821. end;
  3822. {$IFDEF GLB_SDL}
  3823. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3824. function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  3825. var
  3826. Row, RowSize: Integer;
  3827. SourceData, TmpData: PByte;
  3828. TempDepth: Integer;
  3829. FormatDesc: TFormatDescriptor;
  3830. function GetRowPointer(Row: Integer): pByte;
  3831. begin
  3832. result := aSurface.pixels;
  3833. Inc(result, Row * RowSize);
  3834. end;
  3835. begin
  3836. result := false;
  3837. FormatDesc := TFormatDescriptor.Get(Format);
  3838. if FormatDesc.IsCompressed then
  3839. raise EglBitmapUnsupportedFormat.Create(Format);
  3840. if Assigned(Data) then begin
  3841. case Trunc(FormatDesc.PixelSize) of
  3842. 1: TempDepth := 8;
  3843. 2: TempDepth := 16;
  3844. 3: TempDepth := 24;
  3845. 4: TempDepth := 32;
  3846. else
  3847. raise EglBitmapUnsupportedFormat.Create(Format);
  3848. end;
  3849. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
  3850. FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
  3851. SourceData := Data;
  3852. RowSize := FormatDesc.GetSize(FileWidth, 1);
  3853. for Row := 0 to FileHeight-1 do begin
  3854. TmpData := GetRowPointer(Row);
  3855. if Assigned(TmpData) then begin
  3856. Move(SourceData^, TmpData^, RowSize);
  3857. inc(SourceData, RowSize);
  3858. end;
  3859. end;
  3860. result := true;
  3861. end;
  3862. end;
  3863. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3864. function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  3865. var
  3866. pSource, pData, pTempData: PByte;
  3867. Row, RowSize, TempWidth, TempHeight: Integer;
  3868. IntFormat: TglBitmapFormat;
  3869. FormatDesc: TFormatDescriptor;
  3870. function GetRowPointer(Row: Integer): pByte;
  3871. begin
  3872. result := aSurface^.pixels;
  3873. Inc(result, Row * RowSize);
  3874. end;
  3875. begin
  3876. result := false;
  3877. if (Assigned(aSurface)) then begin
  3878. with aSurface^.format^ do begin
  3879. for IntFormat := High(TglBitmapFormat) to Low(TglBitmapFormat) do begin
  3880. FormatDesc := TFormatDescriptor.Get(IntFormat);
  3881. if (FormatDesc.MaskMatch(RMask, GMask, BMask, AMask)) then
  3882. break;
  3883. end;
  3884. if (IntFormat = tfEmpty) then
  3885. raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
  3886. end;
  3887. TempWidth := aSurface^.w;
  3888. TempHeight := aSurface^.h;
  3889. RowSize := FormatDesc.GetSize(TempWidth, 1);
  3890. GetMem(pData, TempHeight * RowSize);
  3891. try
  3892. pTempData := pData;
  3893. for Row := 0 to TempHeight -1 do begin
  3894. pSource := GetRowPointer(Row);
  3895. if (Assigned(pSource)) then begin
  3896. Move(pSource^, pTempData^, RowSize);
  3897. Inc(pTempData, RowSize);
  3898. end;
  3899. end;
  3900. SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  3901. result := true;
  3902. except
  3903. if Assigned(pData) then
  3904. FreeMem(pData);
  3905. raise;
  3906. end;
  3907. end;
  3908. end;
  3909. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3910. function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  3911. var
  3912. Row, Col, AlphaInterleave: Integer;
  3913. pSource, pDest: PByte;
  3914. function GetRowPointer(Row: Integer): pByte;
  3915. begin
  3916. result := aSurface.pixels;
  3917. Inc(result, Row * Width);
  3918. end;
  3919. begin
  3920. result := false;
  3921. if Assigned(Data) then begin
  3922. if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
  3923. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
  3924. AlphaInterleave := 0;
  3925. case Format of
  3926. tfLuminance8Alpha8:
  3927. AlphaInterleave := 1;
  3928. tfBGRA8, tfRGBA8:
  3929. AlphaInterleave := 3;
  3930. end;
  3931. pSource := Data;
  3932. for Row := 0 to Height -1 do begin
  3933. pDest := GetRowPointer(Row);
  3934. if Assigned(pDest) then begin
  3935. for Col := 0 to Width -1 do begin
  3936. Inc(pSource, AlphaInterleave);
  3937. pDest^ := pSource^;
  3938. Inc(pDest);
  3939. Inc(pSource);
  3940. end;
  3941. end;
  3942. end;
  3943. result := true;
  3944. end;
  3945. end;
  3946. end;
  3947. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3948. function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  3949. var
  3950. bmp: TglBitmap2D;
  3951. begin
  3952. bmp := TglBitmap2D.Create;
  3953. try
  3954. bmp.AssignFromSurface(aSurface);
  3955. result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
  3956. finally
  3957. bmp.Free;
  3958. end;
  3959. end;
  3960. {$ENDIF}
  3961. {$IFDEF GLB_DELPHI}
  3962. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3963. function CreateGrayPalette: HPALETTE;
  3964. var
  3965. Idx: Integer;
  3966. Pal: PLogPalette;
  3967. begin
  3968. GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
  3969. Pal.palVersion := $300;
  3970. Pal.palNumEntries := 256;
  3971. for Idx := 0 to Pal.palNumEntries - 1 do begin
  3972. Pal.palPalEntry[Idx].peRed := Idx;
  3973. Pal.palPalEntry[Idx].peGreen := Idx;
  3974. Pal.palPalEntry[Idx].peBlue := Idx;
  3975. Pal.palPalEntry[Idx].peFlags := 0;
  3976. end;
  3977. Result := CreatePalette(Pal^);
  3978. FreeMem(Pal);
  3979. end;
  3980. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3981. function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
  3982. var
  3983. Row: Integer;
  3984. pSource, pData: PByte;
  3985. begin
  3986. result := false;
  3987. if Assigned(Data) then begin
  3988. if Assigned(aBitmap) then begin
  3989. aBitmap.Width := Width;
  3990. aBitmap.Height := Height;
  3991. case Format of
  3992. tfAlpha8, tfLuminance8: begin
  3993. aBitmap.PixelFormat := pf8bit;
  3994. aBitmap.Palette := CreateGrayPalette;
  3995. end;
  3996. tfRGB5A1:
  3997. aBitmap.PixelFormat := pf15bit;
  3998. tfR5G6B5:
  3999. aBitmap.PixelFormat := pf16bit;
  4000. tfRGB8, tfBGR8:
  4001. aBitmap.PixelFormat := pf24bit;
  4002. tfRGBA8, tfBGRA8:
  4003. aBitmap.PixelFormat := pf32bit;
  4004. else
  4005. raise EglBitmapException.Create('AssignToBitmap - Invalid Pixelformat.');
  4006. end;
  4007. pSource := Data;
  4008. for Row := 0 to FileHeight -1 do begin
  4009. pData := aBitmap.Scanline[Row];
  4010. Move(pSource^, pData^, fRowSize);
  4011. Inc(pSource, fRowSize);
  4012. if (Format in [tfRGB8, tfRGBA8]) then // swap RGB(A) to BGR(A)
  4013. SwapRGB(pData, FileWidth, Format = tfRGBA8);
  4014. end;
  4015. result := true;
  4016. end;
  4017. end;
  4018. end;
  4019. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4020. function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  4021. var
  4022. pSource, pData, pTempData: PByte;
  4023. Row, RowSize, TempWidth, TempHeight: Integer;
  4024. IntFormat: TglBitmapFormat;
  4025. begin
  4026. result := false;
  4027. if (Assigned(aBitmap)) then begin
  4028. case aBitmap.PixelFormat of
  4029. pf8bit:
  4030. IntFormat := tfLuminance8;
  4031. pf15bit:
  4032. IntFormat := tfRGB5A1;
  4033. pf16bit:
  4034. IntFormat := tfR5G6B5;
  4035. pf24bit:
  4036. IntFormat := tfBGR8;
  4037. pf32bit:
  4038. IntFormat := tfBGRA8;
  4039. else
  4040. raise EglBitmapException.Create('AssignFromBitmap - Invalid Pixelformat.');
  4041. end;
  4042. TempWidth := aBitmap.Width;
  4043. TempHeight := aBitmap.Height;
  4044. RowSize := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
  4045. GetMem(pData, TempHeight * RowSize);
  4046. try
  4047. pTempData := pData;
  4048. for Row := 0 to TempHeight -1 do begin
  4049. pSource := aBitmap.Scanline[Row];
  4050. if (Assigned(pSource)) then begin
  4051. Move(pSource^, pTempData^, RowSize);
  4052. Inc(pTempData, RowSize);
  4053. end;
  4054. end;
  4055. SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  4056. result := true;
  4057. except
  4058. if Assigned(pData) then
  4059. FreeMem(pData);
  4060. raise;
  4061. end;
  4062. end;
  4063. end;
  4064. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4065. function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  4066. var
  4067. Row, Col, AlphaInterleave: Integer;
  4068. pSource, pDest: PByte;
  4069. begin
  4070. result := false;
  4071. if Assigned(Data) then begin
  4072. if (Format in [tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8]) then begin
  4073. if Assigned(aBitmap) then begin
  4074. aBitmap.PixelFormat := pf8bit;
  4075. aBitmap.Palette := CreateGrayPalette;
  4076. aBitmap.Width := Width;
  4077. aBitmap.Height := Height;
  4078. case Format of
  4079. tfLuminance8Alpha8:
  4080. AlphaInterleave := 1;
  4081. tfRGBA8, tfBGRA8:
  4082. AlphaInterleave := 3;
  4083. else
  4084. AlphaInterleave := 0;
  4085. end;
  4086. // Copy Data
  4087. pSource := Data;
  4088. for Row := 0 to Height -1 do begin
  4089. pDest := aBitmap.Scanline[Row];
  4090. if Assigned(pDest) then begin
  4091. for Col := 0 to Width -1 do begin
  4092. Inc(pSource, AlphaInterleave);
  4093. pDest^ := pSource^;
  4094. Inc(pDest);
  4095. Inc(pSource);
  4096. end;
  4097. end;
  4098. end;
  4099. result := true;
  4100. end;
  4101. end;
  4102. end;
  4103. end;
  4104. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4105. function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4106. var
  4107. tex: TglBitmap2D;
  4108. begin
  4109. tex := TglBitmap2D.Create;
  4110. try
  4111. tex.AssignFromBitmap(ABitmap);
  4112. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4113. finally
  4114. tex.Free;
  4115. end;
  4116. end;
  4117. {$ENDIF}
  4118. {$IFDEF GLB_LAZARUS}
  4119. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4120. function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4121. var
  4122. rid: TRawImageDescription;
  4123. FormatDesc: TFormatDescriptor;
  4124. begin
  4125. result := false;
  4126. if not Assigned(aImage) or (Format = tfEmpty) then
  4127. exit;
  4128. FormatDesc := TFormatDescriptor.Get(Format);
  4129. if FormatDesc.IsCompressed then
  4130. exit;
  4131. FillChar(rid{%H-}, SizeOf(rid), 0);
  4132. if (Format in [
  4133. tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
  4134. tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
  4135. tfLuminance4Alpha4, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16]) then
  4136. rid.Format := ricfGray
  4137. else
  4138. rid.Format := ricfRGBA;
  4139. rid.Width := Width;
  4140. rid.Height := Height;
  4141. rid.Depth := CountSetBits(FormatDesc.Range.r or FormatDesc.Range.g or FormatDesc.Range.b or FormatDesc.Range.a);
  4142. rid.BitOrder := riboBitsInOrder;
  4143. rid.ByteOrder := riboLSBFirst;
  4144. rid.LineOrder := riloTopToBottom;
  4145. rid.LineEnd := rileTight;
  4146. rid.BitsPerPixel := Round(8 * FormatDesc.PixelSize);
  4147. rid.RedPrec := CountSetBits(FormatDesc.Range.r);
  4148. rid.GreenPrec := CountSetBits(FormatDesc.Range.g);
  4149. rid.BluePrec := CountSetBits(FormatDesc.Range.b);
  4150. rid.AlphaPrec := CountSetBits(FormatDesc.Range.a);
  4151. rid.RedShift := FormatDesc.Shift.r;
  4152. rid.GreenShift := FormatDesc.Shift.g;
  4153. rid.BlueShift := FormatDesc.Shift.b;
  4154. rid.AlphaShift := FormatDesc.Shift.a;
  4155. rid.MaskBitsPerPixel := 0;
  4156. rid.PaletteColorCount := 0;
  4157. aImage.DataDescription := rid;
  4158. aImage.CreateData;
  4159. Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
  4160. result := true;
  4161. end;
  4162. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4163. function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4164. var
  4165. f: TglBitmapFormat;
  4166. FormatDesc: TFormatDescriptor;
  4167. ImageData: PByte;
  4168. ImageSize: Integer;
  4169. begin
  4170. result := false;
  4171. if not Assigned(aImage) then
  4172. exit;
  4173. for f := High(f) downto Low(f) do begin
  4174. FormatDesc := TFormatDescriptor.Get(f);
  4175. with aImage.DataDescription do
  4176. if FormatDesc.MaskMatch(
  4177. (QWord(1 shl RedPrec )-1) shl RedShift,
  4178. (QWord(1 shl GreenPrec)-1) shl GreenShift,
  4179. (QWord(1 shl BluePrec )-1) shl BlueShift,
  4180. (QWord(1 shl AlphaPrec)-1) shl AlphaShift) then
  4181. break;
  4182. end;
  4183. if (f = tfEmpty) then
  4184. exit;
  4185. ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
  4186. ImageData := GetMem(ImageSize);
  4187. try
  4188. Move(aImage.PixelData^, ImageData^, (aImage.Width * aImage.Height * aImage.DataDescription.BitsPerPixel) shr 3);
  4189. SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method
  4190. except
  4191. if Assigned(ImageData) then
  4192. FreeMem(ImageData);
  4193. raise;
  4194. end;
  4195. result := true;
  4196. end;
  4197. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4198. function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4199. var
  4200. rid: TRawImageDescription;
  4201. FormatDesc: TFormatDescriptor;
  4202. Pixel: TglBitmapPixelData;
  4203. x, y: Integer;
  4204. srcMD: Pointer;
  4205. src, dst: PByte;
  4206. begin
  4207. result := false;
  4208. if not Assigned(aImage) or (Format = tfEmpty) then
  4209. exit;
  4210. FormatDesc := TFormatDescriptor.Get(Format);
  4211. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  4212. exit;
  4213. FillChar(rid{%H-}, SizeOf(rid), 0);
  4214. rid.Format := ricfGray;
  4215. rid.Width := Width;
  4216. rid.Height := Height;
  4217. rid.Depth := CountSetBits(FormatDesc.Range.a);
  4218. rid.BitOrder := riboBitsInOrder;
  4219. rid.ByteOrder := riboLSBFirst;
  4220. rid.LineOrder := riloTopToBottom;
  4221. rid.LineEnd := rileTight;
  4222. rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
  4223. rid.RedPrec := CountSetBits(FormatDesc.Range.a);
  4224. rid.GreenPrec := 0;
  4225. rid.BluePrec := 0;
  4226. rid.AlphaPrec := 0;
  4227. rid.RedShift := 0;
  4228. rid.GreenShift := 0;
  4229. rid.BlueShift := 0;
  4230. rid.AlphaShift := 0;
  4231. rid.MaskBitsPerPixel := 0;
  4232. rid.PaletteColorCount := 0;
  4233. aImage.DataDescription := rid;
  4234. aImage.CreateData;
  4235. srcMD := FormatDesc.CreateMappingData;
  4236. try
  4237. FormatDesc.PreparePixel(Pixel);
  4238. src := Data;
  4239. dst := aImage.PixelData;
  4240. for y := 0 to Height-1 do
  4241. for x := 0 to Width-1 do begin
  4242. FormatDesc.Unmap(src, Pixel, srcMD);
  4243. case rid.BitsPerPixel of
  4244. 8: begin
  4245. dst^ := Pixel.Data.a;
  4246. inc(dst);
  4247. end;
  4248. 16: begin
  4249. PWord(dst)^ := Pixel.Data.a;
  4250. inc(dst, 2);
  4251. end;
  4252. 24: begin
  4253. PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
  4254. PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
  4255. PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
  4256. inc(dst, 3);
  4257. end;
  4258. 32: begin
  4259. PCardinal(dst)^ := Pixel.Data.a;
  4260. inc(dst, 4);
  4261. end;
  4262. else
  4263. raise EglBitmapUnsupportedFormat.Create(Format);
  4264. end;
  4265. end;
  4266. finally
  4267. FormatDesc.FreeMappingData(srcMD);
  4268. end;
  4269. result := true;
  4270. end;
  4271. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4272. function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4273. var
  4274. tex: TglBitmap2D;
  4275. begin
  4276. tex := TglBitmap2D.Create;
  4277. try
  4278. tex.AssignFromLazIntfImage(aImage);
  4279. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4280. finally
  4281. tex.Free;
  4282. end;
  4283. end;
  4284. {$ENDIF}
  4285. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4286. function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
  4287. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4288. var
  4289. rs: TResourceStream;
  4290. begin
  4291. PrepareResType(aResource, aResType);
  4292. rs := TResourceStream.Create(aInstance, aResource, aResType);
  4293. try
  4294. result := AddAlphaFromStream(rs, aFunc, aArgs);
  4295. finally
  4296. rs.Free;
  4297. end;
  4298. end;
  4299. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4300. function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  4301. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4302. var
  4303. rs: TResourceStream;
  4304. begin
  4305. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  4306. try
  4307. result := AddAlphaFromStream(rs, aFunc, aArgs);
  4308. finally
  4309. rs.Free;
  4310. end;
  4311. end;
  4312. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4313. function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4314. begin
  4315. if TFormatDescriptor.Get(Format).IsCompressed then
  4316. raise EglBitmapUnsupportedFormat.Create(Format);
  4317. result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
  4318. end;
  4319. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4320. function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4321. var
  4322. FS: TFileStream;
  4323. begin
  4324. FS := TFileStream.Create(FileName, fmOpenRead);
  4325. try
  4326. result := AddAlphaFromStream(FS, aFunc, aArgs);
  4327. finally
  4328. FS.Free;
  4329. end;
  4330. end;
  4331. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4332. function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4333. var
  4334. tex: TglBitmap2D;
  4335. begin
  4336. tex := TglBitmap2D.Create(aStream);
  4337. try
  4338. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4339. finally
  4340. tex.Free;
  4341. end;
  4342. end;
  4343. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4344. function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4345. var
  4346. DestData, DestData2, SourceData: pByte;
  4347. TempHeight, TempWidth: Integer;
  4348. SourceFD, DestFD: TFormatDescriptor;
  4349. SourceMD, DestMD, DestMD2: Pointer;
  4350. FuncRec: TglBitmapFunctionRec;
  4351. begin
  4352. result := false;
  4353. Assert(Assigned(Data));
  4354. Assert(Assigned(aBitmap));
  4355. Assert(Assigned(aBitmap.Data));
  4356. if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
  4357. result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
  4358. SourceFD := TFormatDescriptor.Get(aBitmap.Format);
  4359. DestFD := TFormatDescriptor.Get(Format);
  4360. if not Assigned(aFunc) then begin
  4361. aFunc := glBitmapAlphaFunc;
  4362. FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
  4363. end else
  4364. FuncRec.Args := aArgs;
  4365. // Values
  4366. TempHeight := aBitmap.FileHeight;
  4367. TempWidth := aBitmap.FileWidth;
  4368. FuncRec.Sender := Self;
  4369. FuncRec.Size := Dimension;
  4370. FuncRec.Position.Fields := FuncRec.Size.Fields;
  4371. DestData := Data;
  4372. DestData2 := Data;
  4373. SourceData := aBitmap.Data;
  4374. // Mapping
  4375. SourceFD.PreparePixel(FuncRec.Source);
  4376. DestFD.PreparePixel (FuncRec.Dest);
  4377. SourceMD := SourceFD.CreateMappingData;
  4378. DestMD := DestFD.CreateMappingData;
  4379. DestMD2 := DestFD.CreateMappingData;
  4380. try
  4381. FuncRec.Position.Y := 0;
  4382. while FuncRec.Position.Y < TempHeight do begin
  4383. FuncRec.Position.X := 0;
  4384. while FuncRec.Position.X < TempWidth do begin
  4385. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  4386. DestFD.Unmap (DestData, FuncRec.Dest, DestMD);
  4387. aFunc(FuncRec);
  4388. DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
  4389. inc(FuncRec.Position.X);
  4390. end;
  4391. inc(FuncRec.Position.Y);
  4392. end;
  4393. finally
  4394. SourceFD.FreeMappingData(SourceMD);
  4395. DestFD.FreeMappingData(DestMD);
  4396. DestFD.FreeMappingData(DestMD2);
  4397. end;
  4398. end;
  4399. end;
  4400. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4401. function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
  4402. begin
  4403. result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
  4404. end;
  4405. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4406. function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
  4407. var
  4408. PixelData: TglBitmapPixelData;
  4409. begin
  4410. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4411. result := AddAlphaFromColorKeyFloat(
  4412. aRed / PixelData.Range.r,
  4413. aGreen / PixelData.Range.g,
  4414. aBlue / PixelData.Range.b,
  4415. aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
  4416. end;
  4417. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4418. function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
  4419. var
  4420. values: array[0..2] of Single;
  4421. tmp: Cardinal;
  4422. i: Integer;
  4423. PixelData: TglBitmapPixelData;
  4424. begin
  4425. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4426. with PixelData do begin
  4427. values[0] := aRed;
  4428. values[1] := aGreen;
  4429. values[2] := aBlue;
  4430. for i := 0 to 2 do begin
  4431. tmp := Trunc(Range.arr[i] * aDeviation);
  4432. Data.arr[i] := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
  4433. Range.arr[i] := Max(0, Trunc(Range.arr[i] * values[i] - tmp));
  4434. end;
  4435. Data.a := 0;
  4436. Range.a := 0;
  4437. end;
  4438. result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
  4439. end;
  4440. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4441. function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
  4442. begin
  4443. result := AddAlphaFromValueFloat(aAlpha / $FF);
  4444. end;
  4445. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4446. function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  4447. var
  4448. PixelData: TglBitmapPixelData;
  4449. begin
  4450. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4451. result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
  4452. end;
  4453. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4454. function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  4455. var
  4456. PixelData: TglBitmapPixelData;
  4457. begin
  4458. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4459. with PixelData do
  4460. Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
  4461. result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
  4462. end;
  4463. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4464. function TglBitmap.RemoveAlpha: Boolean;
  4465. var
  4466. FormatDesc: TFormatDescriptor;
  4467. begin
  4468. result := false;
  4469. FormatDesc := TFormatDescriptor.Get(Format);
  4470. if Assigned(Data) then begin
  4471. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  4472. raise EglBitmapUnsupportedFormat.Create(Format);
  4473. result := ConvertTo(FormatDesc.WithoutAlpha);
  4474. end;
  4475. end;
  4476. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4477. function TglBitmap.Clone: TglBitmap;
  4478. var
  4479. Temp: TglBitmap;
  4480. TempPtr: PByte;
  4481. Size: Integer;
  4482. begin
  4483. result := nil;
  4484. Temp := (ClassType.Create as TglBitmap);
  4485. try
  4486. // copy texture data if assigned
  4487. if Assigned(Data) then begin
  4488. Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
  4489. GetMem(TempPtr, Size);
  4490. try
  4491. Move(Data^, TempPtr^, Size);
  4492. Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
  4493. except
  4494. if Assigned(TempPtr) then
  4495. FreeMem(TempPtr);
  4496. raise;
  4497. end;
  4498. end else begin
  4499. TempPtr := nil;
  4500. Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method
  4501. end;
  4502. // copy properties
  4503. Temp.fID := ID;
  4504. Temp.fTarget := Target;
  4505. Temp.fFormat := Format;
  4506. Temp.fMipMap := MipMap;
  4507. Temp.fAnisotropic := Anisotropic;
  4508. Temp.fBorderColor := fBorderColor;
  4509. Temp.fDeleteTextureOnFree := DeleteTextureOnFree;
  4510. Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
  4511. Temp.fFilterMin := fFilterMin;
  4512. Temp.fFilterMag := fFilterMag;
  4513. Temp.fWrapS := fWrapS;
  4514. Temp.fWrapT := fWrapT;
  4515. Temp.fWrapR := fWrapR;
  4516. Temp.fFilename := fFilename;
  4517. Temp.fCustomName := fCustomName;
  4518. Temp.fCustomNameW := fCustomNameW;
  4519. Temp.fCustomData := fCustomData;
  4520. result := Temp;
  4521. except
  4522. FreeAndNil(Temp);
  4523. raise;
  4524. end;
  4525. end;
  4526. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4527. function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
  4528. var
  4529. SourceFD, DestFD: TFormatDescriptor;
  4530. SourcePD, DestPD: TglBitmapPixelData;
  4531. ShiftData: TShiftData;
  4532. function CanCopyDirect: Boolean;
  4533. begin
  4534. result :=
  4535. ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  4536. ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  4537. ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  4538. ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  4539. end;
  4540. function CanShift: Boolean;
  4541. begin
  4542. result :=
  4543. ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  4544. ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  4545. ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  4546. ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  4547. end;
  4548. function GetShift(aSource, aDest: Cardinal) : ShortInt;
  4549. begin
  4550. result := 0;
  4551. while (aSource > aDest) and (aSource > 0) do begin
  4552. inc(result);
  4553. aSource := aSource shr 1;
  4554. end;
  4555. end;
  4556. begin
  4557. if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
  4558. SourceFD := TFormatDescriptor.Get(Format);
  4559. DestFD := TFormatDescriptor.Get(aFormat);
  4560. SourceFD.PreparePixel(SourcePD);
  4561. DestFD.PreparePixel (DestPD);
  4562. if CanCopyDirect then
  4563. result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
  4564. else if CanShift then begin
  4565. ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
  4566. ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
  4567. ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
  4568. ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
  4569. result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
  4570. end else
  4571. result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
  4572. end else
  4573. result := true;
  4574. end;
  4575. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4576. procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
  4577. begin
  4578. if aUseRGB or aUseAlpha then
  4579. AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
  4580. ((PtrInt(aUseAlpha) and 1) shl 1) or
  4581. (PtrInt(aUseRGB) and 1) ));
  4582. end;
  4583. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4584. procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  4585. begin
  4586. fBorderColor[0] := aRed;
  4587. fBorderColor[1] := aGreen;
  4588. fBorderColor[2] := aBlue;
  4589. fBorderColor[3] := aAlpha;
  4590. if (ID > 0) then begin
  4591. Bind(false);
  4592. glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
  4593. end;
  4594. end;
  4595. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4596. procedure TglBitmap.FreeData;
  4597. var
  4598. TempPtr: PByte;
  4599. begin
  4600. TempPtr := nil;
  4601. SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method
  4602. end;
  4603. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4604. procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
  4605. const aAlpha: Byte);
  4606. begin
  4607. FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
  4608. end;
  4609. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4610. procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
  4611. var
  4612. PixelData: TglBitmapPixelData;
  4613. begin
  4614. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4615. FillWithColorFloat(
  4616. aRed / PixelData.Range.r,
  4617. aGreen / PixelData.Range.g,
  4618. aBlue / PixelData.Range.b,
  4619. aAlpha / PixelData.Range.a);
  4620. end;
  4621. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4622. procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
  4623. var
  4624. PixelData: TglBitmapPixelData;
  4625. begin
  4626. TFormatDescriptor.Get(Format).PreparePixel(PixelData);
  4627. with PixelData do begin
  4628. Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
  4629. Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
  4630. Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
  4631. Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
  4632. end;
  4633. AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
  4634. end;
  4635. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4636. procedure TglBitmap.SetFilter(const aMin, aMag: Cardinal);
  4637. begin
  4638. //check MIN filter
  4639. case aMin of
  4640. GL_NEAREST:
  4641. fFilterMin := GL_NEAREST;
  4642. GL_LINEAR:
  4643. fFilterMin := GL_LINEAR;
  4644. GL_NEAREST_MIPMAP_NEAREST:
  4645. fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
  4646. GL_LINEAR_MIPMAP_NEAREST:
  4647. fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
  4648. GL_NEAREST_MIPMAP_LINEAR:
  4649. fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
  4650. GL_LINEAR_MIPMAP_LINEAR:
  4651. fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
  4652. else
  4653. raise EglBitmapException.Create('SetFilter - Unknow MIN filter.');
  4654. end;
  4655. //check MAG filter
  4656. case aMag of
  4657. GL_NEAREST:
  4658. fFilterMag := GL_NEAREST;
  4659. GL_LINEAR:
  4660. fFilterMag := GL_LINEAR;
  4661. else
  4662. raise EglBitmapException.Create('SetFilter - Unknow MAG filter.');
  4663. end;
  4664. //apply filter
  4665. if (ID > 0) then begin
  4666. Bind(false);
  4667. glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
  4668. if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
  4669. case fFilterMin of
  4670. GL_NEAREST, GL_LINEAR:
  4671. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  4672. GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
  4673. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
  4674. GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
  4675. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
  4676. end;
  4677. end else
  4678. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  4679. end;
  4680. end;
  4681. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4682. procedure TglBitmap.SetWrap(const S: Cardinal; const T: Cardinal; const R: Cardinal);
  4683. procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
  4684. begin
  4685. case aValue of
  4686. GL_CLAMP:
  4687. aTarget := GL_CLAMP;
  4688. GL_REPEAT:
  4689. aTarget := GL_REPEAT;
  4690. GL_CLAMP_TO_EDGE: begin
  4691. if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
  4692. aTarget := GL_CLAMP_TO_EDGE
  4693. else
  4694. aTarget := GL_CLAMP;
  4695. end;
  4696. GL_CLAMP_TO_BORDER: begin
  4697. if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
  4698. aTarget := GL_CLAMP_TO_BORDER
  4699. else
  4700. aTarget := GL_CLAMP;
  4701. end;
  4702. GL_MIRRORED_REPEAT: begin
  4703. if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
  4704. aTarget := GL_MIRRORED_REPEAT
  4705. else
  4706. raise EglBitmapException.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
  4707. end;
  4708. else
  4709. raise EglBitmapException.Create('SetWrap - Unknow Texturewrap (S).');
  4710. end;
  4711. end;
  4712. begin
  4713. CheckAndSetWrap(S, fWrapS);
  4714. CheckAndSetWrap(T, fWrapT);
  4715. CheckAndSetWrap(R, fWrapR);
  4716. if (ID > 0) then begin
  4717. Bind(false);
  4718. glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
  4719. glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
  4720. glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
  4721. end;
  4722. end;
  4723. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4724. procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
  4725. begin
  4726. if aEnableTextureUnit then
  4727. glEnable(Target);
  4728. if (ID > 0) then
  4729. glBindTexture(Target, ID);
  4730. end;
  4731. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4732. procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
  4733. begin
  4734. if aDisableTextureUnit then
  4735. glDisable(Target);
  4736. glBindTexture(Target, 0);
  4737. end;
  4738. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4739. constructor TglBitmap.Create;
  4740. begin
  4741. if (ClassType = TglBitmap) then
  4742. raise EglBitmapException.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
  4743. {$IFDEF GLB_NATIVE_OGL}
  4744. glbReadOpenGLExtensions;
  4745. {$ENDIF}
  4746. inherited Create;
  4747. end;
  4748. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4749. constructor TglBitmap.Create(const aFileName: String);
  4750. begin
  4751. Create;
  4752. LoadFromFile(FileName);
  4753. end;
  4754. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4755. constructor TglBitmap.Create(const aStream: TStream);
  4756. begin
  4757. Create;
  4758. LoadFromStream(aStream);
  4759. end;
  4760. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4761. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat);
  4762. var
  4763. Image: PByte;
  4764. ImageSize: Integer;
  4765. begin
  4766. Create;
  4767. ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  4768. GetMem(Image, ImageSize);
  4769. try
  4770. FillChar(Image^, ImageSize, #$FF);
  4771. SetDataPointer(Image, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method
  4772. except
  4773. if Assigned(Image) then
  4774. FreeMem(Image);
  4775. raise;
  4776. end;
  4777. end;
  4778. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4779. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat;
  4780. const aFunc: TglBitmapFunction; const aArgs: Pointer);
  4781. begin
  4782. Create;
  4783. LoadFromFunc(aSize, aFunc, aFormat, aArgs);
  4784. end;
  4785. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4786. constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
  4787. begin
  4788. Create;
  4789. LoadFromResource(aInstance, aResource, aResType);
  4790. end;
  4791. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4792. constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  4793. begin
  4794. Create;
  4795. LoadFromResourceID(aInstance, aResourceID, aResType);
  4796. end;
  4797. {$IFDEF GLB_SUPPORT_PNG_READ}
  4798. {$IF DEFINED(GLB_SDL_IMAGE)}
  4799. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4800. //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4801. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4802. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  4803. var
  4804. Surface: PSDL_Surface;
  4805. RWops: PSDL_RWops;
  4806. begin
  4807. result := false;
  4808. RWops := glBitmapCreateRWops(aStream);
  4809. try
  4810. if IMG_isPNG(RWops) > 0 then begin
  4811. Surface := IMG_LoadPNG_RW(RWops);
  4812. try
  4813. AssignFromSurface(Surface);
  4814. result := true;
  4815. finally
  4816. SDL_FreeSurface(Surface);
  4817. end;
  4818. end;
  4819. finally
  4820. SDL_FreeRW(RWops);
  4821. end;
  4822. end;
  4823. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  4824. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4825. procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  4826. begin
  4827. TStream(png_get_io_ptr(png)).Read(buffer^, size);
  4828. end;
  4829. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4830. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  4831. var
  4832. StreamPos: Int64;
  4833. signature: array [0..7] of byte;
  4834. png: png_structp;
  4835. png_info: png_infop;
  4836. TempHeight, TempWidth: Integer;
  4837. Format: TglBitmapFormat;
  4838. png_data: pByte;
  4839. png_rows: array of pByte;
  4840. Row, LineSize: Integer;
  4841. begin
  4842. result := false;
  4843. if not init_libPNG then
  4844. raise Exception.Create('LoadPNG - unable to initialize libPNG.');
  4845. try
  4846. // signature
  4847. StreamPos := aStream.Position;
  4848. aStream.Read(signature{%H-}, 8);
  4849. aStream.Position := StreamPos;
  4850. if png_check_sig(@signature, 8) <> 0 then begin
  4851. // png read struct
  4852. png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  4853. if png = nil then
  4854. raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
  4855. // png info
  4856. png_info := png_create_info_struct(png);
  4857. if png_info = nil then begin
  4858. png_destroy_read_struct(@png, nil, nil);
  4859. raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
  4860. end;
  4861. // set read callback
  4862. png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
  4863. // read informations
  4864. png_read_info(png, png_info);
  4865. // size
  4866. TempHeight := png_get_image_height(png, png_info);
  4867. TempWidth := png_get_image_width(png, png_info);
  4868. // format
  4869. case png_get_color_type(png, png_info) of
  4870. PNG_COLOR_TYPE_GRAY:
  4871. Format := tfLuminance8;
  4872. PNG_COLOR_TYPE_GRAY_ALPHA:
  4873. Format := tfLuminance8Alpha8;
  4874. PNG_COLOR_TYPE_RGB:
  4875. Format := tfRGB8;
  4876. PNG_COLOR_TYPE_RGB_ALPHA:
  4877. Format := tfRGBA8;
  4878. else
  4879. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  4880. end;
  4881. // cut upper 8 bit from 16 bit formats
  4882. if png_get_bit_depth(png, png_info) > 8 then
  4883. png_set_strip_16(png);
  4884. // expand bitdepth smaller than 8
  4885. if png_get_bit_depth(png, png_info) < 8 then
  4886. png_set_expand(png);
  4887. // allocating mem for scanlines
  4888. LineSize := png_get_rowbytes(png, png_info);
  4889. GetMem(png_data, TempHeight * LineSize);
  4890. try
  4891. SetLength(png_rows, TempHeight);
  4892. for Row := Low(png_rows) to High(png_rows) do begin
  4893. png_rows[Row] := png_data;
  4894. Inc(png_rows[Row], Row * LineSize);
  4895. end;
  4896. // read complete image into scanlines
  4897. png_read_image(png, @png_rows[0]);
  4898. // read end
  4899. png_read_end(png, png_info);
  4900. // destroy read struct
  4901. png_destroy_read_struct(@png, @png_info, nil);
  4902. SetLength(png_rows, 0);
  4903. // set new data
  4904. SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method
  4905. result := true;
  4906. except
  4907. if Assigned(png_data) then
  4908. FreeMem(png_data);
  4909. raise;
  4910. end;
  4911. end;
  4912. finally
  4913. quit_libPNG;
  4914. end;
  4915. end;
  4916. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  4917. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4918. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  4919. var
  4920. StreamPos: Int64;
  4921. Png: TPNGObject;
  4922. Header: String[8];
  4923. Row, Col, PixSize, LineSize: Integer;
  4924. NewImage, pSource, pDest, pAlpha: pByte;
  4925. PngFormat: TglBitmapFormat;
  4926. FormatDesc: TFormatDescriptor;
  4927. const
  4928. PngHeader: String[8] = #137#80#78#71#13#10#26#10;
  4929. begin
  4930. result := false;
  4931. StreamPos := aStream.Position;
  4932. aStream.Read(Header[0], SizeOf(Header));
  4933. aStream.Position := StreamPos;
  4934. {Test if the header matches}
  4935. if Header = PngHeader then begin
  4936. Png := TPNGObject.Create;
  4937. try
  4938. Png.LoadFromStream(aStream);
  4939. case Png.Header.ColorType of
  4940. COLOR_GRAYSCALE:
  4941. PngFormat := tfLuminance8;
  4942. COLOR_GRAYSCALEALPHA:
  4943. PngFormat := tfLuminance8Alpha8;
  4944. COLOR_RGB:
  4945. PngFormat := tfBGR8;
  4946. COLOR_RGBALPHA:
  4947. PngFormat := tfBGRA8;
  4948. else
  4949. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  4950. end;
  4951. FormatDesc := TFormatDescriptor.Get(PngFormat);
  4952. PixSize := Round(FormatDesc.PixelSize);
  4953. LineSize := FormatDesc.GetSize(Png.Header.Width, 1);
  4954. GetMem(NewImage, LineSize * Integer(Png.Header.Height));
  4955. try
  4956. pDest := NewImage;
  4957. case Png.Header.ColorType of
  4958. COLOR_RGB, COLOR_GRAYSCALE:
  4959. begin
  4960. for Row := 0 to Png.Height -1 do begin
  4961. Move (Png.Scanline[Row]^, pDest^, LineSize);
  4962. Inc(pDest, LineSize);
  4963. end;
  4964. end;
  4965. COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
  4966. begin
  4967. PixSize := PixSize -1;
  4968. for Row := 0 to Png.Height -1 do begin
  4969. pSource := Png.Scanline[Row];
  4970. pAlpha := pByte(Png.AlphaScanline[Row]);
  4971. for Col := 0 to Png.Width -1 do begin
  4972. Move (pSource^, pDest^, PixSize);
  4973. Inc(pSource, PixSize);
  4974. Inc(pDest, PixSize);
  4975. pDest^ := pAlpha^;
  4976. inc(pAlpha);
  4977. Inc(pDest);
  4978. end;
  4979. end;
  4980. end;
  4981. else
  4982. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  4983. end;
  4984. SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method
  4985. result := true;
  4986. except
  4987. if Assigned(NewImage) then
  4988. FreeMem(NewImage);
  4989. raise;
  4990. end;
  4991. finally
  4992. Png.Free;
  4993. end;
  4994. end;
  4995. end;
  4996. {$IFEND}
  4997. {$ENDIF}
  4998. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  4999. {$IFDEF GLB_LIB_PNG}
  5000. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5001. procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  5002. begin
  5003. TStream(png_get_io_ptr(png)).Write(buffer^, size);
  5004. end;
  5005. {$ENDIF}
  5006. {$IF DEFINED(GLB_LIB_PNG)}
  5007. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5008. procedure TglBitmap.SavePNG(const aStream: TStream);
  5009. var
  5010. png: png_structp;
  5011. png_info: png_infop;
  5012. png_rows: array of pByte;
  5013. LineSize: Integer;
  5014. ColorType: Integer;
  5015. Row: Integer;
  5016. FormatDesc: TFormatDescriptor;
  5017. begin
  5018. if not (ftPNG in FormatGetSupportedFiles(Format)) then
  5019. raise EglBitmapUnsupportedFormat.Create(Format);
  5020. if not init_libPNG then
  5021. raise Exception.Create('unable to initialize libPNG.');
  5022. try
  5023. case Format of
  5024. tfAlpha8, tfLuminance8:
  5025. ColorType := PNG_COLOR_TYPE_GRAY;
  5026. tfLuminance8Alpha8:
  5027. ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
  5028. tfBGR8, tfRGB8:
  5029. ColorType := PNG_COLOR_TYPE_RGB;
  5030. tfBGRA8, tfRGBA8:
  5031. ColorType := PNG_COLOR_TYPE_RGBA;
  5032. else
  5033. raise EglBitmapUnsupportedFormat.Create(Format);
  5034. end;
  5035. FormatDesc := TFormatDescriptor.Get(Format);
  5036. LineSize := FormatDesc.GetSize(Width, 1);
  5037. // creating array for scanline
  5038. SetLength(png_rows, Height);
  5039. try
  5040. for Row := 0 to Height - 1 do begin
  5041. png_rows[Row] := Data;
  5042. Inc(png_rows[Row], Row * LineSize)
  5043. end;
  5044. // write struct
  5045. png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  5046. if png = nil then
  5047. raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
  5048. // create png info
  5049. png_info := png_create_info_struct(png);
  5050. if png_info = nil then begin
  5051. png_destroy_write_struct(@png, nil);
  5052. raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
  5053. end;
  5054. // set read callback
  5055. png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
  5056. // set compression
  5057. png_set_compression_level(png, 6);
  5058. if Format in [tfBGR8, tfBGRA8] then
  5059. png_set_bgr(png);
  5060. png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
  5061. png_write_info(png, png_info);
  5062. png_write_image(png, @png_rows[0]);
  5063. png_write_end(png, png_info);
  5064. png_destroy_write_struct(@png, @png_info);
  5065. finally
  5066. SetLength(png_rows, 0);
  5067. end;
  5068. finally
  5069. quit_libPNG;
  5070. end;
  5071. end;
  5072. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  5073. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5074. procedure TglBitmap.SavePNG(const aStream: TStream);
  5075. var
  5076. Png: TPNGObject;
  5077. pSource, pDest: pByte;
  5078. X, Y, PixSize: Integer;
  5079. ColorType: Cardinal;
  5080. Alpha: Boolean;
  5081. pTemp: pByte;
  5082. Temp: Byte;
  5083. begin
  5084. if not (ftPNG in FormatGetSupportedFiles (Format)) then
  5085. raise EglBitmapUnsupportedFormat.Create(Format);
  5086. case Format of
  5087. tfAlpha8, tfLuminance8: begin
  5088. ColorType := COLOR_GRAYSCALE;
  5089. PixSize := 1;
  5090. Alpha := false;
  5091. end;
  5092. tfLuminance8Alpha8: begin
  5093. ColorType := COLOR_GRAYSCALEALPHA;
  5094. PixSize := 1;
  5095. Alpha := true;
  5096. end;
  5097. tfBGR8, tfRGB8: begin
  5098. ColorType := COLOR_RGB;
  5099. PixSize := 3;
  5100. Alpha := false;
  5101. end;
  5102. tfBGRA8, tfRGBA8: begin
  5103. ColorType := COLOR_RGBALPHA;
  5104. PixSize := 3;
  5105. Alpha := true
  5106. end;
  5107. else
  5108. raise EglBitmapUnsupportedFormat.Create(Format);
  5109. end;
  5110. Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
  5111. try
  5112. // Copy ImageData
  5113. pSource := Data;
  5114. for Y := 0 to Height -1 do begin
  5115. pDest := png.ScanLine[Y];
  5116. for X := 0 to Width -1 do begin
  5117. Move(pSource^, pDest^, PixSize);
  5118. Inc(pDest, PixSize);
  5119. Inc(pSource, PixSize);
  5120. if Alpha then begin
  5121. png.AlphaScanline[Y]^[X] := pSource^;
  5122. Inc(pSource);
  5123. end;
  5124. end;
  5125. // convert RGB line to BGR
  5126. if Format in [tfRGB8, tfRGBA8] then begin
  5127. pTemp := png.ScanLine[Y];
  5128. for X := 0 to Width -1 do begin
  5129. Temp := pByteArray(pTemp)^[0];
  5130. pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
  5131. pByteArray(pTemp)^[2] := Temp;
  5132. Inc(pTemp, 3);
  5133. end;
  5134. end;
  5135. end;
  5136. // Save to Stream
  5137. Png.CompressionLevel := 6;
  5138. Png.SaveToStream(aStream);
  5139. finally
  5140. FreeAndNil(Png);
  5141. end;
  5142. end;
  5143. {$IFEND}
  5144. {$ENDIF}
  5145. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5146. //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5147. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5148. {$IFDEF GLB_LIB_JPEG}
  5149. type
  5150. glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
  5151. glBitmap_libJPEG_source_mgr = record
  5152. pub: jpeg_source_mgr;
  5153. SrcStream: TStream;
  5154. SrcBuffer: array [1..4096] of byte;
  5155. end;
  5156. glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
  5157. glBitmap_libJPEG_dest_mgr = record
  5158. pub: jpeg_destination_mgr;
  5159. DestStream: TStream;
  5160. DestBuffer: array [1..4096] of byte;
  5161. end;
  5162. procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
  5163. begin
  5164. //DUMMY
  5165. end;
  5166. procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
  5167. begin
  5168. //DUMMY
  5169. end;
  5170. procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
  5171. begin
  5172. //DUMMY
  5173. end;
  5174. procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
  5175. begin
  5176. //DUMMY
  5177. end;
  5178. procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
  5179. begin
  5180. //DUMMY
  5181. end;
  5182. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5183. function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
  5184. var
  5185. src: glBitmap_libJPEG_source_mgr_ptr;
  5186. bytes: integer;
  5187. begin
  5188. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  5189. bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
  5190. if (bytes <= 0) then begin
  5191. src^.SrcBuffer[1] := $FF;
  5192. src^.SrcBuffer[2] := JPEG_EOI;
  5193. bytes := 2;
  5194. end;
  5195. src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
  5196. src^.pub.bytes_in_buffer := bytes;
  5197. result := true;
  5198. end;
  5199. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5200. procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
  5201. var
  5202. src: glBitmap_libJPEG_source_mgr_ptr;
  5203. begin
  5204. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  5205. if num_bytes > 0 then begin
  5206. // wanted byte isn't in buffer so set stream position and read buffer
  5207. if num_bytes > src^.pub.bytes_in_buffer then begin
  5208. src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
  5209. src^.pub.fill_input_buffer(cinfo);
  5210. end else begin
  5211. // wanted byte is in buffer so only skip
  5212. inc(src^.pub.next_input_byte, num_bytes);
  5213. dec(src^.pub.bytes_in_buffer, num_bytes);
  5214. end;
  5215. end;
  5216. end;
  5217. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5218. function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
  5219. var
  5220. dest: glBitmap_libJPEG_dest_mgr_ptr;
  5221. begin
  5222. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  5223. if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
  5224. // write complete buffer
  5225. dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
  5226. // reset buffer
  5227. dest^.pub.next_output_byte := @dest^.DestBuffer[1];
  5228. dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
  5229. end;
  5230. result := true;
  5231. end;
  5232. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5233. procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
  5234. var
  5235. Idx: Integer;
  5236. dest: glBitmap_libJPEG_dest_mgr_ptr;
  5237. begin
  5238. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  5239. for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
  5240. // check for endblock
  5241. if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
  5242. // write endblock
  5243. dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
  5244. // leave
  5245. break;
  5246. end else
  5247. dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
  5248. end;
  5249. end;
  5250. {$ENDIF}
  5251. {$IFDEF GLB_SUPPORT_JPEG_READ}
  5252. {$IF DEFINED(GLB_SDL_IMAGE)}
  5253. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5254. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5255. var
  5256. Surface: PSDL_Surface;
  5257. RWops: PSDL_RWops;
  5258. begin
  5259. result := false;
  5260. RWops := glBitmapCreateRWops(aStream);
  5261. try
  5262. if IMG_isJPG(RWops) > 0 then begin
  5263. Surface := IMG_LoadJPG_RW(RWops);
  5264. try
  5265. AssignFromSurface(Surface);
  5266. result := true;
  5267. finally
  5268. SDL_FreeSurface(Surface);
  5269. end;
  5270. end;
  5271. finally
  5272. SDL_FreeRW(RWops);
  5273. end;
  5274. end;
  5275. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  5276. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5277. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5278. var
  5279. StreamPos: Int64;
  5280. Temp: array[0..1]of Byte;
  5281. jpeg: jpeg_decompress_struct;
  5282. jpeg_err: jpeg_error_mgr;
  5283. IntFormat: TglBitmapFormat;
  5284. pImage: pByte;
  5285. TempHeight, TempWidth: Integer;
  5286. pTemp: pByte;
  5287. Row: Integer;
  5288. FormatDesc: TFormatDescriptor;
  5289. begin
  5290. result := false;
  5291. if not init_libJPEG then
  5292. raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
  5293. try
  5294. // reading first two bytes to test file and set cursor back to begin
  5295. StreamPos := aStream.Position;
  5296. aStream.Read({%H-}Temp[0], 2);
  5297. aStream.Position := StreamPos;
  5298. // if Bitmap then read file.
  5299. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  5300. FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
  5301. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  5302. // error managment
  5303. jpeg.err := jpeg_std_error(@jpeg_err);
  5304. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  5305. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  5306. // decompression struct
  5307. jpeg_create_decompress(@jpeg);
  5308. // allocation space for streaming methods
  5309. jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
  5310. // seeting up custom functions
  5311. with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
  5312. pub.init_source := glBitmap_libJPEG_init_source;
  5313. pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
  5314. pub.skip_input_data := glBitmap_libJPEG_skip_input_data;
  5315. pub.resync_to_restart := jpeg_resync_to_restart; // use default method
  5316. pub.term_source := glBitmap_libJPEG_term_source;
  5317. pub.bytes_in_buffer := 0; // forces fill_input_buffer on first read
  5318. pub.next_input_byte := nil; // until buffer loaded
  5319. SrcStream := aStream;
  5320. end;
  5321. // set global decoding state
  5322. jpeg.global_state := DSTATE_START;
  5323. // read header of jpeg
  5324. jpeg_read_header(@jpeg, false);
  5325. // setting output parameter
  5326. case jpeg.jpeg_color_space of
  5327. JCS_GRAYSCALE:
  5328. begin
  5329. jpeg.out_color_space := JCS_GRAYSCALE;
  5330. IntFormat := tfLuminance8;
  5331. end;
  5332. else
  5333. jpeg.out_color_space := JCS_RGB;
  5334. IntFormat := tfRGB8;
  5335. end;
  5336. // reading image
  5337. jpeg_start_decompress(@jpeg);
  5338. TempHeight := jpeg.output_height;
  5339. TempWidth := jpeg.output_width;
  5340. FormatDesc := TFormatDescriptor.Get(IntFormat);
  5341. // creating new image
  5342. GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
  5343. try
  5344. pTemp := pImage;
  5345. for Row := 0 to TempHeight -1 do begin
  5346. jpeg_read_scanlines(@jpeg, @pTemp, 1);
  5347. Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
  5348. end;
  5349. // finish decompression
  5350. jpeg_finish_decompress(@jpeg);
  5351. // destroy decompression
  5352. jpeg_destroy_decompress(@jpeg);
  5353. SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  5354. result := true;
  5355. except
  5356. if Assigned(pImage) then
  5357. FreeMem(pImage);
  5358. raise;
  5359. end;
  5360. end;
  5361. finally
  5362. quit_libJPEG;
  5363. end;
  5364. end;
  5365. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  5366. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5367. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5368. var
  5369. bmp: TBitmap;
  5370. jpg: TJPEGImage;
  5371. StreamPos: Int64;
  5372. Temp: array[0..1]of Byte;
  5373. begin
  5374. result := false;
  5375. // reading first two bytes to test file and set cursor back to begin
  5376. StreamPos := aStream.Position;
  5377. aStream.Read(Temp[0], 2);
  5378. aStream.Position := StreamPos;
  5379. // if Bitmap then read file.
  5380. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  5381. bmp := TBitmap.Create;
  5382. try
  5383. jpg := TJPEGImage.Create;
  5384. try
  5385. jpg.LoadFromStream(aStream);
  5386. bmp.Assign(jpg);
  5387. result := AssignFromBitmap(bmp);
  5388. finally
  5389. jpg.Free;
  5390. end;
  5391. finally
  5392. bmp.Free;
  5393. end;
  5394. end;
  5395. end;
  5396. {$IFEND}
  5397. {$ENDIF}
  5398. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  5399. {$IF DEFINED(GLB_LIB_JPEG)}
  5400. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5401. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  5402. var
  5403. jpeg: jpeg_compress_struct;
  5404. jpeg_err: jpeg_error_mgr;
  5405. Row: Integer;
  5406. pTemp, pTemp2: pByte;
  5407. procedure CopyRow(pDest, pSource: pByte);
  5408. var
  5409. X: Integer;
  5410. begin
  5411. for X := 0 to Width - 1 do begin
  5412. pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
  5413. pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
  5414. pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
  5415. Inc(pDest, 3);
  5416. Inc(pSource, 3);
  5417. end;
  5418. end;
  5419. begin
  5420. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  5421. raise EglBitmapUnsupportedFormat.Create(Format);
  5422. if not init_libJPEG then
  5423. raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
  5424. try
  5425. FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
  5426. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  5427. // error managment
  5428. jpeg.err := jpeg_std_error(@jpeg_err);
  5429. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  5430. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  5431. // compression struct
  5432. jpeg_create_compress(@jpeg);
  5433. // allocation space for streaming methods
  5434. jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
  5435. // seeting up custom functions
  5436. with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
  5437. pub.init_destination := glBitmap_libJPEG_init_destination;
  5438. pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
  5439. pub.term_destination := glBitmap_libJPEG_term_destination;
  5440. pub.next_output_byte := @DestBuffer[1];
  5441. pub.free_in_buffer := Length(DestBuffer);
  5442. DestStream := aStream;
  5443. end;
  5444. // very important state
  5445. jpeg.global_state := CSTATE_START;
  5446. jpeg.image_width := Width;
  5447. jpeg.image_height := Height;
  5448. case Format of
  5449. tfAlpha8, tfLuminance8: begin
  5450. jpeg.input_components := 1;
  5451. jpeg.in_color_space := JCS_GRAYSCALE;
  5452. end;
  5453. tfRGB8, tfBGR8: begin
  5454. jpeg.input_components := 3;
  5455. jpeg.in_color_space := JCS_RGB;
  5456. end;
  5457. end;
  5458. jpeg_set_defaults(@jpeg);
  5459. jpeg_set_quality(@jpeg, 95, true);
  5460. jpeg_start_compress(@jpeg, true);
  5461. pTemp := Data;
  5462. if Format = tfBGR8 then
  5463. GetMem(pTemp2, fRowSize)
  5464. else
  5465. pTemp2 := pTemp;
  5466. try
  5467. for Row := 0 to jpeg.image_height -1 do begin
  5468. // prepare row
  5469. if Format = tfBGR8 then
  5470. CopyRow(pTemp2, pTemp)
  5471. else
  5472. pTemp2 := pTemp;
  5473. // write row
  5474. jpeg_write_scanlines(@jpeg, @pTemp2, 1);
  5475. inc(pTemp, fRowSize);
  5476. end;
  5477. finally
  5478. // free memory
  5479. if Format = tfBGR8 then
  5480. FreeMem(pTemp2);
  5481. end;
  5482. jpeg_finish_compress(@jpeg);
  5483. jpeg_destroy_compress(@jpeg);
  5484. finally
  5485. quit_libJPEG;
  5486. end;
  5487. end;
  5488. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  5489. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5490. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  5491. var
  5492. Bmp: TBitmap;
  5493. Jpg: TJPEGImage;
  5494. begin
  5495. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  5496. raise EglBitmapUnsupportedFormat.Create(Format);
  5497. Bmp := TBitmap.Create;
  5498. try
  5499. Jpg := TJPEGImage.Create;
  5500. try
  5501. AssignToBitmap(Bmp);
  5502. if (Format in [tfAlpha8, tfLuminance8]) then begin
  5503. Jpg.Grayscale := true;
  5504. Jpg.PixelFormat := jf8Bit;
  5505. end;
  5506. Jpg.Assign(Bmp);
  5507. Jpg.SaveToStream(aStream);
  5508. finally
  5509. FreeAndNil(Jpg);
  5510. end;
  5511. finally
  5512. FreeAndNil(Bmp);
  5513. end;
  5514. end;
  5515. {$IFEND}
  5516. {$ENDIF}
  5517. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5518. //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5519. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5520. const
  5521. BMP_MAGIC = $4D42;
  5522. BMP_COMP_RGB = 0;
  5523. BMP_COMP_RLE8 = 1;
  5524. BMP_COMP_RLE4 = 2;
  5525. BMP_COMP_BITFIELDS = 3;
  5526. type
  5527. TBMPHeader = packed record
  5528. bfType: Word;
  5529. bfSize: Cardinal;
  5530. bfReserved1: Word;
  5531. bfReserved2: Word;
  5532. bfOffBits: Cardinal;
  5533. end;
  5534. TBMPInfo = packed record
  5535. biSize: Cardinal;
  5536. biWidth: Longint;
  5537. biHeight: Longint;
  5538. biPlanes: Word;
  5539. biBitCount: Word;
  5540. biCompression: Cardinal;
  5541. biSizeImage: Cardinal;
  5542. biXPelsPerMeter: Longint;
  5543. biYPelsPerMeter: Longint;
  5544. biClrUsed: Cardinal;
  5545. biClrImportant: Cardinal;
  5546. end;
  5547. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5548. function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
  5549. //////////////////////////////////////////////////////////////////////////////////////////////////
  5550. function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapColorRec): TglBitmapFormat;
  5551. begin
  5552. result := tfEmpty;
  5553. aStream.Read(aInfo{%H-}, SizeOf(aInfo));
  5554. FillChar(aMask{%H-}, SizeOf(aMask), 0);
  5555. //Read Compression
  5556. case aInfo.biCompression of
  5557. BMP_COMP_RLE4,
  5558. BMP_COMP_RLE8: begin
  5559. raise EglBitmapException.Create('RLE compression is not supported');
  5560. end;
  5561. BMP_COMP_BITFIELDS: begin
  5562. if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
  5563. aStream.Read(aMask.r, SizeOf(aMask.r));
  5564. aStream.Read(aMask.g, SizeOf(aMask.g));
  5565. aStream.Read(aMask.b, SizeOf(aMask.b));
  5566. aStream.Read(aMask.a, SizeOf(aMask.a));
  5567. end else
  5568. raise EglBitmapException.Create('Bitfields are only supported for 16bit and 32bit formats');
  5569. end;
  5570. end;
  5571. //get suitable format
  5572. case aInfo.biBitCount of
  5573. 8: result := tfLuminance8;
  5574. 16: result := tfBGR5;
  5575. 24: result := tfBGR8;
  5576. 32: result := tfBGRA8;
  5577. end;
  5578. end;
  5579. function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
  5580. var
  5581. i, c: Integer;
  5582. ColorTable: TbmpColorTable;
  5583. begin
  5584. result := nil;
  5585. if (aInfo.biBitCount >= 16) then
  5586. exit;
  5587. aFormat := tfLuminance8;
  5588. c := aInfo.biClrUsed;
  5589. if (c = 0) then
  5590. c := 1 shl aInfo.biBitCount;
  5591. SetLength(ColorTable, c);
  5592. for i := 0 to c-1 do begin
  5593. aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
  5594. if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
  5595. aFormat := tfRGB8;
  5596. end;
  5597. result := TbmpColorTableFormat.Create;
  5598. result.PixelSize := aInfo.biBitCount / 8;
  5599. result.ColorTable := ColorTable;
  5600. result.Range := glBitmapColorRec($FF, $FF, $FF, $00);
  5601. end;
  5602. //////////////////////////////////////////////////////////////////////////////////////////////////
  5603. function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
  5604. const aInfo: TBMPInfo): TbmpBitfieldFormat;
  5605. var
  5606. TmpFormat: TglBitmapFormat;
  5607. FormatDesc: TFormatDescriptor;
  5608. begin
  5609. result := nil;
  5610. if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
  5611. for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  5612. FormatDesc := TFormatDescriptor.Get(TmpFormat);
  5613. if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
  5614. aFormat := FormatDesc.Format;
  5615. exit;
  5616. end;
  5617. end;
  5618. if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
  5619. aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
  5620. if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
  5621. aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
  5622. result := TbmpBitfieldFormat.Create;
  5623. result.PixelSize := aInfo.biBitCount / 8;
  5624. result.RedMask := aMask.r;
  5625. result.GreenMask := aMask.g;
  5626. result.BlueMask := aMask.b;
  5627. result.AlphaMask := aMask.a;
  5628. end;
  5629. end;
  5630. var
  5631. //simple types
  5632. StartPos: Int64;
  5633. ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
  5634. PaddingBuff: Cardinal;
  5635. LineBuf, ImageData, TmpData: PByte;
  5636. SourceMD, DestMD: Pointer;
  5637. BmpFormat: TglBitmapFormat;
  5638. //records
  5639. Mask: TglBitmapColorRec;
  5640. Header: TBMPHeader;
  5641. Info: TBMPInfo;
  5642. //classes
  5643. SpecialFormat: TFormatDescriptor;
  5644. FormatDesc: TFormatDescriptor;
  5645. //////////////////////////////////////////////////////////////////////////////////////////////////
  5646. procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
  5647. var
  5648. i: Integer;
  5649. Pixel: TglBitmapPixelData;
  5650. begin
  5651. aStream.Read(aLineBuf^, rbLineSize);
  5652. SpecialFormat.PreparePixel(Pixel);
  5653. for i := 0 to Info.biWidth-1 do begin
  5654. SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
  5655. glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
  5656. FormatDesc.Map(Pixel, aData, DestMD);
  5657. end;
  5658. end;
  5659. begin
  5660. result := false;
  5661. BmpFormat := tfEmpty;
  5662. SpecialFormat := nil;
  5663. LineBuf := nil;
  5664. SourceMD := nil;
  5665. DestMD := nil;
  5666. // Header
  5667. StartPos := aStream.Position;
  5668. aStream.Read(Header{%H-}, SizeOf(Header));
  5669. if Header.bfType = BMP_MAGIC then begin
  5670. try try
  5671. BmpFormat := ReadInfo(Info, Mask);
  5672. SpecialFormat := ReadColorTable(BmpFormat, Info);
  5673. if not Assigned(SpecialFormat) then
  5674. SpecialFormat := CheckBitfields(BmpFormat, Mask, Info);
  5675. aStream.Position := StartPos + Header.bfOffBits;
  5676. if (BmpFormat <> tfEmpty) then begin
  5677. FormatDesc := TFormatDescriptor.Get(BmpFormat);
  5678. rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
  5679. wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
  5680. Padding := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
  5681. //get Memory
  5682. DestMD := FormatDesc.CreateMappingData;
  5683. ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
  5684. GetMem(ImageData, ImageSize);
  5685. if Assigned(SpecialFormat) then begin
  5686. GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
  5687. SourceMD := SpecialFormat.CreateMappingData;
  5688. end;
  5689. //read Data
  5690. try try
  5691. FillChar(ImageData^, ImageSize, $FF);
  5692. TmpData := ImageData;
  5693. if (Info.biHeight > 0) then
  5694. Inc(TmpData, wbLineSize * (Info.biHeight-1));
  5695. for i := 0 to Abs(Info.biHeight)-1 do begin
  5696. if Assigned(SpecialFormat) then
  5697. SpecialFormatReadLine(TmpData, LineBuf) //if is special format read and convert data
  5698. else
  5699. aStream.Read(TmpData^, wbLineSize); //else only read data
  5700. if (Info.biHeight > 0) then
  5701. dec(TmpData, wbLineSize)
  5702. else
  5703. inc(TmpData, wbLineSize);
  5704. aStream.Read(PaddingBuff{%H-}, Padding);
  5705. end;
  5706. SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method
  5707. result := true;
  5708. finally
  5709. if Assigned(LineBuf) then
  5710. FreeMem(LineBuf);
  5711. if Assigned(SourceMD) then
  5712. SpecialFormat.FreeMappingData(SourceMD);
  5713. FormatDesc.FreeMappingData(DestMD);
  5714. end;
  5715. except
  5716. if Assigned(ImageData) then
  5717. FreeMem(ImageData);
  5718. raise;
  5719. end;
  5720. end else
  5721. raise EglBitmapException.Create('LoadBMP - No suitable format found');
  5722. except
  5723. aStream.Position := StartPos;
  5724. raise;
  5725. end;
  5726. finally
  5727. FreeAndNil(SpecialFormat);
  5728. end;
  5729. end
  5730. else aStream.Position := StartPos;
  5731. end;
  5732. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5733. procedure TglBitmap.SaveBMP(const aStream: TStream);
  5734. var
  5735. Header: TBMPHeader;
  5736. Info: TBMPInfo;
  5737. Converter: TbmpColorTableFormat;
  5738. FormatDesc: TFormatDescriptor;
  5739. SourceFD, DestFD: Pointer;
  5740. pData, srcData, dstData, ConvertBuffer: pByte;
  5741. Pixel: TglBitmapPixelData;
  5742. ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
  5743. RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
  5744. PaddingBuff: Cardinal;
  5745. function GetLineWidth : Integer;
  5746. begin
  5747. result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
  5748. end;
  5749. begin
  5750. if not (ftBMP in FormatGetSupportedFiles(Format)) then
  5751. raise EglBitmapUnsupportedFormat.Create(Format);
  5752. Converter := nil;
  5753. FormatDesc := TFormatDescriptor.Get(Format);
  5754. ImageSize := FormatDesc.GetSize(Dimension);
  5755. FillChar(Header{%H-}, SizeOf(Header), 0);
  5756. Header.bfType := BMP_MAGIC;
  5757. Header.bfSize := SizeOf(Header) + SizeOf(Info) + ImageSize;
  5758. Header.bfReserved1 := 0;
  5759. Header.bfReserved2 := 0;
  5760. Header.bfOffBits := SizeOf(Header) + SizeOf(Info);
  5761. FillChar(Info{%H-}, SizeOf(Info), 0);
  5762. Info.biSize := SizeOf(Info);
  5763. Info.biWidth := Width;
  5764. Info.biHeight := Height;
  5765. Info.biPlanes := 1;
  5766. Info.biCompression := BMP_COMP_RGB;
  5767. Info.biSizeImage := ImageSize;
  5768. try
  5769. case Format of
  5770. tfLuminance4: begin
  5771. Info.biBitCount := 4;
  5772. Header.bfSize := Header.bfSize + 16 * SizeOf(Cardinal);
  5773. Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
  5774. Converter := TbmpColorTableFormat.Create;
  5775. Converter.PixelSize := 0.5;
  5776. Converter.Format := Format;
  5777. Converter.Range := glBitmapColorRec($F, $F, $F, $0);
  5778. Converter.CreateColorTable;
  5779. end;
  5780. tfR3G3B2, tfLuminance8: begin
  5781. Info.biBitCount := 8;
  5782. Header.bfSize := Header.bfSize + 256 * SizeOf(Cardinal);
  5783. Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
  5784. Converter := TbmpColorTableFormat.Create;
  5785. Converter.PixelSize := 1;
  5786. Converter.Format := Format;
  5787. if (Format = tfR3G3B2) then begin
  5788. Converter.Range := glBitmapColorRec($7, $7, $3, $0);
  5789. Converter.Shift := glBitmapShiftRec(0, 3, 6, 0);
  5790. end else
  5791. Converter.Range := glBitmapColorRec($FF, $FF, $FF, $0);
  5792. Converter.CreateColorTable;
  5793. end;
  5794. tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
  5795. tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin
  5796. Info.biBitCount := 16;
  5797. Info.biCompression := BMP_COMP_BITFIELDS;
  5798. end;
  5799. tfBGR8, tfRGB8: begin
  5800. Info.biBitCount := 24;
  5801. end;
  5802. tfRGB10, tfRGB10A2, tfRGBA8,
  5803. tfBGR10, tfBGR10A2, tfBGRA8: begin
  5804. Info.biBitCount := 32;
  5805. Info.biCompression := BMP_COMP_BITFIELDS;
  5806. end;
  5807. else
  5808. raise EglBitmapUnsupportedFormat.Create(Format);
  5809. end;
  5810. Info.biXPelsPerMeter := 2835;
  5811. Info.biYPelsPerMeter := 2835;
  5812. // prepare bitmasks
  5813. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  5814. Header.bfSize := Header.bfSize + 4 * SizeOf(Cardinal);
  5815. Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
  5816. RedMask := FormatDesc.RedMask;
  5817. GreenMask := FormatDesc.GreenMask;
  5818. BlueMask := FormatDesc.BlueMask;
  5819. AlphaMask := FormatDesc.AlphaMask;
  5820. end;
  5821. // headers
  5822. aStream.Write(Header, SizeOf(Header));
  5823. aStream.Write(Info, SizeOf(Info));
  5824. // colortable
  5825. if Assigned(Converter) then
  5826. aStream.Write(Converter.ColorTable[0].b,
  5827. SizeOf(TbmpColorTableEnty) * Length(Converter.ColorTable));
  5828. // bitmasks
  5829. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  5830. aStream.Write(RedMask, SizeOf(Cardinal));
  5831. aStream.Write(GreenMask, SizeOf(Cardinal));
  5832. aStream.Write(BlueMask, SizeOf(Cardinal));
  5833. aStream.Write(AlphaMask, SizeOf(Cardinal));
  5834. end;
  5835. // image data
  5836. rbLineSize := Round(Info.biWidth * FormatDesc.PixelSize);
  5837. wbLineSize := Round(Info.biWidth * Info.biBitCount / 8);
  5838. Padding := GetLineWidth - wbLineSize;
  5839. PaddingBuff := 0;
  5840. pData := Data;
  5841. inc(pData, (Height-1) * rbLineSize);
  5842. // prepare row buffer. But only for RGB because RGBA supports color masks
  5843. // so it's possible to change color within the image.
  5844. if Assigned(Converter) then begin
  5845. FormatDesc.PreparePixel(Pixel);
  5846. GetMem(ConvertBuffer, wbLineSize);
  5847. SourceFD := FormatDesc.CreateMappingData;
  5848. DestFD := Converter.CreateMappingData;
  5849. end else
  5850. ConvertBuffer := nil;
  5851. try
  5852. for LineIdx := 0 to Height - 1 do begin
  5853. // preparing row
  5854. if Assigned(Converter) then begin
  5855. srcData := pData;
  5856. dstData := ConvertBuffer;
  5857. for PixelIdx := 0 to Info.biWidth-1 do begin
  5858. FormatDesc.Unmap(srcData, Pixel, SourceFD);
  5859. glBitmapConvertPixel(Pixel, FormatDesc, Converter);
  5860. Converter.Map(Pixel, dstData, DestFD);
  5861. end;
  5862. aStream.Write(ConvertBuffer^, wbLineSize);
  5863. end else begin
  5864. aStream.Write(pData^, rbLineSize);
  5865. end;
  5866. dec(pData, rbLineSize);
  5867. if (Padding > 0) then
  5868. aStream.Write(PaddingBuff, Padding);
  5869. end;
  5870. finally
  5871. // destroy row buffer
  5872. if Assigned(ConvertBuffer) then begin
  5873. FormatDesc.FreeMappingData(SourceFD);
  5874. Converter.FreeMappingData(DestFD);
  5875. FreeMem(ConvertBuffer);
  5876. end;
  5877. end;
  5878. finally
  5879. if Assigned(Converter) then
  5880. Converter.Free;
  5881. end;
  5882. end;
  5883. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5884. //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5885. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5886. type
  5887. TTGAHeader = packed record
  5888. ImageID: Byte;
  5889. ColorMapType: Byte;
  5890. ImageType: Byte;
  5891. //ColorMapSpec: Array[0..4] of Byte;
  5892. ColorMapStart: Word;
  5893. ColorMapLength: Word;
  5894. ColorMapEntrySize: Byte;
  5895. OrigX: Word;
  5896. OrigY: Word;
  5897. Width: Word;
  5898. Height: Word;
  5899. Bpp: Byte;
  5900. ImageDesc: Byte;
  5901. end;
  5902. const
  5903. TGA_UNCOMPRESSED_RGB = 2;
  5904. TGA_UNCOMPRESSED_GRAY = 3;
  5905. TGA_COMPRESSED_RGB = 10;
  5906. TGA_COMPRESSED_GRAY = 11;
  5907. TGA_NONE_COLOR_TABLE = 0;
  5908. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5909. function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
  5910. var
  5911. Header: TTGAHeader;
  5912. ImageData: System.PByte;
  5913. StartPosition: Int64;
  5914. PixelSize, LineSize: Integer;
  5915. tgaFormat: TglBitmapFormat;
  5916. FormatDesc: TFormatDescriptor;
  5917. Counter: packed record
  5918. X, Y: packed record
  5919. low, high, dir: Integer;
  5920. end;
  5921. end;
  5922. const
  5923. CACHE_SIZE = $4000;
  5924. ////////////////////////////////////////////////////////////////////////////////////////
  5925. procedure ReadUncompressed;
  5926. var
  5927. i, j: Integer;
  5928. buf, tmp1, tmp2: System.PByte;
  5929. begin
  5930. buf := nil;
  5931. if (Counter.X.dir < 0) then
  5932. GetMem(buf, LineSize);
  5933. try
  5934. while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
  5935. tmp1 := ImageData;
  5936. inc(tmp1, (Counter.Y.low * LineSize)); //pointer to LineStart
  5937. if (Counter.X.dir < 0) then begin //flip X
  5938. aStream.Read(buf^, LineSize);
  5939. tmp2 := buf;
  5940. inc(tmp2, LineSize - PixelSize); //pointer to last pixel in line
  5941. for i := 0 to Header.Width-1 do begin //for all pixels in line
  5942. for j := 0 to PixelSize-1 do begin //for all bytes in pixel
  5943. tmp1^ := tmp2^;
  5944. inc(tmp1);
  5945. inc(tmp2);
  5946. end;
  5947. dec(tmp2, 2*PixelSize); //move 2 backwards, because j-loop moved 1 forward
  5948. end;
  5949. end else
  5950. aStream.Read(tmp1^, LineSize);
  5951. inc(Counter.Y.low, Counter.Y.dir); //move to next line index
  5952. end;
  5953. finally
  5954. if Assigned(buf) then
  5955. FreeMem(buf);
  5956. end;
  5957. end;
  5958. ////////////////////////////////////////////////////////////////////////////////////////
  5959. procedure ReadCompressed;
  5960. /////////////////////////////////////////////////////////////////
  5961. var
  5962. TmpData: System.PByte;
  5963. LinePixelsRead: Integer;
  5964. procedure CheckLine;
  5965. begin
  5966. if (LinePixelsRead >= Header.Width) then begin
  5967. LinePixelsRead := 0;
  5968. inc(Counter.Y.low, Counter.Y.dir); //next line index
  5969. TmpData := ImageData;
  5970. inc(TmpData, Counter.Y.low * LineSize); //set line
  5971. if (Counter.X.dir < 0) then //if x flipped then
  5972. inc(TmpData, LineSize - PixelSize); //set last pixel
  5973. end;
  5974. end;
  5975. /////////////////////////////////////////////////////////////////
  5976. var
  5977. Cache: PByte;
  5978. CacheSize, CachePos: Integer;
  5979. procedure CachedRead(out Buffer; Count: Integer);
  5980. var
  5981. BytesRead: Integer;
  5982. begin
  5983. if (CachePos + Count > CacheSize) then begin
  5984. //if buffer overflow save non read bytes
  5985. BytesRead := 0;
  5986. if (CacheSize - CachePos > 0) then begin
  5987. BytesRead := CacheSize - CachePos;
  5988. Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
  5989. inc(CachePos, BytesRead);
  5990. end;
  5991. //load cache from file
  5992. CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
  5993. aStream.Read(Cache^, CacheSize);
  5994. CachePos := 0;
  5995. //read rest of requested bytes
  5996. if (Count - BytesRead > 0) then begin
  5997. Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
  5998. inc(CachePos, Count - BytesRead);
  5999. end;
  6000. end else begin
  6001. //if no buffer overflow just read the data
  6002. Move(PByteArray(Cache)^[CachePos], Buffer, Count);
  6003. inc(CachePos, Count);
  6004. end;
  6005. end;
  6006. procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
  6007. begin
  6008. case PixelSize of
  6009. 1: begin
  6010. aBuffer^ := aData^;
  6011. inc(aBuffer, Counter.X.dir);
  6012. end;
  6013. 2: begin
  6014. PWord(aBuffer)^ := PWord(aData)^;
  6015. inc(aBuffer, 2 * Counter.X.dir);
  6016. end;
  6017. 3: begin
  6018. PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
  6019. PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
  6020. PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
  6021. inc(aBuffer, 3 * Counter.X.dir);
  6022. end;
  6023. 4: begin
  6024. PCardinal(aBuffer)^ := PCardinal(aData)^;
  6025. inc(aBuffer, 4 * Counter.X.dir);
  6026. end;
  6027. end;
  6028. end;
  6029. var
  6030. TotalPixelsToRead, TotalPixelsRead: Integer;
  6031. Temp: Byte;
  6032. buf: array [0..3] of Byte; //1 pixel is max 32bit long
  6033. PixelRepeat: Boolean;
  6034. PixelsToRead, PixelCount: Integer;
  6035. begin
  6036. CacheSize := 0;
  6037. CachePos := 0;
  6038. TotalPixelsToRead := Header.Width * Header.Height;
  6039. TotalPixelsRead := 0;
  6040. LinePixelsRead := 0;
  6041. GetMem(Cache, CACHE_SIZE);
  6042. try
  6043. TmpData := ImageData;
  6044. inc(TmpData, Counter.Y.low * LineSize); //set line
  6045. if (Counter.X.dir < 0) then //if x flipped then
  6046. inc(TmpData, LineSize - PixelSize); //set last pixel
  6047. repeat
  6048. //read CommandByte
  6049. CachedRead(Temp, 1);
  6050. PixelRepeat := (Temp and $80) > 0;
  6051. PixelsToRead := (Temp and $7F) + 1;
  6052. inc(TotalPixelsRead, PixelsToRead);
  6053. if PixelRepeat then
  6054. CachedRead(buf[0], PixelSize);
  6055. while (PixelsToRead > 0) do begin
  6056. CheckLine;
  6057. PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
  6058. while (PixelCount > 0) do begin
  6059. if not PixelRepeat then
  6060. CachedRead(buf[0], PixelSize);
  6061. PixelToBuffer(@buf[0], TmpData);
  6062. inc(LinePixelsRead);
  6063. dec(PixelsToRead);
  6064. dec(PixelCount);
  6065. end;
  6066. end;
  6067. until (TotalPixelsRead >= TotalPixelsToRead);
  6068. finally
  6069. FreeMem(Cache);
  6070. end;
  6071. end;
  6072. function IsGrayFormat: Boolean;
  6073. begin
  6074. result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
  6075. end;
  6076. begin
  6077. result := false;
  6078. // reading header to test file and set cursor back to begin
  6079. StartPosition := aStream.Position;
  6080. aStream.Read(Header{%H-}, SizeOf(Header));
  6081. // no colormapped files
  6082. if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
  6083. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
  6084. begin
  6085. try
  6086. if Header.ImageID <> 0 then // skip image ID
  6087. aStream.Position := aStream.Position + Header.ImageID;
  6088. tgaFormat := tfEmpty;
  6089. case Header.Bpp of
  6090. 8: if IsGrayFormat then case (Header.ImageDesc and $F) of
  6091. 0: tgaFormat := tfLuminance8;
  6092. 8: tgaFormat := tfAlpha8;
  6093. end;
  6094. 16: if IsGrayFormat then case (Header.ImageDesc and $F) of
  6095. 0: tgaFormat := tfLuminance16;
  6096. 8: tgaFormat := tfLuminance8Alpha8;
  6097. end else case (Header.ImageDesc and $F) of
  6098. 0: tgaFormat := tfBGR5;
  6099. 1: tgaFormat := tfBGR5A1;
  6100. 4: tgaFormat := tfBGRA4;
  6101. end;
  6102. 24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  6103. 0: tgaFormat := tfBGR8;
  6104. end;
  6105. 32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  6106. 2: tgaFormat := tfBGR10A2;
  6107. 8: tgaFormat := tfBGRA8;
  6108. end;
  6109. end;
  6110. if (tgaFormat = tfEmpty) then
  6111. raise EglBitmapException.Create('LoadTga - unsupported format');
  6112. FormatDesc := TFormatDescriptor.Get(tgaFormat);
  6113. PixelSize := FormatDesc.GetSize(1, 1);
  6114. LineSize := FormatDesc.GetSize(Header.Width, 1);
  6115. GetMem(ImageData, LineSize * Header.Height);
  6116. try
  6117. //column direction
  6118. if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
  6119. Counter.X.low := Header.Height-1;;
  6120. Counter.X.high := 0;
  6121. Counter.X.dir := -1;
  6122. end else begin
  6123. Counter.X.low := 0;
  6124. Counter.X.high := Header.Height-1;
  6125. Counter.X.dir := 1;
  6126. end;
  6127. // Row direction
  6128. if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
  6129. Counter.Y.low := 0;
  6130. Counter.Y.high := Header.Height-1;
  6131. Counter.Y.dir := 1;
  6132. end else begin
  6133. Counter.Y.low := Header.Height-1;;
  6134. Counter.Y.high := 0;
  6135. Counter.Y.dir := -1;
  6136. end;
  6137. // Read Image
  6138. case Header.ImageType of
  6139. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
  6140. ReadUncompressed;
  6141. TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
  6142. ReadCompressed;
  6143. end;
  6144. SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method
  6145. result := true;
  6146. except
  6147. if Assigned(ImageData) then
  6148. FreeMem(ImageData);
  6149. raise;
  6150. end;
  6151. finally
  6152. aStream.Position := StartPosition;
  6153. end;
  6154. end
  6155. else aStream.Position := StartPosition;
  6156. end;
  6157. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6158. procedure TglBitmap.SaveTGA(const aStream: TStream);
  6159. var
  6160. Header: TTGAHeader;
  6161. LineSize, Size, x, y: Integer;
  6162. Pixel: TglBitmapPixelData;
  6163. LineBuf, SourceData, DestData: PByte;
  6164. SourceMD, DestMD: Pointer;
  6165. FormatDesc: TFormatDescriptor;
  6166. Converter: TFormatDescriptor;
  6167. begin
  6168. if not (ftTGA in FormatGetSupportedFiles(Format)) then
  6169. raise EglBitmapUnsupportedFormat.Create(Format);
  6170. //prepare header
  6171. FillChar(Header{%H-}, SizeOf(Header), 0);
  6172. //set ImageType
  6173. if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
  6174. tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
  6175. Header.ImageType := TGA_UNCOMPRESSED_GRAY
  6176. else
  6177. Header.ImageType := TGA_UNCOMPRESSED_RGB;
  6178. //set BitsPerPixel
  6179. if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
  6180. Header.Bpp := 8
  6181. else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
  6182. tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
  6183. Header.Bpp := 16
  6184. else if (Format in [tfBGR8, tfRGB8]) then
  6185. Header.Bpp := 24
  6186. else
  6187. Header.Bpp := 32;
  6188. //set AlphaBitCount
  6189. case Format of
  6190. tfRGB5A1, tfBGR5A1:
  6191. Header.ImageDesc := 1 and $F;
  6192. tfRGB10A2, tfBGR10A2:
  6193. Header.ImageDesc := 2 and $F;
  6194. tfRGBA4, tfBGRA4:
  6195. Header.ImageDesc := 4 and $F;
  6196. tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
  6197. Header.ImageDesc := 8 and $F;
  6198. end;
  6199. Header.Width := Width;
  6200. Header.Height := Height;
  6201. Header.ImageDesc := Header.ImageDesc or $20; //flip y
  6202. aStream.Write(Header, SizeOf(Header));
  6203. // convert RGB(A) to BGR(A)
  6204. Converter := nil;
  6205. FormatDesc := TFormatDescriptor.Get(Format);
  6206. Size := FormatDesc.GetSize(Dimension);
  6207. if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
  6208. if (FormatDesc.RGBInverted = tfEmpty) then
  6209. raise EglBitmapException.Create('inverted RGB format is empty');
  6210. Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
  6211. if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
  6212. (Converter.PixelSize <> FormatDesc.PixelSize) then
  6213. raise EglBitmapException.Create('invalid inverted RGB format');
  6214. end;
  6215. if Assigned(Converter) then begin
  6216. LineSize := FormatDesc.GetSize(Width, 1);
  6217. GetMem(LineBuf, LineSize);
  6218. SourceMD := FormatDesc.CreateMappingData;
  6219. DestMD := Converter.CreateMappingData;
  6220. try
  6221. SourceData := Data;
  6222. for y := 0 to Height-1 do begin
  6223. DestData := LineBuf;
  6224. for x := 0 to Width-1 do begin
  6225. FormatDesc.Unmap(SourceData, Pixel, SourceMD);
  6226. Converter.Map(Pixel, DestData, DestMD);
  6227. end;
  6228. aStream.Write(LineBuf^, LineSize);
  6229. end;
  6230. finally
  6231. FreeMem(LineBuf);
  6232. FormatDesc.FreeMappingData(SourceMD);
  6233. FormatDesc.FreeMappingData(DestMD);
  6234. end;
  6235. end else
  6236. aStream.Write(Data^, Size);
  6237. end;
  6238. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6239. //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6240. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6241. const
  6242. DDS_MAGIC: Cardinal = $20534444;
  6243. // DDS_header.dwFlags
  6244. DDSD_CAPS = $00000001;
  6245. DDSD_HEIGHT = $00000002;
  6246. DDSD_WIDTH = $00000004;
  6247. DDSD_PIXELFORMAT = $00001000;
  6248. // DDS_header.sPixelFormat.dwFlags
  6249. DDPF_ALPHAPIXELS = $00000001;
  6250. DDPF_ALPHA = $00000002;
  6251. DDPF_FOURCC = $00000004;
  6252. DDPF_RGB = $00000040;
  6253. DDPF_LUMINANCE = $00020000;
  6254. // DDS_header.sCaps.dwCaps1
  6255. DDSCAPS_TEXTURE = $00001000;
  6256. // DDS_header.sCaps.dwCaps2
  6257. DDSCAPS2_CUBEMAP = $00000200;
  6258. D3DFMT_DXT1 = $31545844;
  6259. D3DFMT_DXT3 = $33545844;
  6260. D3DFMT_DXT5 = $35545844;
  6261. type
  6262. TDDSPixelFormat = packed record
  6263. dwSize: Cardinal;
  6264. dwFlags: Cardinal;
  6265. dwFourCC: Cardinal;
  6266. dwRGBBitCount: Cardinal;
  6267. dwRBitMask: Cardinal;
  6268. dwGBitMask: Cardinal;
  6269. dwBBitMask: Cardinal;
  6270. dwABitMask: Cardinal;
  6271. end;
  6272. TDDSCaps = packed record
  6273. dwCaps1: Cardinal;
  6274. dwCaps2: Cardinal;
  6275. dwDDSX: Cardinal;
  6276. dwReserved: Cardinal;
  6277. end;
  6278. TDDSHeader = packed record
  6279. dwSize: Cardinal;
  6280. dwFlags: Cardinal;
  6281. dwHeight: Cardinal;
  6282. dwWidth: Cardinal;
  6283. dwPitchOrLinearSize: Cardinal;
  6284. dwDepth: Cardinal;
  6285. dwMipMapCount: Cardinal;
  6286. dwReserved: array[0..10] of Cardinal;
  6287. PixelFormat: TDDSPixelFormat;
  6288. Caps: TDDSCaps;
  6289. dwReserved2: Cardinal;
  6290. end;
  6291. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6292. function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
  6293. var
  6294. Header: TDDSHeader;
  6295. Converter: TbmpBitfieldFormat;
  6296. function GetDDSFormat: TglBitmapFormat;
  6297. var
  6298. fd: TFormatDescriptor;
  6299. i: Integer;
  6300. Range: TglBitmapColorRec;
  6301. match: Boolean;
  6302. begin
  6303. result := tfEmpty;
  6304. with Header.PixelFormat do begin
  6305. // Compresses
  6306. if ((dwFlags and DDPF_FOURCC) > 0) then begin
  6307. case Header.PixelFormat.dwFourCC of
  6308. D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
  6309. D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
  6310. D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
  6311. end;
  6312. end else if ((Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin
  6313. //find matching format
  6314. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  6315. fd := TFormatDescriptor.Get(result);
  6316. if fd.MaskMatch(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask) and
  6317. (8 * fd.PixelSize = dwRGBBitCount) then
  6318. exit;
  6319. end;
  6320. //find format with same Range
  6321. Range.r := dwRBitMask;
  6322. Range.g := dwGBitMask;
  6323. Range.b := dwBBitMask;
  6324. Range.a := dwABitMask;
  6325. for i := 0 to 3 do begin
  6326. while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do
  6327. Range.arr[i] := Range.arr[i] shr 1;
  6328. end;
  6329. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  6330. fd := TFormatDescriptor.Get(result);
  6331. match := true;
  6332. for i := 0 to 3 do
  6333. if (fd.Range.arr[i] <> Range.arr[i]) then begin
  6334. match := false;
  6335. break;
  6336. end;
  6337. if match then
  6338. break;
  6339. end;
  6340. //no format with same range found -> use default
  6341. if (result = tfEmpty) then begin
  6342. if (dwABitMask > 0) then
  6343. result := tfBGRA8
  6344. else
  6345. result := tfBGR8;
  6346. end;
  6347. Converter := TbmpBitfieldFormat.Create;
  6348. Converter.RedMask := dwRBitMask;
  6349. Converter.GreenMask := dwGBitMask;
  6350. Converter.BlueMask := dwBBitMask;
  6351. Converter.AlphaMask := dwABitMask;
  6352. Converter.PixelSize := dwRGBBitCount / 8;
  6353. end;
  6354. end;
  6355. end;
  6356. var
  6357. StreamPos: Int64;
  6358. x, y, LineSize, RowSize, Magic: Cardinal;
  6359. NewImage, TmpData, RowData, SrcData: System.PByte;
  6360. SourceMD, DestMD: Pointer;
  6361. Pixel: TglBitmapPixelData;
  6362. ddsFormat: TglBitmapFormat;
  6363. FormatDesc: TFormatDescriptor;
  6364. begin
  6365. result := false;
  6366. Converter := nil;
  6367. StreamPos := aStream.Position;
  6368. // Magic
  6369. aStream.Read(Magic{%H-}, sizeof(Magic));
  6370. if (Magic <> DDS_MAGIC) then begin
  6371. aStream.Position := StreamPos;
  6372. exit;
  6373. end;
  6374. //Header
  6375. aStream.Read(Header{%H-}, sizeof(Header));
  6376. if (Header.dwSize <> SizeOf(Header)) or
  6377. ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
  6378. (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
  6379. begin
  6380. aStream.Position := StreamPos;
  6381. exit;
  6382. end;
  6383. if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
  6384. raise EglBitmapException.Create('LoadDDS - CubeMaps are not supported');
  6385. ddsFormat := GetDDSFormat;
  6386. try
  6387. if (ddsFormat = tfEmpty) then
  6388. raise EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');
  6389. FormatDesc := TFormatDescriptor.Get(ddsFormat);
  6390. LineSize := Trunc(Header.dwWidth * FormatDesc.PixelSize);
  6391. GetMem(NewImage, Header.dwHeight * LineSize);
  6392. try
  6393. TmpData := NewImage;
  6394. //Converter needed
  6395. if Assigned(Converter) then begin
  6396. RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
  6397. GetMem(RowData, RowSize);
  6398. SourceMD := Converter.CreateMappingData;
  6399. DestMD := FormatDesc.CreateMappingData;
  6400. try
  6401. for y := 0 to Header.dwHeight-1 do begin
  6402. TmpData := NewImage;
  6403. inc(TmpData, y * LineSize);
  6404. SrcData := RowData;
  6405. aStream.Read(SrcData^, RowSize);
  6406. for x := 0 to Header.dwWidth-1 do begin
  6407. Converter.Unmap(SrcData, Pixel, SourceMD);
  6408. glBitmapConvertPixel(Pixel, Converter, FormatDesc);
  6409. FormatDesc.Map(Pixel, TmpData, DestMD);
  6410. end;
  6411. end;
  6412. finally
  6413. Converter.FreeMappingData(SourceMD);
  6414. FormatDesc.FreeMappingData(DestMD);
  6415. FreeMem(RowData);
  6416. end;
  6417. end else
  6418. // Compressed
  6419. if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
  6420. RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
  6421. for Y := 0 to Header.dwHeight-1 do begin
  6422. aStream.Read(TmpData^, RowSize);
  6423. Inc(TmpData, LineSize);
  6424. end;
  6425. end else
  6426. // Uncompressed
  6427. if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
  6428. RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
  6429. for Y := 0 to Header.dwHeight-1 do begin
  6430. aStream.Read(TmpData^, RowSize);
  6431. Inc(TmpData, LineSize);
  6432. end;
  6433. end else
  6434. raise EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');
  6435. SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method
  6436. result := true;
  6437. except
  6438. if Assigned(NewImage) then
  6439. FreeMem(NewImage);
  6440. raise;
  6441. end;
  6442. finally
  6443. FreeAndNil(Converter);
  6444. end;
  6445. end;
  6446. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6447. procedure TglBitmap.SaveDDS(const aStream: TStream);
  6448. var
  6449. Header: TDDSHeader;
  6450. FormatDesc: TFormatDescriptor;
  6451. begin
  6452. if not (ftDDS in FormatGetSupportedFiles(Format)) then
  6453. raise EglBitmapUnsupportedFormat.Create(Format);
  6454. FormatDesc := TFormatDescriptor.Get(Format);
  6455. // Generell
  6456. FillChar(Header{%H-}, SizeOf(Header), 0);
  6457. Header.dwSize := SizeOf(Header);
  6458. Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
  6459. Header.dwWidth := Max(1, Width);
  6460. Header.dwHeight := Max(1, Height);
  6461. // Caps
  6462. Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
  6463. // Pixelformat
  6464. Header.PixelFormat.dwSize := sizeof(Header);
  6465. if (FormatDesc.IsCompressed) then begin
  6466. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
  6467. case Format of
  6468. tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
  6469. tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
  6470. tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
  6471. end;
  6472. end else if (Format in [tfAlpha8, tfAlpha16]) then begin
  6473. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHA;
  6474. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6475. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6476. end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
  6477. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
  6478. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6479. Header.PixelFormat.dwRBitMask := FormatDesc.RedMask;
  6480. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6481. end else begin
  6482. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
  6483. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6484. Header.PixelFormat.dwRBitMask := FormatDesc.RedMask;
  6485. Header.PixelFormat.dwGBitMask := FormatDesc.GreenMask;
  6486. Header.PixelFormat.dwBBitMask := FormatDesc.BlueMask;
  6487. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6488. end;
  6489. if (FormatDesc.HasAlpha) then
  6490. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
  6491. aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
  6492. aStream.Write(Header, SizeOf(Header));
  6493. aStream.Write(Data^, FormatDesc.GetSize(Dimension));
  6494. end;
  6495. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6496. //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6497. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6498. procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  6499. const aWidth: Integer; const aHeight: Integer);
  6500. var
  6501. pTemp: pByte;
  6502. Size: Integer;
  6503. begin
  6504. if (aHeight > 1) then begin
  6505. Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);
  6506. GetMem(pTemp, Size);
  6507. try
  6508. Move(aData^, pTemp^, Size);
  6509. FreeMem(aData);
  6510. aData := nil;
  6511. except
  6512. FreeMem(pTemp);
  6513. raise;
  6514. end;
  6515. end else
  6516. pTemp := aData;
  6517. inherited SetDataPointer(pTemp, aFormat, aWidth);
  6518. end;
  6519. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6520. function TglBitmap1D.FlipHorz: Boolean;
  6521. var
  6522. Col: Integer;
  6523. pTempDest, pDest, pSource: PByte;
  6524. begin
  6525. result := inherited FlipHorz;
  6526. if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin
  6527. pSource := Data;
  6528. GetMem(pDest, fRowSize);
  6529. try
  6530. pTempDest := pDest;
  6531. Inc(pTempDest, fRowSize);
  6532. for Col := 0 to Width-1 do begin
  6533. dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data
  6534. Move(pSource^, pTempDest^, fPixelSize);
  6535. Inc(pSource, fPixelSize);
  6536. end;
  6537. SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method
  6538. result := true;
  6539. except
  6540. if Assigned(pDest) then
  6541. FreeMem(pDest);
  6542. raise;
  6543. end;
  6544. end;
  6545. end;
  6546. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6547. procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);
  6548. var
  6549. FormatDesc: TFormatDescriptor;
  6550. begin
  6551. // Upload data
  6552. FormatDesc := TFormatDescriptor.Get(Format);
  6553. if FormatDesc.IsCompressed then
  6554. glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)
  6555. else if aBuildWithGlu then
  6556. gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  6557. else
  6558. glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  6559. // Free Data
  6560. if (FreeDataAfterGenTexture) then
  6561. FreeData;
  6562. end;
  6563. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6564. procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);
  6565. var
  6566. BuildWithGlu, TexRec: Boolean;
  6567. TexSize: Integer;
  6568. begin
  6569. if Assigned(Data) then begin
  6570. // Check Texture Size
  6571. if (aTestTextureSize) then begin
  6572. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  6573. if (Width > TexSize) then
  6574. raise EglBitmapSizeToLargeException.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  6575. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
  6576. (Target = GL_TEXTURE_RECTANGLE_ARB);
  6577. if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  6578. raise EglBitmapNonPowerOfTwoException.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  6579. end;
  6580. CreateId;
  6581. SetupParameters(BuildWithGlu);
  6582. UploadData(BuildWithGlu);
  6583. glAreTexturesResident(1, @fID, @fIsResident);
  6584. end;
  6585. end;
  6586. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6587. procedure TglBitmap1D.AfterConstruction;
  6588. begin
  6589. inherited;
  6590. Target := GL_TEXTURE_1D;
  6591. end;
  6592. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6593. //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6594. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6595. function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
  6596. begin
  6597. if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
  6598. result := fLines[aIndex]
  6599. else
  6600. result := nil;
  6601. end;
  6602. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6603. procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;
  6604. const aWidth: Integer; const aHeight: Integer);
  6605. var
  6606. Idx, LineWidth: Integer;
  6607. begin
  6608. inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
  6609. if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
  6610. // Assigning Data
  6611. if Assigned(Data) then begin
  6612. SetLength(fLines, GetHeight);
  6613. LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
  6614. for Idx := 0 to GetHeight-1 do begin
  6615. fLines[Idx] := Data;
  6616. Inc(fLines[Idx], Idx * LineWidth);
  6617. end;
  6618. end
  6619. else SetLength(fLines, 0);
  6620. end else begin
  6621. SetLength(fLines, 0);
  6622. end;
  6623. end;
  6624. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6625. procedure TglBitmap2D.UploadData(const aBuildWithGlu: Boolean);
  6626. var
  6627. FormatDesc: TFormatDescriptor;
  6628. begin
  6629. glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
  6630. FormatDesc := TFormatDescriptor.Get(Format);
  6631. if FormatDesc.IsCompressed then begin
  6632. glCompressedTexImage2D(Target, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
  6633. end else if aBuildWithGlu then begin
  6634. gluBuild2DMipmaps(Target, FormatDesc.Components, Width, Height,
  6635. FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  6636. end else begin
  6637. glTexImage2D(Target, 0, FormatDesc.glInternalFormat, Width, Height, 0,
  6638. FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  6639. end;
  6640. // Freigeben
  6641. if (FreeDataAfterGenTexture) then
  6642. FreeData;
  6643. end;
  6644. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6645. procedure TglBitmap2D.AfterConstruction;
  6646. begin
  6647. inherited;
  6648. Target := GL_TEXTURE_2D;
  6649. end;
  6650. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6651. procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  6652. var
  6653. Temp: pByte;
  6654. Size, w, h: Integer;
  6655. FormatDesc: TFormatDescriptor;
  6656. begin
  6657. FormatDesc := TFormatDescriptor.Get(Format);
  6658. if FormatDesc.IsCompressed then
  6659. raise EglBitmapUnsupportedFormat.Create(Format);
  6660. w := aRight - aLeft;
  6661. h := aBottom - aTop;
  6662. Size := FormatDesc.GetSize(w, h);
  6663. GetMem(Temp, Size);
  6664. try
  6665. glPixelStorei(GL_PACK_ALIGNMENT, 1);
  6666. glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  6667. SetDataPointer(Temp, Format, w, h); //be careful, Data could be freed by this method
  6668. FlipVert;
  6669. except
  6670. if Assigned(Temp) then
  6671. FreeMem(Temp);
  6672. raise;
  6673. end;
  6674. end;
  6675. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6676. procedure TglBitmap2D.GetDataFromTexture;
  6677. var
  6678. Temp: PByte;
  6679. TempWidth, TempHeight: Integer;
  6680. TempIntFormat: Cardinal;
  6681. IntFormat, f: TglBitmapFormat;
  6682. FormatDesc: TFormatDescriptor;
  6683. begin
  6684. Bind;
  6685. // Request Data
  6686. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH, @TempWidth);
  6687. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT, @TempHeight);
  6688. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
  6689. IntFormat := tfEmpty;
  6690. for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
  6691. FormatDesc := TFormatDescriptor.Get(f);
  6692. if (FormatDesc.glInternalFormat = TempIntFormat) then begin
  6693. IntFormat := FormatDesc.Format;
  6694. break;
  6695. end;
  6696. end;
  6697. // Getting data from OpenGL
  6698. FormatDesc := TFormatDescriptor.Get(IntFormat);
  6699. GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
  6700. try
  6701. if FormatDesc.IsCompressed then
  6702. glGetCompressedTexImage(Target, 0, Temp)
  6703. else
  6704. glGetTexImage(Target, 0, FormatDesc.glInternalFormat, FormatDesc.glDataFormat, Temp);
  6705. SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method
  6706. except
  6707. if Assigned(Temp) then
  6708. FreeMem(Temp);
  6709. raise;
  6710. end;
  6711. end;
  6712. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6713. procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
  6714. var
  6715. BuildWithGlu, PotTex, TexRec: Boolean;
  6716. TexSize: Integer;
  6717. begin
  6718. if Assigned(Data) then begin
  6719. // Check Texture Size
  6720. if (aTestTextureSize) then begin
  6721. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  6722. if ((Height > TexSize) or (Width > TexSize)) then
  6723. raise EglBitmapSizeToLargeException.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  6724. PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
  6725. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
  6726. if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  6727. raise EglBitmapNonPowerOfTwoException.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  6728. end;
  6729. CreateId;
  6730. SetupParameters(BuildWithGlu);
  6731. UploadData(BuildWithGlu);
  6732. glAreTexturesResident(1, @fID, @fIsResident);
  6733. end;
  6734. end;
  6735. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6736. function TglBitmap2D.FlipHorz: Boolean;
  6737. var
  6738. Col, Row: Integer;
  6739. TempDestData, DestData, SourceData: PByte;
  6740. ImgSize: Integer;
  6741. begin
  6742. result := inherited FlipHorz;
  6743. if Assigned(Data) then begin
  6744. SourceData := Data;
  6745. ImgSize := Height * fRowSize;
  6746. GetMem(DestData, ImgSize);
  6747. try
  6748. TempDestData := DestData;
  6749. Dec(TempDestData, fRowSize + fPixelSize);
  6750. for Row := 0 to Height -1 do begin
  6751. Inc(TempDestData, fRowSize * 2);
  6752. for Col := 0 to Width -1 do begin
  6753. Move(SourceData^, TempDestData^, fPixelSize);
  6754. Inc(SourceData, fPixelSize);
  6755. Dec(TempDestData, fPixelSize);
  6756. end;
  6757. end;
  6758. SetDataPointer(DestData, Format); //be careful, Data could be freed by this method
  6759. result := true;
  6760. except
  6761. if Assigned(DestData) then
  6762. FreeMem(DestData);
  6763. raise;
  6764. end;
  6765. end;
  6766. end;
  6767. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6768. function TglBitmap2D.FlipVert: Boolean;
  6769. var
  6770. Row: Integer;
  6771. TempDestData, DestData, SourceData: PByte;
  6772. begin
  6773. result := inherited FlipVert;
  6774. if Assigned(Data) then begin
  6775. SourceData := Data;
  6776. GetMem(DestData, Height * fRowSize);
  6777. try
  6778. TempDestData := DestData;
  6779. Inc(TempDestData, Width * (Height -1) * fPixelSize);
  6780. for Row := 0 to Height -1 do begin
  6781. Move(SourceData^, TempDestData^, fRowSize);
  6782. Dec(TempDestData, fRowSize);
  6783. Inc(SourceData, fRowSize);
  6784. end;
  6785. SetDataPointer(DestData, Format); //be careful, Data could be freed by this method
  6786. result := true;
  6787. except
  6788. if Assigned(DestData) then
  6789. FreeMem(DestData);
  6790. raise;
  6791. end;
  6792. end;
  6793. end;
  6794. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6795. //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6796. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6797. type
  6798. TMatrixItem = record
  6799. X, Y: Integer;
  6800. W: Single;
  6801. end;
  6802. PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
  6803. TglBitmapToNormalMapRec = Record
  6804. Scale: Single;
  6805. Heights: array of Single;
  6806. MatrixU : array of TMatrixItem;
  6807. MatrixV : array of TMatrixItem;
  6808. end;
  6809. const
  6810. ONE_OVER_255 = 1 / 255;
  6811. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6812. procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
  6813. var
  6814. Val: Single;
  6815. begin
  6816. with FuncRec do begin
  6817. Val :=
  6818. Source.Data.r * LUMINANCE_WEIGHT_R +
  6819. Source.Data.g * LUMINANCE_WEIGHT_G +
  6820. Source.Data.b * LUMINANCE_WEIGHT_B;
  6821. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
  6822. end;
  6823. end;
  6824. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6825. procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  6826. begin
  6827. with FuncRec do
  6828. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
  6829. end;
  6830. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6831. procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
  6832. type
  6833. TVec = Array[0..2] of Single;
  6834. var
  6835. Idx: Integer;
  6836. du, dv: Double;
  6837. Len: Single;
  6838. Vec: TVec;
  6839. function GetHeight(X, Y: Integer): Single;
  6840. begin
  6841. with FuncRec do begin
  6842. X := Max(0, Min(Size.X -1, X));
  6843. Y := Max(0, Min(Size.Y -1, Y));
  6844. result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
  6845. end;
  6846. end;
  6847. begin
  6848. with FuncRec do begin
  6849. with PglBitmapToNormalMapRec(Args)^ do begin
  6850. du := 0;
  6851. for Idx := Low(MatrixU) to High(MatrixU) do
  6852. du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
  6853. dv := 0;
  6854. for Idx := Low(MatrixU) to High(MatrixU) do
  6855. dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
  6856. Vec[0] := -du * Scale;
  6857. Vec[1] := -dv * Scale;
  6858. Vec[2] := 1;
  6859. end;
  6860. // Normalize
  6861. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  6862. if Len <> 0 then begin
  6863. Vec[0] := Vec[0] * Len;
  6864. Vec[1] := Vec[1] * Len;
  6865. Vec[2] := Vec[2] * Len;
  6866. end;
  6867. // Farbe zuweisem
  6868. Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
  6869. Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
  6870. Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
  6871. end;
  6872. end;
  6873. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6874. procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
  6875. var
  6876. Rec: TglBitmapToNormalMapRec;
  6877. procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
  6878. begin
  6879. if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
  6880. Matrix[Index].X := X;
  6881. Matrix[Index].Y := Y;
  6882. Matrix[Index].W := W;
  6883. end;
  6884. end;
  6885. begin
  6886. if TFormatDescriptor.Get(Format).IsCompressed then
  6887. raise EglBitmapUnsupportedFormat.Create(Format);
  6888. if aScale > 100 then
  6889. Rec.Scale := 100
  6890. else if aScale < -100 then
  6891. Rec.Scale := -100
  6892. else
  6893. Rec.Scale := aScale;
  6894. SetLength(Rec.Heights, Width * Height);
  6895. try
  6896. case aFunc of
  6897. nm4Samples: begin
  6898. SetLength(Rec.MatrixU, 2);
  6899. SetEntry(Rec.MatrixU, 0, -1, 0, -0.5);
  6900. SetEntry(Rec.MatrixU, 1, 1, 0, 0.5);
  6901. SetLength(Rec.MatrixV, 2);
  6902. SetEntry(Rec.MatrixV, 0, 0, 1, 0.5);
  6903. SetEntry(Rec.MatrixV, 1, 0, -1, -0.5);
  6904. end;
  6905. nmSobel: begin
  6906. SetLength(Rec.MatrixU, 6);
  6907. SetEntry(Rec.MatrixU, 0, -1, 1, -1.0);
  6908. SetEntry(Rec.MatrixU, 1, -1, 0, -2.0);
  6909. SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
  6910. SetEntry(Rec.MatrixU, 3, 1, 1, 1.0);
  6911. SetEntry(Rec.MatrixU, 4, 1, 0, 2.0);
  6912. SetEntry(Rec.MatrixU, 5, 1, -1, 1.0);
  6913. SetLength(Rec.MatrixV, 6);
  6914. SetEntry(Rec.MatrixV, 0, -1, 1, 1.0);
  6915. SetEntry(Rec.MatrixV, 1, 0, 1, 2.0);
  6916. SetEntry(Rec.MatrixV, 2, 1, 1, 1.0);
  6917. SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
  6918. SetEntry(Rec.MatrixV, 4, 0, -1, -2.0);
  6919. SetEntry(Rec.MatrixV, 5, 1, -1, -1.0);
  6920. end;
  6921. nm3x3: begin
  6922. SetLength(Rec.MatrixU, 6);
  6923. SetEntry(Rec.MatrixU, 0, -1, 1, -1/6);
  6924. SetEntry(Rec.MatrixU, 1, -1, 0, -1/6);
  6925. SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
  6926. SetEntry(Rec.MatrixU, 3, 1, 1, 1/6);
  6927. SetEntry(Rec.MatrixU, 4, 1, 0, 1/6);
  6928. SetEntry(Rec.MatrixU, 5, 1, -1, 1/6);
  6929. SetLength(Rec.MatrixV, 6);
  6930. SetEntry(Rec.MatrixV, 0, -1, 1, 1/6);
  6931. SetEntry(Rec.MatrixV, 1, 0, 1, 1/6);
  6932. SetEntry(Rec.MatrixV, 2, 1, 1, 1/6);
  6933. SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
  6934. SetEntry(Rec.MatrixV, 4, 0, -1, -1/6);
  6935. SetEntry(Rec.MatrixV, 5, 1, -1, -1/6);
  6936. end;
  6937. nm5x5: begin
  6938. SetLength(Rec.MatrixU, 20);
  6939. SetEntry(Rec.MatrixU, 0, -2, 2, -1 / 16);
  6940. SetEntry(Rec.MatrixU, 1, -1, 2, -1 / 10);
  6941. SetEntry(Rec.MatrixU, 2, 1, 2, 1 / 10);
  6942. SetEntry(Rec.MatrixU, 3, 2, 2, 1 / 16);
  6943. SetEntry(Rec.MatrixU, 4, -2, 1, -1 / 10);
  6944. SetEntry(Rec.MatrixU, 5, -1, 1, -1 / 8);
  6945. SetEntry(Rec.MatrixU, 6, 1, 1, 1 / 8);
  6946. SetEntry(Rec.MatrixU, 7, 2, 1, 1 / 10);
  6947. SetEntry(Rec.MatrixU, 8, -2, 0, -1 / 2.8);
  6948. SetEntry(Rec.MatrixU, 9, -1, 0, -0.5);
  6949. SetEntry(Rec.MatrixU, 10, 1, 0, 0.5);
  6950. SetEntry(Rec.MatrixU, 11, 2, 0, 1 / 2.8);
  6951. SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
  6952. SetEntry(Rec.MatrixU, 13, -1, -1, -1 / 8);
  6953. SetEntry(Rec.MatrixU, 14, 1, -1, 1 / 8);
  6954. SetEntry(Rec.MatrixU, 15, 2, -1, 1 / 10);
  6955. SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
  6956. SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
  6957. SetEntry(Rec.MatrixU, 18, 1, -2, 1 / 10);
  6958. SetEntry(Rec.MatrixU, 19, 2, -2, 1 / 16);
  6959. SetLength(Rec.MatrixV, 20);
  6960. SetEntry(Rec.MatrixV, 0, -2, 2, 1 / 16);
  6961. SetEntry(Rec.MatrixV, 1, -1, 2, 1 / 10);
  6962. SetEntry(Rec.MatrixV, 2, 0, 2, 0.25);
  6963. SetEntry(Rec.MatrixV, 3, 1, 2, 1 / 10);
  6964. SetEntry(Rec.MatrixV, 4, 2, 2, 1 / 16);
  6965. SetEntry(Rec.MatrixV, 5, -2, 1, 1 / 10);
  6966. SetEntry(Rec.MatrixV, 6, -1, 1, 1 / 8);
  6967. SetEntry(Rec.MatrixV, 7, 0, 1, 0.5);
  6968. SetEntry(Rec.MatrixV, 8, 1, 1, 1 / 8);
  6969. SetEntry(Rec.MatrixV, 9, 2, 1, 1 / 16);
  6970. SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
  6971. SetEntry(Rec.MatrixV, 11, -1, -1, -1 / 8);
  6972. SetEntry(Rec.MatrixV, 12, 0, -1, -0.5);
  6973. SetEntry(Rec.MatrixV, 13, 1, -1, -1 / 8);
  6974. SetEntry(Rec.MatrixV, 14, 2, -1, -1 / 10);
  6975. SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
  6976. SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
  6977. SetEntry(Rec.MatrixV, 17, 0, -2, -0.25);
  6978. SetEntry(Rec.MatrixV, 18, 1, -2, -1 / 10);
  6979. SetEntry(Rec.MatrixV, 19, 2, -2, -1 / 16);
  6980. end;
  6981. end;
  6982. // Daten Sammeln
  6983. if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
  6984. AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
  6985. else
  6986. AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
  6987. AddFunc(glBitmapToNormalMapFunc, false, @Rec);
  6988. finally
  6989. SetLength(Rec.Heights, 0);
  6990. end;
  6991. end;
  6992. (*
  6993. { TglBitmapCubeMap }
  6994. procedure TglBitmapCubeMap.AfterConstruction;
  6995. begin
  6996. inherited;
  6997. if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
  6998. raise EglBitmapException.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
  6999. SetWrap; // set all to GL_CLAMP_TO_EDGE
  7000. Target := GL_TEXTURE_CUBE_MAP;
  7001. fGenMode := GL_REFLECTION_MAP;
  7002. end;
  7003. procedure TglBitmapCubeMap.Bind(EnableTexCoordsGen, EnableTextureUnit: Boolean);
  7004. begin
  7005. inherited Bind (EnableTextureUnit);
  7006. if EnableTexCoordsGen then begin
  7007. glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
  7008. glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
  7009. glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
  7010. glEnable(GL_TEXTURE_GEN_S);
  7011. glEnable(GL_TEXTURE_GEN_T);
  7012. glEnable(GL_TEXTURE_GEN_R);
  7013. end;
  7014. end;
  7015. procedure TglBitmapCubeMap.GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean);
  7016. var
  7017. glFormat, glInternalFormat, glType: Cardinal;
  7018. BuildWithGlu: Boolean;
  7019. TexSize: Integer;
  7020. begin
  7021. // Check Texture Size
  7022. if (TestTextureSize) then begin
  7023. glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
  7024. if ((Height > TexSize) or (Width > TexSize)) then
  7025. raise EglBitmapSizeToLargeException.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
  7026. if not ((IsPowerOfTwo (Height) and IsPowerOfTwo (Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
  7027. raise EglBitmapNonPowerOfTwoException.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
  7028. end;
  7029. // create Texture
  7030. if ID = 0 then begin
  7031. CreateID;
  7032. SetupParameters(BuildWithGlu);
  7033. end;
  7034. SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
  7035. UploadData (CubeTarget, glFormat, glInternalFormat, glType, BuildWithGlu);
  7036. end;
  7037. procedure TglBitmapCubeMap.GenTexture(TestTextureSize: Boolean);
  7038. begin
  7039. Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
  7040. end;
  7041. procedure TglBitmapCubeMap.Unbind(DisableTexCoordsGen,
  7042. DisableTextureUnit: Boolean);
  7043. begin
  7044. inherited Unbind (DisableTextureUnit);
  7045. if DisableTexCoordsGen then begin
  7046. glDisable(GL_TEXTURE_GEN_S);
  7047. glDisable(GL_TEXTURE_GEN_T);
  7048. glDisable(GL_TEXTURE_GEN_R);
  7049. end;
  7050. end;
  7051. { TglBitmapNormalMap }
  7052. type
  7053. TVec = Array[0..2] of Single;
  7054. TglBitmapNormalMapGetVectorFunc = procedure (var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  7055. PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
  7056. TglBitmapNormalMapRec = record
  7057. HalfSize : Integer;
  7058. Func: TglBitmapNormalMapGetVectorFunc;
  7059. end;
  7060. procedure glBitmapNormalMapPosX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  7061. begin
  7062. Vec[0] := HalfSize;
  7063. Vec[1] := - (Position.Y + 0.5 - HalfSize);
  7064. Vec[2] := - (Position.X + 0.5 - HalfSize);
  7065. end;
  7066. procedure glBitmapNormalMapNegX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  7067. begin
  7068. Vec[0] := - HalfSize;
  7069. Vec[1] := - (Position.Y + 0.5 - HalfSize);
  7070. Vec[2] := Position.X + 0.5 - HalfSize;
  7071. end;
  7072. procedure glBitmapNormalMapPosY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  7073. begin
  7074. Vec[0] := Position.X + 0.5 - HalfSize;
  7075. Vec[1] := HalfSize;
  7076. Vec[2] := Position.Y + 0.5 - HalfSize;
  7077. end;
  7078. procedure glBitmapNormalMapNegY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  7079. begin
  7080. Vec[0] := Position.X + 0.5 - HalfSize;
  7081. Vec[1] := - HalfSize;
  7082. Vec[2] := - (Position.Y + 0.5 - HalfSize);
  7083. end;
  7084. procedure glBitmapNormalMapPosZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  7085. begin
  7086. Vec[0] := Position.X + 0.5 - HalfSize;
  7087. Vec[1] := - (Position.Y + 0.5 - HalfSize);
  7088. Vec[2] := HalfSize;
  7089. end;
  7090. procedure glBitmapNormalMapNegZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  7091. begin
  7092. Vec[0] := - (Position.X + 0.5 - HalfSize);
  7093. Vec[1] := - (Position.Y + 0.5 - HalfSize);
  7094. Vec[2] := - HalfSize;
  7095. end;
  7096. procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
  7097. var
  7098. Vec : TVec;
  7099. Len: Single;
  7100. begin
  7101. with FuncRec do begin
  7102. with PglBitmapNormalMapRec (CustomData)^ do begin
  7103. Func(Vec, Position, HalfSize);
  7104. // Normalize
  7105. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  7106. if Len <> 0 then begin
  7107. Vec[0] := Vec[0] * Len;
  7108. Vec[1] := Vec[1] * Len;
  7109. Vec[2] := Vec[2] * Len;
  7110. end;
  7111. // Scale Vector and AddVectro
  7112. Vec[0] := Vec[0] * 0.5 + 0.5;
  7113. Vec[1] := Vec[1] * 0.5 + 0.5;
  7114. Vec[2] := Vec[2] * 0.5 + 0.5;
  7115. end;
  7116. // Set Color
  7117. Dest.Red := Round(Vec[0] * 255);
  7118. Dest.Green := Round(Vec[1] * 255);
  7119. Dest.Blue := Round(Vec[2] * 255);
  7120. end;
  7121. end;
  7122. procedure TglBitmapNormalMap.AfterConstruction;
  7123. begin
  7124. inherited;
  7125. fGenMode := GL_NORMAL_MAP;
  7126. end;
  7127. procedure TglBitmapNormalMap.GenerateNormalMap(Size: Integer;
  7128. TestTextureSize: Boolean);
  7129. var
  7130. Rec: TglBitmapNormalMapRec;
  7131. SizeRec: TglBitmapPixelPosition;
  7132. begin
  7133. Rec.HalfSize := Size div 2;
  7134. FreeDataAfterGenTexture := false;
  7135. SizeRec.Fields := [ffX, ffY];
  7136. SizeRec.X := Size;
  7137. SizeRec.Y := Size;
  7138. // Positive X
  7139. Rec.Func := glBitmapNormalMapPosX;
  7140. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  7141. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, TestTextureSize);
  7142. // Negative X
  7143. Rec.Func := glBitmapNormalMapNegX;
  7144. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  7145. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, TestTextureSize);
  7146. // Positive Y
  7147. Rec.Func := glBitmapNormalMapPosY;
  7148. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  7149. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, TestTextureSize);
  7150. // Negative Y
  7151. Rec.Func := glBitmapNormalMapNegY;
  7152. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  7153. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, TestTextureSize);
  7154. // Positive Z
  7155. Rec.Func := glBitmapNormalMapPosZ;
  7156. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  7157. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, TestTextureSize);
  7158. // Negative Z
  7159. Rec.Func := glBitmapNormalMapNegZ;
  7160. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  7161. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, TestTextureSize);
  7162. end;
  7163. *)
  7164. initialization
  7165. glBitmapSetDefaultFormat(tfEmpty);
  7166. glBitmapSetDefaultMipmap(mmMipmap);
  7167. glBitmapSetDefaultFilter(GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
  7168. glBitmapSetDefaultWrap (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
  7169. glBitmapSetDefaultFreeDataAfterGenTexture(true);
  7170. glBitmapSetDefaultDeleteTextureOnFree (true);
  7171. TFormatDescriptor.Init;
  7172. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  7173. OpenGLInitialized := false;
  7174. InitOpenGLCS := TCriticalSection.Create;
  7175. {$ENDIF}
  7176. finalization
  7177. TFormatDescriptor.Finalize;
  7178. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  7179. FreeAndNil(InitOpenGLCS);
  7180. {$ENDIF}
  7181. end.