Nevar pievienot vairāk kā 25 tēmas Tēmai ir jāsākas ar burtu vai ciparu, tā var saturēt domu zīmes ('-') un var būt līdz 35 simboliem gara.

8300 rindas
278 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)}
  265. {$DEFINE GLB_WIN}
  266. {$ELSEIF DEFINED(LINUX)}
  267. {$DEFINE GLB_LINUX}
  268. {$ENDIF}
  269. // native OpenGL Support
  270. {$IF DEFINED(GLB_NATIVE_OGL_STATIC) OR DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
  271. {$DEFINE GLB_NATIVE_OGL}
  272. {$ENDIF}
  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. {$ENDIF}
  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, {$ENDIF}
  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. {$IFNDEF GLB_DELPHI}
  353. type
  354. HGLRC = Cardinal;
  355. DWORD = Cardinal;
  356. PDWORD = ^DWORD;
  357. TRGBQuad = packed record
  358. rgbBlue: Byte;
  359. rgbGreen: Byte;
  360. rgbRed: Byte;
  361. rgbReserved: Byte;
  362. end;
  363. {$ENDIF}
  364. {$IFDEF GLB_NATIVE_OGL}
  365. const
  366. GL_TRUE = 1;
  367. GL_FALSE = 0;
  368. GL_VERSION = $1F02;
  369. GL_EXTENSIONS = $1F03;
  370. GL_TEXTURE_1D = $0DE0;
  371. GL_TEXTURE_2D = $0DE1;
  372. GL_TEXTURE_RECTANGLE = $84F5;
  373. GL_TEXTURE_WIDTH = $1000;
  374. GL_TEXTURE_HEIGHT = $1001;
  375. GL_TEXTURE_INTERNAL_FORMAT = $1003;
  376. GL_ALPHA = $1906;
  377. GL_ALPHA4 = $803B;
  378. GL_ALPHA8 = $803C;
  379. GL_ALPHA12 = $803D;
  380. GL_ALPHA16 = $803E;
  381. GL_LUMINANCE = $1909;
  382. GL_LUMINANCE4 = $803F;
  383. GL_LUMINANCE8 = $8040;
  384. GL_LUMINANCE12 = $8041;
  385. GL_LUMINANCE16 = $8042;
  386. GL_LUMINANCE_ALPHA = $190A;
  387. GL_LUMINANCE4_ALPHA4 = $8043;
  388. GL_LUMINANCE6_ALPHA2 = $8044;
  389. GL_LUMINANCE8_ALPHA8 = $8045;
  390. GL_LUMINANCE12_ALPHA4 = $8046;
  391. GL_LUMINANCE12_ALPHA12 = $8047;
  392. GL_LUMINANCE16_ALPHA16 = $8048;
  393. GL_RGB = $1907;
  394. GL_BGR = $80E0;
  395. GL_R3_G3_B2 = $2A10;
  396. GL_RGB4 = $804F;
  397. GL_RGB5 = $8050;
  398. GL_RGB565 = $8D62;
  399. GL_RGB8 = $8051;
  400. GL_RGB10 = $8052;
  401. GL_RGB12 = $8053;
  402. GL_RGB16 = $8054;
  403. GL_RGBA = $1908;
  404. GL_BGRA = $80E1;
  405. GL_RGBA2 = $8055;
  406. GL_RGBA4 = $8056;
  407. GL_RGB5_A1 = $8057;
  408. GL_RGBA8 = $8058;
  409. GL_RGB10_A2 = $8059;
  410. GL_RGBA12 = $805A;
  411. GL_RGBA16 = $805B;
  412. GL_DEPTH_COMPONENT = $1902;
  413. GL_DEPTH_COMPONENT16 = $81A5;
  414. GL_DEPTH_COMPONENT24 = $81A6;
  415. GL_DEPTH_COMPONENT32 = $81A7;
  416. GL_COMPRESSED_RGB = $84ED;
  417. GL_COMPRESSED_RGBA = $84EE;
  418. GL_COMPRESSED_RGB_S3TC_DXT1_EXT = $83F0;
  419. GL_COMPRESSED_RGBA_S3TC_DXT1_EXT = $83F1;
  420. GL_COMPRESSED_RGBA_S3TC_DXT3_EXT = $83F2;
  421. GL_COMPRESSED_RGBA_S3TC_DXT5_EXT = $83F3;
  422. GL_UNSIGNED_BYTE = $1401;
  423. GL_UNSIGNED_BYTE_3_3_2 = $8032;
  424. GL_UNSIGNED_BYTE_2_3_3_REV = $8362;
  425. GL_UNSIGNED_SHORT = $1403;
  426. GL_UNSIGNED_SHORT_5_6_5 = $8363;
  427. GL_UNSIGNED_SHORT_4_4_4_4 = $8033;
  428. GL_UNSIGNED_SHORT_5_5_5_1 = $8034;
  429. GL_UNSIGNED_SHORT_5_6_5_REV = $8364;
  430. GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;
  431. GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;
  432. GL_UNSIGNED_INT = $1405;
  433. GL_UNSIGNED_INT_8_8_8_8 = $8035;
  434. GL_UNSIGNED_INT_10_10_10_2 = $8036;
  435. GL_UNSIGNED_INT_8_8_8_8_REV = $8367;
  436. GL_UNSIGNED_INT_2_10_10_10_REV = $8368;
  437. { Texture Filter }
  438. GL_TEXTURE_MAG_FILTER = $2800;
  439. GL_TEXTURE_MIN_FILTER = $2801;
  440. GL_NEAREST = $2600;
  441. GL_NEAREST_MIPMAP_NEAREST = $2700;
  442. GL_NEAREST_MIPMAP_LINEAR = $2702;
  443. GL_LINEAR = $2601;
  444. GL_LINEAR_MIPMAP_NEAREST = $2701;
  445. GL_LINEAR_MIPMAP_LINEAR = $2703;
  446. { Texture Wrap }
  447. GL_TEXTURE_WRAP_S = $2802;
  448. GL_TEXTURE_WRAP_T = $2803;
  449. GL_TEXTURE_WRAP_R = $8072;
  450. GL_CLAMP = $2900;
  451. GL_REPEAT = $2901;
  452. GL_CLAMP_TO_EDGE = $812F;
  453. GL_CLAMP_TO_BORDER = $812D;
  454. GL_MIRRORED_REPEAT = $8370;
  455. { Other }
  456. GL_GENERATE_MIPMAP = $8191;
  457. GL_TEXTURE_BORDER_COLOR = $1004;
  458. GL_MAX_TEXTURE_SIZE = $0D33;
  459. GL_PACK_ALIGNMENT = $0D05;
  460. GL_UNPACK_ALIGNMENT = $0CF5;
  461. GL_TEXTURE_MAX_ANISOTROPY_EXT = $84FE;
  462. GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;
  463. {$ifdef LINUX}
  464. libglu = 'libGLU.so.1';
  465. libopengl = 'libGL.so.1';
  466. {$else}
  467. libglu = 'glu32.dll';
  468. libopengl = 'opengl32.dll';
  469. {$endif}
  470. type
  471. GLboolean = BYTEBOOL;
  472. GLint = Integer;
  473. GLsizei = Integer;
  474. GLuint = Cardinal;
  475. GLfloat = Single;
  476. GLenum = Cardinal;
  477. PGLvoid = Pointer;
  478. PGLboolean = ^GLboolean;
  479. PGLint = ^GLint;
  480. PGLuint = ^GLuint;
  481. PGLfloat = ^GLfloat;
  482. TglCompressedTexImage1D = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  483. 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}
  484. TglGetCompressedTexImage = procedure(target: GLenum; level: GLint; img: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  485. {$IF DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
  486. TglEnable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  487. TglDisable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  488. TglGetString = function(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  489. TglGetIntegerv = procedure(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  490. TglTexParameteri = procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  491. TglTexParameterfv = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  492. TglGetTexParameteriv = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  493. TglGetTexParameterfv = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  494. TglGetTexLevelParameteriv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  495. TglGetTexLevelParameterfv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  496. TglGenTextures = procedure(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  497. TglBindTexture = procedure(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  498. TglDeleteTextures = procedure(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  499. TglAreTexturesResident = function(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  500. TglReadPixels = procedure(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  501. TglPixelStorei = procedure(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  502. 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}
  503. 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}
  504. TglGetTexImage = procedure(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  505. TgluBuild1DMipmaps = function(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  506. TgluBuild2DMipmaps = function(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  507. {$IFDEF GLB_LINUX}
  508. TglXGetProcAddress = function(ProcName: PAnsiChar): Pointer; cdecl;
  509. TglXGetProcAddressARB = function(const name: PAnsiChar): pointer; cdecl;
  510. {$ELSE}
  511. TwglGetProcAddress = function(ProcName: PAnsiChar): Pointer; stdcall;
  512. {$ENDIF}
  513. {$ELSEIF DEFINED(GLB_NATIVE_OGL_STATIC)}
  514. procedure glEnable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  515. procedure glDisable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  516. function glGetString(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  517. procedure glGetIntegerv(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  518. procedure glTexParameteri(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  519. procedure glTexParameterfv(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  520. procedure glGetTexParameteriv(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  521. procedure glGetTexParameterfv(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  522. procedure glGetTexLevelParameteriv(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  523. procedure glGetTexLevelParameterfv(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  524. procedure glGenTextures(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  525. procedure glBindTexture(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  526. procedure glDeleteTextures(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  527. function glAreTexturesResident(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  528. 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;
  529. procedure glPixelStorei(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  530. 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;
  531. 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;
  532. procedure glGetTexImage(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  533. function gluBuild1DMipmaps(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
  534. function gluBuild2DMipmaps(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
  535. {$ENDIF}
  536. var
  537. GL_VERSION_1_2,
  538. GL_VERSION_1_3,
  539. GL_VERSION_1_4,
  540. GL_VERSION_2_0,
  541. GL_SGIS_generate_mipmap,
  542. GL_ARB_texture_border_clamp,
  543. GL_ARB_texture_mirrored_repeat,
  544. GL_ARB_texture_rectangle,
  545. GL_ARB_texture_non_power_of_two,
  546. GL_IBM_texture_mirrored_repeat,
  547. GL_NV_texture_rectangle,
  548. GL_EXT_texture_edge_clamp,
  549. GL_EXT_texture_rectangle,
  550. GL_EXT_texture_filter_anisotropic: Boolean;
  551. glCompressedTexImage1D: TglCompressedTexImage1D;
  552. glCompressedTexImage2D: TglCompressedTexImage2D;
  553. glGetCompressedTexImage: TglGetCompressedTexImage;
  554. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  555. glEnable: TglEnable;
  556. glDisable: TglDisable;
  557. glGetString: TglGetString;
  558. glGetIntegerv: TglGetIntegerv;
  559. glTexParameteri: TglTexParameteri;
  560. glTexParameterfv: TglTexParameterfv;
  561. glGetTexParameteriv: TglGetTexParameteriv;
  562. glGetTexParameterfv: TglGetTexParameterfv;
  563. glGetTexLevelParameteriv: TglGetTexLevelParameteriv;
  564. glGetTexLevelParameterfv: TglGetTexLevelParameterfv;
  565. glGenTextures: TglGenTextures;
  566. glBindTexture: TglBindTexture;
  567. glDeleteTextures: TglDeleteTextures;
  568. glAreTexturesResident: TglAreTexturesResident;
  569. glReadPixels: TglReadPixels;
  570. glPixelStorei: TglPixelStorei;
  571. glTexImage1D: TglTexImage1D;
  572. glTexImage2D: TglTexImage2D;
  573. glGetTexImage: TglGetTexImage;
  574. gluBuild1DMipmaps: TgluBuild1DMipmaps;
  575. gluBuild2DMipmaps: TgluBuild2DMipmaps;
  576. {$IF DEFINED(GLB_WIN)}
  577. wglGetProcAddress: TwglGetProcAddress;
  578. {$ELSEIF DEFINED(GLB_LINUX)}
  579. glXGetProcAddress: TglXGetProcAddress;
  580. glXGetProcAddressARB: TglXGetProcAddressARB;
  581. {$ENDIF}
  582. {$ENDIF}
  583. (*
  584. {$IFDEF GLB_DELPHI}
  585. var
  586. gLastContext: HGLRC;
  587. {$ENDIF}
  588. *)
  589. {$ENDIF}
  590. type
  591. ////////////////////////////////////////////////////////////////////////////////////////////////////
  592. TglBitmapFormat = (
  593. tfEmpty = 0, //must be smallest value!
  594. tfAlpha4,
  595. tfAlpha8,
  596. tfAlpha12,
  597. tfAlpha16,
  598. tfLuminance4,
  599. tfLuminance8,
  600. tfLuminance12,
  601. tfLuminance16,
  602. tfLuminance4Alpha4,
  603. tfLuminance6Alpha2,
  604. tfLuminance8Alpha8,
  605. tfLuminance12Alpha4,
  606. tfLuminance12Alpha12,
  607. tfLuminance16Alpha16,
  608. tfR3G3B2,
  609. tfRGB4,
  610. tfR5G6B5,
  611. tfRGB5,
  612. tfRGB8,
  613. tfRGB10,
  614. tfRGB12,
  615. tfRGB16,
  616. tfRGBA2,
  617. tfRGBA4,
  618. tfRGB5A1,
  619. tfRGBA8,
  620. tfRGB10A2,
  621. tfRGBA12,
  622. tfRGBA16,
  623. tfBGR4,
  624. tfB5G6R5,
  625. tfBGR5,
  626. tfBGR8,
  627. tfBGR10,
  628. tfBGR12,
  629. tfBGR16,
  630. tfBGRA2,
  631. tfBGRA4,
  632. tfBGR5A1,
  633. tfBGRA8,
  634. tfBGR10A2,
  635. tfBGRA12,
  636. tfBGRA16,
  637. tfDepth16,
  638. tfDepth24,
  639. tfDepth32,
  640. tfS3tcDtx1RGBA,
  641. tfS3tcDtx3RGBA,
  642. tfS3tcDtx5RGBA
  643. );
  644. TglBitmapFileType = (
  645. {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG, {$ENDIF}
  646. {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
  647. ftDDS,
  648. ftTGA,
  649. ftBMP);
  650. TglBitmapFileTypes = set of TglBitmapFileType;
  651. TglBitmapMipMap = (
  652. mmNone,
  653. mmMipmap,
  654. mmMipmapGlu);
  655. TglBitmapNormalMapFunc = (
  656. nm4Samples,
  657. nmSobel,
  658. nm3x3,
  659. nm5x5);
  660. ////////////////////////////////////////////////////////////////////////////////////////////////////
  661. EglBitmapException = class(Exception);
  662. EglBitmapSizeToLargeException = class(EglBitmapException);
  663. EglBitmapNonPowerOfTwoException = class(EglBitmapException);
  664. EglBitmapUnsupportedFormat = class(EglBitmapException)
  665. constructor Create(const aFormat: TglBitmapFormat); overload;
  666. constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;
  667. end;
  668. ////////////////////////////////////////////////////////////////////////////////////////////////////
  669. TglBitmapColorRec = packed record
  670. case Integer of
  671. 0: (r, g, b, a: Cardinal);
  672. 1: (arr: array[0..3] of Cardinal);
  673. end;
  674. TglBitmapPixelData = packed record
  675. Data, Range: TglBitmapColorRec;
  676. Format: TglBitmapFormat;
  677. end;
  678. PglBitmapPixelData = ^TglBitmapPixelData;
  679. ////////////////////////////////////////////////////////////////////////////////////////////////////
  680. TglBitmapPixelPositionFields = set of (ffX, ffY);
  681. TglBitmapPixelPosition = record
  682. Fields : TglBitmapPixelPositionFields;
  683. X : Word;
  684. Y : Word;
  685. end;
  686. ////////////////////////////////////////////////////////////////////////////////////////////////////
  687. TglBitmap = class;
  688. TglBitmapFunctionRec = record
  689. Sender: TglBitmap;
  690. Size: TglBitmapPixelPosition;
  691. Position: TglBitmapPixelPosition;
  692. Source: TglBitmapPixelData;
  693. Dest: TglBitmapPixelData;
  694. Args: Pointer;
  695. end;
  696. TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
  697. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  698. TglBitmap = class
  699. protected
  700. fID: GLuint;
  701. fTarget: GLuint;
  702. fAnisotropic: Integer;
  703. fDeleteTextureOnFree: Boolean;
  704. fFreeDataAfterGenTexture: Boolean;
  705. fData: PByte;
  706. fIsResident: Boolean;
  707. fBorderColor: array[0..3] of Single;
  708. fDimension: TglBitmapPixelPosition;
  709. fMipMap: TglBitmapMipMap;
  710. fFormat: TglBitmapFormat;
  711. // Mapping
  712. fPixelSize: Integer;
  713. fRowSize: Integer;
  714. // Filtering
  715. fFilterMin: Cardinal;
  716. fFilterMag: Cardinal;
  717. // TexturWarp
  718. fWrapS: Cardinal;
  719. fWrapT: Cardinal;
  720. fWrapR: Cardinal;
  721. // CustomData
  722. fFilename: String;
  723. fCustomName: String;
  724. fCustomNameW: WideString;
  725. fCustomData: Pointer;
  726. //Getter
  727. function GetWidth: Integer; virtual;
  728. function GetHeight: Integer; virtual;
  729. function GetFileWidth: Integer; virtual;
  730. function GetFileHeight: Integer; virtual;
  731. //Setter
  732. procedure SetCustomData(const aValue: Pointer);
  733. procedure SetCustomName(const aValue: String);
  734. procedure SetCustomNameW(const aValue: WideString);
  735. procedure SetDeleteTextureOnFree(const aValue: Boolean);
  736. procedure SetFormat(const aValue: TglBitmapFormat);
  737. procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
  738. procedure SetID(const aValue: Cardinal);
  739. procedure SetMipMap(const aValue: TglBitmapMipMap);
  740. procedure SetTarget(const aValue: Cardinal);
  741. procedure SetAnisotropic(const aValue: Integer);
  742. procedure CreateID;
  743. procedure SetupParameters(out aBuildWithGlu: Boolean);
  744. procedure SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
  745. const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;
  746. procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
  747. function FlipHorz: Boolean; virtual;
  748. function FlipVert: Boolean; virtual;
  749. property Width: Integer read GetWidth;
  750. property Height: Integer read GetHeight;
  751. property FileWidth: Integer read GetFileWidth;
  752. property FileHeight: Integer read GetFileHeight;
  753. public
  754. //Properties
  755. property ID: Cardinal read fID write SetID;
  756. property Target: Cardinal read fTarget write SetTarget;
  757. property Format: TglBitmapFormat read fFormat write SetFormat;
  758. property MipMap: TglBitmapMipMap read fMipMap write SetMipMap;
  759. property Anisotropic: Integer read fAnisotropic write SetAnisotropic;
  760. property Filename: String read fFilename;
  761. property CustomName: String read fCustomName write SetCustomName;
  762. property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
  763. property CustomData: Pointer read fCustomData write SetCustomData;
  764. property DeleteTextureOnFree: Boolean read fDeleteTextureOnFree write SetDeleteTextureOnFree;
  765. property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
  766. property Dimension: TglBitmapPixelPosition read fDimension;
  767. property Data: PByte read fData;
  768. property IsResident: Boolean read fIsResident;
  769. procedure AfterConstruction; override;
  770. procedure BeforeDestruction; override;
  771. procedure PrepareResType(var aResource: String; var aResType: PChar);
  772. //Load
  773. procedure LoadFromFile(const aFilename: String);
  774. procedure LoadFromStream(const aStream: TStream); virtual;
  775. procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  776. const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
  777. procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
  778. procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  779. //Save
  780. procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  781. procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
  782. //Convert
  783. function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
  784. function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  785. const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
  786. public
  787. //Alpha & Co
  788. {$IFDEF GLB_SDL}
  789. function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  790. function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  791. function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  792. function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
  793. const aArgs: Pointer = nil): Boolean;
  794. {$ENDIF}
  795. {$IFDEF GLB_DELPHI}
  796. function AssignToBitmap(const aBitmap: TBitmap): Boolean;
  797. function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  798. function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  799. function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
  800. const aArgs: Pointer = nil): Boolean;
  801. {$ENDIF}
  802. {$IFDEF GLB_LAZARUS}
  803. function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  804. function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  805. function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  806. function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil;
  807. const aArgs: Pointer = nil): Boolean;
  808. {$ENDIF}
  809. function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil;
  810. const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  811. function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  812. const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  813. function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
  814. function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  815. function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  816. function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  817. function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
  818. function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
  819. function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
  820. function AddAlphaFromValue(const aAlpha: Byte): Boolean;
  821. function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  822. function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  823. function RemoveAlpha: Boolean; virtual;
  824. public
  825. //Common
  826. function Clone: TglBitmap;
  827. function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
  828. procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
  829. procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  830. procedure FreeData;
  831. //ColorFill
  832. procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
  833. procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
  834. procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
  835. //TexParameters
  836. procedure SetFilter(const aMin, aMag: Cardinal);
  837. procedure SetWrap(
  838. const S: Cardinal = GL_CLAMP_TO_EDGE;
  839. const T: Cardinal = GL_CLAMP_TO_EDGE;
  840. const R: Cardinal = GL_CLAMP_TO_EDGE);
  841. procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
  842. procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
  843. //Constructors
  844. constructor Create; overload;
  845. constructor Create(const aFileName: String); overload;
  846. constructor Create(const aStream: TStream); overload;
  847. constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat); overload;
  848. constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
  849. constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
  850. constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
  851. private
  852. {$IFDEF GLB_SUPPORT_PNG_READ} function LoadPNG(const aStream: TStream): Boolean; virtual; {$ENDIF}
  853. {$ifdef GLB_SUPPORT_PNG_WRITE} procedure SavePNG(const aStream: TStream); virtual; {$ENDIF}
  854. {$IFDEF GLB_SUPPORT_JPEG_READ} function LoadJPEG(const aStream: TStream): Boolean; virtual; {$ENDIF}
  855. {$IFDEF GLB_SUPPORT_JPEG_WRITE} procedure SaveJPEG(const aStream: TStream); virtual; {$ENDIF}
  856. function LoadBMP(const aStream: TStream): Boolean; virtual;
  857. procedure SaveBMP(const aStream: TStream); virtual;
  858. function LoadTGA(const aStream: TStream): Boolean; virtual;
  859. procedure SaveTGA(const aStream: TStream); virtual;
  860. function LoadDDS(const aStream: TStream): Boolean; virtual;
  861. procedure SaveDDS(const aStream: TStream); virtual;
  862. end;
  863. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  864. TglBitmap2D = class(TglBitmap)
  865. protected
  866. // Bildeinstellungen
  867. fLines: array of PByte;
  868. function GetScanline(const aIndex: Integer): Pointer;
  869. procedure SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
  870. const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
  871. procedure UploadData(const aTarget: Cardinal; const aBuildWithGlu: Boolean);
  872. public
  873. property Width;
  874. property Height;
  875. property Scanline[const aIndex: Integer]: Pointer read GetScanline;
  876. procedure AfterConstruction; override;
  877. procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  878. procedure GetDataFromTexture;
  879. procedure GenTexture(const aTestTextureSize: Boolean = true); override;
  880. function FlipHorz: Boolean; override;
  881. function FlipVert: Boolean; override;
  882. procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
  883. const aScale: Single = 2; const aUseAlpha: Boolean = false);
  884. end;
  885. (* TODO
  886. TglBitmapCubeMap = class(TglBitmap2D)
  887. protected
  888. fGenMode: Integer;
  889. // Hide GenTexture
  890. procedure GenTexture(TestTextureSize: Boolean = true); reintroduce;
  891. public
  892. procedure AfterConstruction; override;
  893. procedure GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean = true);
  894. procedure Unbind(DisableTexCoordsGen: Boolean = true; DisableTextureUnit: Boolean = true); reintroduce; virtual;
  895. procedure Bind(EnableTexCoordsGen: Boolean = true; EnableTextureUnit: Boolean = true); reintroduce; virtual;
  896. end;
  897. TglBitmapNormalMap = class(TglBitmapCubeMap)
  898. public
  899. procedure AfterConstruction; override;
  900. procedure GenerateNormalMap(Size: Integer = 32; TestTextureSize: Boolean = true);
  901. end;
  902. TglBitmap1D = class(TglBitmap)
  903. protected
  904. procedure GetPixel1DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
  905. procedure SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width: Integer = -1; Height: Integer = -1); override;
  906. procedure UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
  907. public
  908. // propertys
  909. property Width;
  910. procedure AfterConstruction; override;
  911. // Other
  912. function FlipHorz: Boolean; override;
  913. // Generation
  914. procedure GenTexture(TestTextureSize: Boolean = true); override;
  915. end;
  916. *)
  917. const
  918. NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
  919. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  920. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  921. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  922. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  923. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  924. procedure glBitmapSetDefaultWrap(
  925. const S: Cardinal = GL_CLAMP_TO_EDGE;
  926. const T: Cardinal = GL_CLAMP_TO_EDGE;
  927. const R: Cardinal = GL_CLAMP_TO_EDGE);
  928. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  929. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  930. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  931. function glBitmapGetDefaultFormat: TglBitmapFormat;
  932. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  933. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  934. function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
  935. function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
  936. function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
  937. var
  938. glBitmapDefaultDeleteTextureOnFree: Boolean;
  939. glBitmapDefaultFreeDataAfterGenTextures: Boolean;
  940. glBitmapDefaultFormat: TglBitmapFormat;
  941. glBitmapDefaultMipmap: TglBitmapMipMap;
  942. glBitmapDefaultFilterMin: Cardinal;
  943. glBitmapDefaultFilterMag: Cardinal;
  944. glBitmapDefaultWrapS: Cardinal;
  945. glBitmapDefaultWrapT: Cardinal;
  946. glBitmapDefaultWrapR: Cardinal;
  947. {$IFDEF GLB_DELPHI}
  948. function CreateGrayPalette: HPALETTE;
  949. {$ENDIF}
  950. implementation
  951. uses
  952. Math, syncobjs, typinfo;
  953. type
  954. ////////////////////////////////////////////////////////////////////////////////////////////////////
  955. TShiftRec = packed record
  956. case Integer of
  957. 0: (r, g, b, a: Byte);
  958. 1: (arr: array[0..3] of Byte);
  959. end;
  960. TFormatDescriptor = class(TObject)
  961. private
  962. function GetRedMask: QWord;
  963. function GetGreenMask: QWord;
  964. function GetBlueMask: QWord;
  965. function GetAlphaMask: QWord;
  966. protected
  967. fFormat: TglBitmapFormat;
  968. fWithAlpha: TglBitmapFormat;
  969. fWithoutAlpha: TglBitmapFormat;
  970. fRGBInverted: TglBitmapFormat;
  971. fUncompressed: TglBitmapFormat;
  972. fPixelSize: Single;
  973. fIsCompressed: Boolean;
  974. fRange: TglBitmapColorRec;
  975. fShift: TShiftRec;
  976. fglFormat: Cardinal;
  977. fglInternalFormat: Cardinal;
  978. fglDataFormat: Cardinal;
  979. function GetComponents: Integer; virtual;
  980. public
  981. property Format: TglBitmapFormat read fFormat;
  982. property WithAlpha: TglBitmapFormat read fWithAlpha;
  983. property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;
  984. property RGBInverted: TglBitmapFormat read fRGBInverted;
  985. property Components: Integer read GetComponents;
  986. property PixelSize: Single read fPixelSize;
  987. property IsCompressed: Boolean read fIsCompressed;
  988. property glFormat: Cardinal read fglFormat;
  989. property glInternalFormat: Cardinal read fglInternalFormat;
  990. property glDataFormat: Cardinal read fglDataFormat;
  991. property Range: TglBitmapColorRec read fRange;
  992. property Shift: TShiftRec read fShift;
  993. property RedMask: QWord read GetRedMask;
  994. property GreenMask: QWord read GetGreenMask;
  995. property BlueMask: QWord read GetBlueMask;
  996. property AlphaMask: QWord read GetAlphaMask;
  997. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
  998. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
  999. function GetSize(const aSize: TglBitmapPixelPosition): Integer; virtual; overload;
  1000. function GetSize(const aWidth, aHeight: Integer): Integer; virtual; overload;
  1001. function CreateMappingData: Pointer; virtual;
  1002. procedure FreeMappingData(var aMappingData: Pointer); virtual;
  1003. function IsEmpty: Boolean; virtual;
  1004. function HasAlpha: Boolean; virtual;
  1005. function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean; virtual;
  1006. procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
  1007. constructor Create; virtual;
  1008. public
  1009. class procedure Init;
  1010. class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1011. class function GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1012. class procedure Clear;
  1013. class procedure Finalize;
  1014. end;
  1015. TFormatDescriptorClass = class of TFormatDescriptor;
  1016. TfdEmpty = class(TFormatDescriptor);
  1017. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1018. TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1019. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1020. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1021. constructor Create; override;
  1022. end;
  1023. TfdLuminance_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1024. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1025. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1026. constructor Create; override;
  1027. end;
  1028. TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1029. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1030. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1031. constructor Create; override;
  1032. end;
  1033. TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte
  1034. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1035. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1036. constructor Create; override;
  1037. end;
  1038. TfdRGB_UB3 = class(TFormatDescriptor) //3* unsigned byte
  1039. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1040. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1041. constructor Create; override;
  1042. end;
  1043. TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
  1044. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1045. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1046. constructor Create; override;
  1047. end;
  1048. TfdRGBA_UB4 = class(TfdRGB_UB3) //4* unsigned byte
  1049. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1050. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1051. constructor Create; override;
  1052. end;
  1053. TfdBGRA_UB4 = class(TfdBGR_UB3) //4* unsigned byte (inverse)
  1054. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1055. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1056. constructor Create; override;
  1057. end;
  1058. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1059. TfdAlpha_US1 = class(TFormatDescriptor) //1* unsigned short
  1060. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1061. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1062. constructor Create; override;
  1063. end;
  1064. TfdLuminance_US1 = class(TFormatDescriptor) //1* unsigned short
  1065. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1066. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1067. constructor Create; override;
  1068. end;
  1069. TfdUniversal_US1 = class(TFormatDescriptor) //1* unsigned short
  1070. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1071. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1072. constructor Create; override;
  1073. end;
  1074. TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short
  1075. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1076. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1077. constructor Create; override;
  1078. end;
  1079. TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short
  1080. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1081. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1082. constructor Create; override;
  1083. end;
  1084. TfdRGB_US3 = class(TFormatDescriptor) //3* unsigned short
  1085. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1086. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1087. constructor Create; override;
  1088. end;
  1089. TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)
  1090. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1091. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1092. constructor Create; override;
  1093. end;
  1094. TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
  1095. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1096. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1097. constructor Create; override;
  1098. end;
  1099. TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
  1100. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1101. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1102. constructor Create; override;
  1103. end;
  1104. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1105. TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int
  1106. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1107. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1108. constructor Create; override;
  1109. end;
  1110. TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int
  1111. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1112. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1113. constructor Create; override;
  1114. end;
  1115. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1116. TfdAlpha4 = class(TfdAlpha_UB1)
  1117. constructor Create; override;
  1118. end;
  1119. TfdAlpha8 = class(TfdAlpha_UB1)
  1120. constructor Create; override;
  1121. end;
  1122. TfdAlpha12 = class(TfdAlpha_US1)
  1123. constructor Create; override;
  1124. end;
  1125. TfdAlpha16 = class(TfdAlpha_US1)
  1126. constructor Create; override;
  1127. end;
  1128. TfdLuminance4 = class(TfdLuminance_UB1)
  1129. constructor Create; override;
  1130. end;
  1131. TfdLuminance8 = class(TfdLuminance_UB1)
  1132. constructor Create; override;
  1133. end;
  1134. TfdLuminance12 = class(TfdLuminance_US1)
  1135. constructor Create; override;
  1136. end;
  1137. TfdLuminance16 = class(TfdLuminance_US1)
  1138. constructor Create; override;
  1139. end;
  1140. TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
  1141. constructor Create; override;
  1142. end;
  1143. TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
  1144. constructor Create; override;
  1145. end;
  1146. TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
  1147. constructor Create; override;
  1148. end;
  1149. TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
  1150. constructor Create; override;
  1151. end;
  1152. TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)
  1153. constructor Create; override;
  1154. end;
  1155. TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
  1156. constructor Create; override;
  1157. end;
  1158. TfdR3G3B2 = class(TfdUniversal_UB1)
  1159. constructor Create; override;
  1160. end;
  1161. TfdRGB4 = class(TfdUniversal_US1)
  1162. constructor Create; override;
  1163. end;
  1164. TfdR5G6B5 = class(TfdUniversal_US1)
  1165. constructor Create; override;
  1166. end;
  1167. TfdRGB5 = class(TfdUniversal_US1)
  1168. constructor Create; override;
  1169. end;
  1170. TfdRGB8 = class(TfdRGB_UB3)
  1171. constructor Create; override;
  1172. end;
  1173. TfdRGB10 = class(TfdUniversal_UI1)
  1174. constructor Create; override;
  1175. end;
  1176. TfdRGB12 = class(TfdRGB_US3)
  1177. constructor Create; override;
  1178. end;
  1179. TfdRGB16 = class(TfdRGB_US3)
  1180. constructor Create; override;
  1181. end;
  1182. TfdRGBA2 = class(TfdRGBA_UB4)
  1183. constructor Create; override;
  1184. end;
  1185. TfdRGBA4 = class(TfdUniversal_US1)
  1186. constructor Create; override;
  1187. end;
  1188. TfdRGB5A1 = class(TfdUniversal_US1)
  1189. constructor Create; override;
  1190. end;
  1191. TfdRGBA8 = class(TfdRGBA_UB4)
  1192. constructor Create; override;
  1193. end;
  1194. TfdRGB10A2 = class(TfdUniversal_UI1)
  1195. constructor Create; override;
  1196. end;
  1197. TfdRGBA12 = class(TfdRGBA_US4)
  1198. constructor Create; override;
  1199. end;
  1200. TfdRGBA16 = class(TfdRGBA_US4)
  1201. constructor Create; override;
  1202. end;
  1203. TfdBGR4 = class(TfdUniversal_US1)
  1204. constructor Create; override;
  1205. end;
  1206. TfdB5G6R5 = class(TfdUniversal_US1)
  1207. constructor Create; override;
  1208. end;
  1209. TfdBGR5 = class(TfdUniversal_US1)
  1210. constructor Create; override;
  1211. end;
  1212. TfdBGR8 = class(TfdBGR_UB3)
  1213. constructor Create; override;
  1214. end;
  1215. TfdBGR10 = class(TfdUniversal_UI1)
  1216. constructor Create; override;
  1217. end;
  1218. TfdBGR12 = class(TfdBGR_US3)
  1219. constructor Create; override;
  1220. end;
  1221. TfdBGR16 = class(TfdBGR_US3)
  1222. constructor Create; override;
  1223. end;
  1224. TfdBGRA2 = class(TfdBGRA_UB4)
  1225. constructor Create; override;
  1226. end;
  1227. TfdBGRA4 = class(TfdUniversal_US1)
  1228. constructor Create; override;
  1229. end;
  1230. TfdBGR5A1 = class(TfdUniversal_US1)
  1231. constructor Create; override;
  1232. end;
  1233. TfdBGRA8 = class(TfdBGRA_UB4)
  1234. constructor Create; override;
  1235. end;
  1236. TfdBGR10A2 = class(TfdUniversal_UI1)
  1237. constructor Create; override;
  1238. end;
  1239. TfdBGRA12 = class(TfdBGRA_US4)
  1240. constructor Create; override;
  1241. end;
  1242. TfdBGRA16 = class(TfdBGRA_US4)
  1243. constructor Create; override;
  1244. end;
  1245. TfdDepth16 = class(TfdDepth_US1)
  1246. constructor Create; override;
  1247. end;
  1248. TfdDepth24 = class(TfdDepth_UI1)
  1249. constructor Create; override;
  1250. end;
  1251. TfdDepth32 = class(TfdDepth_UI1)
  1252. constructor Create; override;
  1253. end;
  1254. TfdS3tcDtx1RGBA = class(TFormatDescriptor)
  1255. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1256. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1257. constructor Create; override;
  1258. end;
  1259. TfdS3tcDtx3RGBA = class(TFormatDescriptor)
  1260. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1261. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1262. constructor Create; override;
  1263. end;
  1264. TfdS3tcDtx5RGBA = class(TFormatDescriptor)
  1265. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1266. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1267. constructor Create; override;
  1268. end;
  1269. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1270. TbmpBitfieldFormat = class(TFormatDescriptor)
  1271. private
  1272. procedure SetRedMask (const aValue: QWord);
  1273. procedure SetGreenMask(const aValue: QWord);
  1274. procedure SetBlueMask (const aValue: QWord);
  1275. procedure SetAlphaMask(const aValue: QWord);
  1276. procedure Update(aMask: QWord; out aRange: Cardinal; out aShift: Byte);
  1277. public
  1278. property RedMask: QWord read GetRedMask write SetRedMask;
  1279. property GreenMask: QWord read GetGreenMask write SetGreenMask;
  1280. property BlueMask: QWord read GetBlueMask write SetBlueMask;
  1281. property AlphaMask: QWord read GetAlphaMask write SetAlphaMask;
  1282. property PixelSize: Single read fPixelSize write fPixelSize;
  1283. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1284. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1285. end;
  1286. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1287. TbmpColorTableEnty = packed record
  1288. b, g, r, a: Byte;
  1289. end;
  1290. TbmpColorTable = array of TbmpColorTableEnty;
  1291. TbmpColorTableFormat = class(TFormatDescriptor)
  1292. private
  1293. fColorTable: TbmpColorTable;
  1294. public
  1295. property PixelSize: Single read fPixelSize write fPixelSize;
  1296. property ColorTable: TbmpColorTable read fColorTable write fColorTable;
  1297. property Range: TglBitmapColorRec read fRange write fRange;
  1298. property Shift: TShiftRec read fShift write fShift;
  1299. property Format: TglBitmapFormat read fFormat write fFormat;
  1300. procedure CreateColorTable;
  1301. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1302. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1303. destructor Destroy; override;
  1304. end;
  1305. const
  1306. LUMINANCE_WEIGHT_R = 0.30;
  1307. LUMINANCE_WEIGHT_G = 0.59;
  1308. LUMINANCE_WEIGHT_B = 0.11;
  1309. ALPHA_WEIGHT_R = 0.30;
  1310. ALPHA_WEIGHT_G = 0.59;
  1311. ALPHA_WEIGHT_B = 0.11;
  1312. DEPTH_WEIGHT_R = 0.333333333;
  1313. DEPTH_WEIGHT_G = 0.333333333;
  1314. DEPTH_WEIGHT_B = 0.333333333;
  1315. UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
  1316. FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
  1317. TfdEmpty,
  1318. TfdAlpha4,
  1319. TfdAlpha8,
  1320. TfdAlpha12,
  1321. TfdAlpha16,
  1322. TfdLuminance4,
  1323. TfdLuminance8,
  1324. TfdLuminance12,
  1325. TfdLuminance16,
  1326. TfdLuminance4Alpha4,
  1327. TfdLuminance6Alpha2,
  1328. TfdLuminance8Alpha8,
  1329. TfdLuminance12Alpha4,
  1330. TfdLuminance12Alpha12,
  1331. TfdLuminance16Alpha16,
  1332. TfdR3G3B2,
  1333. TfdRGB4,
  1334. TfdR5G6B5,
  1335. TfdRGB5,
  1336. TfdRGB8,
  1337. TfdRGB10,
  1338. TfdRGB12,
  1339. TfdRGB16,
  1340. TfdRGBA2,
  1341. TfdRGBA4,
  1342. TfdRGB5A1,
  1343. TfdRGBA8,
  1344. TfdRGB10A2,
  1345. TfdRGBA12,
  1346. TfdRGBA16,
  1347. TfdBGR4,
  1348. TfdB5G6R5,
  1349. TfdBGR5,
  1350. TfdBGR8,
  1351. TfdBGR10,
  1352. TfdBGR12,
  1353. TfdBGR16,
  1354. TfdBGRA2,
  1355. TfdBGRA4,
  1356. TfdBGR5A1,
  1357. TfdBGRA8,
  1358. TfdBGR10A2,
  1359. TfdBGRA12,
  1360. TfdBGRA16,
  1361. TfdDepth16,
  1362. TfdDepth24,
  1363. TfdDepth32,
  1364. TfdS3tcDtx1RGBA,
  1365. TfdS3tcDtx3RGBA,
  1366. TfdS3tcDtx5RGBA
  1367. );
  1368. var
  1369. FormatDescriptorCS: TCriticalSection;
  1370. FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
  1371. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1372. constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
  1373. begin
  1374. inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1375. end;
  1376. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1377. constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
  1378. begin
  1379. inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1380. end;
  1381. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1382. function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
  1383. begin
  1384. result.Fields := [];
  1385. if X >= 0 then
  1386. result.Fields := result.Fields + [ffX];
  1387. if Y >= 0 then
  1388. result.Fields := result.Fields + [ffY];
  1389. result.X := Max(0, X);
  1390. result.Y := Max(0, Y);
  1391. end;
  1392. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1393. function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
  1394. begin
  1395. result.r := r;
  1396. result.g := g;
  1397. result.b := b;
  1398. result.a := a;
  1399. end;
  1400. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1401. function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
  1402. var
  1403. i: Integer;
  1404. begin
  1405. result := false;
  1406. for i := 0 to high(r1.arr) do
  1407. if (r1.arr[i] <> r2.arr[i]) then
  1408. exit;
  1409. result := true;
  1410. end;
  1411. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1412. function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
  1413. begin
  1414. result.r := r;
  1415. result.g := g;
  1416. result.b := b;
  1417. result.a := a;
  1418. end;
  1419. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1420. function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
  1421. begin
  1422. result := [];
  1423. if (aFormat in [
  1424. //4 bbp
  1425. tfLuminance4,
  1426. //8bpp
  1427. tfR3G3B2, tfLuminance8,
  1428. //16bpp
  1429. tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
  1430. tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,
  1431. //24bpp
  1432. tfBGR8, tfRGB8,
  1433. //32bpp
  1434. tfRGB10, tfRGB10A2, tfRGBA8,
  1435. tfBGR10, tfBGR10A2, tfBGRA8]) then
  1436. result := result + [ftBMP];
  1437. if (aFormat in [
  1438. //8 bpp
  1439. tfLuminance8, tfAlpha8,
  1440. //16 bpp
  1441. tfLuminance16, tfLuminance8Alpha8,
  1442. tfRGB5, tfRGB5A1, tfRGBA4,
  1443. tfBGR5, tfBGR5A1, tfBGRA4,
  1444. //24 bpp
  1445. tfRGB8, tfBGR8,
  1446. //32 bpp
  1447. tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
  1448. result := result + [ftTGA];
  1449. if (aFormat in [
  1450. //8 bpp
  1451. tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,
  1452. tfR3G3B2, tfRGBA2, tfBGRA2,
  1453. //16 bpp
  1454. tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,
  1455. tfRGB4, tfR5G6B5, tfRGB5, tfRGBA4, tfRGB5A1,
  1456. tfBGR4, tfB5G6R5, tfBGR5, tfBGRA4, tfBGR5A1,
  1457. //24 bpp
  1458. tfRGB8, tfBGR8,
  1459. //32 bbp
  1460. tfLuminance16Alpha16,
  1461. tfRGBA8, tfRGB10A2,
  1462. tfBGRA8, tfBGR10A2,
  1463. //compressed
  1464. tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then
  1465. result := result + [ftDDS];
  1466. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  1467. if aFormat in [
  1468. tfAlpha8, tfLuminance8, tfLuminance8Alpha8,
  1469. tfRGB8, tfRGBA8,
  1470. tfBGR8, tfBGRA8] then
  1471. result := result + [ftPNG];
  1472. {$ENDIF}
  1473. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  1474. if aFormat in [tfAlpha8, tfLuminance8, tfRGB8, tfBGR8] then
  1475. result := result + [ftJPEG];
  1476. {$ENDIF}
  1477. end;
  1478. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1479. function IsPowerOfTwo(aNumber: Integer): Boolean;
  1480. begin
  1481. while (aNumber and 1) = 0 do
  1482. aNumber := aNumber shr 1;
  1483. result := aNumber = 1;
  1484. end;
  1485. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1486. function GetTopMostBit(aBitSet: QWord): Integer;
  1487. begin
  1488. result := 0;
  1489. while aBitSet > 0 do begin
  1490. inc(result);
  1491. aBitSet := aBitSet shr 1;
  1492. end;
  1493. end;
  1494. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1495. function CountSetBits(aBitSet: QWord): Integer;
  1496. begin
  1497. result := 0;
  1498. while aBitSet > 0 do begin
  1499. if (aBitSet and 1) = 1 then
  1500. inc(result);
  1501. aBitSet := aBitSet shr 1;
  1502. end;
  1503. end;
  1504. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1505. function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1506. begin
  1507. result := Trunc(
  1508. LUMINANCE_WEIGHT_R * aPixel.Data.r +
  1509. LUMINANCE_WEIGHT_G * aPixel.Data.g +
  1510. LUMINANCE_WEIGHT_B * aPixel.Data.b);
  1511. end;
  1512. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1513. function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1514. begin
  1515. result := Trunc(
  1516. DEPTH_WEIGHT_R * aPixel.Data.r +
  1517. DEPTH_WEIGHT_G * aPixel.Data.g +
  1518. DEPTH_WEIGHT_B * aPixel.Data.b);
  1519. end;
  1520. {$IFDEF GLB_NATIVE_OGL}
  1521. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1522. //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1523. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1524. var
  1525. GL_LibHandle: Pointer = nil;
  1526. function glbGetProcAddress(aProcName: PChar; aLibHandle: Pointer = nil): Pointer;
  1527. begin
  1528. result := nil;
  1529. if not Assigned(aLibHandle) then
  1530. aLibHandle := GL_LibHandle;
  1531. {$IF DEFINED(GLB_WIN)}
  1532. result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
  1533. if Assigned(result) then
  1534. exit;
  1535. if Assigned(wglGetProcAddress) then
  1536. result := wglGetProcAddress(aProcName);
  1537. {$ELSEIF DEFINED(GLB_LINUX)}
  1538. if Assigned(glXGetProcAddress) then begin
  1539. result := glXGetProcAddress(aProcName);
  1540. if Assigned(result) then
  1541. exit;
  1542. end;
  1543. if Assigned(glXGetProcAddressARB) then begin
  1544. result := glXGetProcAddressARB(aProcName);
  1545. if Assigned(result) then
  1546. exit;
  1547. end;
  1548. result := dlsym(aLibHandle, aProcName);
  1549. {$ENDIF}
  1550. if not Assigned(result) then
  1551. raise EglBitmapException.Create('unable to load procedure form library: ' + aProcName);
  1552. end;
  1553. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  1554. var
  1555. GLU_LibHandle: Pointer = nil;
  1556. OpenGLInitialized: Boolean;
  1557. InitOpenGLCS: TCriticalSection;
  1558. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1559. procedure glbInitOpenGL;
  1560. ////////////////////////////////////////////////////////////////////////////////
  1561. function glbLoadLibrary(const aName: PChar): Pointer;
  1562. begin
  1563. {$IF DEFINED(GLB_WIN)}
  1564. result := {%H-}Pointer(LoadLibrary(aName));
  1565. {$ELSEIF DEFINED(GLB_LINUX)}
  1566. result := dlopen(Name, RTLD_LAZY);
  1567. {$ELSE}
  1568. result := nil;
  1569. {$ENDIF}
  1570. end;
  1571. ////////////////////////////////////////////////////////////////////////////////
  1572. function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
  1573. begin
  1574. result := false;
  1575. if not Assigned(aLibHandle) then
  1576. exit;
  1577. {$IF DEFINED(GLB_WIN)}
  1578. Result := FreeLibrary({%H-}HINST(aLibHandle));
  1579. {$ELSEIF DEFINED(GLB_LINUX)}
  1580. Result := dlclose(aLibHandle) = 0;
  1581. {$ENDIF}
  1582. end;
  1583. begin
  1584. if Assigned(GL_LibHandle) then
  1585. glbFreeLibrary(GL_LibHandle);
  1586. if Assigned(GLU_LibHandle) then
  1587. glbFreeLibrary(GLU_LibHandle);
  1588. GL_LibHandle := glbLoadLibrary(libopengl);
  1589. if not Assigned(GL_LibHandle) then
  1590. raise EglBitmapException.Create('unable to load library: ' + libopengl);
  1591. GLU_LibHandle := glbLoadLibrary(libglu);
  1592. if not Assigned(GLU_LibHandle) then
  1593. raise EglBitmapException.Create('unable to load library: ' + libglu);
  1594. try
  1595. {$IF DEFINED(GLB_WIN)}
  1596. wglGetProcAddress := glbGetProcAddress('wglGetProcAddress');
  1597. {$ELSEIF DEFINED(GLB_LINUX)}
  1598. glXGetProcAddress := glbGetProcAddress('glXGetProcAddress');
  1599. glXGetProcAddressARB := dglGetProcAddress('glXGetProcAddressARB');
  1600. {$ENDIF}
  1601. glEnable := glbGetProcAddress('glEnable');
  1602. glDisable := glbGetProcAddress('glDisable');
  1603. glGetString := glbGetProcAddress('glGetString');
  1604. glGetIntegerv := glbGetProcAddress('glGetIntegerv');
  1605. glTexParameteri := glbGetProcAddress('glTexParameteri');
  1606. glTexParameterfv := glbGetProcAddress('glTexParameterfv');
  1607. glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
  1608. glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
  1609. glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
  1610. glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
  1611. glGenTextures := glbGetProcAddress('glGenTextures');
  1612. glBindTexture := glbGetProcAddress('glBindTexture');
  1613. glDeleteTextures := glbGetProcAddress('glDeleteTextures');
  1614. glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
  1615. glReadPixels := glbGetProcAddress('glReadPixels');
  1616. glPixelStorei := glbGetProcAddress('glPixelStorei');
  1617. glTexImage1D := glbGetProcAddress('glTexImage1D');
  1618. glTexImage2D := glbGetProcAddress('glTexImage2D');
  1619. glGetTexImage := glbGetProcAddress('glGetTexImage');
  1620. gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
  1621. gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
  1622. finally
  1623. glbFreeLibrary(GL_LibHandle);
  1624. glbFreeLibrary(GLU_LibHandle);
  1625. end;
  1626. end;
  1627. {$ENDIF}
  1628. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1629. procedure glbReadOpenGLExtensions;
  1630. var
  1631. {$IFDEF GLB_DELPHI}
  1632. Context: HGLRC;
  1633. {$ENDIF}
  1634. Buffer: AnsiString;
  1635. MajorVersion, MinorVersion: Integer;
  1636. ///////////////////////////////////////////////////////////////////////////////////////////
  1637. procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
  1638. var
  1639. Separator: Integer;
  1640. begin
  1641. aMinor := 0;
  1642. aMajor := 0;
  1643. Separator := Pos(AnsiString('.'), aBuffer);
  1644. if (Separator > 1) and (Separator < Length(aBuffer)) and
  1645. (aBuffer[Separator - 1] in ['0'..'9']) and
  1646. (aBuffer[Separator + 1] in ['0'..'9']) then begin
  1647. Dec(Separator);
  1648. while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
  1649. Dec(Separator);
  1650. Delete(aBuffer, 1, Separator);
  1651. Separator := Pos(AnsiString('.'), aBuffer) + 1;
  1652. while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
  1653. Inc(Separator);
  1654. Delete(aBuffer, Separator, 255);
  1655. Separator := Pos(AnsiString('.'), aBuffer);
  1656. aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
  1657. aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
  1658. end;
  1659. end;
  1660. ///////////////////////////////////////////////////////////////////////////////////////////
  1661. function CheckExtension(const Extension: AnsiString): Boolean;
  1662. var
  1663. ExtPos: Integer;
  1664. begin
  1665. ExtPos := Pos(Extension, Buffer);
  1666. result := ExtPos > 0;
  1667. if result then
  1668. result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
  1669. end;
  1670. begin
  1671. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  1672. InitOpenGLCS.Enter;
  1673. try
  1674. if not OpenGLInitialized then begin
  1675. glbInitOpenGL;
  1676. OpenGLInitialized := true;
  1677. end;
  1678. finally
  1679. InitOpenGLCS.Leave;
  1680. end;
  1681. {$ENDIF}
  1682. {$IFDEF GLB_DELPHI}
  1683. Context := wglGetCurrentContext;
  1684. if (Context <> gLastContext) then begin
  1685. gLastContext := Context;
  1686. {$ENDIF}
  1687. // Version
  1688. Buffer := glGetString(GL_VERSION);
  1689. TrimVersionString(Buffer, MajorVersion, MinorVersion);
  1690. GL_VERSION_1_2 := false;
  1691. GL_VERSION_1_3 := false;
  1692. GL_VERSION_1_4 := false;
  1693. GL_VERSION_2_0 := false;
  1694. if MajorVersion = 1 then begin
  1695. if MinorVersion >= 2 then
  1696. GL_VERSION_1_2 := true;
  1697. if MinorVersion >= 3 then
  1698. GL_VERSION_1_3 := true;
  1699. if MinorVersion >= 4 then
  1700. GL_VERSION_1_4 := true;
  1701. end else if MajorVersion >= 2 then begin
  1702. GL_VERSION_1_2 := true;
  1703. GL_VERSION_1_3 := true;
  1704. GL_VERSION_1_4 := true;
  1705. GL_VERSION_2_0 := true;
  1706. end;
  1707. // Extensions
  1708. Buffer := glGetString(GL_EXTENSIONS);
  1709. GL_ARB_texture_border_clamp := CheckExtension('GL_ARB_texture_border_clamp');
  1710. GL_ARB_texture_non_power_of_two := CheckExtension('GL_ARB_texture_non_power_of_two');
  1711. GL_ARB_texture_rectangle := CheckExtension('GL_ARB_texture_rectangle');
  1712. GL_ARB_texture_mirrored_repeat := CheckExtension('GL_ARB_texture_mirrored_repeat');
  1713. GL_EXT_texture_edge_clamp := CheckExtension('GL_EXT_texture_edge_clamp');
  1714. GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
  1715. GL_EXT_texture_rectangle := CheckExtension('GL_EXT_texture_rectangle');
  1716. GL_NV_texture_rectangle := CheckExtension('GL_NV_texture_rectangle');
  1717. GL_IBM_texture_mirrored_repeat := CheckExtension('GL_IBM_texture_mirrored_repeat');
  1718. GL_SGIS_generate_mipmap := CheckExtension('GL_SGIS_generate_mipmap');
  1719. if GL_VERSION_1_3 then begin
  1720. glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1D');
  1721. glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2D');
  1722. glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
  1723. end else begin
  1724. glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1DARB');
  1725. glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2DARB');
  1726. glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB');
  1727. end;
  1728. {$IFDEF GLB_DELPHI}
  1729. end;
  1730. {$ENDIF}
  1731. end;
  1732. {$ENDIF}
  1733. (* TODO GLB_DELPHI
  1734. {$IFDEF GLB_DELPHI}
  1735. function CreateGrayPalette: HPALETTE;
  1736. var
  1737. Idx: Integer;
  1738. Pal: PLogPalette;
  1739. begin
  1740. GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
  1741. Pal.palVersion := $300;
  1742. Pal.palNumEntries := 256;
  1743. {$IFOPT R+}
  1744. {$DEFINE GLB_TEMPRANGECHECK}
  1745. {$R-}
  1746. {$ENDIF}
  1747. for Idx := 0 to 256 - 1 do begin
  1748. Pal.palPalEntry[Idx].peRed := Idx;
  1749. Pal.palPalEntry[Idx].peGreen := Idx;
  1750. Pal.palPalEntry[Idx].peBlue := Idx;
  1751. Pal.palPalEntry[Idx].peFlags := 0;
  1752. end;
  1753. {$IFDEF GLB_TEMPRANGECHECK}
  1754. {$UNDEF GLB_TEMPRANGECHECK}
  1755. {$R+}
  1756. {$ENDIF}
  1757. result := CreatePalette(Pal^);
  1758. FreeMem(Pal);
  1759. end;
  1760. {$ENDIF}
  1761. *)
  1762. {$IFDEF GLB_SDL_IMAGE}
  1763. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1764. // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1765. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1766. function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
  1767. begin
  1768. result := TStream(context^.unknown.data1).Seek(offset, whence);
  1769. end;
  1770. function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
  1771. begin
  1772. result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
  1773. end;
  1774. function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
  1775. begin
  1776. result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
  1777. end;
  1778. function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
  1779. begin
  1780. result := 0;
  1781. end;
  1782. function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
  1783. begin
  1784. result := SDL_AllocRW;
  1785. if result = nil then
  1786. raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
  1787. result^.seek := glBitmapRWseek;
  1788. result^.read := glBitmapRWread;
  1789. result^.write := glBitmapRWwrite;
  1790. result^.close := glBitmapRWclose;
  1791. result^.unknown.data1 := Stream;
  1792. end;
  1793. {$ENDIF}
  1794. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1795. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1796. begin
  1797. glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
  1798. end;
  1799. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1800. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1801. begin
  1802. glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
  1803. end;
  1804. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1805. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1806. begin
  1807. glBitmapDefaultMipmap := aValue;
  1808. end;
  1809. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1810. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1811. begin
  1812. glBitmapDefaultFormat := aFormat;
  1813. end;
  1814. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1815. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1816. begin
  1817. glBitmapDefaultFilterMin := aMin;
  1818. glBitmapDefaultFilterMag := aMag;
  1819. end;
  1820. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1821. procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
  1822. begin
  1823. glBitmapDefaultWrapS := S;
  1824. glBitmapDefaultWrapT := T;
  1825. glBitmapDefaultWrapR := R;
  1826. end;
  1827. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1828. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1829. begin
  1830. result := glBitmapDefaultDeleteTextureOnFree;
  1831. end;
  1832. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1833. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1834. begin
  1835. result := glBitmapDefaultFreeDataAfterGenTextures;
  1836. end;
  1837. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1838. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1839. begin
  1840. result := glBitmapDefaultMipmap;
  1841. end;
  1842. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1843. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1844. begin
  1845. result := glBitmapDefaultFormat;
  1846. end;
  1847. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1848. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  1849. begin
  1850. aMin := glBitmapDefaultFilterMin;
  1851. aMag := glBitmapDefaultFilterMag;
  1852. end;
  1853. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1854. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  1855. begin
  1856. S := glBitmapDefaultWrapS;
  1857. T := glBitmapDefaultWrapT;
  1858. R := glBitmapDefaultWrapR;
  1859. end;
  1860. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1861. //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1862. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1863. function TFormatDescriptor.GetRedMask: QWord;
  1864. begin
  1865. result := fRange.r shl fShift.r;
  1866. end;
  1867. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1868. function TFormatDescriptor.GetGreenMask: QWord;
  1869. begin
  1870. result := fRange.g shl fShift.g;
  1871. end;
  1872. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1873. function TFormatDescriptor.GetBlueMask: QWord;
  1874. begin
  1875. result := fRange.b shl fShift.b;
  1876. end;
  1877. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1878. function TFormatDescriptor.GetAlphaMask: QWord;
  1879. begin
  1880. result := fRange.a shl fShift.a;
  1881. end;
  1882. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1883. function TFormatDescriptor.GetComponents: Integer;
  1884. var
  1885. i: Integer;
  1886. begin
  1887. result := 0;
  1888. for i := 0 to 3 do
  1889. if (fRange.arr[i] > 0) then
  1890. inc(result);
  1891. end;
  1892. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1893. function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
  1894. var
  1895. w, h: Integer;
  1896. begin
  1897. if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
  1898. w := Max(1, aSize.X);
  1899. h := Max(1, aSize.Y);
  1900. result := GetSize(w, h);
  1901. end else
  1902. result := 0;
  1903. end;
  1904. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1905. function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
  1906. begin
  1907. result := 0;
  1908. if (aWidth <= 0) or (aHeight <= 0) then
  1909. exit;
  1910. result := Ceil(aWidth * aHeight * fPixelSize);
  1911. end;
  1912. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1913. function TFormatDescriptor.CreateMappingData: Pointer;
  1914. begin
  1915. result := nil;
  1916. end;
  1917. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1918. procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
  1919. begin
  1920. //DUMMY
  1921. end;
  1922. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1923. function TFormatDescriptor.IsEmpty: Boolean;
  1924. begin
  1925. result := (fFormat = tfEmpty);
  1926. end;
  1927. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1928. function TFormatDescriptor.HasAlpha: Boolean;
  1929. begin
  1930. result := (fRange.a > 0);
  1931. end;
  1932. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1933. function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean;
  1934. begin
  1935. result := false;
  1936. if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
  1937. raise EglBitmapException.Create('FormatCheckFormat - All Masks are 0');
  1938. if (aRedMask <> RedMask) then
  1939. exit;
  1940. if (aGreenMask <> GreenMask) then
  1941. exit;
  1942. if (aBlueMask <> BlueMask) then
  1943. exit;
  1944. if (aAlphaMask <> AlphaMask) then
  1945. exit;
  1946. result := true;
  1947. end;
  1948. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1949. procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
  1950. begin
  1951. FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
  1952. aPixel.Data := fRange;
  1953. aPixel.Range := fRange;
  1954. aPixel.Format := fFormat;
  1955. end;
  1956. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1957. constructor TFormatDescriptor.Create;
  1958. begin
  1959. inherited Create;
  1960. fFormat := tfEmpty;
  1961. fWithAlpha := tfEmpty;
  1962. fWithoutAlpha := tfEmpty;
  1963. fRGBInverted := tfEmpty;
  1964. fUncompressed := tfEmpty;
  1965. fPixelSize := 0.0;
  1966. fIsCompressed := false;
  1967. fglFormat := 0;
  1968. fglInternalFormat := 0;
  1969. fglDataFormat := 0;
  1970. FillChar(fRange, 0, SizeOf(fRange));
  1971. FillChar(fShift, 0, SizeOf(fShift));
  1972. end;
  1973. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1974. //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1975. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1976. procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1977. begin
  1978. aData^ := aPixel.Data.a;
  1979. inc(aData);
  1980. end;
  1981. procedure TfdAlpha_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1982. begin
  1983. aPixel.Data.r := 0;
  1984. aPixel.Data.g := 0;
  1985. aPixel.Data.b := 0;
  1986. aPixel.Data.a := aData^;
  1987. inc(aData);
  1988. end;
  1989. constructor TfdAlpha_UB1.Create;
  1990. begin
  1991. inherited Create;
  1992. fPixelSize := 1.0;
  1993. fRange.a := $FF;
  1994. fglFormat := GL_ALPHA;
  1995. fglDataFormat := GL_UNSIGNED_BYTE;
  1996. end;
  1997. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1998. //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1999. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2000. procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2001. begin
  2002. aData^ := LuminanceWeight(aPixel);
  2003. inc(aData);
  2004. end;
  2005. procedure TfdLuminance_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2006. begin
  2007. aPixel.Data.r := aData^;
  2008. aPixel.Data.g := aData^;
  2009. aPixel.Data.b := aData^;
  2010. aPixel.Data.a := 0;
  2011. inc(aData);
  2012. end;
  2013. constructor TfdLuminance_UB1.Create;
  2014. begin
  2015. inherited Create;
  2016. fPixelSize := 1.0;
  2017. fRange.r := $FF;
  2018. fRange.g := $FF;
  2019. fRange.b := $FF;
  2020. fglFormat := GL_LUMINANCE;
  2021. fglDataFormat := GL_UNSIGNED_BYTE;
  2022. end;
  2023. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2024. //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2025. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2026. procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2027. var
  2028. i: Integer;
  2029. begin
  2030. aData^ := 0;
  2031. for i := 0 to 3 do
  2032. if (fRange.arr[i] > 0) then
  2033. aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2034. inc(aData);
  2035. end;
  2036. procedure TfdUniversal_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2037. var
  2038. i: Integer;
  2039. begin
  2040. for i := 0 to 3 do
  2041. aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
  2042. inc(aData);
  2043. end;
  2044. constructor TfdUniversal_UB1.Create;
  2045. begin
  2046. inherited Create;
  2047. fPixelSize := 1.0;
  2048. end;
  2049. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2050. //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2051. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2052. procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2053. begin
  2054. inherited Map(aPixel, aData, aMapData);
  2055. aData^ := aPixel.Data.a;
  2056. inc(aData);
  2057. end;
  2058. procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2059. begin
  2060. inherited Unmap(aData, aPixel, aMapData);
  2061. aPixel.Data.a := aData^;
  2062. inc(aData);
  2063. end;
  2064. constructor TfdLuminanceAlpha_UB2.Create;
  2065. begin
  2066. inherited Create;
  2067. fPixelSize := 2.0;
  2068. fRange.a := $FF;
  2069. fShift.a := 8;
  2070. fglFormat := GL_LUMINANCE_ALPHA;
  2071. fglDataFormat := GL_UNSIGNED_BYTE;
  2072. end;
  2073. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2074. //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2075. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2076. procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2077. begin
  2078. aData^ := aPixel.Data.r;
  2079. inc(aData);
  2080. aData^ := aPixel.Data.g;
  2081. inc(aData);
  2082. aData^ := aPixel.Data.b;
  2083. inc(aData);
  2084. end;
  2085. procedure TfdRGB_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2086. begin
  2087. aPixel.Data.r := aData^;
  2088. inc(aData);
  2089. aPixel.Data.g := aData^;
  2090. inc(aData);
  2091. aPixel.Data.b := aData^;
  2092. inc(aData);
  2093. aPixel.Data.a := 0;
  2094. end;
  2095. constructor TfdRGB_UB3.Create;
  2096. begin
  2097. inherited Create;
  2098. fPixelSize := 3.0;
  2099. fRange.r := $FF;
  2100. fRange.g := $FF;
  2101. fRange.b := $FF;
  2102. fShift.r := 0;
  2103. fShift.g := 8;
  2104. fShift.b := 16;
  2105. fglFormat := GL_RGB;
  2106. fglDataFormat := GL_UNSIGNED_BYTE;
  2107. end;
  2108. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2109. //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2110. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2111. procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2112. begin
  2113. aData^ := aPixel.Data.b;
  2114. inc(aData);
  2115. aData^ := aPixel.Data.g;
  2116. inc(aData);
  2117. aData^ := aPixel.Data.r;
  2118. inc(aData);
  2119. end;
  2120. procedure TfdBGR_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2121. begin
  2122. aPixel.Data.b := aData^;
  2123. inc(aData);
  2124. aPixel.Data.g := aData^;
  2125. inc(aData);
  2126. aPixel.Data.r := aData^;
  2127. inc(aData);
  2128. aPixel.Data.a := 0;
  2129. end;
  2130. constructor TfdBGR_UB3.Create;
  2131. begin
  2132. fPixelSize := 3.0;
  2133. fRange.r := $FF;
  2134. fRange.g := $FF;
  2135. fRange.b := $FF;
  2136. fShift.r := 16;
  2137. fShift.g := 8;
  2138. fShift.b := 0;
  2139. fglFormat := GL_BGR;
  2140. fglDataFormat := GL_UNSIGNED_BYTE;
  2141. end;
  2142. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2143. //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2144. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2145. procedure TfdRGBA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2146. begin
  2147. inherited Map(aPixel, aData, aMapData);
  2148. aData^ := aPixel.Data.a;
  2149. inc(aData);
  2150. end;
  2151. procedure TfdRGBA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2152. begin
  2153. inherited Unmap(aData, aPixel, aMapData);
  2154. aPixel.Data.a := aData^;
  2155. inc(aData);
  2156. end;
  2157. constructor TfdRGBA_UB4.Create;
  2158. begin
  2159. inherited Create;
  2160. fPixelSize := 4.0;
  2161. fRange.a := $FF;
  2162. fShift.a := 24;
  2163. fglFormat := GL_RGBA;
  2164. fglDataFormat := GL_UNSIGNED_BYTE;
  2165. end;
  2166. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2167. //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2168. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2169. procedure TfdBGRA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2170. begin
  2171. inherited Map(aPixel, aData, aMapData);
  2172. aData^ := aPixel.Data.a;
  2173. inc(aData);
  2174. end;
  2175. procedure TfdBGRA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2176. begin
  2177. inherited Unmap(aData, aPixel, aMapData);
  2178. aPixel.Data.a := aData^;
  2179. inc(aData);
  2180. end;
  2181. constructor TfdBGRA_UB4.Create;
  2182. begin
  2183. inherited Create;
  2184. fPixelSize := 4.0;
  2185. fRange.a := $FF;
  2186. fShift.a := 24;
  2187. fglFormat := GL_BGRA;
  2188. fglDataFormat := GL_UNSIGNED_BYTE;
  2189. end;
  2190. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2191. //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2192. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2193. procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2194. begin
  2195. PWord(aData)^ := aPixel.Data.a;
  2196. inc(aData, 2);
  2197. end;
  2198. procedure TfdAlpha_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2199. begin
  2200. aPixel.Data.r := 0;
  2201. aPixel.Data.g := 0;
  2202. aPixel.Data.b := 0;
  2203. aPixel.Data.a := PWord(aData)^;
  2204. inc(aData, 2);
  2205. end;
  2206. constructor TfdAlpha_US1.Create;
  2207. begin
  2208. inherited Create;
  2209. fPixelSize := 2.0;
  2210. fRange.a := $FFFF;
  2211. fglFormat := GL_ALPHA;
  2212. fglDataFormat := GL_UNSIGNED_SHORT;
  2213. end;
  2214. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2215. //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2216. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2217. procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2218. begin
  2219. PWord(aData)^ := LuminanceWeight(aPixel);
  2220. inc(aData, 2);
  2221. end;
  2222. procedure TfdLuminance_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2223. begin
  2224. aPixel.Data.r := PWord(aData)^;
  2225. aPixel.Data.g := PWord(aData)^;
  2226. aPixel.Data.b := PWord(aData)^;
  2227. aPixel.Data.a := 0;
  2228. inc(aData, 2);
  2229. end;
  2230. constructor TfdLuminance_US1.Create;
  2231. begin
  2232. inherited Create;
  2233. fPixelSize := 2.0;
  2234. fRange.r := $FFFF;
  2235. fRange.g := $FFFF;
  2236. fRange.b := $FFFF;
  2237. fglFormat := GL_LUMINANCE;
  2238. fglDataFormat := GL_UNSIGNED_SHORT;
  2239. end;
  2240. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2241. //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2242. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2243. procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2244. var
  2245. i: Integer;
  2246. begin
  2247. PWord(aData)^ := 0;
  2248. for i := 0 to 3 do
  2249. if (fRange.arr[i] > 0) then
  2250. PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2251. inc(aData, 2);
  2252. end;
  2253. procedure TfdUniversal_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2254. var
  2255. i: Integer;
  2256. begin
  2257. for i := 0 to 3 do
  2258. aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
  2259. inc(aData, 2);
  2260. end;
  2261. constructor TfdUniversal_US1.Create;
  2262. begin
  2263. inherited Create;
  2264. fPixelSize := 2.0;
  2265. end;
  2266. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2267. //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2268. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2269. procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2270. begin
  2271. PWord(aData)^ := DepthWeight(aPixel);
  2272. inc(aData, 2);
  2273. end;
  2274. procedure TfdDepth_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2275. begin
  2276. aPixel.Data.r := PWord(aData)^;
  2277. aPixel.Data.g := PWord(aData)^;
  2278. aPixel.Data.b := PWord(aData)^;
  2279. aPixel.Data.a := 0;
  2280. inc(aData, 2);
  2281. end;
  2282. constructor TfdDepth_US1.Create;
  2283. begin
  2284. inherited Create;
  2285. fPixelSize := 2.0;
  2286. fRange.r := $FFFF;
  2287. fRange.g := $FFFF;
  2288. fRange.b := $FFFF;
  2289. fglFormat := GL_DEPTH_COMPONENT;
  2290. fglDataFormat := GL_UNSIGNED_SHORT;
  2291. end;
  2292. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2293. //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2294. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2295. procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2296. begin
  2297. inherited Map(aPixel, aData, aMapData);
  2298. PWord(aData)^ := aPixel.Data.a;
  2299. inc(aData, 2);
  2300. end;
  2301. procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2302. begin
  2303. inherited Unmap(aData, aPixel, aMapData);
  2304. aPixel.Data.a := PWord(aData)^;
  2305. inc(aData, 2);
  2306. end;
  2307. constructor TfdLuminanceAlpha_US2.Create;
  2308. begin
  2309. inherited Create;
  2310. fPixelSize := 4.0;
  2311. fRange.a := $FFFF;
  2312. fShift.a := 16;
  2313. fglFormat := GL_LUMINANCE_ALPHA;
  2314. fglDataFormat := GL_UNSIGNED_SHORT;
  2315. end;
  2316. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2317. //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2318. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2319. procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2320. begin
  2321. PWord(aData)^ := aPixel.Data.r;
  2322. inc(aData, 2);
  2323. PWord(aData)^ := aPixel.Data.g;
  2324. inc(aData, 2);
  2325. PWord(aData)^ := aPixel.Data.b;
  2326. inc(aData, 2);
  2327. end;
  2328. procedure TfdRGB_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2329. begin
  2330. aPixel.Data.r := PWord(aData)^;
  2331. inc(aData, 2);
  2332. aPixel.Data.g := PWord(aData)^;
  2333. inc(aData, 2);
  2334. aPixel.Data.b := PWord(aData)^;
  2335. inc(aData, 2);
  2336. aPixel.Data.a := 0;
  2337. end;
  2338. constructor TfdRGB_US3.Create;
  2339. begin
  2340. inherited Create;
  2341. fPixelSize := 6.0;
  2342. fRange.r := $FFFF;
  2343. fRange.g := $FFFF;
  2344. fRange.b := $FFFF;
  2345. fShift.r := 0;
  2346. fShift.g := 16;
  2347. fShift.b := 32;
  2348. fglFormat := GL_RGB;
  2349. fglDataFormat := GL_UNSIGNED_SHORT;
  2350. end;
  2351. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2352. //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2353. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2354. procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2355. begin
  2356. PWord(aData)^ := aPixel.Data.b;
  2357. inc(aData, 2);
  2358. PWord(aData)^ := aPixel.Data.g;
  2359. inc(aData, 2);
  2360. PWord(aData)^ := aPixel.Data.r;
  2361. inc(aData, 2);
  2362. end;
  2363. procedure TfdBGR_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2364. begin
  2365. aPixel.Data.b := PWord(aData)^;
  2366. inc(aData, 2);
  2367. aPixel.Data.g := PWord(aData)^;
  2368. inc(aData, 2);
  2369. aPixel.Data.r := PWord(aData)^;
  2370. inc(aData, 2);
  2371. aPixel.Data.a := 0;
  2372. end;
  2373. constructor TfdBGR_US3.Create;
  2374. begin
  2375. inherited Create;
  2376. fPixelSize := 6.0;
  2377. fRange.r := $FFFF;
  2378. fRange.g := $FFFF;
  2379. fRange.b := $FFFF;
  2380. fShift.r := 32;
  2381. fShift.g := 16;
  2382. fShift.b := 0;
  2383. fglFormat := GL_BGR;
  2384. fglDataFormat := GL_UNSIGNED_SHORT;
  2385. end;
  2386. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2387. //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2388. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2389. procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2390. begin
  2391. inherited Map(aPixel, aData, aMapData);
  2392. PWord(aData)^ := aPixel.Data.a;
  2393. inc(aData, 2);
  2394. end;
  2395. procedure TfdRGBA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2396. begin
  2397. inherited Unmap(aData, aPixel, aMapData);
  2398. aPixel.Data.a := PWord(aData)^;
  2399. inc(aData, 2);
  2400. end;
  2401. constructor TfdRGBA_US4.Create;
  2402. begin
  2403. inherited Create;
  2404. fPixelSize := 8.0;
  2405. fRange.a := $FFFF;
  2406. fShift.a := 48;
  2407. fglFormat := GL_RGBA;
  2408. fglDataFormat := GL_UNSIGNED_SHORT;
  2409. end;
  2410. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2411. //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2412. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2413. procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2414. begin
  2415. inherited Map(aPixel, aData, aMapData);
  2416. PWord(aData)^ := aPixel.Data.a;
  2417. inc(aData, 2);
  2418. end;
  2419. procedure TfdBGRA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2420. begin
  2421. inherited Unmap(aData, aPixel, aMapData);
  2422. aPixel.Data.a := PWord(aData)^;
  2423. inc(aData, 2);
  2424. end;
  2425. constructor TfdBGRA_US4.Create;
  2426. begin
  2427. inherited Create;
  2428. fPixelSize := 8.0;
  2429. fRange.a := $FFFF;
  2430. fShift.a := 48;
  2431. fglFormat := GL_BGRA;
  2432. fglDataFormat := GL_UNSIGNED_SHORT;
  2433. end;
  2434. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2435. //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2436. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2437. procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2438. var
  2439. i: Integer;
  2440. begin
  2441. PCardinal(aData)^ := 0;
  2442. for i := 0 to 3 do
  2443. if (fRange.arr[i] > 0) then
  2444. PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2445. inc(aData, 4);
  2446. end;
  2447. procedure TfdUniversal_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2448. var
  2449. i: Integer;
  2450. begin
  2451. for i := 0 to 3 do
  2452. aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
  2453. inc(aData, 2);
  2454. end;
  2455. constructor TfdUniversal_UI1.Create;
  2456. begin
  2457. inherited Create;
  2458. fPixelSize := 4.0;
  2459. end;
  2460. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2461. //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2462. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2463. procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2464. begin
  2465. PCardinal(aData)^ := DepthWeight(aPixel);
  2466. inc(aData, 4);
  2467. end;
  2468. procedure TfdDepth_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2469. begin
  2470. aPixel.Data.r := PCardinal(aData)^;
  2471. aPixel.Data.g := PCardinal(aData)^;
  2472. aPixel.Data.b := PCardinal(aData)^;
  2473. aPixel.Data.a := 0;
  2474. inc(aData, 4);
  2475. end;
  2476. constructor TfdDepth_UI1.Create;
  2477. begin
  2478. inherited Create;
  2479. fPixelSize := 4.0;
  2480. fRange.r := $FFFFFFFF;
  2481. fRange.g := $FFFFFFFF;
  2482. fRange.b := $FFFFFFFF;
  2483. fglFormat := GL_DEPTH_COMPONENT;
  2484. fglDataFormat := GL_UNSIGNED_INT;
  2485. end;
  2486. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2487. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2488. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2489. constructor TfdAlpha4.Create;
  2490. begin
  2491. inherited Create;
  2492. fFormat := tfAlpha4;
  2493. fWithAlpha := tfAlpha4;
  2494. fglInternalFormat := GL_ALPHA4;
  2495. end;
  2496. constructor TfdAlpha8.Create;
  2497. begin
  2498. inherited Create;
  2499. fFormat := tfAlpha8;
  2500. fWithAlpha := tfAlpha8;
  2501. fglInternalFormat := GL_ALPHA8;
  2502. end;
  2503. constructor TfdAlpha12.Create;
  2504. begin
  2505. inherited Create;
  2506. fFormat := tfAlpha12;
  2507. fWithAlpha := tfAlpha12;
  2508. fglInternalFormat := GL_ALPHA12;
  2509. end;
  2510. constructor TfdAlpha16.Create;
  2511. begin
  2512. inherited Create;
  2513. fFormat := tfAlpha16;
  2514. fWithAlpha := tfAlpha16;
  2515. fglInternalFormat := GL_ALPHA16;
  2516. end;
  2517. constructor TfdLuminance4.Create;
  2518. begin
  2519. inherited Create;
  2520. fFormat := tfLuminance4;
  2521. fWithAlpha := tfLuminance4Alpha4;
  2522. fWithoutAlpha := tfLuminance4;
  2523. fglInternalFormat := GL_LUMINANCE4;
  2524. end;
  2525. constructor TfdLuminance8.Create;
  2526. begin
  2527. inherited Create;
  2528. fFormat := tfLuminance8;
  2529. fWithAlpha := tfLuminance8Alpha8;
  2530. fWithoutAlpha := tfLuminance8;
  2531. fglInternalFormat := GL_LUMINANCE8;
  2532. end;
  2533. constructor TfdLuminance12.Create;
  2534. begin
  2535. inherited Create;
  2536. fFormat := tfLuminance12;
  2537. fWithAlpha := tfLuminance12Alpha12;
  2538. fWithoutAlpha := tfLuminance12;
  2539. fglInternalFormat := GL_LUMINANCE12;
  2540. end;
  2541. constructor TfdLuminance16.Create;
  2542. begin
  2543. inherited Create;
  2544. fFormat := tfLuminance16;
  2545. fWithAlpha := tfLuminance16Alpha16;
  2546. fWithoutAlpha := tfLuminance16;
  2547. fglInternalFormat := GL_LUMINANCE16;
  2548. end;
  2549. constructor TfdLuminance4Alpha4.Create;
  2550. begin
  2551. inherited Create;
  2552. fFormat := tfLuminance4Alpha4;
  2553. fWithAlpha := tfLuminance4Alpha4;
  2554. fWithoutAlpha := tfLuminance4;
  2555. fglInternalFormat := GL_LUMINANCE4_ALPHA4;
  2556. end;
  2557. constructor TfdLuminance6Alpha2.Create;
  2558. begin
  2559. inherited Create;
  2560. fFormat := tfLuminance6Alpha2;
  2561. fWithAlpha := tfLuminance6Alpha2;
  2562. fWithoutAlpha := tfLuminance8;
  2563. fglInternalFormat := GL_LUMINANCE6_ALPHA2;
  2564. end;
  2565. constructor TfdLuminance8Alpha8.Create;
  2566. begin
  2567. inherited Create;
  2568. fFormat := tfLuminance8Alpha8;
  2569. fWithAlpha := tfLuminance8Alpha8;
  2570. fWithoutAlpha := tfLuminance8;
  2571. fglInternalFormat := GL_LUMINANCE8_ALPHA8;
  2572. end;
  2573. constructor TfdLuminance12Alpha4.Create;
  2574. begin
  2575. inherited Create;
  2576. fFormat := tfLuminance12Alpha4;
  2577. fWithAlpha := tfLuminance12Alpha4;
  2578. fWithoutAlpha := tfLuminance12;
  2579. fglInternalFormat := GL_LUMINANCE12_ALPHA4;
  2580. end;
  2581. constructor TfdLuminance12Alpha12.Create;
  2582. begin
  2583. inherited Create;
  2584. fFormat := tfLuminance12Alpha12;
  2585. fWithAlpha := tfLuminance12Alpha12;
  2586. fWithoutAlpha := tfLuminance12;
  2587. fglInternalFormat := GL_LUMINANCE12_ALPHA12;
  2588. end;
  2589. constructor TfdLuminance16Alpha16.Create;
  2590. begin
  2591. inherited Create;
  2592. fFormat := tfLuminance16Alpha16;
  2593. fWithAlpha := tfLuminance16Alpha16;
  2594. fWithoutAlpha := tfLuminance16;
  2595. fglInternalFormat := GL_LUMINANCE16_ALPHA16;
  2596. end;
  2597. constructor TfdR3G3B2.Create;
  2598. begin
  2599. inherited Create;
  2600. fFormat := tfR3G3B2;
  2601. fWithAlpha := tfRGBA2;
  2602. fWithoutAlpha := tfR3G3B2;
  2603. fRange.r := $7;
  2604. fRange.g := $7;
  2605. fRange.b := $3;
  2606. fShift.r := 0;
  2607. fShift.g := 3;
  2608. fShift.b := 6;
  2609. fglFormat := GL_RGB;
  2610. fglInternalFormat := GL_R3_G3_B2;
  2611. fglDataFormat := GL_UNSIGNED_BYTE_2_3_3_REV;
  2612. end;
  2613. constructor TfdRGB4.Create;
  2614. begin
  2615. inherited Create;
  2616. fFormat := tfRGB4;
  2617. fWithAlpha := tfRGBA4;
  2618. fWithoutAlpha := tfRGB4;
  2619. fRGBInverted := tfBGR4;
  2620. fRange.r := $F;
  2621. fRange.g := $F;
  2622. fRange.b := $F;
  2623. fShift.r := 0;
  2624. fShift.g := 4;
  2625. fShift.b := 8;
  2626. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2627. fglInternalFormat := GL_RGB4;
  2628. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2629. end;
  2630. constructor TfdR5G6B5.Create;
  2631. begin
  2632. inherited Create;
  2633. fFormat := tfR5G6B5;
  2634. fWithAlpha := tfRGBA4;
  2635. fWithoutAlpha := tfR5G6B5;
  2636. fRGBInverted := tfB5G6R5;
  2637. fRange.r := $1F;
  2638. fRange.g := $3F;
  2639. fRange.b := $1F;
  2640. fShift.r := 0;
  2641. fShift.g := 5;
  2642. fShift.b := 11;
  2643. fglFormat := GL_RGB;
  2644. fglInternalFormat := GL_RGB565;
  2645. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5_REV;
  2646. end;
  2647. constructor TfdRGB5.Create;
  2648. begin
  2649. inherited Create;
  2650. fFormat := tfRGB5;
  2651. fWithAlpha := tfRGB5A1;
  2652. fWithoutAlpha := tfRGB5;
  2653. fRGBInverted := tfBGR5;
  2654. fRange.r := $1F;
  2655. fRange.g := $1F;
  2656. fRange.b := $1F;
  2657. fShift.r := 0;
  2658. fShift.g := 5;
  2659. fShift.b := 10;
  2660. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2661. fglInternalFormat := GL_RGB5;
  2662. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2663. end;
  2664. constructor TfdRGB8.Create;
  2665. begin
  2666. inherited Create;
  2667. fFormat := tfRGB8;
  2668. fWithAlpha := tfRGBA8;
  2669. fWithoutAlpha := tfRGB8;
  2670. fRGBInverted := tfBGR8;
  2671. fglInternalFormat := GL_RGB8;
  2672. end;
  2673. constructor TfdRGB10.Create;
  2674. begin
  2675. inherited Create;
  2676. fFormat := tfRGB10;
  2677. fWithAlpha := tfRGB10A2;
  2678. fWithoutAlpha := tfRGB10;
  2679. fRGBInverted := tfBGR10;
  2680. fRange.r := $3FF;
  2681. fRange.g := $3FF;
  2682. fRange.b := $3FF;
  2683. fShift.r := 0;
  2684. fShift.g := 10;
  2685. fShift.b := 20;
  2686. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2687. fglInternalFormat := GL_RGB10;
  2688. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2689. end;
  2690. constructor TfdRGB12.Create;
  2691. begin
  2692. inherited Create;
  2693. fFormat := tfRGB12;
  2694. fWithAlpha := tfRGBA12;
  2695. fWithoutAlpha := tfRGB12;
  2696. fRGBInverted := tfBGR12;
  2697. fglInternalFormat := GL_RGB12;
  2698. end;
  2699. constructor TfdRGB16.Create;
  2700. begin
  2701. inherited Create;
  2702. fFormat := tfRGB16;
  2703. fWithAlpha := tfRGBA16;
  2704. fWithoutAlpha := tfRGB16;
  2705. fRGBInverted := tfBGR16;
  2706. fglInternalFormat := GL_RGB16;
  2707. end;
  2708. constructor TfdRGBA2.Create;
  2709. begin
  2710. inherited Create;
  2711. fFormat := tfRGBA2;
  2712. fWithAlpha := tfRGBA2;
  2713. fWithoutAlpha := tfR3G3B2;
  2714. fRGBInverted := tfBGRA2;
  2715. fglInternalFormat := GL_RGBA2;
  2716. end;
  2717. constructor TfdRGBA4.Create;
  2718. begin
  2719. inherited Create;
  2720. fFormat := tfRGBA4;
  2721. fWithAlpha := tfRGBA4;
  2722. fWithoutAlpha := tfRGB4;
  2723. fRGBInverted := tfBGRA4;
  2724. fRange.r := $F;
  2725. fRange.g := $F;
  2726. fRange.b := $F;
  2727. fRange.a := $F;
  2728. fShift.r := 0;
  2729. fShift.g := 4;
  2730. fShift.b := 8;
  2731. fShift.a := 12;
  2732. fglFormat := GL_RGBA;
  2733. fglInternalFormat := GL_RGBA4;
  2734. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2735. end;
  2736. constructor TfdRGB5A1.Create;
  2737. begin
  2738. inherited Create;
  2739. fFormat := tfRGB5A1;
  2740. fWithAlpha := tfRGB5A1;
  2741. fWithoutAlpha := tfRGB5;
  2742. fRGBInverted := tfBGR5A1;
  2743. fRange.r := $1F;
  2744. fRange.g := $1F;
  2745. fRange.b := $1F;
  2746. fRange.a := $01;
  2747. fShift.r := 0;
  2748. fShift.g := 5;
  2749. fShift.b := 10;
  2750. fShift.a := 15;
  2751. fglFormat := GL_RGBA;
  2752. fglInternalFormat := GL_RGB5_A1;
  2753. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2754. end;
  2755. constructor TfdRGBA8.Create;
  2756. begin
  2757. inherited Create;
  2758. fFormat := tfRGBA8;
  2759. fWithAlpha := tfRGBA8;
  2760. fWithoutAlpha := tfRGB8;
  2761. fRGBInverted := tfBGRA8;
  2762. fglInternalFormat := GL_RGBA8;
  2763. end;
  2764. constructor TfdRGB10A2.Create;
  2765. begin
  2766. inherited Create;
  2767. fFormat := tfRGB10A2;
  2768. fWithAlpha := tfRGB10A2;
  2769. fWithoutAlpha := tfRGB10;
  2770. fRGBInverted := tfBGR10A2;
  2771. fRange.r := $3FF;
  2772. fRange.g := $3FF;
  2773. fRange.b := $3FF;
  2774. fRange.a := $003;
  2775. fShift.r := 0;
  2776. fShift.g := 10;
  2777. fShift.b := 20;
  2778. fShift.a := 30;
  2779. fglFormat := GL_RGBA;
  2780. fglInternalFormat := GL_RGB10_A2;
  2781. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2782. end;
  2783. constructor TfdRGBA12.Create;
  2784. begin
  2785. inherited Create;
  2786. fFormat := tfRGBA12;
  2787. fWithAlpha := tfRGBA12;
  2788. fWithoutAlpha := tfRGB12;
  2789. fRGBInverted := tfBGRA12;
  2790. fglInternalFormat := GL_RGBA12;
  2791. end;
  2792. constructor TfdRGBA16.Create;
  2793. begin
  2794. inherited Create;
  2795. fFormat := tfRGBA16;
  2796. fWithAlpha := tfRGBA16;
  2797. fWithoutAlpha := tfRGB16;
  2798. fRGBInverted := tfBGRA16;
  2799. fglInternalFormat := GL_RGBA16;
  2800. end;
  2801. constructor TfdBGR4.Create;
  2802. begin
  2803. inherited Create;
  2804. fPixelSize := 2.0;
  2805. fFormat := tfBGR4;
  2806. fWithAlpha := tfBGRA4;
  2807. fWithoutAlpha := tfBGR4;
  2808. fRGBInverted := tfRGB4;
  2809. fRange.r := $F;
  2810. fRange.g := $F;
  2811. fRange.b := $F;
  2812. fRange.a := $0;
  2813. fShift.r := 8;
  2814. fShift.g := 4;
  2815. fShift.b := 0;
  2816. fShift.a := 0;
  2817. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2818. fglInternalFormat := GL_RGB4;
  2819. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2820. end;
  2821. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2822. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2823. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2824. constructor TfdB5G6R5.Create;
  2825. begin
  2826. inherited Create;
  2827. fFormat := tfB5G6R5;
  2828. fWithAlpha := tfBGRA4;
  2829. fWithoutAlpha := tfB5G6R5;
  2830. fRGBInverted := tfR5G6B5;
  2831. fRange.r := $1F;
  2832. fRange.g := $3F;
  2833. fRange.b := $1F;
  2834. fShift.r := 11;
  2835. fShift.g := 5;
  2836. fShift.b := 0;
  2837. fglFormat := GL_RGB; //B5G6R5 is only possible as R5G6B5 -> use reverted dataformat
  2838. fglInternalFormat := GL_RGB8;
  2839. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5;
  2840. end;
  2841. constructor TfdBGR5.Create;
  2842. begin
  2843. inherited Create;
  2844. fPixelSize := 2.0;
  2845. fFormat := tfBGR5;
  2846. fWithAlpha := tfBGR5A1;
  2847. fWithoutAlpha := tfBGR5;
  2848. fRGBInverted := tfRGB5;
  2849. fRange.r := $1F;
  2850. fRange.g := $1F;
  2851. fRange.b := $1F;
  2852. fRange.a := $00;
  2853. fShift.r := 10;
  2854. fShift.g := 5;
  2855. fShift.b := 0;
  2856. fShift.a := 0;
  2857. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2858. fglInternalFormat := GL_RGB5;
  2859. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2860. end;
  2861. constructor TfdBGR8.Create;
  2862. begin
  2863. inherited Create;
  2864. fFormat := tfBGR8;
  2865. fWithAlpha := tfBGRA8;
  2866. fWithoutAlpha := tfBGR8;
  2867. fRGBInverted := tfRGB8;
  2868. fglInternalFormat := GL_RGB8;
  2869. end;
  2870. constructor TfdBGR10.Create;
  2871. begin
  2872. inherited Create;
  2873. fFormat := tfBGR10;
  2874. fWithAlpha := tfBGR10A2;
  2875. fWithoutAlpha := tfBGR10;
  2876. fRGBInverted := tfRGB10;
  2877. fRange.r := $3FF;
  2878. fRange.g := $3FF;
  2879. fRange.b := $3FF;
  2880. fRange.a := $000;
  2881. fShift.r := 20;
  2882. fShift.g := 10;
  2883. fShift.b := 0;
  2884. fShift.a := 0;
  2885. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2886. fglInternalFormat := GL_RGB10;
  2887. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2888. end;
  2889. constructor TfdBGR12.Create;
  2890. begin
  2891. inherited Create;
  2892. fFormat := tfBGR12;
  2893. fWithAlpha := tfBGRA12;
  2894. fWithoutAlpha := tfBGR12;
  2895. fRGBInverted := tfRGB12;
  2896. fglInternalFormat := GL_RGB12;
  2897. end;
  2898. constructor TfdBGR16.Create;
  2899. begin
  2900. inherited Create;
  2901. fFormat := tfBGR16;
  2902. fWithAlpha := tfBGRA16;
  2903. fWithoutAlpha := tfBGR16;
  2904. fRGBInverted := tfRGB16;
  2905. fglInternalFormat := GL_RGB16;
  2906. end;
  2907. constructor TfdBGRA2.Create;
  2908. begin
  2909. inherited Create;
  2910. fFormat := tfBGRA2;
  2911. fWithAlpha := tfBGRA4;
  2912. fWithoutAlpha := tfBGR4;
  2913. fRGBInverted := tfRGBA2;
  2914. fglInternalFormat := GL_RGBA2;
  2915. end;
  2916. constructor TfdBGRA4.Create;
  2917. begin
  2918. inherited Create;
  2919. fFormat := tfBGRA4;
  2920. fWithAlpha := tfBGRA4;
  2921. fWithoutAlpha := tfBGR4;
  2922. fRGBInverted := tfRGBA4;
  2923. fRange.r := $F;
  2924. fRange.g := $F;
  2925. fRange.b := $F;
  2926. fRange.a := $F;
  2927. fShift.r := 8;
  2928. fShift.g := 4;
  2929. fShift.b := 0;
  2930. fShift.a := 12;
  2931. fglFormat := GL_BGRA;
  2932. fglInternalFormat := GL_RGBA4;
  2933. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2934. end;
  2935. constructor TfdBGR5A1.Create;
  2936. begin
  2937. inherited Create;
  2938. fFormat := tfBGR5A1;
  2939. fWithAlpha := tfBGR5A1;
  2940. fWithoutAlpha := tfBGR5;
  2941. fRGBInverted := tfRGB5A1;
  2942. fRange.r := $1F;
  2943. fRange.g := $1F;
  2944. fRange.b := $1F;
  2945. fRange.a := $01;
  2946. fShift.r := 10;
  2947. fShift.g := 5;
  2948. fShift.b := 0;
  2949. fShift.a := 15;
  2950. fglFormat := GL_BGRA;
  2951. fglInternalFormat := GL_RGB5_A1;
  2952. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2953. end;
  2954. constructor TfdBGRA8.Create;
  2955. begin
  2956. inherited Create;
  2957. fFormat := tfBGRA8;
  2958. fWithAlpha := tfBGRA8;
  2959. fWithoutAlpha := tfBGR8;
  2960. fRGBInverted := tfRGBA8;
  2961. fglInternalFormat := GL_RGBA8;
  2962. end;
  2963. constructor TfdBGR10A2.Create;
  2964. begin
  2965. inherited Create;
  2966. fFormat := tfBGR10A2;
  2967. fWithAlpha := tfBGR10A2;
  2968. fWithoutAlpha := tfBGR10;
  2969. fRGBInverted := tfRGB10A2;
  2970. fRange.r := $3FF;
  2971. fRange.g := $3FF;
  2972. fRange.b := $3FF;
  2973. fRange.a := $003;
  2974. fShift.r := 20;
  2975. fShift.g := 10;
  2976. fShift.b := 0;
  2977. fShift.a := 30;
  2978. fglFormat := GL_BGRA;
  2979. fglInternalFormat := GL_RGB10_A2;
  2980. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2981. end;
  2982. constructor TfdBGRA12.Create;
  2983. begin
  2984. inherited Create;
  2985. fFormat := tfBGRA12;
  2986. fWithAlpha := tfBGRA12;
  2987. fWithoutAlpha := tfBGR12;
  2988. fRGBInverted := tfRGBA12;
  2989. fglInternalFormat := GL_RGBA12;
  2990. end;
  2991. constructor TfdBGRA16.Create;
  2992. begin
  2993. inherited Create;
  2994. fFormat := tfBGRA16;
  2995. fWithAlpha := tfBGRA16;
  2996. fWithoutAlpha := tfBGR16;
  2997. fRGBInverted := tfRGBA16;
  2998. fglInternalFormat := GL_RGBA16;
  2999. end;
  3000. constructor TfdDepth16.Create;
  3001. begin
  3002. inherited Create;
  3003. fFormat := tfDepth16;
  3004. fWithAlpha := tfEmpty;
  3005. fWithoutAlpha := tfDepth16;
  3006. fglInternalFormat := GL_DEPTH_COMPONENT16;
  3007. end;
  3008. constructor TfdDepth24.Create;
  3009. begin
  3010. inherited Create;
  3011. fFormat := tfDepth24;
  3012. fWithAlpha := tfEmpty;
  3013. fWithoutAlpha := tfDepth24;
  3014. fglInternalFormat := GL_DEPTH_COMPONENT24;
  3015. end;
  3016. constructor TfdDepth32.Create;
  3017. begin
  3018. inherited Create;
  3019. fFormat := tfDepth32;
  3020. fWithAlpha := tfEmpty;
  3021. fWithoutAlpha := tfDepth32;
  3022. fglInternalFormat := GL_DEPTH_COMPONENT32;
  3023. end;
  3024. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3025. //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3026. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3027. procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3028. begin
  3029. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  3030. end;
  3031. procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3032. begin
  3033. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  3034. end;
  3035. constructor TfdS3tcDtx1RGBA.Create;
  3036. begin
  3037. inherited Create;
  3038. fFormat := tfS3tcDtx1RGBA;
  3039. fWithAlpha := tfS3tcDtx1RGBA;
  3040. fUncompressed := tfRGB5A1;
  3041. fPixelSize := 0.5;
  3042. fIsCompressed := true;
  3043. fglFormat := GL_COMPRESSED_RGBA;
  3044. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
  3045. fglDataFormat := GL_UNSIGNED_BYTE;
  3046. end;
  3047. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3048. //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3049. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3050. procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3051. begin
  3052. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  3053. end;
  3054. procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3055. begin
  3056. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  3057. end;
  3058. constructor TfdS3tcDtx3RGBA.Create;
  3059. begin
  3060. inherited Create;
  3061. fFormat := tfS3tcDtx3RGBA;
  3062. fWithAlpha := tfS3tcDtx3RGBA;
  3063. fUncompressed := tfRGBA8;
  3064. fPixelSize := 1.0;
  3065. fIsCompressed := true;
  3066. fglFormat := GL_COMPRESSED_RGBA;
  3067. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
  3068. fglDataFormat := GL_UNSIGNED_BYTE;
  3069. end;
  3070. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3071. //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3072. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3073. procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3074. begin
  3075. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  3076. end;
  3077. procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3078. begin
  3079. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  3080. end;
  3081. constructor TfdS3tcDtx5RGBA.Create;
  3082. begin
  3083. inherited Create;
  3084. fFormat := tfS3tcDtx3RGBA;
  3085. fWithAlpha := tfS3tcDtx3RGBA;
  3086. fUncompressed := tfRGBA8;
  3087. fPixelSize := 1.0;
  3088. fIsCompressed := true;
  3089. fglFormat := GL_COMPRESSED_RGBA;
  3090. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
  3091. fglDataFormat := GL_UNSIGNED_BYTE;
  3092. end;
  3093. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3094. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3095. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3096. class procedure TFormatDescriptor.Init;
  3097. begin
  3098. if not Assigned(FormatDescriptorCS) then
  3099. FormatDescriptorCS := TCriticalSection.Create;
  3100. end;
  3101. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3102. class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3103. begin
  3104. FormatDescriptorCS.Enter;
  3105. try
  3106. result := FormatDescriptors[aFormat];
  3107. if not Assigned(result) then begin
  3108. result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
  3109. FormatDescriptors[aFormat] := result;
  3110. end;
  3111. finally
  3112. FormatDescriptorCS.Leave;
  3113. end;
  3114. end;
  3115. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3116. class function TFormatDescriptor.GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3117. begin
  3118. result := Get(Get(aFormat).WithAlpha);
  3119. end;
  3120. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3121. class procedure TFormatDescriptor.Clear;
  3122. var
  3123. f: TglBitmapFormat;
  3124. begin
  3125. FormatDescriptorCS.Enter;
  3126. try
  3127. for f := low(FormatDescriptors) to high(FormatDescriptors) do
  3128. FreeAndNil(FormatDescriptors[f]);
  3129. finally
  3130. FormatDescriptorCS.Leave;
  3131. end;
  3132. end;
  3133. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3134. class procedure TFormatDescriptor.Finalize;
  3135. begin
  3136. Clear;
  3137. FreeAndNil(FormatDescriptorCS);
  3138. end;
  3139. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3140. //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3141. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3142. procedure TbmpBitfieldFormat.SetRedMask(const aValue: QWord);
  3143. begin
  3144. Update(aValue, fRange.r, fShift.r);
  3145. end;
  3146. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3147. procedure TbmpBitfieldFormat.SetGreenMask(const aValue: QWord);
  3148. begin
  3149. Update(aValue, fRange.g, fShift.g);
  3150. end;
  3151. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3152. procedure TbmpBitfieldFormat.SetBlueMask(const aValue: QWord);
  3153. begin
  3154. Update(aValue, fRange.b, fShift.b);
  3155. end;
  3156. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3157. procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: QWord);
  3158. begin
  3159. Update(aValue, fRange.a, fShift.a);
  3160. end;
  3161. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3162. procedure TbmpBitfieldFormat.Update(aMask: QWord; out aRange: Cardinal; out
  3163. aShift: Byte);
  3164. begin
  3165. aShift := 0;
  3166. aRange := 0;
  3167. if (aMask = 0) then
  3168. exit;
  3169. while (aMask > 0) and ((aMask and 1) = 0) do begin
  3170. inc(aShift);
  3171. aMask := aMask shr 1;
  3172. end;
  3173. aRange := 1;
  3174. while (aMask > 0) do begin
  3175. aRange := aRange shl 1;
  3176. aMask := aMask shr 1;
  3177. end;
  3178. dec(aRange);
  3179. fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
  3180. end;
  3181. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3182. procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3183. var
  3184. data: QWord;
  3185. s: Integer;
  3186. begin
  3187. data :=
  3188. ((aPixel.Data.r and fRange.r) shl fShift.r) or
  3189. ((aPixel.Data.g and fRange.g) shl fShift.g) or
  3190. ((aPixel.Data.b and fRange.b) shl fShift.b) or
  3191. ((aPixel.Data.a and fRange.a) shl fShift.a);
  3192. s := Round(fPixelSize);
  3193. case s of
  3194. 1: aData^ := data;
  3195. 2: PWord(aData)^ := data;
  3196. 4: PCardinal(aData)^ := data;
  3197. 8: PQWord(aData)^ := data;
  3198. else
  3199. raise EglBitmapException.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
  3200. end;
  3201. inc(aData, s);
  3202. end;
  3203. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3204. procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3205. var
  3206. data: QWord;
  3207. s, i: Integer;
  3208. begin
  3209. s := Round(fPixelSize);
  3210. case s of
  3211. 1: data := aData^;
  3212. 2: data := PWord(aData)^;
  3213. 4: data := PCardinal(aData)^;
  3214. 8: data := PQWord(aData)^;
  3215. else
  3216. raise EglBitmapException.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
  3217. end;
  3218. for i := 0 to 3 do
  3219. aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
  3220. inc(aData, s);
  3221. end;
  3222. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3223. //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3224. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3225. procedure TbmpColorTableFormat.CreateColorTable;
  3226. var
  3227. i: Integer;
  3228. begin
  3229. if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
  3230. raise EglBitmapException.Create(UNSUPPORTED_FORMAT);
  3231. if (Format = tfLuminance4) then
  3232. SetLength(fColorTable, 16)
  3233. else
  3234. SetLength(fColorTable, 256);
  3235. case Format of
  3236. tfLuminance4: begin
  3237. for i := 0 to High(fColorTable) do begin
  3238. fColorTable[i].r := 16 * i;
  3239. fColorTable[i].g := 16 * i;
  3240. fColorTable[i].b := 16 * i;
  3241. fColorTable[i].a := 0;
  3242. end;
  3243. end;
  3244. tfLuminance8: begin
  3245. for i := 0 to High(fColorTable) do begin
  3246. fColorTable[i].r := i;
  3247. fColorTable[i].g := i;
  3248. fColorTable[i].b := i;
  3249. fColorTable[i].a := 0;
  3250. end;
  3251. end;
  3252. tfR3G3B2: begin
  3253. for i := 0 to High(fColorTable) do begin
  3254. fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
  3255. fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
  3256. fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
  3257. fColorTable[i].a := 0;
  3258. end;
  3259. end;
  3260. end;
  3261. end;
  3262. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3263. procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3264. var
  3265. d: Byte;
  3266. begin
  3267. if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
  3268. raise EglBitmapException.Create(UNSUPPORTED_FORMAT);
  3269. case Format of
  3270. tfLuminance4: begin
  3271. if (aMapData = nil) then
  3272. aData^ := 0;
  3273. d := LuminanceWeight(aPixel) and Range.r;
  3274. aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData)));
  3275. inc(aMapData, 4);
  3276. if ({%H-}PtrUInt(aMapData) >= 8) then begin
  3277. inc(aData);
  3278. aMapData := nil;
  3279. end;
  3280. end;
  3281. tfLuminance8: begin
  3282. aData^ := LuminanceWeight(aPixel) and Range.r;
  3283. inc(aData);
  3284. end;
  3285. tfR3G3B2: begin
  3286. aData^ := Round(
  3287. ((aPixel.Data.r and Range.r) shl Shift.r) or
  3288. ((aPixel.Data.g and Range.g) shl Shift.g) or
  3289. ((aPixel.Data.b and Range.b) shl Shift.b));
  3290. inc(aData);
  3291. end;
  3292. end;
  3293. end;
  3294. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3295. procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3296. var
  3297. idx: QWord;
  3298. s: Integer;
  3299. bits: Byte;
  3300. f: Single;
  3301. begin
  3302. s := Trunc(fPixelSize);
  3303. f := fPixelSize - s;
  3304. bits := Round(8 * f);
  3305. case s of
  3306. 0: idx := (aData^ shr (8 - bits - {%H-}PtrInt(aMapData))) and ((1 shl bits) - 1);
  3307. 1: idx := aData^;
  3308. 2: idx := PWord(aData)^;
  3309. 4: idx := PCardinal(aData)^;
  3310. 8: idx := PQWord(aData)^;
  3311. else
  3312. raise EglBitmapException.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
  3313. end;
  3314. if (idx >= Length(fColorTable)) then
  3315. raise EglBitmapException.CreateFmt('invalid color index: %d', [idx]);
  3316. with fColorTable[idx] do begin
  3317. aPixel.Data.r := r;
  3318. aPixel.Data.g := g;
  3319. aPixel.Data.b := b;
  3320. aPixel.Data.a := a;
  3321. end;
  3322. inc(aMapData, bits);
  3323. if ({%H-}PtrUInt(aMapData) >= 8) then begin
  3324. inc(aData, 1);
  3325. dec(aMapData, 8);
  3326. end;
  3327. inc(aData, s);
  3328. end;
  3329. destructor TbmpColorTableFormat.Destroy;
  3330. begin
  3331. SetLength(fColorTable, 0);
  3332. inherited Destroy;
  3333. end;
  3334. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3335. //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3336. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3337. procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
  3338. var
  3339. i: Integer;
  3340. begin
  3341. for i := 0 to 3 do begin
  3342. if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
  3343. if (aSourceFD.Range.arr[i] > 0) then
  3344. aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
  3345. else
  3346. aPixel.Data.arr[i] := aDestFD.Range.arr[i];
  3347. end;
  3348. end;
  3349. end;
  3350. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3351. procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
  3352. begin
  3353. with aFuncRec do begin
  3354. if (Source.Range.r > 0) then
  3355. Dest.Data.r := Source.Data.r;
  3356. if (Source.Range.g > 0) then
  3357. Dest.Data.g := Source.Data.g;
  3358. if (Source.Range.b > 0) then
  3359. Dest.Data.b := Source.Data.b;
  3360. if (Source.Range.a > 0) then
  3361. Dest.Data.a := Source.Data.a;
  3362. end;
  3363. end;
  3364. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3365. procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3366. var
  3367. i: Integer;
  3368. begin
  3369. with aFuncRec do begin
  3370. for i := 0 to 3 do
  3371. if (Source.Range.arr[i] > 0) then
  3372. Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
  3373. end;
  3374. end;
  3375. type
  3376. TShiftData = packed record
  3377. case Integer of
  3378. 0: (r, g, b, a: SmallInt);
  3379. 1: (arr: array[0..3] of SmallInt);
  3380. end;
  3381. PShiftData = ^TShiftData;
  3382. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3383. procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3384. var
  3385. i: Integer;
  3386. begin
  3387. with aFuncRec do
  3388. for i := 0 to 3 do
  3389. if (Source.Range.arr[i] > 0) then
  3390. Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
  3391. end;
  3392. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3393. procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
  3394. begin
  3395. with aFuncRec do begin
  3396. Dest.Data := Source.Data;
  3397. if ({%H-}PtrUInt(Args) and $1 > 0) then begin
  3398. Dest.Data.r := Dest.Data.r xor Dest.Range.r;
  3399. Dest.Data.g := Dest.Data.g xor Dest.Range.g;
  3400. Dest.Data.b := Dest.Data.b xor Dest.Range.b;
  3401. end;
  3402. if ({%H-}PtrUInt(Args) and $2 > 0) then begin
  3403. Dest.Data.a := Dest.Data.a xor Dest.Range.a;
  3404. end;
  3405. end;
  3406. end;
  3407. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3408. procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
  3409. var
  3410. i: Integer;
  3411. begin
  3412. with aFuncRec do begin
  3413. for i := 0 to 3 do
  3414. Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
  3415. end;
  3416. end;
  3417. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3418. procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3419. var
  3420. Temp: Single;
  3421. begin
  3422. with FuncRec do begin
  3423. if (FuncRec.Args = nil) then begin //source has no alpha
  3424. Temp :=
  3425. Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
  3426. Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
  3427. Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
  3428. Dest.Data.a := Round(Dest.Range.a * Temp);
  3429. end else
  3430. Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
  3431. end;
  3432. end;
  3433. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3434. procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3435. type
  3436. PglBitmapPixelData = ^TglBitmapPixelData;
  3437. begin
  3438. with FuncRec do begin
  3439. Dest.Data.r := Source.Data.r;
  3440. Dest.Data.g := Source.Data.g;
  3441. Dest.Data.b := Source.Data.b;
  3442. with PglBitmapPixelData(Args)^ do
  3443. if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
  3444. (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
  3445. (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
  3446. Dest.Data.a := 0
  3447. else
  3448. Dest.Data.a := Dest.Range.a;
  3449. end;
  3450. end;
  3451. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3452. procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3453. begin
  3454. with FuncRec do begin
  3455. Dest.Data.r := Source.Data.r;
  3456. Dest.Data.g := Source.Data.g;
  3457. Dest.Data.b := Source.Data.b;
  3458. Dest.Data.a := PCardinal(Args)^;
  3459. end;
  3460. end;
  3461. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3462. procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
  3463. type
  3464. PRGBPix = ^TRGBPix;
  3465. TRGBPix = array [0..2] of byte;
  3466. var
  3467. Temp: Byte;
  3468. begin
  3469. while aWidth > 0 do begin
  3470. Temp := PRGBPix(aData)^[0];
  3471. PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
  3472. PRGBPix(aData)^[2] := Temp;
  3473. if aHasAlpha then
  3474. Inc(aData, 4)
  3475. else
  3476. Inc(aData, 3);
  3477. dec(aWidth);
  3478. end;
  3479. end;
  3480. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3481. //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3482. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3483. function TglBitmap.GetWidth: Integer;
  3484. begin
  3485. if (ffX in fDimension.Fields) then
  3486. result := fDimension.X
  3487. else
  3488. result := -1;
  3489. end;
  3490. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3491. function TglBitmap.GetHeight: Integer;
  3492. begin
  3493. if (ffY in fDimension.Fields) then
  3494. result := fDimension.Y
  3495. else
  3496. result := -1;
  3497. end;
  3498. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3499. function TglBitmap.GetFileWidth: Integer;
  3500. begin
  3501. result := Max(1, Width);
  3502. end;
  3503. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3504. function TglBitmap.GetFileHeight: Integer;
  3505. begin
  3506. result := Max(1, Height);
  3507. end;
  3508. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3509. procedure TglBitmap.SetCustomData(const aValue: Pointer);
  3510. begin
  3511. if fCustomData = aValue then
  3512. exit;
  3513. fCustomData := aValue;
  3514. end;
  3515. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3516. procedure TglBitmap.SetCustomName(const aValue: String);
  3517. begin
  3518. if fCustomName = aValue then
  3519. exit;
  3520. fCustomName := aValue;
  3521. end;
  3522. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3523. procedure TglBitmap.SetCustomNameW(const aValue: WideString);
  3524. begin
  3525. if fCustomNameW = aValue then
  3526. exit;
  3527. fCustomNameW := aValue;
  3528. end;
  3529. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3530. procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
  3531. begin
  3532. if fDeleteTextureOnFree = aValue then
  3533. exit;
  3534. fDeleteTextureOnFree := aValue;
  3535. end;
  3536. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3537. procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
  3538. begin
  3539. if fFormat = aValue then
  3540. exit;
  3541. if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
  3542. raise EglBitmapUnsupportedFormat.Create(Format);
  3543. SetDataPointer(Data, aValue, Width, Height);
  3544. end;
  3545. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3546. procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
  3547. begin
  3548. if fFreeDataAfterGenTexture = aValue then
  3549. exit;
  3550. fFreeDataAfterGenTexture := aValue;
  3551. end;
  3552. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3553. procedure TglBitmap.SetID(const aValue: Cardinal);
  3554. begin
  3555. if fID = aValue then
  3556. exit;
  3557. fID := aValue;
  3558. end;
  3559. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3560. procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
  3561. begin
  3562. if fMipMap = aValue then
  3563. exit;
  3564. fMipMap := aValue;
  3565. end;
  3566. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3567. procedure TglBitmap.SetTarget(const aValue: Cardinal);
  3568. begin
  3569. if fTarget = aValue then
  3570. exit;
  3571. fTarget := aValue;
  3572. end;
  3573. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3574. procedure TglBitmap.SetAnisotropic(const aValue: Integer);
  3575. var
  3576. MaxAnisotropic: Integer;
  3577. begin
  3578. fAnisotropic := aValue;
  3579. if (ID > 0) then begin
  3580. if GL_EXT_texture_filter_anisotropic then begin
  3581. if fAnisotropic > 0 then begin
  3582. Bind(false);
  3583. glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
  3584. if aValue > MaxAnisotropic then
  3585. fAnisotropic := MaxAnisotropic;
  3586. glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
  3587. end;
  3588. end else begin
  3589. fAnisotropic := 0;
  3590. end;
  3591. end;
  3592. end;
  3593. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3594. procedure TglBitmap.CreateID;
  3595. begin
  3596. if (ID <> 0) then
  3597. glDeleteTextures(1, @fID);
  3598. glGenTextures(1, @fID);
  3599. Bind(false);
  3600. end;
  3601. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3602. procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
  3603. begin
  3604. // Set Up Parameters
  3605. SetWrap(fWrapS, fWrapT, fWrapR);
  3606. SetFilter(fFilterMin, fFilterMag);
  3607. SetAnisotropic(fAnisotropic);
  3608. SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
  3609. // Mip Maps Generation Mode
  3610. aBuildWithGlu := false;
  3611. if (MipMap = mmMipmap) then begin
  3612. if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
  3613. glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
  3614. else
  3615. aBuildWithGlu := true;
  3616. end else if (MipMap = mmMipmapGlu) then
  3617. aBuildWithGlu := true;
  3618. end;
  3619. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3620. procedure TglBitmap.SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
  3621. const aWidth: Integer; const aHeight: Integer);
  3622. var
  3623. s: Single;
  3624. begin
  3625. if (Data <> aData) then begin
  3626. if (Assigned(Data)) then
  3627. FreeMem(Data);
  3628. fData := aData;
  3629. end;
  3630. FillChar(fDimension, SizeOf(fDimension), 0);
  3631. if not Assigned(fData) then begin
  3632. fFormat := tfEmpty;
  3633. fPixelSize := 0;
  3634. fRowSize := 0;
  3635. end else begin
  3636. if aWidth <> -1 then begin
  3637. fDimension.Fields := fDimension.Fields + [ffX];
  3638. fDimension.X := aWidth;
  3639. end;
  3640. if aHeight <> -1 then begin
  3641. fDimension.Fields := fDimension.Fields + [ffY];
  3642. fDimension.Y := aHeight;
  3643. end;
  3644. s := TFormatDescriptor.Get(aFormat).PixelSize;
  3645. fFormat := aFormat;
  3646. fPixelSize := Ceil(s);
  3647. fRowSize := Ceil(s * aWidth);
  3648. end;
  3649. end;
  3650. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3651. function TglBitmap.FlipHorz: Boolean;
  3652. begin
  3653. result := false;
  3654. end;
  3655. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3656. function TglBitmap.FlipVert: Boolean;
  3657. begin
  3658. result := false;
  3659. end;
  3660. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3661. //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3662. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3663. procedure TglBitmap.AfterConstruction;
  3664. begin
  3665. inherited AfterConstruction;
  3666. fID := 0;
  3667. fTarget := 0;
  3668. fIsResident := false;
  3669. fFormat := glBitmapGetDefaultFormat;
  3670. fMipMap := glBitmapDefaultMipmap;
  3671. fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
  3672. fDeleteTextureOnFree := glBitmapGetDefaultDeleteTextureOnFree;
  3673. glBitmapGetDefaultFilter (fFilterMin, fFilterMag);
  3674. glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
  3675. end;
  3676. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3677. procedure TglBitmap.BeforeDestruction;
  3678. begin
  3679. SetDataPointer(nil, tfEmpty);
  3680. if (fID > 0) and fDeleteTextureOnFree then
  3681. glDeleteTextures(1, @fID);
  3682. inherited BeforeDestruction;
  3683. end;
  3684. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3685. procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
  3686. var
  3687. TempPos: Integer;
  3688. begin
  3689. if not Assigned(aResType) then begin
  3690. TempPos := Pos('.', aResource);
  3691. aResType := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
  3692. aResource := UpperCase(Copy(aResource, 0, TempPos -1));
  3693. end;
  3694. end;
  3695. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3696. procedure TglBitmap.LoadFromFile(const aFilename: String);
  3697. var
  3698. fs: TFileStream;
  3699. begin
  3700. if not FileExists(aFilename) then
  3701. raise EglBitmapException.Create('file does not exist: ' + aFilename);
  3702. fFilename := aFilename;
  3703. fs := TFileStream.Create(fFilename, fmOpenRead);
  3704. try
  3705. fs.Position := 0;
  3706. LoadFromStream(fs);
  3707. finally
  3708. fs.Free;
  3709. end;
  3710. end;
  3711. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3712. procedure TglBitmap.LoadFromStream(const aStream: TStream);
  3713. begin
  3714. {$IFDEF GLB_SUPPORT_PNG_READ}
  3715. if not LoadPNG(aStream) then
  3716. {$ENDIF}
  3717. {$IFDEF GLB_SUPPORT_JPEG_READ}
  3718. if not LoadJPEG(aStream) then
  3719. {$ENDIF}
  3720. if not LoadDDS(aStream) then
  3721. if not LoadTGA(aStream) then
  3722. if not LoadBMP(aStream) then
  3723. raise EglBitmapException.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
  3724. end;
  3725. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3726. procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  3727. const aFormat: TglBitmapFormat; const aArgs: Pointer);
  3728. var
  3729. tmpData: PByte;
  3730. size: Integer;
  3731. begin
  3732. size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  3733. GetMem(tmpData, size);
  3734. try
  3735. FillChar(tmpData^, size, #$FF);
  3736. SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y);
  3737. except
  3738. FreeMem(tmpData);
  3739. raise;
  3740. end;
  3741. AddFunc(Self, aFunc, false, Format, aArgs);
  3742. end;
  3743. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3744. procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
  3745. var
  3746. rs: TResourceStream;
  3747. begin
  3748. PrepareResType(aResource, aResType);
  3749. rs := TResourceStream.Create(aInstance, aResource, aResType);
  3750. try
  3751. LoadFromStream(rs);
  3752. finally
  3753. rs.Free;
  3754. end;
  3755. end;
  3756. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3757. procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  3758. var
  3759. rs: TResourceStream;
  3760. begin
  3761. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  3762. try
  3763. LoadFromStream(rs);
  3764. finally
  3765. rs.Free;
  3766. end;
  3767. end;
  3768. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3769. procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  3770. var
  3771. fs: TFileStream;
  3772. begin
  3773. fs := TFileStream.Create(aFileName, fmCreate);
  3774. try
  3775. fs.Position := 0;
  3776. SaveToStream(fs, aFileType);
  3777. finally
  3778. fs.Free;
  3779. end;
  3780. end;
  3781. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3782. procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
  3783. begin
  3784. case aFileType of
  3785. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  3786. ftPNG: SavePNG(aStream);
  3787. {$ENDIF}
  3788. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  3789. ftJPEG: SaveJPEG(aStream);
  3790. {$ENDIF}
  3791. ftDDS: SaveDDS(aStream);
  3792. ftTGA: SaveTGA(aStream);
  3793. ftBMP: SaveBMP(aStream);
  3794. end;
  3795. end;
  3796. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3797. function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
  3798. begin
  3799. result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
  3800. end;
  3801. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3802. function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  3803. const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
  3804. var
  3805. DestData, TmpData, SourceData: pByte;
  3806. TempHeight, TempWidth: Integer;
  3807. SourceFD, DestFD: TFormatDescriptor;
  3808. SourceMD, DestMD: Pointer;
  3809. FuncRec: TglBitmapFunctionRec;
  3810. begin
  3811. Assert(Assigned(Data));
  3812. Assert(Assigned(aSource));
  3813. Assert(Assigned(aSource.Data));
  3814. result := false;
  3815. if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
  3816. SourceFD := TFormatDescriptor.Get(aSource.Format);
  3817. DestFD := TFormatDescriptor.Get(aFormat);
  3818. if (SourceFD.IsCompressed) then
  3819. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
  3820. if (DestFD.IsCompressed) then
  3821. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
  3822. // inkompatible Formats so CreateTemp
  3823. if (SourceFD.PixelSize <> DestFD.PixelSize) then
  3824. aCreateTemp := true;
  3825. // Values
  3826. TempHeight := Max(1, aSource.Height);
  3827. TempWidth := Max(1, aSource.Width);
  3828. FuncRec.Sender := Self;
  3829. FuncRec.Args := aArgs;
  3830. TmpData := nil;
  3831. if aCreateTemp then begin
  3832. GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
  3833. DestData := TmpData;
  3834. end else
  3835. DestData := Data;
  3836. try
  3837. SourceFD.PreparePixel(FuncRec.Source);
  3838. DestFD.PreparePixel (FuncRec.Dest);
  3839. SourceMD := SourceFD.CreateMappingData;
  3840. DestMD := DestFD.CreateMappingData;
  3841. FuncRec.Size := aSource.Dimension;
  3842. FuncRec.Position.Fields := FuncRec.Size.Fields;
  3843. try
  3844. SourceData := aSource.Data;
  3845. FuncRec.Position.Y := 0;
  3846. while FuncRec.Position.Y < TempHeight do begin
  3847. FuncRec.Position.X := 0;
  3848. while FuncRec.Position.X < TempWidth do begin
  3849. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  3850. aFunc(FuncRec);
  3851. DestFD.Map(FuncRec.Dest, DestData, DestMD);
  3852. inc(FuncRec.Position.X);
  3853. end;
  3854. inc(FuncRec.Position.Y);
  3855. end;
  3856. // Updating Image or InternalFormat
  3857. if aCreateTemp then
  3858. SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height)
  3859. else if (aFormat <> fFormat) then
  3860. Format := aFormat;
  3861. result := true;
  3862. finally
  3863. SourceFD.FreeMappingData(SourceMD);
  3864. DestFD.FreeMappingData(DestMD);
  3865. end;
  3866. except
  3867. if aCreateTemp then
  3868. FreeMem(TmpData);
  3869. raise;
  3870. end;
  3871. end;
  3872. end;
  3873. {$IFDEF GLB_SDL}
  3874. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3875. function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  3876. var
  3877. Row, RowSize: Integer;
  3878. SourceData, TmpData: PByte;
  3879. TempDepth: Integer;
  3880. FormatDesc: TFormatDescriptor;
  3881. function GetRowPointer(Row: Integer): pByte;
  3882. begin
  3883. result := aSurface.pixels;
  3884. Inc(result, Row * RowSize);
  3885. end;
  3886. begin
  3887. result := false;
  3888. FormatDesc := TFormatDescriptor.Get(Format);
  3889. if FormatDesc.IsCompressed then
  3890. raise EglBitmapUnsupportedFormat.Create(Format);
  3891. if Assigned(Data) then begin
  3892. case Trunc(FormatDesc.PixelSize) of
  3893. 1: TempDepth := 8;
  3894. 2: TempDepth := 16;
  3895. 3: TempDepth := 24;
  3896. 4: TempDepth := 32;
  3897. else
  3898. raise EglBitmapUnsupportedFormat.Create(Format);
  3899. end;
  3900. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
  3901. FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
  3902. SourceData := Data;
  3903. RowSize := FormatDesc.GetSize(FileWidth, 1);
  3904. for Row := 0 to FileHeight-1 do begin
  3905. TmpData := GetRowPointer(Row);
  3906. if Assigned(TmpData) then begin
  3907. Move(SourceData^, TmpData^, RowSize);
  3908. inc(SourceData, RowSize);
  3909. end;
  3910. end;
  3911. result := true;
  3912. end;
  3913. end;
  3914. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3915. function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  3916. var
  3917. pSource, pData, pTempData: PByte;
  3918. Row, RowSize, TempWidth, TempHeight: Integer;
  3919. IntFormat: TglBitmapFormat;
  3920. FormatDesc: TFormatDescriptor;
  3921. function GetRowPointer(Row: Integer): pByte;
  3922. begin
  3923. result := aSurface^.pixels;
  3924. Inc(result, Row * RowSize);
  3925. end;
  3926. begin
  3927. result := false;
  3928. if (Assigned(aSurface)) then begin
  3929. with aSurface^.format^ do begin
  3930. for IntFormat := High(TglBitmapFormat) to Low(TglBitmapFormat) do begin
  3931. FormatDesc := TFormatDescriptor.Get(IntFormat);
  3932. if (FormatDesc.MaskMatch(RMask, GMask, BMask, AMask)) then
  3933. break;
  3934. end;
  3935. if (IntFormat = tfEmpty) then
  3936. raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
  3937. end;
  3938. TempWidth := aSurface^.w;
  3939. TempHeight := aSurface^.h;
  3940. RowSize := FormatDesc.GetSize(TempWidth, 1);
  3941. GetMem(pData, TempHeight * RowSize);
  3942. try
  3943. pTempData := pData;
  3944. for Row := 0 to TempHeight -1 do begin
  3945. pSource := GetRowPointer(Row);
  3946. if (Assigned(pSource)) then begin
  3947. Move(pSource^, pTempData^, RowSize);
  3948. Inc(pTempData, RowSize);
  3949. end;
  3950. end;
  3951. SetDataPointer(pData, IntFormat, TempWidth, TempHeight);
  3952. result := true;
  3953. except
  3954. FreeMem(pData);
  3955. raise;
  3956. end;
  3957. end;
  3958. end;
  3959. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3960. function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  3961. var
  3962. Row, Col, AlphaInterleave: Integer;
  3963. pSource, pDest: PByte;
  3964. function GetRowPointer(Row: Integer): pByte;
  3965. begin
  3966. result := aSurface.pixels;
  3967. Inc(result, Row * Width);
  3968. end;
  3969. begin
  3970. result := false;
  3971. if Assigned(Data) then begin
  3972. if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
  3973. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
  3974. AlphaInterleave := 0;
  3975. case Format of
  3976. tfLuminance8Alpha8:
  3977. AlphaInterleave := 1;
  3978. tfBGRA8, tfRGBA8:
  3979. AlphaInterleave := 3;
  3980. end;
  3981. pSource := Data;
  3982. for Row := 0 to Height -1 do begin
  3983. pDest := GetRowPointer(Row);
  3984. if Assigned(pDest) then begin
  3985. for Col := 0 to Width -1 do begin
  3986. Inc(pSource, AlphaInterleave);
  3987. pDest^ := pSource^;
  3988. Inc(pDest);
  3989. Inc(pSource);
  3990. end;
  3991. end;
  3992. end;
  3993. result := true;
  3994. end;
  3995. end;
  3996. end;
  3997. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3998. function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  3999. var
  4000. bmp: TglBitmap2D;
  4001. begin
  4002. bmp := TglBitmap2D.Create;
  4003. try
  4004. bmp.AssignFromSurface(aSurface);
  4005. result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
  4006. finally
  4007. bmp.Free;
  4008. end;
  4009. end;
  4010. {$ENDIF}
  4011. {$IFDEF GLB_DELPHI}
  4012. //TODO rework & test
  4013. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4014. function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
  4015. var
  4016. Row: Integer;
  4017. pSource, pData: PByte;
  4018. begin
  4019. result := false;
  4020. if Assigned(Data) then begin
  4021. if Assigned(aBitmap) then begin
  4022. aBitmap.Width := Width;
  4023. aBitmap.Height := Height;
  4024. case Format of
  4025. tfAlpha8, ifLuminance, ifDepth8:
  4026. begin
  4027. Bitmap.PixelFormat := pf8bit;
  4028. Bitmap.Palette := CreateGrayPalette;
  4029. end;
  4030. ifRGB5A1:
  4031. Bitmap.PixelFormat := pf15bit;
  4032. ifR5G6B5:
  4033. Bitmap.PixelFormat := pf16bit;
  4034. ifRGB8, ifBGR8:
  4035. Bitmap.PixelFormat := pf24bit;
  4036. ifRGBA8, ifBGRA8:
  4037. Bitmap.PixelFormat := pf32bit;
  4038. else
  4039. raise EglBitmapException.Create('AssignToBitmap - Invalid Pixelformat.');
  4040. end;
  4041. pSource := Data;
  4042. for Row := 0 to FileHeight -1 do begin
  4043. pData := Bitmap.Scanline[Row];
  4044. Move(pSource^, pData^, fRowSize);
  4045. Inc(pSource, fRowSize);
  4046. // swap RGB(A) to BGR(A)
  4047. if InternalFormat in [ifRGB8, ifRGBA8] then
  4048. SwapRGB(pData, FileWidth, InternalFormat = ifRGBA8);
  4049. end;
  4050. result := true;
  4051. end;
  4052. end;
  4053. end;
  4054. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4055. function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  4056. var
  4057. pSource, pData, pTempData: PByte;
  4058. Row, RowSize, TempWidth, TempHeight: Integer;
  4059. IntFormat: TglBitmapInternalFormat;
  4060. begin
  4061. result := false;
  4062. if (Assigned(Bitmap)) then begin
  4063. case Bitmap.PixelFormat of
  4064. pf8bit:
  4065. IntFormat := ifLuminance;
  4066. pf15bit:
  4067. IntFormat := ifRGB5A1;
  4068. pf16bit:
  4069. IntFormat := ifR5G6B5;
  4070. pf24bit:
  4071. IntFormat := ifBGR8;
  4072. pf32bit:
  4073. IntFormat := ifBGRA8;
  4074. else
  4075. raise EglBitmapException.Create('AssignFromBitmap - Invalid Pixelformat.');
  4076. end;
  4077. TempWidth := Bitmap.Width;
  4078. TempHeight := Bitmap.Height;
  4079. RowSize := Trunc(TempWidth * FormatGetSize(IntFormat));
  4080. GetMem(pData, TempHeight * RowSize);
  4081. try
  4082. pTempData := pData;
  4083. for Row := 0 to TempHeight -1 do begin
  4084. pSource := Bitmap.Scanline[Row];
  4085. if (Assigned(pSource)) then begin
  4086. Move(pSource^, pTempData^, RowSize);
  4087. Inc(pTempData, RowSize);
  4088. end;
  4089. end;
  4090. SetDataPointer(pData, IntFormat, TempWidth, TempHeight);
  4091. result := true;
  4092. except
  4093. FreeMem(pData);
  4094. raise;
  4095. end;
  4096. end;
  4097. end;
  4098. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4099. function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  4100. var
  4101. Row, Col, AlphaInterleave: Integer;
  4102. pSource, pDest: PByte;
  4103. begin
  4104. result := false;
  4105. if Assigned(Data) then begin
  4106. if InternalFormat in [ifAlpha, ifLuminanceAlpha, ifRGBA8, ifBGRA8] then begin
  4107. if Assigned(Bitmap) then begin
  4108. Bitmap.PixelFormat := pf8bit;
  4109. Bitmap.Palette := CreateGrayPalette;
  4110. Bitmap.Width := Width;
  4111. Bitmap.Height := Height;
  4112. case InternalFormat of
  4113. ifLuminanceAlpha:
  4114. AlphaInterleave := 1;
  4115. ifRGBA8, ifBGRA8:
  4116. AlphaInterleave := 3;
  4117. else
  4118. AlphaInterleave := 0;
  4119. end;
  4120. // Copy Data
  4121. pSource := Data;
  4122. for Row := 0 to Height -1 do begin
  4123. pDest := Bitmap.Scanline[Row];
  4124. if Assigned(pDest) then begin
  4125. for Col := 0 to Width -1 do begin
  4126. Inc(pSource, AlphaInterleave);
  4127. pDest^ := pSource^;
  4128. Inc(pDest);
  4129. Inc(pSource);
  4130. end;
  4131. end;
  4132. end;
  4133. result := true;
  4134. end;
  4135. end;
  4136. end;
  4137. end;
  4138. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4139. function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
  4140. var
  4141. tex: TglBitmap2D;
  4142. begin
  4143. tex := TglBitmap2D.Create;
  4144. try
  4145. tex.AssignFromBitmap(Bitmap);
  4146. result := AddAlphaFromglBitmap(tex, Func, CustomData);
  4147. finally
  4148. tex.Free;
  4149. end;
  4150. end;
  4151. {$ENDIF}
  4152. {$IFDEF GLB_LAZARUS}
  4153. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4154. function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4155. var
  4156. rid: TRawImageDescription;
  4157. FormatDesc: TFormatDescriptor;
  4158. begin
  4159. result := false;
  4160. if not Assigned(aImage) or (Format = tfEmpty) then
  4161. exit;
  4162. FormatDesc := TFormatDescriptor.Get(Format);
  4163. if FormatDesc.IsCompressed then
  4164. exit;
  4165. FillChar(rid{%H-}, SizeOf(rid), 0);
  4166. if (Format in [
  4167. tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
  4168. tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
  4169. tfLuminance4Alpha4, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16]) then
  4170. rid.Format := ricfGray
  4171. else
  4172. rid.Format := ricfRGBA;
  4173. rid.Width := Width;
  4174. rid.Height := Height;
  4175. rid.Depth := CountSetBits(FormatDesc.Range.r or FormatDesc.Range.g or FormatDesc.Range.b or FormatDesc.Range.a);
  4176. rid.BitOrder := riboBitsInOrder;
  4177. rid.ByteOrder := riboLSBFirst;
  4178. rid.LineOrder := riloTopToBottom;
  4179. rid.LineEnd := rileTight;
  4180. rid.BitsPerPixel := Round(8 * FormatDesc.PixelSize);
  4181. rid.RedPrec := CountSetBits(FormatDesc.Range.r);
  4182. rid.GreenPrec := CountSetBits(FormatDesc.Range.g);
  4183. rid.BluePrec := CountSetBits(FormatDesc.Range.b);
  4184. rid.AlphaPrec := CountSetBits(FormatDesc.Range.a);
  4185. rid.RedShift := FormatDesc.Shift.r;
  4186. rid.GreenShift := FormatDesc.Shift.g;
  4187. rid.BlueShift := FormatDesc.Shift.b;
  4188. rid.AlphaShift := FormatDesc.Shift.a;
  4189. rid.MaskBitsPerPixel := 0;
  4190. rid.PaletteColorCount := 0;
  4191. aImage.DataDescription := rid;
  4192. aImage.CreateData;
  4193. Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
  4194. result := true;
  4195. end;
  4196. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4197. function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4198. var
  4199. f: TglBitmapFormat;
  4200. FormatDesc: TFormatDescriptor;
  4201. ImageData: PByte;
  4202. ImageSize: Integer;
  4203. begin
  4204. result := false;
  4205. if not Assigned(aImage) then
  4206. exit;
  4207. for f := High(f) downto Low(f) do begin
  4208. FormatDesc := TFormatDescriptor.Get(f);
  4209. with aImage.DataDescription do
  4210. if FormatDesc.MaskMatch(
  4211. (QWord(1 shl RedPrec )-1) shl RedShift,
  4212. (QWord(1 shl GreenPrec)-1) shl GreenShift,
  4213. (QWord(1 shl BluePrec )-1) shl BlueShift,
  4214. (QWord(1 shl AlphaPrec)-1) shl AlphaShift) then
  4215. break;
  4216. end;
  4217. if (f = tfEmpty) then
  4218. exit;
  4219. ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
  4220. ImageData := GetMem(ImageSize);
  4221. try
  4222. Move(aImage.PixelData^, ImageData^, (aImage.Width * aImage.Height * aImage.DataDescription.BitsPerPixel) shr 3);
  4223. SetDataPointer(ImageData, f, aImage.Width, aImage.Height);
  4224. except
  4225. FreeMem(ImageData);
  4226. raise;
  4227. end;
  4228. result := true;
  4229. end;
  4230. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4231. function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  4232. var
  4233. rid: TRawImageDescription;
  4234. FormatDesc: TFormatDescriptor;
  4235. Pixel: TglBitmapPixelData;
  4236. x, y: Integer;
  4237. srcMD: Pointer;
  4238. src, dst: PByte;
  4239. begin
  4240. result := false;
  4241. if not Assigned(aImage) or (Format = tfEmpty) then
  4242. exit;
  4243. FormatDesc := TFormatDescriptor.Get(Format);
  4244. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  4245. exit;
  4246. FillChar(rid{%H-}, SizeOf(rid), 0);
  4247. rid.Format := ricfGray;
  4248. rid.Width := Width;
  4249. rid.Height := Height;
  4250. rid.Depth := CountSetBits(FormatDesc.Range.a);
  4251. rid.BitOrder := riboBitsInOrder;
  4252. rid.ByteOrder := riboLSBFirst;
  4253. rid.LineOrder := riloTopToBottom;
  4254. rid.LineEnd := rileTight;
  4255. rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
  4256. rid.RedPrec := CountSetBits(FormatDesc.Range.a);
  4257. rid.GreenPrec := 0;
  4258. rid.BluePrec := 0;
  4259. rid.AlphaPrec := 0;
  4260. rid.RedShift := 0;
  4261. rid.GreenShift := 0;
  4262. rid.BlueShift := 0;
  4263. rid.AlphaShift := 0;
  4264. rid.MaskBitsPerPixel := 0;
  4265. rid.PaletteColorCount := 0;
  4266. aImage.DataDescription := rid;
  4267. aImage.CreateData;
  4268. srcMD := FormatDesc.CreateMappingData;
  4269. try
  4270. FormatDesc.PreparePixel(Pixel);
  4271. src := Data;
  4272. dst := aImage.PixelData;
  4273. for y := 0 to Height-1 do
  4274. for x := 0 to Width-1 do begin
  4275. FormatDesc.Unmap(src, Pixel, srcMD);
  4276. case rid.BitsPerPixel of
  4277. 8: begin
  4278. dst^ := Pixel.Data.a;
  4279. inc(dst);
  4280. end;
  4281. 16: begin
  4282. PWord(dst)^ := Pixel.Data.a;
  4283. inc(dst, 2);
  4284. end;
  4285. 24: begin
  4286. PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
  4287. PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
  4288. PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
  4289. inc(dst, 3);
  4290. end;
  4291. 32: begin
  4292. PCardinal(dst)^ := Pixel.Data.a;
  4293. inc(dst, 4);
  4294. end;
  4295. else
  4296. raise EglBitmapUnsupportedFormat.Create(Format);
  4297. end;
  4298. end;
  4299. finally
  4300. FormatDesc.FreeMappingData(srcMD);
  4301. end;
  4302. result := true;
  4303. end;
  4304. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4305. function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4306. var
  4307. tex: TglBitmap2D;
  4308. begin
  4309. tex := TglBitmap2D.Create;
  4310. try
  4311. tex.AssignFromLazIntfImage(aImage);
  4312. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4313. finally
  4314. tex.Free;
  4315. end;
  4316. end;
  4317. {$ENDIF}
  4318. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4319. function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
  4320. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4321. var
  4322. rs: TResourceStream;
  4323. begin
  4324. PrepareResType(aResource, aResType);
  4325. rs := TResourceStream.Create(aInstance, aResource, aResType);
  4326. try
  4327. result := AddAlphaFromStream(rs, aFunc, aArgs);
  4328. finally
  4329. rs.Free;
  4330. end;
  4331. end;
  4332. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4333. function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  4334. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4335. var
  4336. rs: TResourceStream;
  4337. begin
  4338. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  4339. try
  4340. result := AddAlphaFromStream(rs, aFunc, aArgs);
  4341. finally
  4342. rs.Free;
  4343. end;
  4344. end;
  4345. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4346. function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4347. begin
  4348. if TFormatDescriptor.Get(Format).IsCompressed then
  4349. raise EglBitmapUnsupportedFormat.Create(Format);
  4350. result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
  4351. end;
  4352. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4353. function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4354. var
  4355. FS: TFileStream;
  4356. begin
  4357. FS := TFileStream.Create(FileName, fmOpenRead);
  4358. try
  4359. result := AddAlphaFromStream(FS, aFunc, aArgs);
  4360. finally
  4361. FS.Free;
  4362. end;
  4363. end;
  4364. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4365. function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4366. var
  4367. tex: TglBitmap2D;
  4368. begin
  4369. tex := TglBitmap2D.Create(aStream);
  4370. try
  4371. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4372. finally
  4373. tex.Free;
  4374. end;
  4375. end;
  4376. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4377. function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4378. var
  4379. DestData, DestData2, SourceData: pByte;
  4380. TempHeight, TempWidth: Integer;
  4381. SourceFD, DestFD: TFormatDescriptor;
  4382. SourceMD, DestMD, DestMD2: Pointer;
  4383. FuncRec: TglBitmapFunctionRec;
  4384. begin
  4385. result := false;
  4386. Assert(Assigned(Data));
  4387. Assert(Assigned(aBitmap));
  4388. Assert(Assigned(aBitmap.Data));
  4389. if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
  4390. result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
  4391. SourceFD := TFormatDescriptor.Get(aBitmap.Format);
  4392. DestFD := TFormatDescriptor.Get(Format);
  4393. if not Assigned(aFunc) then begin
  4394. aFunc := glBitmapAlphaFunc;
  4395. FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
  4396. end else
  4397. FuncRec.Args := aArgs;
  4398. // Values
  4399. TempHeight := aBitmap.FileHeight;
  4400. TempWidth := aBitmap.FileWidth;
  4401. FuncRec.Sender := Self;
  4402. FuncRec.Size := Dimension;
  4403. FuncRec.Position.Fields := FuncRec.Size.Fields;
  4404. DestData := Data;
  4405. DestData2 := Data;
  4406. SourceData := aBitmap.Data;
  4407. // Mapping
  4408. SourceFD.PreparePixel(FuncRec.Source);
  4409. DestFD.PreparePixel (FuncRec.Dest);
  4410. SourceMD := SourceFD.CreateMappingData;
  4411. DestMD := DestFD.CreateMappingData;
  4412. DestMD2 := DestFD.CreateMappingData;
  4413. try
  4414. FuncRec.Position.Y := 0;
  4415. while FuncRec.Position.Y < TempHeight do begin
  4416. FuncRec.Position.X := 0;
  4417. while FuncRec.Position.X < TempWidth do begin
  4418. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  4419. DestFD.Unmap (DestData, FuncRec.Dest, DestMD);
  4420. aFunc(FuncRec);
  4421. DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
  4422. inc(FuncRec.Position.X);
  4423. end;
  4424. inc(FuncRec.Position.Y);
  4425. end;
  4426. finally
  4427. SourceFD.FreeMappingData(SourceMD);
  4428. DestFD.FreeMappingData(DestMD);
  4429. DestFD.FreeMappingData(DestMD2);
  4430. end;
  4431. end;
  4432. end;
  4433. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4434. function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
  4435. begin
  4436. result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
  4437. end;
  4438. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4439. function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
  4440. var
  4441. PixelData: TglBitmapPixelData;
  4442. begin
  4443. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4444. result := AddAlphaFromColorKeyFloat(
  4445. aRed / PixelData.Range.r,
  4446. aGreen / PixelData.Range.g,
  4447. aBlue / PixelData.Range.b,
  4448. aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
  4449. end;
  4450. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4451. function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
  4452. var
  4453. values: array[0..2] of Single;
  4454. tmp: Cardinal;
  4455. i: Integer;
  4456. PixelData: TglBitmapPixelData;
  4457. begin
  4458. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4459. with PixelData do begin
  4460. values[0] := aRed;
  4461. values[1] := aGreen;
  4462. values[2] := aBlue;
  4463. for i := 0 to 2 do begin
  4464. tmp := Trunc(Range.arr[i] * aDeviation);
  4465. Data.arr[i] := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
  4466. Range.arr[i] := Max(0, Trunc(Range.arr[i] * values[i] - tmp));
  4467. end;
  4468. Data.a := 0;
  4469. Range.a := 0;
  4470. end;
  4471. result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
  4472. end;
  4473. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4474. function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
  4475. begin
  4476. result := AddAlphaFromValueFloat(aAlpha / $FF);
  4477. end;
  4478. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4479. function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  4480. var
  4481. PixelData: TglBitmapPixelData;
  4482. begin
  4483. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4484. result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
  4485. end;
  4486. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4487. function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  4488. var
  4489. PixelData: TglBitmapPixelData;
  4490. begin
  4491. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4492. with PixelData do
  4493. Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
  4494. result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
  4495. end;
  4496. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4497. function TglBitmap.RemoveAlpha: Boolean;
  4498. var
  4499. FormatDesc: TFormatDescriptor;
  4500. begin
  4501. result := false;
  4502. FormatDesc := TFormatDescriptor.Get(Format);
  4503. if Assigned(Data) then begin
  4504. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  4505. raise EglBitmapUnsupportedFormat.Create(Format);
  4506. result := ConvertTo(FormatDesc.WithoutAlpha);
  4507. end;
  4508. end;
  4509. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4510. function TglBitmap.Clone: TglBitmap;
  4511. var
  4512. Temp: TglBitmap;
  4513. TempPtr: PByte;
  4514. Size: Integer;
  4515. begin
  4516. result := nil;
  4517. Temp := (ClassType.Create as TglBitmap);
  4518. try
  4519. // copy texture data if assigned
  4520. if Assigned(Data) then begin
  4521. Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
  4522. GetMem(TempPtr, Size);
  4523. try
  4524. Move(Data^, TempPtr^, Size);
  4525. Temp.SetDataPointer(TempPtr, Format, Width, Height);
  4526. except
  4527. FreeMem(TempPtr);
  4528. raise;
  4529. end;
  4530. end else
  4531. Temp.SetDataPointer(nil, Format, Width, Height);
  4532. // copy properties
  4533. Temp.fID := ID;
  4534. Temp.fTarget := Target;
  4535. Temp.fFormat := Format;
  4536. Temp.fMipMap := MipMap;
  4537. Temp.fAnisotropic := Anisotropic;
  4538. Temp.fBorderColor := fBorderColor;
  4539. Temp.fDeleteTextureOnFree := DeleteTextureOnFree;
  4540. Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
  4541. Temp.fFilterMin := fFilterMin;
  4542. Temp.fFilterMag := fFilterMag;
  4543. Temp.fWrapS := fWrapS;
  4544. Temp.fWrapT := fWrapT;
  4545. Temp.fWrapR := fWrapR;
  4546. Temp.fFilename := fFilename;
  4547. Temp.fCustomName := fCustomName;
  4548. Temp.fCustomNameW := fCustomNameW;
  4549. Temp.fCustomData := fCustomData;
  4550. result := Temp;
  4551. except
  4552. FreeAndNil(Temp);
  4553. raise;
  4554. end;
  4555. end;
  4556. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4557. function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
  4558. var
  4559. SourceFD, DestFD: TFormatDescriptor;
  4560. SourcePD, DestPD: TglBitmapPixelData;
  4561. ShiftData: TShiftData;
  4562. function CanCopyDirect: Boolean;
  4563. begin
  4564. result :=
  4565. ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  4566. ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  4567. ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  4568. ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  4569. end;
  4570. function CanShift: Boolean;
  4571. begin
  4572. result :=
  4573. ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  4574. ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  4575. ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  4576. ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  4577. end;
  4578. function GetShift(aSource, aDest: Cardinal) : ShortInt;
  4579. begin
  4580. result := 0;
  4581. while (aSource > aDest) and (aSource > 0) do begin
  4582. inc(result);
  4583. aSource := aSource shr 1;
  4584. end;
  4585. end;
  4586. begin
  4587. if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
  4588. SourceFD := TFormatDescriptor.Get(Format);
  4589. DestFD := TFormatDescriptor.Get(aFormat);
  4590. SourceFD.PreparePixel(SourcePD);
  4591. DestFD.PreparePixel (DestPD);
  4592. if CanCopyDirect then
  4593. result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
  4594. else if CanShift then begin
  4595. ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
  4596. ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
  4597. ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
  4598. ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
  4599. result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
  4600. end else
  4601. result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
  4602. end else
  4603. result := true;
  4604. end;
  4605. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4606. procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
  4607. begin
  4608. if aUseRGB or aUseAlpha then
  4609. AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
  4610. ((PtrInt(aUseAlpha) and 1) shl 1) or
  4611. (PtrInt(aUseRGB) and 1) ));
  4612. end;
  4613. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4614. procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  4615. begin
  4616. fBorderColor[0] := aRed;
  4617. fBorderColor[1] := aGreen;
  4618. fBorderColor[2] := aBlue;
  4619. fBorderColor[3] := aAlpha;
  4620. if (ID > 0) then begin
  4621. Bind(false);
  4622. glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
  4623. end;
  4624. end;
  4625. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4626. procedure TglBitmap.FreeData;
  4627. begin
  4628. SetDataPointer(nil, tfEmpty);
  4629. end;
  4630. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4631. procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
  4632. const aAlpha: Byte);
  4633. begin
  4634. FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
  4635. end;
  4636. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4637. procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
  4638. var
  4639. PixelData: TglBitmapPixelData;
  4640. begin
  4641. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4642. FillWithColorFloat(
  4643. aRed / PixelData.Range.r,
  4644. aGreen / PixelData.Range.g,
  4645. aBlue / PixelData.Range.b,
  4646. aAlpha / PixelData.Range.a);
  4647. end;
  4648. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4649. procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
  4650. var
  4651. PixelData: TglBitmapPixelData;
  4652. begin
  4653. TFormatDescriptor.Get(Format).PreparePixel(PixelData);
  4654. with PixelData do begin
  4655. Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
  4656. Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
  4657. Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
  4658. Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
  4659. end;
  4660. AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
  4661. end;
  4662. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4663. procedure TglBitmap.SetFilter(const aMin, aMag: Cardinal);
  4664. begin
  4665. //check MIN filter
  4666. case aMin of
  4667. GL_NEAREST:
  4668. fFilterMin := GL_NEAREST;
  4669. GL_LINEAR:
  4670. fFilterMin := GL_LINEAR;
  4671. GL_NEAREST_MIPMAP_NEAREST:
  4672. fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
  4673. GL_LINEAR_MIPMAP_NEAREST:
  4674. fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
  4675. GL_NEAREST_MIPMAP_LINEAR:
  4676. fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
  4677. GL_LINEAR_MIPMAP_LINEAR:
  4678. fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
  4679. else
  4680. raise EglBitmapException.Create('SetFilter - Unknow MIN filter.');
  4681. end;
  4682. //check MAG filter
  4683. case aMag of
  4684. GL_NEAREST:
  4685. fFilterMag := GL_NEAREST;
  4686. GL_LINEAR:
  4687. fFilterMag := GL_LINEAR;
  4688. else
  4689. raise EglBitmapException.Create('SetFilter - Unknow MAG filter.');
  4690. end;
  4691. //apply filter
  4692. if (ID > 0) then begin
  4693. Bind(false);
  4694. glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
  4695. if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
  4696. case fFilterMin of
  4697. GL_NEAREST, GL_LINEAR:
  4698. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  4699. GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
  4700. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
  4701. GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
  4702. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
  4703. end;
  4704. end else
  4705. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  4706. end;
  4707. end;
  4708. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4709. procedure TglBitmap.SetWrap(const S: Cardinal; const T: Cardinal; const R: Cardinal);
  4710. procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
  4711. begin
  4712. case aValue of
  4713. GL_CLAMP:
  4714. aTarget := GL_CLAMP;
  4715. GL_REPEAT:
  4716. aTarget := GL_REPEAT;
  4717. GL_CLAMP_TO_EDGE: begin
  4718. if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
  4719. aTarget := GL_CLAMP_TO_EDGE
  4720. else
  4721. aTarget := GL_CLAMP;
  4722. end;
  4723. GL_CLAMP_TO_BORDER: begin
  4724. if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
  4725. aTarget := GL_CLAMP_TO_BORDER
  4726. else
  4727. aTarget := GL_CLAMP;
  4728. end;
  4729. GL_MIRRORED_REPEAT: begin
  4730. if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
  4731. aTarget := GL_MIRRORED_REPEAT
  4732. else
  4733. raise EglBitmapException.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
  4734. end;
  4735. else
  4736. raise EglBitmapException.Create('SetWrap - Unknow Texturewrap (S).');
  4737. end;
  4738. end;
  4739. begin
  4740. CheckAndSetWrap(S, fWrapS);
  4741. CheckAndSetWrap(T, fWrapT);
  4742. CheckAndSetWrap(R, fWrapR);
  4743. if (ID > 0) then begin
  4744. Bind(false);
  4745. glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
  4746. glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
  4747. glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
  4748. end;
  4749. end;
  4750. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4751. procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
  4752. begin
  4753. if aEnableTextureUnit then
  4754. glEnable(Target);
  4755. if (ID > 0) then
  4756. glBindTexture(Target, ID);
  4757. end;
  4758. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4759. procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
  4760. begin
  4761. if aDisableTextureUnit then
  4762. glDisable(Target);
  4763. glBindTexture(Target, 0);
  4764. end;
  4765. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4766. constructor TglBitmap.Create;
  4767. begin
  4768. {$IFDEF GLB_NATIVE_OGL}
  4769. glbReadOpenGLExtensions;
  4770. {$ENDIF}
  4771. if (ClassType = TglBitmap) then
  4772. raise EglBitmapException.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
  4773. inherited Create;
  4774. end;
  4775. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4776. constructor TglBitmap.Create(const aFileName: String);
  4777. begin
  4778. Create;
  4779. LoadFromFile(FileName);
  4780. end;
  4781. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4782. constructor TglBitmap.Create(const aStream: TStream);
  4783. begin
  4784. Create;
  4785. LoadFromStream(aStream);
  4786. end;
  4787. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4788. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat);
  4789. var
  4790. Image: PByte;
  4791. ImageSize: Integer;
  4792. begin
  4793. Create;
  4794. ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  4795. GetMem(Image, ImageSize);
  4796. try
  4797. FillChar(Image^, ImageSize, #$FF);
  4798. SetDataPointer(Image, aFormat, aSize.X, aSize.Y);
  4799. except
  4800. FreeMem(Image);
  4801. raise;
  4802. end;
  4803. end;
  4804. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4805. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat;
  4806. const aFunc: TglBitmapFunction; const aArgs: Pointer);
  4807. begin
  4808. Create;
  4809. LoadFromFunc(aSize, aFunc, aFormat, aArgs);
  4810. end;
  4811. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4812. constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
  4813. begin
  4814. Create;
  4815. LoadFromResource(aInstance, aResource, aResType);
  4816. end;
  4817. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4818. constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  4819. begin
  4820. Create;
  4821. LoadFromResourceID(aInstance, aResourceID, aResType);
  4822. end;
  4823. {$IFDEF GLB_SUPPORT_PNG_READ}
  4824. {$IF DEFINED(GLB_SDL_IMAGE)}
  4825. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4826. //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4827. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4828. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  4829. var
  4830. Surface: PSDL_Surface;
  4831. RWops: PSDL_RWops;
  4832. begin
  4833. result := false;
  4834. RWops := glBitmapCreateRWops(aStream);
  4835. try
  4836. if IMG_isPNG(RWops) > 0 then begin
  4837. Surface := IMG_LoadPNG_RW(RWops);
  4838. try
  4839. AssignFromSurface(Surface);
  4840. result := true;
  4841. finally
  4842. SDL_FreeSurface(Surface);
  4843. end;
  4844. end;
  4845. finally
  4846. SDL_FreeRW(RWops);
  4847. end;
  4848. end;
  4849. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  4850. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4851. procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  4852. begin
  4853. TStream(png_get_io_ptr(png)).Read(buffer^, size);
  4854. end;
  4855. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4856. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  4857. var
  4858. StreamPos: Int64;
  4859. signature: array [0..7] of byte;
  4860. png: png_structp;
  4861. png_info: png_infop;
  4862. TempHeight, TempWidth: Integer;
  4863. Format: TglBitmapFormat;
  4864. png_data: pByte;
  4865. png_rows: array of pByte;
  4866. Row, LineSize: Integer;
  4867. begin
  4868. result := false;
  4869. if not init_libPNG then
  4870. raise Exception.Create('LoadPNG - unable to initialize libPNG.');
  4871. try
  4872. // signature
  4873. StreamPos := aStream.Position;
  4874. aStream.Read(signature{%H-}, 8);
  4875. aStream.Position := StreamPos;
  4876. if png_check_sig(@signature, 8) <> 0 then begin
  4877. // png read struct
  4878. png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  4879. if png = nil then
  4880. raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
  4881. // png info
  4882. png_info := png_create_info_struct(png);
  4883. if png_info = nil then begin
  4884. png_destroy_read_struct(@png, nil, nil);
  4885. raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
  4886. end;
  4887. // set read callback
  4888. png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
  4889. // read informations
  4890. png_read_info(png, png_info);
  4891. // size
  4892. TempHeight := png_get_image_height(png, png_info);
  4893. TempWidth := png_get_image_width(png, png_info);
  4894. // format
  4895. case png_get_color_type(png, png_info) of
  4896. PNG_COLOR_TYPE_GRAY:
  4897. Format := tfLuminance8;
  4898. PNG_COLOR_TYPE_GRAY_ALPHA:
  4899. Format := tfLuminance8Alpha8;
  4900. PNG_COLOR_TYPE_RGB:
  4901. Format := tfRGB8;
  4902. PNG_COLOR_TYPE_RGB_ALPHA:
  4903. Format := tfRGBA8;
  4904. else
  4905. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  4906. end;
  4907. // cut upper 8 bit from 16 bit formats
  4908. if png_get_bit_depth(png, png_info) > 8 then
  4909. png_set_strip_16(png);
  4910. // expand bitdepth smaller than 8
  4911. if png_get_bit_depth(png, png_info) < 8 then
  4912. png_set_expand(png);
  4913. // allocating mem for scanlines
  4914. LineSize := png_get_rowbytes(png, png_info);
  4915. GetMem(png_data, TempHeight * LineSize);
  4916. try
  4917. SetLength(png_rows, TempHeight);
  4918. for Row := Low(png_rows) to High(png_rows) do begin
  4919. png_rows[Row] := png_data;
  4920. Inc(png_rows[Row], Row * LineSize);
  4921. end;
  4922. // read complete image into scanlines
  4923. png_read_image(png, @png_rows[0]);
  4924. // read end
  4925. png_read_end(png, png_info);
  4926. // destroy read struct
  4927. png_destroy_read_struct(@png, @png_info, nil);
  4928. SetLength(png_rows, 0);
  4929. // set new data
  4930. SetDataPointer(png_data, Format, TempWidth, TempHeight);
  4931. result := true;
  4932. except
  4933. FreeMem(png_data);
  4934. raise;
  4935. end;
  4936. end;
  4937. finally
  4938. quit_libPNG;
  4939. end;
  4940. end;
  4941. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  4942. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4943. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  4944. var
  4945. StreamPos: Int64;
  4946. Png: TPNGObject;
  4947. Header: String[8];
  4948. Row, Col, PixSize, LineSize: Integer;
  4949. NewImage, pSource, pDest, pAlpha: pByte;
  4950. PngFormat: TglBitmapFormat;
  4951. FormatDesc: TFormatDescriptor;
  4952. const
  4953. PngHeader: String[8] = #137#80#78#71#13#10#26#10;
  4954. begin
  4955. result := false;
  4956. StreamPos := aStream.Position;
  4957. aStream.Read(Header[0], SizeOf(Header));
  4958. aStream.Position := StreamPos;
  4959. {Test if the header matches}
  4960. if Header = PngHeader then begin
  4961. Png := TPNGObject.Create;
  4962. try
  4963. Png.LoadFromStream(aStream);
  4964. case Png.Header.ColorType of
  4965. COLOR_GRAYSCALE:
  4966. PngFormat := tfLuminance8;
  4967. COLOR_GRAYSCALEALPHA:
  4968. PngFormat := tfLuminance8Alpha8;
  4969. COLOR_RGB:
  4970. PngFormat := tfBGR8;
  4971. COLOR_RGBALPHA:
  4972. PngFormat := tfBGRA8;
  4973. else
  4974. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  4975. end;
  4976. FormatDesc := TFormatDescriptor.Get(PngFormat);
  4977. PixSize := Round(FormatDesc.PixelSize);
  4978. LineSize := FormatDesc.GetSize(Png.Header.Width, 1);
  4979. GetMem(NewImage, LineSize * Integer(Png.Header.Height));
  4980. try
  4981. pDest := NewImage;
  4982. case Png.Header.ColorType of
  4983. COLOR_RGB, COLOR_GRAYSCALE:
  4984. begin
  4985. for Row := 0 to Png.Height -1 do begin
  4986. Move (Png.Scanline[Row]^, pDest^, LineSize);
  4987. Inc(pDest, LineSize);
  4988. end;
  4989. end;
  4990. COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
  4991. begin
  4992. PixSize := PixSize -1;
  4993. for Row := 0 to Png.Height -1 do begin
  4994. pSource := Png.Scanline[Row];
  4995. pAlpha := pByte(Png.AlphaScanline[Row]);
  4996. for Col := 0 to Png.Width -1 do begin
  4997. Move (pSource^, pDest^, PixSize);
  4998. Inc(pSource, PixSize);
  4999. Inc(pDest, PixSize);
  5000. pDest^ := pAlpha^;
  5001. inc(pAlpha);
  5002. Inc(pDest);
  5003. end;
  5004. end;
  5005. end;
  5006. else
  5007. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5008. end;
  5009. SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height);
  5010. result := true;
  5011. except
  5012. FreeMem(NewImage);
  5013. raise;
  5014. end;
  5015. finally
  5016. Png.Free;
  5017. end;
  5018. end;
  5019. end;
  5020. {$ENDIF}
  5021. {$ENDIF}
  5022. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  5023. {$IFDEF GLB_LIB_PNG}
  5024. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5025. procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  5026. begin
  5027. TStream(png_get_io_ptr(png)).Write(buffer^, size);
  5028. end;
  5029. {$ENDIF}
  5030. {$IF DEFINED(GLB_LIB_PNG)}
  5031. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5032. procedure TglBitmap.SavePNG(const aStream: TStream);
  5033. var
  5034. png: png_structp;
  5035. png_info: png_infop;
  5036. png_rows: array of pByte;
  5037. LineSize: Integer;
  5038. ColorType: Integer;
  5039. Row: Integer;
  5040. FormatDesc: TFormatDescriptor;
  5041. begin
  5042. if not (ftPNG in FormatGetSupportedFiles(Format)) then
  5043. raise EglBitmapUnsupportedFormat.Create(Format);
  5044. if not init_libPNG then
  5045. raise Exception.Create('unable to initialize libPNG.');
  5046. try
  5047. case Format of
  5048. tfAlpha8, tfLuminance8:
  5049. ColorType := PNG_COLOR_TYPE_GRAY;
  5050. tfLuminance8Alpha8:
  5051. ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
  5052. tfBGR8, tfRGB8:
  5053. ColorType := PNG_COLOR_TYPE_RGB;
  5054. tfBGRA8, tfRGBA8:
  5055. ColorType := PNG_COLOR_TYPE_RGBA;
  5056. else
  5057. raise EglBitmapUnsupportedFormat.Create(Format);
  5058. end;
  5059. FormatDesc := TFormatDescriptor.Get(Format);
  5060. LineSize := FormatDesc.GetSize(Width, 1);
  5061. // creating array for scanline
  5062. SetLength(png_rows, Height);
  5063. try
  5064. for Row := 0 to Height - 1 do begin
  5065. png_rows[Row] := Data;
  5066. Inc(png_rows[Row], Row * LineSize)
  5067. end;
  5068. // write struct
  5069. png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  5070. if png = nil then
  5071. raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
  5072. // create png info
  5073. png_info := png_create_info_struct(png);
  5074. if png_info = nil then begin
  5075. png_destroy_write_struct(@png, nil);
  5076. raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
  5077. end;
  5078. // set read callback
  5079. png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
  5080. // set compression
  5081. png_set_compression_level(png, 6);
  5082. if Format in [tfBGR8, tfBGRA8] then
  5083. png_set_bgr(png);
  5084. png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
  5085. png_write_info(png, png_info);
  5086. png_write_image(png, @png_rows[0]);
  5087. png_write_end(png, png_info);
  5088. png_destroy_write_struct(@png, @png_info);
  5089. finally
  5090. SetLength(png_rows, 0);
  5091. end;
  5092. finally
  5093. quit_libPNG;
  5094. end;
  5095. end;
  5096. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  5097. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5098. procedure TglBitmap.SavePNG(const aStream: TStream);
  5099. var
  5100. Png: TPNGObject;
  5101. pSource, pDest: pByte;
  5102. X, Y, PixSize: Integer;
  5103. ColorType: Cardinal;
  5104. Alpha: Boolean;
  5105. pTemp: pByte;
  5106. Temp: Byte;
  5107. begin
  5108. if not (ftPNG in FormatGetSupportedFiles (Format)) then
  5109. raise EglBitmapUnsupportedFormat.Create(Format);
  5110. case Format of
  5111. tfAlpha8, tfLuminance8: begin
  5112. ColorType := COLOR_GRAYSCALE;
  5113. PixSize := 1;
  5114. Alpha := false;
  5115. end;
  5116. tfLuminance8Alpha8: begin
  5117. ColorType := COLOR_GRAYSCALEALPHA;
  5118. PixSize := 1;
  5119. Alpha := true;
  5120. end;
  5121. tfBGR8, tfRGB8: begin
  5122. ColorType := COLOR_RGB;
  5123. PixSize := 3;
  5124. Alpha := false;
  5125. end;
  5126. tfBGRA8, tfRGBA8: begin
  5127. ColorType := COLOR_RGBALPHA;
  5128. PixSize := 3;
  5129. Alpha := true
  5130. end;
  5131. else
  5132. raise EglBitmapUnsupportedFormat.Create(Format);
  5133. end;
  5134. Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
  5135. try
  5136. // Copy ImageData
  5137. pSource := Data;
  5138. for Y := 0 to Height -1 do begin
  5139. pDest := png.ScanLine[Y];
  5140. for X := 0 to Width -1 do begin
  5141. Move(pSource^, pDest^, PixSize);
  5142. Inc(pDest, PixSize);
  5143. Inc(pSource, PixSize);
  5144. if Alpha then begin
  5145. png.AlphaScanline[Y]^[X] := pSource^;
  5146. Inc(pSource);
  5147. end;
  5148. end;
  5149. // convert RGB line to BGR
  5150. if Format in [tfRGB8, tfRGBA8] then begin
  5151. pTemp := png.ScanLine[Y];
  5152. for X := 0 to Width -1 do begin
  5153. Temp := pByteArray(pTemp)^[0];
  5154. pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
  5155. pByteArray(pTemp)^[2] := Temp;
  5156. Inc(pTemp, 3);
  5157. end;
  5158. end;
  5159. end;
  5160. // Save to Stream
  5161. Png.CompressionLevel := 6;
  5162. Png.SaveToStream(aStream);
  5163. finally
  5164. FreeAndNil(Png);
  5165. end;
  5166. end;
  5167. {$ENDIF}
  5168. {$ENDIF}
  5169. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5170. //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5171. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5172. {$IFDEF GLB_LIB_JPEG}
  5173. type
  5174. glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
  5175. glBitmap_libJPEG_source_mgr = record
  5176. pub: jpeg_source_mgr;
  5177. SrcStream: TStream;
  5178. SrcBuffer: array [1..4096] of byte;
  5179. end;
  5180. glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
  5181. glBitmap_libJPEG_dest_mgr = record
  5182. pub: jpeg_destination_mgr;
  5183. DestStream: TStream;
  5184. DestBuffer: array [1..4096] of byte;
  5185. end;
  5186. procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
  5187. begin
  5188. //DUMMY
  5189. end;
  5190. procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
  5191. begin
  5192. //DUMMY
  5193. end;
  5194. procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
  5195. begin
  5196. //DUMMY
  5197. end;
  5198. procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
  5199. begin
  5200. //DUMMY
  5201. end;
  5202. procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
  5203. begin
  5204. //DUMMY
  5205. end;
  5206. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5207. function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
  5208. var
  5209. src: glBitmap_libJPEG_source_mgr_ptr;
  5210. bytes: integer;
  5211. begin
  5212. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  5213. bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
  5214. if (bytes <= 0) then begin
  5215. src^.SrcBuffer[1] := $FF;
  5216. src^.SrcBuffer[2] := JPEG_EOI;
  5217. bytes := 2;
  5218. end;
  5219. src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
  5220. src^.pub.bytes_in_buffer := bytes;
  5221. result := true;
  5222. end;
  5223. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5224. procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
  5225. var
  5226. src: glBitmap_libJPEG_source_mgr_ptr;
  5227. begin
  5228. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  5229. if num_bytes > 0 then begin
  5230. // wanted byte isn't in buffer so set stream position and read buffer
  5231. if num_bytes > src^.pub.bytes_in_buffer then begin
  5232. src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
  5233. src^.pub.fill_input_buffer(cinfo);
  5234. end else begin
  5235. // wanted byte is in buffer so only skip
  5236. inc(src^.pub.next_input_byte, num_bytes);
  5237. dec(src^.pub.bytes_in_buffer, num_bytes);
  5238. end;
  5239. end;
  5240. end;
  5241. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5242. function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
  5243. var
  5244. dest: glBitmap_libJPEG_dest_mgr_ptr;
  5245. begin
  5246. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  5247. if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
  5248. // write complete buffer
  5249. dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
  5250. // reset buffer
  5251. dest^.pub.next_output_byte := @dest^.DestBuffer[1];
  5252. dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
  5253. end;
  5254. result := true;
  5255. end;
  5256. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5257. procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
  5258. var
  5259. Idx: Integer;
  5260. dest: glBitmap_libJPEG_dest_mgr_ptr;
  5261. begin
  5262. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  5263. for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
  5264. // check for endblock
  5265. if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
  5266. // write endblock
  5267. dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
  5268. // leave
  5269. break;
  5270. end else
  5271. dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
  5272. end;
  5273. end;
  5274. {$ENDIF}
  5275. {$IFDEF GLB_SUPPORT_JPEG_READ}
  5276. {$IF DEFINED(GLB_SDL_IMAGE)}
  5277. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5278. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5279. var
  5280. Surface: PSDL_Surface;
  5281. RWops: PSDL_RWops;
  5282. begin
  5283. result := false;
  5284. RWops := glBitmapCreateRWops(aStream);
  5285. try
  5286. if IMG_isJPG(RWops) > 0 then begin
  5287. Surface := IMG_LoadJPG_RW(RWops);
  5288. try
  5289. AssignFromSurface(Surface);
  5290. result := true;
  5291. finally
  5292. SDL_FreeSurface(Surface);
  5293. end;
  5294. end;
  5295. finally
  5296. SDL_FreeRW(RWops);
  5297. end;
  5298. end;
  5299. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  5300. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5301. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5302. var
  5303. StreamPos: Int64;
  5304. Temp: array[0..1]of Byte;
  5305. jpeg: jpeg_decompress_struct;
  5306. jpeg_err: jpeg_error_mgr;
  5307. IntFormat: TglBitmapFormat;
  5308. pImage: pByte;
  5309. TempHeight, TempWidth: Integer;
  5310. pTemp: pByte;
  5311. Row: Integer;
  5312. FormatDesc: TFormatDescriptor;
  5313. begin
  5314. result := false;
  5315. if not init_libJPEG then
  5316. raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
  5317. try
  5318. // reading first two bytes to test file and set cursor back to begin
  5319. StreamPos := aStream.Position;
  5320. aStream.Read({%H-}Temp[0], 2);
  5321. aStream.Position := StreamPos;
  5322. // if Bitmap then read file.
  5323. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  5324. FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
  5325. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  5326. // error managment
  5327. jpeg.err := jpeg_std_error(@jpeg_err);
  5328. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  5329. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  5330. // decompression struct
  5331. jpeg_create_decompress(@jpeg);
  5332. // allocation space for streaming methods
  5333. jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
  5334. // seeting up custom functions
  5335. with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
  5336. pub.init_source := glBitmap_libJPEG_init_source;
  5337. pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
  5338. pub.skip_input_data := glBitmap_libJPEG_skip_input_data;
  5339. pub.resync_to_restart := jpeg_resync_to_restart; // use default method
  5340. pub.term_source := glBitmap_libJPEG_term_source;
  5341. pub.bytes_in_buffer := 0; // forces fill_input_buffer on first read
  5342. pub.next_input_byte := nil; // until buffer loaded
  5343. SrcStream := aStream;
  5344. end;
  5345. // set global decoding state
  5346. jpeg.global_state := DSTATE_START;
  5347. // read header of jpeg
  5348. jpeg_read_header(@jpeg, false);
  5349. // setting output parameter
  5350. case jpeg.jpeg_color_space of
  5351. JCS_GRAYSCALE:
  5352. begin
  5353. jpeg.out_color_space := JCS_GRAYSCALE;
  5354. IntFormat := tfLuminance8;
  5355. end;
  5356. else
  5357. jpeg.out_color_space := JCS_RGB;
  5358. IntFormat := tfRGB8;
  5359. end;
  5360. // reading image
  5361. jpeg_start_decompress(@jpeg);
  5362. TempHeight := jpeg.output_height;
  5363. TempWidth := jpeg.output_width;
  5364. FormatDesc := TFormatDescriptor.Get(IntFormat);
  5365. // creating new image
  5366. GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
  5367. try
  5368. pTemp := pImage;
  5369. for Row := 0 to TempHeight -1 do begin
  5370. jpeg_read_scanlines(@jpeg, @pTemp, 1);
  5371. Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
  5372. end;
  5373. // finish decompression
  5374. jpeg_finish_decompress(@jpeg);
  5375. // destroy decompression
  5376. jpeg_destroy_decompress(@jpeg);
  5377. SetDataPointer(pImage, IntFormat, TempWidth, TempHeight);
  5378. result := true;
  5379. except
  5380. FreeMem(pImage);
  5381. raise;
  5382. end;
  5383. end;
  5384. finally
  5385. quit_libJPEG;
  5386. end;
  5387. end;
  5388. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  5389. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5390. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5391. var
  5392. bmp: TBitmap;
  5393. jpg: TJPEGImage;
  5394. StreamPos: Int64;
  5395. Temp: array[0..1]of Byte;
  5396. begin
  5397. result := false;
  5398. // reading first two bytes to test file and set cursor back to begin
  5399. StreamPos := Stream.Position;
  5400. Stream.Read(Temp[0], 2);
  5401. Stream.Position := StreamPos;
  5402. // if Bitmap then read file.
  5403. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  5404. bmp := TBitmap.Create;
  5405. try
  5406. jpg := TJPEGImage.Create;
  5407. try
  5408. jpg.LoadFromStream(Stream);
  5409. bmp.Assign(jpg);
  5410. result := AssignFromBitmap(bmp);
  5411. finally
  5412. jpg.Free;
  5413. end;
  5414. finally
  5415. bmp.Free;
  5416. end;
  5417. end;
  5418. end;
  5419. {$ENDIF}
  5420. {$ENDIF}
  5421. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  5422. {$IF DEFINED(GLB_LIB_JPEG)}
  5423. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5424. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  5425. var
  5426. jpeg: jpeg_compress_struct;
  5427. jpeg_err: jpeg_error_mgr;
  5428. Row: Integer;
  5429. pTemp, pTemp2: pByte;
  5430. procedure CopyRow(pDest, pSource: pByte);
  5431. var
  5432. X: Integer;
  5433. begin
  5434. for X := 0 to Width - 1 do begin
  5435. pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
  5436. pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
  5437. pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
  5438. Inc(pDest, 3);
  5439. Inc(pSource, 3);
  5440. end;
  5441. end;
  5442. begin
  5443. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  5444. raise EglBitmapUnsupportedFormat.Create(Format);
  5445. if not init_libJPEG then
  5446. raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
  5447. try
  5448. FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
  5449. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  5450. // error managment
  5451. jpeg.err := jpeg_std_error(@jpeg_err);
  5452. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  5453. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  5454. // compression struct
  5455. jpeg_create_compress(@jpeg);
  5456. // allocation space for streaming methods
  5457. jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
  5458. // seeting up custom functions
  5459. with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
  5460. pub.init_destination := glBitmap_libJPEG_init_destination;
  5461. pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
  5462. pub.term_destination := glBitmap_libJPEG_term_destination;
  5463. pub.next_output_byte := @DestBuffer[1];
  5464. pub.free_in_buffer := Length(DestBuffer);
  5465. DestStream := aStream;
  5466. end;
  5467. // very important state
  5468. jpeg.global_state := CSTATE_START;
  5469. jpeg.image_width := Width;
  5470. jpeg.image_height := Height;
  5471. case Format of
  5472. tfAlpha8, tfLuminance8: begin
  5473. jpeg.input_components := 1;
  5474. jpeg.in_color_space := JCS_GRAYSCALE;
  5475. end;
  5476. tfRGB8, tfBGR8: begin
  5477. jpeg.input_components := 3;
  5478. jpeg.in_color_space := JCS_RGB;
  5479. end;
  5480. end;
  5481. jpeg_set_defaults(@jpeg);
  5482. jpeg_set_quality(@jpeg, 95, true);
  5483. jpeg_start_compress(@jpeg, true);
  5484. pTemp := Data;
  5485. if Format = tfBGR8 then
  5486. GetMem(pTemp2, fRowSize)
  5487. else
  5488. pTemp2 := pTemp;
  5489. try
  5490. for Row := 0 to jpeg.image_height -1 do begin
  5491. // prepare row
  5492. if Format = tfBGR8 then
  5493. CopyRow(pTemp2, pTemp)
  5494. else
  5495. pTemp2 := pTemp;
  5496. // write row
  5497. jpeg_write_scanlines(@jpeg, @pTemp2, 1);
  5498. inc(pTemp, fRowSize);
  5499. end;
  5500. finally
  5501. // free memory
  5502. if Format = tfBGR8 then
  5503. FreeMem(pTemp2);
  5504. end;
  5505. jpeg_finish_compress(@jpeg);
  5506. jpeg_destroy_compress(@jpeg);
  5507. finally
  5508. quit_libJPEG;
  5509. end;
  5510. end;
  5511. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  5512. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5513. procedure TglBitmap.SaveJPEG(Stream: TStream);
  5514. var
  5515. Bmp: TBitmap;
  5516. Jpg: TJPEGImage;
  5517. begin
  5518. if not (ftJPEG in FormatGetSupportedFiles (InternalFormat)) then
  5519. raise EglBitmapUnsupportedInternalFormat.Create('SaveJpg - ' + UNSUPPORTED_INTERNAL_FORMAT);
  5520. Bmp := TBitmap.Create;
  5521. try
  5522. Jpg := TJPEGImage.Create;
  5523. try
  5524. AssignToBitmap(Bmp);
  5525. if FInternalFormat in [ifAlpha, ifLuminance, ifDepth8] then begin
  5526. Jpg.Grayscale := true;
  5527. Jpg.PixelFormat := jf8Bit;
  5528. end;
  5529. Jpg.Assign(Bmp);
  5530. Jpg.SaveToStream(Stream);
  5531. finally
  5532. FreeAndNil(Jpg);
  5533. end;
  5534. finally
  5535. FreeAndNil(Bmp);
  5536. end;
  5537. end;
  5538. {$ENDIF}
  5539. {$ENDIF}
  5540. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5541. //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5542. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5543. const
  5544. BMP_MAGIC = $4D42;
  5545. BMP_COMP_RGB = 0;
  5546. BMP_COMP_RLE8 = 1;
  5547. BMP_COMP_RLE4 = 2;
  5548. BMP_COMP_BITFIELDS = 3;
  5549. type
  5550. TBMPHeader = packed record
  5551. bfType: Word;
  5552. bfSize: Cardinal;
  5553. bfReserved1: Word;
  5554. bfReserved2: Word;
  5555. bfOffBits: Cardinal;
  5556. end;
  5557. TBMPInfo = packed record
  5558. biSize: Cardinal;
  5559. biWidth: Longint;
  5560. biHeight: Longint;
  5561. biPlanes: Word;
  5562. biBitCount: Word;
  5563. biCompression: Cardinal;
  5564. biSizeImage: Cardinal;
  5565. biXPelsPerMeter: Longint;
  5566. biYPelsPerMeter: Longint;
  5567. biClrUsed: Cardinal;
  5568. biClrImportant: Cardinal;
  5569. end;
  5570. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5571. function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
  5572. //////////////////////////////////////////////////////////////////////////////////////////////////
  5573. function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapColorRec): TglBitmapFormat;
  5574. begin
  5575. result := tfEmpty;
  5576. aStream.Read(aInfo{%H-}, SizeOf(aInfo));
  5577. FillChar(aMask{%H-}, SizeOf(aMask), 0);
  5578. //Read Compression
  5579. case aInfo.biCompression of
  5580. BMP_COMP_RLE4,
  5581. BMP_COMP_RLE8: begin
  5582. raise EglBitmapException.Create('RLE compression is not supported');
  5583. end;
  5584. BMP_COMP_BITFIELDS: begin
  5585. if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
  5586. aStream.Read(aMask.r, SizeOf(aMask.r));
  5587. aStream.Read(aMask.g, SizeOf(aMask.g));
  5588. aStream.Read(aMask.b, SizeOf(aMask.b));
  5589. aStream.Read(aMask.a, SizeOf(aMask.a));
  5590. end else
  5591. raise EglBitmapException.Create('Bitfields are only supported for 16bit and 32bit formats');
  5592. end;
  5593. end;
  5594. //get suitable format
  5595. case aInfo.biBitCount of
  5596. 8: result := tfLuminance8;
  5597. 16: result := tfBGR5;
  5598. 24: result := tfBGR8;
  5599. 32: result := tfBGRA8;
  5600. end;
  5601. end;
  5602. function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
  5603. var
  5604. i, c: Integer;
  5605. ColorTable: TbmpColorTable;
  5606. begin
  5607. result := nil;
  5608. if (aInfo.biBitCount >= 16) then
  5609. exit;
  5610. aFormat := tfLuminance8;
  5611. c := aInfo.biClrUsed;
  5612. if (c = 0) then
  5613. c := 1 shl aInfo.biBitCount;
  5614. SetLength(ColorTable, c);
  5615. for i := 0 to c-1 do begin
  5616. aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
  5617. if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
  5618. aFormat := tfRGB8;
  5619. end;
  5620. result := TbmpColorTableFormat.Create;
  5621. result.PixelSize := aInfo.biBitCount / 8;
  5622. result.ColorTable := ColorTable;
  5623. result.Range := glBitmapColorRec($FF, $FF, $FF, $00);
  5624. end;
  5625. //////////////////////////////////////////////////////////////////////////////////////////////////
  5626. function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
  5627. const aInfo: TBMPInfo): TbmpBitfieldFormat;
  5628. var
  5629. TmpFormat: TglBitmapFormat;
  5630. FormatDesc: TFormatDescriptor;
  5631. begin
  5632. result := nil;
  5633. if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
  5634. for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  5635. FormatDesc := TFormatDescriptor.Get(TmpFormat);
  5636. if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
  5637. aFormat := FormatDesc.Format;
  5638. exit;
  5639. end;
  5640. end;
  5641. if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
  5642. aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
  5643. if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
  5644. aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
  5645. result := TbmpBitfieldFormat.Create;
  5646. result.PixelSize := aInfo.biBitCount / 8;
  5647. result.RedMask := aMask.r;
  5648. result.GreenMask := aMask.g;
  5649. result.BlueMask := aMask.b;
  5650. result.AlphaMask := aMask.a;
  5651. end;
  5652. end;
  5653. var
  5654. //simple types
  5655. StartPos: Int64;
  5656. ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
  5657. PaddingBuff: Cardinal;
  5658. LineBuf, ImageData, TmpData: PByte;
  5659. SourceMD, DestMD: Pointer;
  5660. BmpFormat: TglBitmapFormat;
  5661. //records
  5662. Mask: TglBitmapColorRec;
  5663. Header: TBMPHeader;
  5664. Info: TBMPInfo;
  5665. //classes
  5666. SpecialFormat: TFormatDescriptor;
  5667. FormatDesc: TFormatDescriptor;
  5668. //////////////////////////////////////////////////////////////////////////////////////////////////
  5669. procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
  5670. var
  5671. i: Integer;
  5672. Pixel: TglBitmapPixelData;
  5673. begin
  5674. aStream.Read(aLineBuf^, rbLineSize);
  5675. SpecialFormat.PreparePixel(Pixel);
  5676. for i := 0 to Info.biWidth-1 do begin
  5677. SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
  5678. glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
  5679. FormatDesc.Map(Pixel, aData, DestMD);
  5680. end;
  5681. end;
  5682. begin
  5683. result := false;
  5684. BmpFormat := tfEmpty;
  5685. SpecialFormat := nil;
  5686. LineBuf := nil;
  5687. SourceMD := nil;
  5688. DestMD := nil;
  5689. // Header
  5690. StartPos := aStream.Position;
  5691. aStream.Read(Header{%H-}, SizeOf(Header));
  5692. if Header.bfType = BMP_MAGIC then begin
  5693. try try
  5694. BmpFormat := ReadInfo(Info, Mask);
  5695. SpecialFormat := ReadColorTable(BmpFormat, Info);
  5696. if not Assigned(SpecialFormat) then
  5697. SpecialFormat := CheckBitfields(BmpFormat, Mask, Info);
  5698. aStream.Position := StartPos + Header.bfOffBits;
  5699. if (BmpFormat <> tfEmpty) then begin
  5700. FormatDesc := TFormatDescriptor.Get(BmpFormat);
  5701. rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
  5702. wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
  5703. Padding := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
  5704. //get Memory
  5705. DestMD := FormatDesc.CreateMappingData;
  5706. ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
  5707. GetMem(ImageData, ImageSize);
  5708. if Assigned(SpecialFormat) then begin
  5709. GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
  5710. SourceMD := SpecialFormat.CreateMappingData;
  5711. end;
  5712. //read Data
  5713. try try
  5714. FillChar(ImageData^, ImageSize, $FF);
  5715. TmpData := ImageData;
  5716. if (Info.biHeight > 0) then
  5717. Inc(TmpData, wbLineSize * (Info.biHeight-1));
  5718. for i := 0 to Abs(Info.biHeight)-1 do begin
  5719. if Assigned(SpecialFormat) then
  5720. SpecialFormatReadLine(TmpData, LineBuf) //if is special format read and convert data
  5721. else
  5722. aStream.Read(TmpData^, wbLineSize); //else only read data
  5723. if (Info.biHeight > 0) then
  5724. dec(TmpData, wbLineSize)
  5725. else
  5726. inc(TmpData, wbLineSize);
  5727. aStream.Read(PaddingBuff{%H-}, Padding);
  5728. end;
  5729. SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight));
  5730. result := true;
  5731. finally
  5732. if Assigned(LineBuf) then
  5733. FreeMem(LineBuf);
  5734. if Assigned(SourceMD) then
  5735. SpecialFormat.FreeMappingData(SourceMD);
  5736. FormatDesc.FreeMappingData(DestMD);
  5737. end;
  5738. except
  5739. FreeMem(ImageData);
  5740. raise;
  5741. end;
  5742. end else
  5743. raise EglBitmapException.Create('LoadBMP - No suitable format found');
  5744. except
  5745. aStream.Position := StartPos;
  5746. raise;
  5747. end;
  5748. finally
  5749. FreeAndNil(SpecialFormat);
  5750. end;
  5751. end
  5752. else aStream.Position := StartPos;
  5753. end;
  5754. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5755. procedure TglBitmap.SaveBMP(const aStream: TStream);
  5756. var
  5757. Header: TBMPHeader;
  5758. Info: TBMPInfo;
  5759. Converter: TbmpColorTableFormat;
  5760. FormatDesc: TFormatDescriptor;
  5761. SourceFD, DestFD: Pointer;
  5762. pData, srcData, dstData, ConvertBuffer: pByte;
  5763. Pixel: TglBitmapPixelData;
  5764. ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
  5765. RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
  5766. PaddingBuff: Cardinal;
  5767. function GetLineWidth : Integer;
  5768. begin
  5769. result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
  5770. end;
  5771. begin
  5772. if not (ftBMP in FormatGetSupportedFiles(Format)) then
  5773. raise EglBitmapUnsupportedFormat.Create(Format);
  5774. Converter := nil;
  5775. FormatDesc := TFormatDescriptor.Get(Format);
  5776. ImageSize := FormatDesc.GetSize(Dimension);
  5777. FillChar(Header{%H-}, SizeOf(Header), 0);
  5778. Header.bfType := BMP_MAGIC;
  5779. Header.bfSize := SizeOf(Header) + SizeOf(Info) + ImageSize;
  5780. Header.bfReserved1 := 0;
  5781. Header.bfReserved2 := 0;
  5782. Header.bfOffBits := SizeOf(Header) + SizeOf(Info);
  5783. FillChar(Info{%H-}, SizeOf(Info), 0);
  5784. Info.biSize := SizeOf(Info);
  5785. Info.biWidth := Width;
  5786. Info.biHeight := Height;
  5787. Info.biPlanes := 1;
  5788. Info.biCompression := BMP_COMP_RGB;
  5789. Info.biSizeImage := ImageSize;
  5790. try
  5791. case Format of
  5792. tfLuminance4: begin
  5793. Info.biBitCount := 4;
  5794. Header.bfSize := Header.bfSize + 16 * SizeOf(Cardinal);
  5795. Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
  5796. Converter := TbmpColorTableFormat.Create;
  5797. Converter.PixelSize := 0.5;
  5798. Converter.Format := Format;
  5799. Converter.Range := glBitmapColorRec($F, $F, $F, $0);
  5800. Converter.CreateColorTable;
  5801. end;
  5802. tfR3G3B2, tfLuminance8: begin
  5803. Info.biBitCount := 8;
  5804. Header.bfSize := Header.bfSize + 256 * SizeOf(Cardinal);
  5805. Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
  5806. Converter := TbmpColorTableFormat.Create;
  5807. Converter.PixelSize := 1;
  5808. Converter.Format := Format;
  5809. if (Format = tfR3G3B2) then begin
  5810. Converter.Range := glBitmapColorRec($7, $7, $3, $0);
  5811. Converter.Shift := glBitmapShiftRec(0, 3, 6, 0);
  5812. end else
  5813. Converter.Range := glBitmapColorRec($FF, $FF, $FF, $0);
  5814. Converter.CreateColorTable;
  5815. end;
  5816. tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
  5817. tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin
  5818. Info.biBitCount := 16;
  5819. Info.biCompression := BMP_COMP_BITFIELDS;
  5820. end;
  5821. tfBGR8, tfRGB8: begin
  5822. Info.biBitCount := 24;
  5823. end;
  5824. tfRGB10, tfRGB10A2, tfRGBA8,
  5825. tfBGR10, tfBGR10A2, tfBGRA8: begin
  5826. Info.biBitCount := 32;
  5827. Info.biCompression := BMP_COMP_BITFIELDS;
  5828. end;
  5829. else
  5830. raise EglBitmapUnsupportedFormat.Create(Format);
  5831. end;
  5832. Info.biXPelsPerMeter := 2835;
  5833. Info.biYPelsPerMeter := 2835;
  5834. // prepare bitmasks
  5835. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  5836. Header.bfSize := Header.bfSize + 4 * SizeOf(Cardinal);
  5837. Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
  5838. RedMask := FormatDesc.RedMask;
  5839. GreenMask := FormatDesc.GreenMask;
  5840. BlueMask := FormatDesc.BlueMask;
  5841. AlphaMask := FormatDesc.AlphaMask;
  5842. end;
  5843. // headers
  5844. aStream.Write(Header, SizeOf(Header));
  5845. aStream.Write(Info, SizeOf(Info));
  5846. // colortable
  5847. if Assigned(Converter) then
  5848. aStream.Write(Converter.ColorTable[0].b,
  5849. SizeOf(TbmpColorTableEnty) * Length(Converter.ColorTable));
  5850. // bitmasks
  5851. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  5852. aStream.Write(RedMask, SizeOf(Cardinal));
  5853. aStream.Write(GreenMask, SizeOf(Cardinal));
  5854. aStream.Write(BlueMask, SizeOf(Cardinal));
  5855. aStream.Write(AlphaMask, SizeOf(Cardinal));
  5856. end;
  5857. // image data
  5858. rbLineSize := Round(Info.biWidth * FormatDesc.PixelSize);
  5859. wbLineSize := Round(Info.biWidth * Info.biBitCount / 8);
  5860. Padding := GetLineWidth - wbLineSize;
  5861. PaddingBuff := 0;
  5862. pData := Data;
  5863. inc(pData, (Height-1) * rbLineSize);
  5864. // prepare row buffer. But only for RGB because RGBA supports color masks
  5865. // so it's possible to change color within the image.
  5866. if Assigned(Converter) then begin
  5867. FormatDesc.PreparePixel(Pixel);
  5868. GetMem(ConvertBuffer, wbLineSize);
  5869. SourceFD := FormatDesc.CreateMappingData;
  5870. DestFD := Converter.CreateMappingData;
  5871. end else
  5872. ConvertBuffer := nil;
  5873. try
  5874. for LineIdx := 0 to Height - 1 do begin
  5875. // preparing row
  5876. if Assigned(Converter) then begin
  5877. srcData := pData;
  5878. dstData := ConvertBuffer;
  5879. for PixelIdx := 0 to Info.biWidth-1 do begin
  5880. FormatDesc.Unmap(srcData, Pixel, SourceFD);
  5881. glBitmapConvertPixel(Pixel, FormatDesc, Converter);
  5882. Converter.Map(Pixel, dstData, DestFD);
  5883. end;
  5884. aStream.Write(ConvertBuffer^, wbLineSize);
  5885. end else begin
  5886. aStream.Write(pData^, rbLineSize);
  5887. end;
  5888. dec(pData, rbLineSize);
  5889. if (Padding > 0) then
  5890. aStream.Write(PaddingBuff, Padding);
  5891. end;
  5892. finally
  5893. // destroy row buffer
  5894. if Assigned(ConvertBuffer) then begin
  5895. FormatDesc.FreeMappingData(SourceFD);
  5896. Converter.FreeMappingData(DestFD);
  5897. FreeMem(ConvertBuffer);
  5898. end;
  5899. end;
  5900. finally
  5901. if Assigned(Converter) then
  5902. Converter.Free;
  5903. end;
  5904. end;
  5905. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5906. //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5907. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5908. type
  5909. TTGAHeader = packed record
  5910. ImageID: Byte;
  5911. ColorMapType: Byte;
  5912. ImageType: Byte;
  5913. //ColorMapSpec: Array[0..4] of Byte;
  5914. ColorMapStart: Word;
  5915. ColorMapLength: Word;
  5916. ColorMapEntrySize: Byte;
  5917. OrigX: Word;
  5918. OrigY: Word;
  5919. Width: Word;
  5920. Height: Word;
  5921. Bpp: Byte;
  5922. ImageDesc: Byte;
  5923. end;
  5924. const
  5925. TGA_UNCOMPRESSED_RGB = 2;
  5926. TGA_UNCOMPRESSED_GRAY = 3;
  5927. TGA_COMPRESSED_RGB = 10;
  5928. TGA_COMPRESSED_GRAY = 11;
  5929. TGA_NONE_COLOR_TABLE = 0;
  5930. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5931. function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
  5932. var
  5933. Header: TTGAHeader;
  5934. ImageData: System.PByte;
  5935. StartPosition: Int64;
  5936. PixelSize, LineSize: Integer;
  5937. tgaFormat: TglBitmapFormat;
  5938. FormatDesc: TFormatDescriptor;
  5939. Counter: packed record
  5940. X, Y: packed record
  5941. low, high, dir: Integer;
  5942. end;
  5943. end;
  5944. const
  5945. CACHE_SIZE = $4000;
  5946. ////////////////////////////////////////////////////////////////////////////////////////
  5947. procedure ReadUncompressed;
  5948. var
  5949. i, j: Integer;
  5950. buf, tmp1, tmp2: System.PByte;
  5951. begin
  5952. buf := nil;
  5953. if (Counter.X.dir < 0) then
  5954. buf := GetMem(LineSize);
  5955. try
  5956. while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
  5957. tmp1 := ImageData + (Counter.Y.low * LineSize); //pointer to LineStart
  5958. if (Counter.X.dir < 0) then begin //flip X
  5959. aStream.Read(buf^, LineSize);
  5960. tmp2 := buf + LineSize - PixelSize; //pointer to last pixel in line
  5961. for i := 0 to Header.Width-1 do begin //for all pixels in line
  5962. for j := 0 to PixelSize-1 do begin //for all bytes in pixel
  5963. tmp1^ := tmp2^;
  5964. inc(tmp1);
  5965. inc(tmp2);
  5966. end;
  5967. dec(tmp2, 2*PixelSize); //move 2 backwards, because j-loop moved 1 forward
  5968. end;
  5969. end else
  5970. aStream.Read(tmp1^, LineSize);
  5971. inc(Counter.Y.low, Counter.Y.dir); //move to next line index
  5972. end;
  5973. finally
  5974. if Assigned(buf) then
  5975. FreeMem(buf);
  5976. end;
  5977. end;
  5978. ////////////////////////////////////////////////////////////////////////////////////////
  5979. procedure ReadCompressed;
  5980. /////////////////////////////////////////////////////////////////
  5981. var
  5982. TmpData: System.PByte;
  5983. LinePixelsRead: Integer;
  5984. procedure CheckLine;
  5985. begin
  5986. if (LinePixelsRead >= Header.Width) then begin
  5987. LinePixelsRead := 0;
  5988. inc(Counter.Y.low, Counter.Y.dir); //next line index
  5989. TmpData := ImageData + Counter.Y.low * LineSize; //set line
  5990. if (Counter.X.dir < 0) then //if x flipped then
  5991. TmpData := TmpData + LineSize - PixelSize; //set last pixel
  5992. end;
  5993. end;
  5994. /////////////////////////////////////////////////////////////////
  5995. var
  5996. Cache: PByte;
  5997. CacheSize, CachePos: Integer;
  5998. procedure CachedRead(out Buffer; Count: Integer);
  5999. var
  6000. BytesRead: Integer;
  6001. begin
  6002. if (CachePos + Count > CacheSize) then begin
  6003. //if buffer overflow save non read bytes
  6004. BytesRead := 0;
  6005. if (CacheSize - CachePos > 0) then begin
  6006. BytesRead := CacheSize - CachePos;
  6007. Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
  6008. inc(CachePos, BytesRead);
  6009. end;
  6010. //load cache from file
  6011. CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
  6012. aStream.Read(Cache^, CacheSize);
  6013. CachePos := 0;
  6014. //read rest of requested bytes
  6015. if (Count - BytesRead > 0) then begin
  6016. Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
  6017. inc(CachePos, Count - BytesRead);
  6018. end;
  6019. end else begin
  6020. //if no buffer overflow just read the data
  6021. Move(PByteArray(Cache)^[CachePos], Buffer, Count);
  6022. inc(CachePos, Count);
  6023. end;
  6024. end;
  6025. procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
  6026. begin
  6027. case PixelSize of
  6028. 1: begin
  6029. aBuffer^ := aData^;
  6030. inc(aBuffer, Counter.X.dir);
  6031. end;
  6032. 2: begin
  6033. PWord(aBuffer)^ := PWord(aData)^;
  6034. inc(aBuffer, 2 * Counter.X.dir);
  6035. end;
  6036. 3: begin
  6037. PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
  6038. PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
  6039. PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
  6040. inc(aBuffer, 3 * Counter.X.dir);
  6041. end;
  6042. 4: begin
  6043. PCardinal(aBuffer)^ := PCardinal(aData)^;
  6044. inc(aBuffer, 4 * Counter.X.dir);
  6045. end;
  6046. end;
  6047. end;
  6048. var
  6049. TotalPixelsToRead, TotalPixelsRead: Integer;
  6050. Temp: Byte;
  6051. buf: array [0..3] of Byte; //1 pixel is max 32bit long
  6052. PixelRepeat: Boolean;
  6053. PixelsToRead, PixelCount: Integer;
  6054. begin
  6055. CacheSize := 0;
  6056. CachePos := 0;
  6057. TotalPixelsToRead := Header.Width * Header.Height;
  6058. TotalPixelsRead := 0;
  6059. LinePixelsRead := 0;
  6060. GetMem(Cache, CACHE_SIZE);
  6061. try
  6062. TmpData := ImageData + Counter.Y.low * LineSize; //set line
  6063. if (Counter.X.dir < 0) then //if x flipped then
  6064. TmpData := TmpData + LineSize - PixelSize; //set last pixel
  6065. repeat
  6066. //read CommandByte
  6067. CachedRead(Temp, 1);
  6068. PixelRepeat := (Temp and $80) > 0;
  6069. PixelsToRead := (Temp and $7F) + 1;
  6070. inc(TotalPixelsRead, PixelsToRead);
  6071. if PixelRepeat then
  6072. CachedRead(buf[0], PixelSize);
  6073. while (PixelsToRead > 0) do begin
  6074. CheckLine;
  6075. PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
  6076. while (PixelCount > 0) do begin
  6077. if not PixelRepeat then
  6078. CachedRead(buf[0], PixelSize);
  6079. PixelToBuffer(@buf[0], TmpData);
  6080. inc(LinePixelsRead);
  6081. dec(PixelsToRead);
  6082. dec(PixelCount);
  6083. end;
  6084. end;
  6085. until (TotalPixelsRead >= TotalPixelsToRead);
  6086. finally
  6087. FreeMem(Cache);
  6088. end;
  6089. end;
  6090. function IsGrayFormat: Boolean;
  6091. begin
  6092. result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
  6093. end;
  6094. begin
  6095. result := false;
  6096. // reading header to test file and set cursor back to begin
  6097. StartPosition := aStream.Position;
  6098. aStream.Read(Header{%H-}, SizeOf(Header));
  6099. // no colormapped files
  6100. if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
  6101. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
  6102. begin
  6103. try
  6104. if Header.ImageID <> 0 then // skip image ID
  6105. aStream.Position := aStream.Position + Header.ImageID;
  6106. case Header.Bpp of
  6107. 8: if IsGrayFormat then case (Header.ImageDesc and $F) of
  6108. 0: tgaFormat := tfLuminance8;
  6109. 8: tgaFormat := tfAlpha8;
  6110. end;
  6111. 16: if IsGrayFormat then case (Header.ImageDesc and $F) of
  6112. 0: tgaFormat := tfLuminance16;
  6113. 8: tgaFormat := tfLuminance8Alpha8;
  6114. end else case (Header.ImageDesc and $F) of
  6115. 0: tgaFormat := tfBGR5;
  6116. 1: tgaFormat := tfBGR5A1;
  6117. 4: tgaFormat := tfBGRA4;
  6118. end;
  6119. 24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  6120. 0: tgaFormat := tfBGR8;
  6121. end;
  6122. 32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  6123. 2: tgaFormat := tfBGR10A2;
  6124. 8: tgaFormat := tfBGRA8;
  6125. end;
  6126. end;
  6127. if (tgaFormat = tfEmpty) then
  6128. raise EglBitmapException.Create('LoadTga - unsupported format');
  6129. FormatDesc := TFormatDescriptor.Get(tgaFormat);
  6130. PixelSize := FormatDesc.GetSize(1, 1);
  6131. LineSize := FormatDesc.GetSize(Header.Width, 1);
  6132. GetMem(ImageData, LineSize * Header.Height);
  6133. try
  6134. //column direction
  6135. if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
  6136. Counter.X.low := Header.Height-1;;
  6137. Counter.X.high := 0;
  6138. Counter.X.dir := -1;
  6139. end else begin
  6140. Counter.X.low := 0;
  6141. Counter.X.high := Header.Height-1;
  6142. Counter.X.dir := 1;
  6143. end;
  6144. // Row direction
  6145. if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
  6146. Counter.Y.low := 0;
  6147. Counter.Y.high := Header.Height-1;
  6148. Counter.Y.dir := 1;
  6149. end else begin
  6150. Counter.Y.low := Header.Height-1;;
  6151. Counter.Y.high := 0;
  6152. Counter.Y.dir := -1;
  6153. end;
  6154. // Read Image
  6155. case Header.ImageType of
  6156. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
  6157. ReadUncompressed;
  6158. TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
  6159. ReadCompressed;
  6160. end;
  6161. SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height);
  6162. result := true;
  6163. except
  6164. FreeMem(ImageData);
  6165. raise;
  6166. end;
  6167. finally
  6168. aStream.Position := StartPosition;
  6169. end;
  6170. end
  6171. else aStream.Position := StartPosition;
  6172. end;
  6173. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6174. procedure TglBitmap.SaveTGA(const aStream: TStream);
  6175. var
  6176. Header: TTGAHeader;
  6177. LineSize, Size, x, y: Integer;
  6178. Pixel: TglBitmapPixelData;
  6179. LineBuf, SourceData, DestData: PByte;
  6180. SourceMD, DestMD: Pointer;
  6181. FormatDesc: TFormatDescriptor;
  6182. Converter: TFormatDescriptor;
  6183. begin
  6184. if not (ftTGA in FormatGetSupportedFiles(Format)) then
  6185. raise EglBitmapUnsupportedFormat.Create(Format);
  6186. //prepare header
  6187. FillChar(Header{%H-}, SizeOf(Header), 0);
  6188. //set ImageType
  6189. if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
  6190. tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
  6191. Header.ImageType := TGA_UNCOMPRESSED_GRAY
  6192. else
  6193. Header.ImageType := TGA_UNCOMPRESSED_RGB;
  6194. //set BitsPerPixel
  6195. if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
  6196. Header.Bpp := 8
  6197. else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
  6198. tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
  6199. Header.Bpp := 16
  6200. else if (Format in [tfBGR8, tfRGB8]) then
  6201. Header.Bpp := 24
  6202. else
  6203. Header.Bpp := 32;
  6204. //set AlphaBitCount
  6205. case Format of
  6206. tfRGB5A1, tfBGR5A1:
  6207. Header.ImageDesc := 1 and $F;
  6208. tfRGB10A2, tfBGR10A2:
  6209. Header.ImageDesc := 2 and $F;
  6210. tfRGBA4, tfBGRA4:
  6211. Header.ImageDesc := 4 and $F;
  6212. tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
  6213. Header.ImageDesc := 8 and $F;
  6214. end;
  6215. Header.Width := Width;
  6216. Header.Height := Height;
  6217. Header.ImageDesc := Header.ImageDesc or $20; //flip y
  6218. aStream.Write(Header, SizeOf(Header));
  6219. // convert RGB(A) to BGR(A)
  6220. Converter := nil;
  6221. FormatDesc := TFormatDescriptor.Get(Format);
  6222. Size := FormatDesc.GetSize(Dimension);
  6223. if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
  6224. if (FormatDesc.RGBInverted = tfEmpty) then
  6225. raise EglBitmapException.Create('inverted RGB format is empty');
  6226. Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
  6227. if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
  6228. (Converter.PixelSize <> FormatDesc.PixelSize) then
  6229. raise EglBitmapException.Create('invalid inverted RGB format');
  6230. end;
  6231. if Assigned(Converter) then begin
  6232. LineSize := FormatDesc.GetSize(Width, 1);
  6233. LineBuf := GetMem(LineSize);
  6234. SourceMD := FormatDesc.CreateMappingData;
  6235. DestMD := Converter.CreateMappingData;
  6236. try
  6237. SourceData := Data;
  6238. for y := 0 to Height-1 do begin
  6239. DestData := LineBuf;
  6240. for x := 0 to Width-1 do begin
  6241. FormatDesc.Unmap(SourceData, Pixel, SourceMD);
  6242. Converter.Map(Pixel, DestData, DestMD);
  6243. end;
  6244. aStream.Write(LineBuf^, LineSize);
  6245. end;
  6246. finally
  6247. FreeMem(LineBuf);
  6248. FormatDesc.FreeMappingData(SourceMD);
  6249. FormatDesc.FreeMappingData(DestMD);
  6250. end;
  6251. end else
  6252. aStream.Write(Data^, Size);
  6253. end;
  6254. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6255. //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6256. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6257. const
  6258. DDS_MAGIC: Cardinal = $20534444;
  6259. // DDS_header.dwFlags
  6260. DDSD_CAPS = $00000001;
  6261. DDSD_HEIGHT = $00000002;
  6262. DDSD_WIDTH = $00000004;
  6263. DDSD_PIXELFORMAT = $00001000;
  6264. // DDS_header.sPixelFormat.dwFlags
  6265. DDPF_ALPHAPIXELS = $00000001;
  6266. DDPF_ALPHA = $00000002;
  6267. DDPF_FOURCC = $00000004;
  6268. DDPF_RGB = $00000040;
  6269. DDPF_LUMINANCE = $00020000;
  6270. // DDS_header.sCaps.dwCaps1
  6271. DDSCAPS_TEXTURE = $00001000;
  6272. // DDS_header.sCaps.dwCaps2
  6273. DDSCAPS2_CUBEMAP = $00000200;
  6274. D3DFMT_DXT1 = $31545844;
  6275. D3DFMT_DXT3 = $33545844;
  6276. D3DFMT_DXT5 = $35545844;
  6277. type
  6278. TDDSPixelFormat = packed record
  6279. dwSize: Cardinal;
  6280. dwFlags: Cardinal;
  6281. dwFourCC: Cardinal;
  6282. dwRGBBitCount: Cardinal;
  6283. dwRBitMask: Cardinal;
  6284. dwGBitMask: Cardinal;
  6285. dwBBitMask: Cardinal;
  6286. dwABitMask: Cardinal;
  6287. end;
  6288. TDDSCaps = packed record
  6289. dwCaps1: Cardinal;
  6290. dwCaps2: Cardinal;
  6291. dwDDSX: Cardinal;
  6292. dwReserved: Cardinal;
  6293. end;
  6294. TDDSHeader = packed record
  6295. dwSize: Cardinal;
  6296. dwFlags: Cardinal;
  6297. dwHeight: Cardinal;
  6298. dwWidth: Cardinal;
  6299. dwPitchOrLinearSize: Cardinal;
  6300. dwDepth: Cardinal;
  6301. dwMipMapCount: Cardinal;
  6302. dwReserved: array[0..10] of Cardinal;
  6303. PixelFormat: TDDSPixelFormat;
  6304. Caps: TDDSCaps;
  6305. dwReserved2: Cardinal;
  6306. end;
  6307. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6308. function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
  6309. var
  6310. Header: TDDSHeader;
  6311. Converter: TbmpBitfieldFormat;
  6312. function GetDDSFormat: TglBitmapFormat;
  6313. var
  6314. fd: TFormatDescriptor;
  6315. i: Integer;
  6316. Range: TglBitmapColorRec;
  6317. match: Boolean;
  6318. begin
  6319. result := tfEmpty;
  6320. with Header.PixelFormat do begin
  6321. // Compresses
  6322. if ((dwFlags and DDPF_FOURCC) > 0) then begin
  6323. case Header.PixelFormat.dwFourCC of
  6324. D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
  6325. D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
  6326. D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
  6327. end;
  6328. end else if ((Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin
  6329. //find matching format
  6330. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  6331. fd := TFormatDescriptor.Get(result);
  6332. if fd.MaskMatch(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask) and
  6333. (8 * fd.PixelSize = dwRGBBitCount) then
  6334. exit;
  6335. end;
  6336. //find format with same Range
  6337. Range.r := dwRBitMask;
  6338. Range.g := dwGBitMask;
  6339. Range.b := dwBBitMask;
  6340. Range.a := dwABitMask;
  6341. for i := 0 to 3 do begin
  6342. while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do
  6343. Range.arr[i] := Range.arr[i] shr 1;
  6344. end;
  6345. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  6346. fd := TFormatDescriptor.Get(result);
  6347. match := true;
  6348. for i := 0 to 3 do
  6349. if (fd.Range.arr[i] <> Range.arr[i]) then begin
  6350. match := false;
  6351. break;
  6352. end;
  6353. if match then
  6354. break;
  6355. end;
  6356. //no format with same range found -> use default
  6357. if (result = tfEmpty) then begin
  6358. if (dwABitMask > 0) then
  6359. result := tfBGRA8
  6360. else
  6361. result := tfBGR8;
  6362. end;
  6363. Converter := TbmpBitfieldFormat.Create;
  6364. Converter.RedMask := dwRBitMask;
  6365. Converter.GreenMask := dwGBitMask;
  6366. Converter.BlueMask := dwBBitMask;
  6367. Converter.AlphaMask := dwABitMask;
  6368. Converter.PixelSize := dwRGBBitCount / 8;
  6369. end;
  6370. end;
  6371. end;
  6372. var
  6373. StreamPos: Int64;
  6374. x, y, LineSize, RowSize, Magic: Cardinal;
  6375. NewImage, TmpData, RowData, SrcData: System.PByte;
  6376. SourceMD, DestMD: Pointer;
  6377. Pixel: TglBitmapPixelData;
  6378. ddsFormat: TglBitmapFormat;
  6379. FormatDesc: TFormatDescriptor;
  6380. begin
  6381. result := false;
  6382. Converter := nil;
  6383. StreamPos := aStream.Position;
  6384. // Magic
  6385. aStream.Read(Magic{%H-}, sizeof(Magic));
  6386. if (Magic <> DDS_MAGIC) then begin
  6387. aStream.Position := StreamPos;
  6388. exit;
  6389. end;
  6390. //Header
  6391. aStream.Read(Header{%H-}, sizeof(Header));
  6392. if (Header.dwSize <> SizeOf(Header)) or
  6393. ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
  6394. (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
  6395. begin
  6396. aStream.Position := StreamPos;
  6397. exit;
  6398. end;
  6399. if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
  6400. raise EglBitmapException.Create('LoadDDS - CubeMaps are not supported');
  6401. ddsFormat := GetDDSFormat;
  6402. try
  6403. if (ddsFormat = tfEmpty) then
  6404. raise EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');
  6405. FormatDesc := TFormatDescriptor.Get(ddsFormat);
  6406. LineSize := Trunc(Header.dwWidth * FormatDesc.PixelSize);
  6407. GetMem(NewImage, Header.dwHeight * LineSize);
  6408. try
  6409. TmpData := NewImage;
  6410. //Converter needed
  6411. if Assigned(Converter) then begin
  6412. RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
  6413. GetMem(RowData, RowSize);
  6414. SourceMD := Converter.CreateMappingData;
  6415. DestMD := FormatDesc.CreateMappingData;
  6416. try
  6417. for y := 0 to Header.dwHeight-1 do begin
  6418. TmpData := NewImage + y * LineSize;
  6419. SrcData := RowData;
  6420. aStream.Read(SrcData^, RowSize);
  6421. for x := 0 to Header.dwWidth-1 do begin
  6422. Converter.Unmap(SrcData, Pixel, SourceMD);
  6423. glBitmapConvertPixel(Pixel, Converter, FormatDesc);
  6424. FormatDesc.Map(Pixel, TmpData, DestMD);
  6425. end;
  6426. end;
  6427. finally
  6428. Converter.FreeMappingData(SourceMD);
  6429. FormatDesc.FreeMappingData(DestMD);
  6430. FreeMem(RowData);
  6431. end;
  6432. end else
  6433. // Compressed
  6434. if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
  6435. RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
  6436. for Y := 0 to Header.dwHeight-1 do begin
  6437. aStream.Read(TmpData^, RowSize);
  6438. Inc(TmpData, LineSize);
  6439. end;
  6440. end else
  6441. // Uncompressed
  6442. if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
  6443. RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
  6444. for Y := 0 to Header.dwHeight-1 do begin
  6445. aStream.Read(TmpData^, RowSize);
  6446. Inc(TmpData, LineSize);
  6447. end;
  6448. end else
  6449. raise EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');
  6450. SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight);
  6451. result := true;
  6452. except
  6453. FreeMem(NewImage);
  6454. raise;
  6455. end;
  6456. finally
  6457. FreeAndNil(Converter);
  6458. end;
  6459. end;
  6460. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6461. procedure TglBitmap.SaveDDS(const aStream: TStream);
  6462. var
  6463. Header: TDDSHeader;
  6464. FormatDesc: TFormatDescriptor;
  6465. begin
  6466. if not (ftDDS in FormatGetSupportedFiles(Format)) then
  6467. raise EglBitmapUnsupportedFormat.Create(Format);
  6468. FormatDesc := TFormatDescriptor.Get(Format);
  6469. // Generell
  6470. FillChar(Header{%H-}, SizeOf(Header), 0);
  6471. Header.dwSize := SizeOf(Header);
  6472. Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
  6473. Header.dwWidth := Max(1, Width);
  6474. Header.dwHeight := Max(1, Height);
  6475. // Caps
  6476. Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
  6477. // Pixelformat
  6478. Header.PixelFormat.dwSize := sizeof(Header);
  6479. if (FormatDesc.IsCompressed) then begin
  6480. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
  6481. case Format of
  6482. tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
  6483. tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
  6484. tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
  6485. end;
  6486. end else if (Format in [tfAlpha8, tfAlpha16]) then begin
  6487. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHA;
  6488. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6489. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6490. end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
  6491. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
  6492. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6493. Header.PixelFormat.dwRBitMask := FormatDesc.RedMask;
  6494. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6495. end else begin
  6496. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
  6497. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6498. Header.PixelFormat.dwRBitMask := FormatDesc.RedMask;
  6499. Header.PixelFormat.dwGBitMask := FormatDesc.GreenMask;
  6500. Header.PixelFormat.dwBBitMask := FormatDesc.BlueMask;
  6501. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6502. end;
  6503. if (FormatDesc.HasAlpha) then
  6504. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
  6505. aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
  6506. aStream.Write(Header, SizeOf(Header));
  6507. aStream.Write(Data^, FormatDesc.GetSize(Dimension));
  6508. end;
  6509. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6510. //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6511. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6512. function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
  6513. begin
  6514. if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
  6515. result := fLines[aIndex]
  6516. else
  6517. result := nil;
  6518. end;
  6519. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6520. procedure TglBitmap2D.SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
  6521. const aWidth: Integer; const aHeight: Integer);
  6522. var
  6523. Idx, LineWidth: Integer;
  6524. begin
  6525. inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
  6526. if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
  6527. // Assigning Data
  6528. if Assigned(Data) then begin
  6529. SetLength(fLines, GetHeight);
  6530. LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
  6531. for Idx := 0 to GetHeight-1 do begin
  6532. fLines[Idx] := Data;
  6533. Inc(fLines[Idx], Idx * LineWidth);
  6534. end;
  6535. end
  6536. else SetLength(fLines, 0);
  6537. end else begin
  6538. SetLength(fLines, 0);
  6539. end;
  6540. end;
  6541. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6542. procedure TglBitmap2D.UploadData(const aTarget: Cardinal; const aBuildWithGlu: Boolean);
  6543. var
  6544. FormatDesc: TFormatDescriptor;
  6545. begin
  6546. glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
  6547. FormatDesc := TFormatDescriptor.Get(Format);
  6548. if FormatDesc.IsCompressed then begin
  6549. glCompressedTexImage2D(Target, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
  6550. end else if aBuildWithGlu then begin
  6551. gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
  6552. FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  6553. end else begin
  6554. glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
  6555. FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  6556. end;
  6557. // Freigeben
  6558. if (FreeDataAfterGenTexture) then
  6559. FreeData;
  6560. end;
  6561. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6562. procedure TglBitmap2D.AfterConstruction;
  6563. begin
  6564. inherited;
  6565. Target := GL_TEXTURE_2D;
  6566. end;
  6567. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6568. procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  6569. var
  6570. Temp: pByte;
  6571. Size, w, h: Integer;
  6572. FormatDesc: TFormatDescriptor;
  6573. begin
  6574. FormatDesc := TFormatDescriptor.Get(Format);
  6575. if FormatDesc.IsCompressed then
  6576. raise EglBitmapUnsupportedFormat.Create(Format);
  6577. w := aRight - aLeft;
  6578. h := aBottom - aTop;
  6579. Size := FormatDesc.GetSize(w, h);
  6580. GetMem(Temp, Size);
  6581. try
  6582. glPixelStorei(GL_PACK_ALIGNMENT, 1);
  6583. glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  6584. SetDataPointer(Temp, Format, w, h);
  6585. FlipVert;
  6586. except
  6587. FreeMem(Temp);
  6588. raise;
  6589. end;
  6590. end;
  6591. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6592. procedure TglBitmap2D.GetDataFromTexture;
  6593. var
  6594. Temp: PByte;
  6595. TempWidth, TempHeight: Integer;
  6596. TempIntFormat: Cardinal;
  6597. IntFormat, f: TglBitmapFormat;
  6598. FormatDesc: TFormatDescriptor;
  6599. begin
  6600. Bind;
  6601. // Request Data
  6602. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH, @TempWidth);
  6603. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT, @TempHeight);
  6604. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
  6605. IntFormat := tfEmpty;
  6606. for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
  6607. FormatDesc := TFormatDescriptor.Get(f);
  6608. if (FormatDesc.glInternalFormat = TempIntFormat) then begin
  6609. IntFormat := FormatDesc.Format;
  6610. break;
  6611. end;
  6612. end;
  6613. // Getting data from OpenGL
  6614. FormatDesc := TFormatDescriptor.Get(IntFormat);
  6615. GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
  6616. try
  6617. if FormatDesc.IsCompressed then
  6618. glGetCompressedTexImage(Target, 0, Temp)
  6619. else
  6620. glGetTexImage(Target, 0, FormatDesc.glInternalFormat, FormatDesc.glDataFormat, Temp);
  6621. SetDataPointer(Temp, IntFormat, TempWidth, TempHeight);
  6622. except
  6623. FreeMem(Temp);
  6624. raise;
  6625. end;
  6626. end;
  6627. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6628. procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
  6629. var
  6630. BuildWithGlu, PotTex, TexRec: Boolean;
  6631. TexSize: Integer;
  6632. begin
  6633. if Assigned(Data) then begin
  6634. // Check Texture Size
  6635. if (aTestTextureSize) then begin
  6636. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  6637. if ((Height > TexSize) or (Width > TexSize)) then
  6638. raise EglBitmapSizeToLargeException.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  6639. PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
  6640. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
  6641. if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  6642. raise EglBitmapNonPowerOfTwoException.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  6643. end;
  6644. CreateId;
  6645. SetupParameters(BuildWithGlu);
  6646. UploadData(Target, BuildWithGlu);
  6647. glAreTexturesResident(1, @fID, @fIsResident);
  6648. end;
  6649. end;
  6650. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6651. function TglBitmap2D.FlipHorz: Boolean;
  6652. var
  6653. Col, Row: Integer;
  6654. TempDestData, DestData, SourceData: PByte;
  6655. ImgSize: Integer;
  6656. begin
  6657. result := inherited FlipHorz;
  6658. if Assigned(Data) then begin
  6659. SourceData := Data;
  6660. ImgSize := Height * fRowSize;
  6661. GetMem(DestData, ImgSize);
  6662. try
  6663. TempDestData := DestData;
  6664. Dec(TempDestData, fRowSize + fPixelSize);
  6665. for Row := 0 to Height -1 do begin
  6666. Inc(TempDestData, fRowSize * 2);
  6667. for Col := 0 to Width -1 do begin
  6668. Move(SourceData^, TempDestData^, fPixelSize);
  6669. Inc(SourceData, fPixelSize);
  6670. Dec(TempDestData, fPixelSize);
  6671. end;
  6672. end;
  6673. SetDataPointer(DestData, Format);
  6674. result := true;
  6675. except
  6676. FreeMem(DestData);
  6677. raise;
  6678. end;
  6679. end;
  6680. end;
  6681. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6682. function TglBitmap2D.FlipVert: Boolean;
  6683. var
  6684. Row: Integer;
  6685. TempDestData, DestData, SourceData: PByte;
  6686. begin
  6687. result := inherited FlipVert;
  6688. if Assigned(Data) then begin
  6689. SourceData := Data;
  6690. GetMem(DestData, Height * fRowSize);
  6691. try
  6692. TempDestData := DestData;
  6693. Inc(TempDestData, Width * (Height -1) * fPixelSize);
  6694. for Row := 0 to Height -1 do begin
  6695. Move(SourceData^, TempDestData^, fRowSize);
  6696. Dec(TempDestData, fRowSize);
  6697. Inc(SourceData, fRowSize);
  6698. end;
  6699. SetDataPointer(DestData, Format);
  6700. result := true;
  6701. except
  6702. FreeMem(DestData);
  6703. raise;
  6704. end;
  6705. end;
  6706. end;
  6707. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6708. //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6709. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6710. type
  6711. TMatrixItem = record
  6712. X, Y: Integer;
  6713. W: Single;
  6714. end;
  6715. PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
  6716. TglBitmapToNormalMapRec = Record
  6717. Scale: Single;
  6718. Heights: array of Single;
  6719. MatrixU : array of TMatrixItem;
  6720. MatrixV : array of TMatrixItem;
  6721. end;
  6722. const
  6723. ONE_OVER_255 = 1 / 255;
  6724. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6725. procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
  6726. var
  6727. Val: Single;
  6728. begin
  6729. with FuncRec do begin
  6730. Val :=
  6731. Source.Data.r * LUMINANCE_WEIGHT_R +
  6732. Source.Data.g * LUMINANCE_WEIGHT_G +
  6733. Source.Data.b * LUMINANCE_WEIGHT_B;
  6734. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
  6735. end;
  6736. end;
  6737. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6738. procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  6739. begin
  6740. with FuncRec do
  6741. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
  6742. end;
  6743. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6744. procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
  6745. type
  6746. TVec = Array[0..2] of Single;
  6747. var
  6748. Idx: Integer;
  6749. du, dv: Double;
  6750. Len: Single;
  6751. Vec: TVec;
  6752. function GetHeight(X, Y: Integer): Single;
  6753. begin
  6754. with FuncRec do begin
  6755. X := Max(0, Min(Size.X -1, X));
  6756. Y := Max(0, Min(Size.Y -1, Y));
  6757. result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
  6758. end;
  6759. end;
  6760. begin
  6761. with FuncRec do begin
  6762. with PglBitmapToNormalMapRec(Args)^ do begin
  6763. du := 0;
  6764. for Idx := Low(MatrixU) to High(MatrixU) do
  6765. du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
  6766. dv := 0;
  6767. for Idx := Low(MatrixU) to High(MatrixU) do
  6768. dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
  6769. Vec[0] := -du * Scale;
  6770. Vec[1] := -dv * Scale;
  6771. Vec[2] := 1;
  6772. end;
  6773. // Normalize
  6774. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  6775. if Len <> 0 then begin
  6776. Vec[0] := Vec[0] * Len;
  6777. Vec[1] := Vec[1] * Len;
  6778. Vec[2] := Vec[2] * Len;
  6779. end;
  6780. // Farbe zuweisem
  6781. Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
  6782. Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
  6783. Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
  6784. end;
  6785. end;
  6786. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6787. procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
  6788. var
  6789. Rec: TglBitmapToNormalMapRec;
  6790. procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
  6791. begin
  6792. if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
  6793. Matrix[Index].X := X;
  6794. Matrix[Index].Y := Y;
  6795. Matrix[Index].W := W;
  6796. end;
  6797. end;
  6798. begin
  6799. if TFormatDescriptor.Get(Format).IsCompressed then
  6800. raise EglBitmapUnsupportedFormat.Create(Format);
  6801. if aScale > 100 then
  6802. Rec.Scale := 100
  6803. else if aScale < -100 then
  6804. Rec.Scale := -100
  6805. else
  6806. Rec.Scale := aScale;
  6807. SetLength(Rec.Heights, Width * Height);
  6808. try
  6809. case aFunc of
  6810. nm4Samples: begin
  6811. SetLength(Rec.MatrixU, 2);
  6812. SetEntry(Rec.MatrixU, 0, -1, 0, -0.5);
  6813. SetEntry(Rec.MatrixU, 1, 1, 0, 0.5);
  6814. SetLength(Rec.MatrixV, 2);
  6815. SetEntry(Rec.MatrixV, 0, 0, 1, 0.5);
  6816. SetEntry(Rec.MatrixV, 1, 0, -1, -0.5);
  6817. end;
  6818. nmSobel: begin
  6819. SetLength(Rec.MatrixU, 6);
  6820. SetEntry(Rec.MatrixU, 0, -1, 1, -1.0);
  6821. SetEntry(Rec.MatrixU, 1, -1, 0, -2.0);
  6822. SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
  6823. SetEntry(Rec.MatrixU, 3, 1, 1, 1.0);
  6824. SetEntry(Rec.MatrixU, 4, 1, 0, 2.0);
  6825. SetEntry(Rec.MatrixU, 5, 1, -1, 1.0);
  6826. SetLength(Rec.MatrixV, 6);
  6827. SetEntry(Rec.MatrixV, 0, -1, 1, 1.0);
  6828. SetEntry(Rec.MatrixV, 1, 0, 1, 2.0);
  6829. SetEntry(Rec.MatrixV, 2, 1, 1, 1.0);
  6830. SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
  6831. SetEntry(Rec.MatrixV, 4, 0, -1, -2.0);
  6832. SetEntry(Rec.MatrixV, 5, 1, -1, -1.0);
  6833. end;
  6834. nm3x3: begin
  6835. SetLength(Rec.MatrixU, 6);
  6836. SetEntry(Rec.MatrixU, 0, -1, 1, -1/6);
  6837. SetEntry(Rec.MatrixU, 1, -1, 0, -1/6);
  6838. SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
  6839. SetEntry(Rec.MatrixU, 3, 1, 1, 1/6);
  6840. SetEntry(Rec.MatrixU, 4, 1, 0, 1/6);
  6841. SetEntry(Rec.MatrixU, 5, 1, -1, 1/6);
  6842. SetLength(Rec.MatrixV, 6);
  6843. SetEntry(Rec.MatrixV, 0, -1, 1, 1/6);
  6844. SetEntry(Rec.MatrixV, 1, 0, 1, 1/6);
  6845. SetEntry(Rec.MatrixV, 2, 1, 1, 1/6);
  6846. SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
  6847. SetEntry(Rec.MatrixV, 4, 0, -1, -1/6);
  6848. SetEntry(Rec.MatrixV, 5, 1, -1, -1/6);
  6849. end;
  6850. nm5x5: begin
  6851. SetLength(Rec.MatrixU, 20);
  6852. SetEntry(Rec.MatrixU, 0, -2, 2, -1 / 16);
  6853. SetEntry(Rec.MatrixU, 1, -1, 2, -1 / 10);
  6854. SetEntry(Rec.MatrixU, 2, 1, 2, 1 / 10);
  6855. SetEntry(Rec.MatrixU, 3, 2, 2, 1 / 16);
  6856. SetEntry(Rec.MatrixU, 4, -2, 1, -1 / 10);
  6857. SetEntry(Rec.MatrixU, 5, -1, 1, -1 / 8);
  6858. SetEntry(Rec.MatrixU, 6, 1, 1, 1 / 8);
  6859. SetEntry(Rec.MatrixU, 7, 2, 1, 1 / 10);
  6860. SetEntry(Rec.MatrixU, 8, -2, 0, -1 / 2.8);
  6861. SetEntry(Rec.MatrixU, 9, -1, 0, -0.5);
  6862. SetEntry(Rec.MatrixU, 10, 1, 0, 0.5);
  6863. SetEntry(Rec.MatrixU, 11, 2, 0, 1 / 2.8);
  6864. SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
  6865. SetEntry(Rec.MatrixU, 13, -1, -1, -1 / 8);
  6866. SetEntry(Rec.MatrixU, 14, 1, -1, 1 / 8);
  6867. SetEntry(Rec.MatrixU, 15, 2, -1, 1 / 10);
  6868. SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
  6869. SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
  6870. SetEntry(Rec.MatrixU, 18, 1, -2, 1 / 10);
  6871. SetEntry(Rec.MatrixU, 19, 2, -2, 1 / 16);
  6872. SetLength(Rec.MatrixV, 20);
  6873. SetEntry(Rec.MatrixV, 0, -2, 2, 1 / 16);
  6874. SetEntry(Rec.MatrixV, 1, -1, 2, 1 / 10);
  6875. SetEntry(Rec.MatrixV, 2, 0, 2, 0.25);
  6876. SetEntry(Rec.MatrixV, 3, 1, 2, 1 / 10);
  6877. SetEntry(Rec.MatrixV, 4, 2, 2, 1 / 16);
  6878. SetEntry(Rec.MatrixV, 5, -2, 1, 1 / 10);
  6879. SetEntry(Rec.MatrixV, 6, -1, 1, 1 / 8);
  6880. SetEntry(Rec.MatrixV, 7, 0, 1, 0.5);
  6881. SetEntry(Rec.MatrixV, 8, 1, 1, 1 / 8);
  6882. SetEntry(Rec.MatrixV, 9, 2, 1, 1 / 16);
  6883. SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
  6884. SetEntry(Rec.MatrixV, 11, -1, -1, -1 / 8);
  6885. SetEntry(Rec.MatrixV, 12, 0, -1, -0.5);
  6886. SetEntry(Rec.MatrixV, 13, 1, -1, -1 / 8);
  6887. SetEntry(Rec.MatrixV, 14, 2, -1, -1 / 10);
  6888. SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
  6889. SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
  6890. SetEntry(Rec.MatrixV, 17, 0, -2, -0.25);
  6891. SetEntry(Rec.MatrixV, 18, 1, -2, -1 / 10);
  6892. SetEntry(Rec.MatrixV, 19, 2, -2, -1 / 16);
  6893. end;
  6894. end;
  6895. // Daten Sammeln
  6896. if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
  6897. AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
  6898. else
  6899. AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
  6900. AddFunc(glBitmapToNormalMapFunc, false, @Rec);
  6901. finally
  6902. SetLength(Rec.Heights, 0);
  6903. end;
  6904. end;
  6905. (*
  6906. procedure TglBitmap1D.SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width, Height: Integer);
  6907. var
  6908. pTemp: pByte;
  6909. Size: Integer;
  6910. begin
  6911. if Height > 1 then begin
  6912. // extract first line of the data
  6913. Size := FormatGetImageSize(glBitmapPosition(Width), Format);
  6914. GetMem(pTemp, Size);
  6915. Move(Data^, pTemp^, Size);
  6916. FreeMem(Data);
  6917. end else
  6918. pTemp := Data;
  6919. // set data pointer
  6920. inherited SetDataPointer(pTemp, Format, Width);
  6921. if FormatIsUncompressed(Format) then begin
  6922. fUnmapFunc := FormatGetUnMapFunc(Format);
  6923. fGetPixelFunc := GetPixel1DUnmap;
  6924. end;
  6925. end;
  6926. procedure TglBitmap1D.GetPixel1DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
  6927. var
  6928. pTemp: pByte;
  6929. begin
  6930. pTemp := Data;
  6931. Inc(pTemp, Pos.X * fPixelSize);
  6932. fUnmapFunc(pTemp, Pixel);
  6933. end;
  6934. function TglBitmap1D.FlipHorz: Boolean;
  6935. var
  6936. Col: Integer;
  6937. pTempDest, pDest, pSource: pByte;
  6938. begin
  6939. result := inherited FlipHorz;
  6940. if Assigned(Data) and FormatIsUncompressed(InternalFormat) then begin
  6941. pSource := Data;
  6942. GetMem(pDest, fRowSize);
  6943. try
  6944. pTempDest := pDest;
  6945. Inc(pTempDest, fRowSize);
  6946. for Col := 0 to Width -1 do begin
  6947. Move(pSource^, pTempDest^, fPixelSize);
  6948. Inc(pSource, fPixelSize);
  6949. Dec(pTempDest, fPixelSize);
  6950. end;
  6951. SetDataPointer(pDest, InternalFormat);
  6952. result := true;
  6953. finally
  6954. FreeMem(pDest);
  6955. end;
  6956. end;
  6957. end;
  6958. procedure TglBitmap1D.UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
  6959. begin
  6960. // Upload data
  6961. if Self.InternalFormat in [ifDXT1, ifDXT3, ifDXT5] then
  6962. glCompressedTexImage1D(Target, 0, InternalFormat, Width, 0, Trunc(Width * FormatGetSize(Self.InternalFormat)), Data)
  6963. else
  6964. // Upload data
  6965. if BuildWithGlu then
  6966. gluBuild1DMipmaps(Target, InternalFormat, Width, Format, Typ, Data)
  6967. else
  6968. glTexImage1D(Target, 0, InternalFormat, Width, 0, Format, Typ, Data);
  6969. // Freigeben
  6970. if (FreeDataAfterGenTexture) then
  6971. FreeData;
  6972. end;
  6973. procedure TglBitmap1D.GenTexture(TestTextureSize: Boolean);
  6974. var
  6975. BuildWithGlu, TexRec: Boolean;
  6976. glFormat, glInternalFormat, glType: Cardinal;
  6977. TexSize: Integer;
  6978. begin
  6979. if Assigned(Data) then begin
  6980. // Check Texture Size
  6981. if (TestTextureSize) then begin
  6982. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  6983. if (Width > TexSize) then
  6984. raise EglBitmapSizeToLargeException.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  6985. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
  6986. (Target = GL_TEXTURE_RECTANGLE_ARB);
  6987. if not (IsPowerOfTwo (Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  6988. raise EglBitmapNonPowerOfTwoException.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  6989. end;
  6990. CreateId;
  6991. SetupParameters(BuildWithGlu);
  6992. SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
  6993. UploadData(Target, glFormat, glInternalFormat, glType, BuildWithGlu);
  6994. // Infos sammeln
  6995. glAreTexturesResident(1, @fID, @fIsResident);
  6996. end;
  6997. end;
  6998. procedure TglBitmap1D.AfterConstruction;
  6999. begin
  7000. inherited;
  7001. Target := GL_TEXTURE_1D;
  7002. end;
  7003. { TglBitmapCubeMap }
  7004. procedure TglBitmapCubeMap.AfterConstruction;
  7005. begin
  7006. inherited;
  7007. if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
  7008. raise EglBitmapException.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
  7009. SetWrap; // set all to GL_CLAMP_TO_EDGE
  7010. Target := GL_TEXTURE_CUBE_MAP;
  7011. fGenMode := GL_REFLECTION_MAP;
  7012. end;
  7013. procedure TglBitmapCubeMap.Bind(EnableTexCoordsGen, EnableTextureUnit: Boolean);
  7014. begin
  7015. inherited Bind (EnableTextureUnit);
  7016. if EnableTexCoordsGen then begin
  7017. glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
  7018. glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
  7019. glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
  7020. glEnable(GL_TEXTURE_GEN_S);
  7021. glEnable(GL_TEXTURE_GEN_T);
  7022. glEnable(GL_TEXTURE_GEN_R);
  7023. end;
  7024. end;
  7025. procedure TglBitmapCubeMap.GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean);
  7026. var
  7027. glFormat, glInternalFormat, glType: Cardinal;
  7028. BuildWithGlu: Boolean;
  7029. TexSize: Integer;
  7030. begin
  7031. // Check Texture Size
  7032. if (TestTextureSize) then begin
  7033. glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
  7034. if ((Height > TexSize) or (Width > TexSize)) then
  7035. raise EglBitmapSizeToLargeException.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
  7036. if not ((IsPowerOfTwo (Height) and IsPowerOfTwo (Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
  7037. raise EglBitmapNonPowerOfTwoException.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
  7038. end;
  7039. // create Texture
  7040. if ID = 0 then begin
  7041. CreateID;
  7042. SetupParameters(BuildWithGlu);
  7043. end;
  7044. SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
  7045. UploadData (CubeTarget, glFormat, glInternalFormat, glType, BuildWithGlu);
  7046. end;
  7047. procedure TglBitmapCubeMap.GenTexture(TestTextureSize: Boolean);
  7048. begin
  7049. Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
  7050. end;
  7051. procedure TglBitmapCubeMap.Unbind(DisableTexCoordsGen,
  7052. DisableTextureUnit: Boolean);
  7053. begin
  7054. inherited Unbind (DisableTextureUnit);
  7055. if DisableTexCoordsGen then begin
  7056. glDisable(GL_TEXTURE_GEN_S);
  7057. glDisable(GL_TEXTURE_GEN_T);
  7058. glDisable(GL_TEXTURE_GEN_R);
  7059. end;
  7060. end;
  7061. { TglBitmapNormalMap }
  7062. type
  7063. TVec = Array[0..2] of Single;
  7064. TglBitmapNormalMapGetVectorFunc = procedure (var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  7065. PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
  7066. TglBitmapNormalMapRec = record
  7067. HalfSize : Integer;
  7068. Func: TglBitmapNormalMapGetVectorFunc;
  7069. end;
  7070. procedure glBitmapNormalMapPosX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  7071. begin
  7072. Vec[0] := HalfSize;
  7073. Vec[1] := - (Position.Y + 0.5 - HalfSize);
  7074. Vec[2] := - (Position.X + 0.5 - HalfSize);
  7075. end;
  7076. procedure glBitmapNormalMapNegX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  7077. begin
  7078. Vec[0] := - HalfSize;
  7079. Vec[1] := - (Position.Y + 0.5 - HalfSize);
  7080. Vec[2] := Position.X + 0.5 - HalfSize;
  7081. end;
  7082. procedure glBitmapNormalMapPosY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  7083. begin
  7084. Vec[0] := Position.X + 0.5 - HalfSize;
  7085. Vec[1] := HalfSize;
  7086. Vec[2] := Position.Y + 0.5 - HalfSize;
  7087. end;
  7088. procedure glBitmapNormalMapNegY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  7089. begin
  7090. Vec[0] := Position.X + 0.5 - HalfSize;
  7091. Vec[1] := - HalfSize;
  7092. Vec[2] := - (Position.Y + 0.5 - HalfSize);
  7093. end;
  7094. procedure glBitmapNormalMapPosZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  7095. begin
  7096. Vec[0] := Position.X + 0.5 - HalfSize;
  7097. Vec[1] := - (Position.Y + 0.5 - HalfSize);
  7098. Vec[2] := HalfSize;
  7099. end;
  7100. procedure glBitmapNormalMapNegZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  7101. begin
  7102. Vec[0] := - (Position.X + 0.5 - HalfSize);
  7103. Vec[1] := - (Position.Y + 0.5 - HalfSize);
  7104. Vec[2] := - HalfSize;
  7105. end;
  7106. procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
  7107. var
  7108. Vec : TVec;
  7109. Len: Single;
  7110. begin
  7111. with FuncRec do begin
  7112. with PglBitmapNormalMapRec (CustomData)^ do begin
  7113. Func(Vec, Position, HalfSize);
  7114. // Normalize
  7115. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  7116. if Len <> 0 then begin
  7117. Vec[0] := Vec[0] * Len;
  7118. Vec[1] := Vec[1] * Len;
  7119. Vec[2] := Vec[2] * Len;
  7120. end;
  7121. // Scale Vector and AddVectro
  7122. Vec[0] := Vec[0] * 0.5 + 0.5;
  7123. Vec[1] := Vec[1] * 0.5 + 0.5;
  7124. Vec[2] := Vec[2] * 0.5 + 0.5;
  7125. end;
  7126. // Set Color
  7127. Dest.Red := Round(Vec[0] * 255);
  7128. Dest.Green := Round(Vec[1] * 255);
  7129. Dest.Blue := Round(Vec[2] * 255);
  7130. end;
  7131. end;
  7132. procedure TglBitmapNormalMap.AfterConstruction;
  7133. begin
  7134. inherited;
  7135. fGenMode := GL_NORMAL_MAP;
  7136. end;
  7137. procedure TglBitmapNormalMap.GenerateNormalMap(Size: Integer;
  7138. TestTextureSize: Boolean);
  7139. var
  7140. Rec: TglBitmapNormalMapRec;
  7141. SizeRec: TglBitmapPixelPosition;
  7142. begin
  7143. Rec.HalfSize := Size div 2;
  7144. FreeDataAfterGenTexture := false;
  7145. SizeRec.Fields := [ffX, ffY];
  7146. SizeRec.X := Size;
  7147. SizeRec.Y := Size;
  7148. // Positive X
  7149. Rec.Func := glBitmapNormalMapPosX;
  7150. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  7151. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, TestTextureSize);
  7152. // Negative X
  7153. Rec.Func := glBitmapNormalMapNegX;
  7154. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  7155. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, TestTextureSize);
  7156. // Positive Y
  7157. Rec.Func := glBitmapNormalMapPosY;
  7158. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  7159. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, TestTextureSize);
  7160. // Negative Y
  7161. Rec.Func := glBitmapNormalMapNegY;
  7162. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  7163. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, TestTextureSize);
  7164. // Positive Z
  7165. Rec.Func := glBitmapNormalMapPosZ;
  7166. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  7167. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, TestTextureSize);
  7168. // Negative Z
  7169. Rec.Func := glBitmapNormalMapNegZ;
  7170. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  7171. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, TestTextureSize);
  7172. end;
  7173. *)
  7174. initialization
  7175. glBitmapSetDefaultFormat(tfEmpty);
  7176. glBitmapSetDefaultMipmap(mmMipmap);
  7177. glBitmapSetDefaultFilter(GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
  7178. glBitmapSetDefaultWrap (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
  7179. glBitmapSetDefaultFreeDataAfterGenTexture(true);
  7180. glBitmapSetDefaultDeleteTextureOnFree (true);
  7181. TFormatDescriptor.Init;
  7182. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  7183. OpenGLInitialized := false;
  7184. InitOpenGLCS := TCriticalSection.Create;
  7185. {$ENDIF}
  7186. finalization
  7187. TFormatDescriptor.Finalize;
  7188. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  7189. FreeAndNil(InitOpenGLCS);
  7190. {$ENDIF}
  7191. end.