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

8262 regels
276 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. {.$MESSAGE warn 'Hey. I''m the glBitmap.pas and i need to be configured. My master tell me your preferences! ;)'}
  218. // Please uncomment the defines below to configure the glBitmap to your preferences.
  219. // If you have configured the unit you can uncomment the warning above.
  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. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  234. // activate to enable the support of SDL_image to load files. (READ ONLY)
  235. // If you enable SDL_image all other libraries will be ignored!
  236. {.$DEFINE GLB_SDL_IMAGE}
  237. // PNG /////////////////////////////////////////////////////////////////////////////////////////////
  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. // JPEG ////////////////////////////////////////////////////////////////////////////////////////////
  245. // if you enable delphi jpegs the libJPEG will be ignored
  246. {.$DEFINE GLB_DELPHI_JPEG}
  247. // activate to use the libJPEG -> http://www.ijg.org/
  248. // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libjpeg
  249. {$DEFINE GLB_LIB_JPEG}
  250. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  251. // PRIVATE: do not change anything! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  252. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  253. // Delphi Versions
  254. {$IFDEF fpc}
  255. {$MODE Delphi}
  256. {$IFDEF CPUI386}
  257. {$DEFINE CPU386}
  258. {$ASMMODE INTEL}
  259. {$ENDIF}
  260. {$IFNDEF WINDOWS}
  261. {$linklib c}
  262. {$ENDIF}
  263. {$ENDIF}
  264. // Operation System
  265. {$IF DEFINED(WIN32) or DEFINED(WIN64)}
  266. {$DEFINE GLB_WIN}
  267. {$ELSEIF DEFINED(LINUX)}
  268. {$DEFINE GLB_LINUX}
  269. {$IFEND}
  270. // native OpenGL Support
  271. {$IF DEFINED(GLB_NATIVE_OGL_STATIC) OR DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
  272. {$DEFINE GLB_NATIVE_OGL}
  273. {$IFEND}
  274. // checking define combinations
  275. //SDL Image
  276. {$IFDEF GLB_SDL_IMAGE}
  277. {$IFNDEF GLB_SDL}
  278. {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
  279. {$DEFINE GLB_SDL}
  280. {$ENDIF}
  281. {$IFDEF GLB_PNGIMAGE}
  282. {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
  283. {$undef GLB_PNGIMAGE}
  284. {$ENDIF}
  285. {$IFDEF GLB_DELPHI_JPEG}
  286. {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
  287. {$undef GLB_DELPHI_JPEG}
  288. {$ENDIF}
  289. {$IFDEF GLB_LIB_PNG}
  290. {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
  291. {$undef GLB_LIB_PNG}
  292. {$ENDIF}
  293. {$IFDEF GLB_LIB_JPEG}
  294. {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
  295. {$undef GLB_LIB_JPEG}
  296. {$ENDIF}
  297. {$DEFINE GLB_SUPPORT_PNG_READ}
  298. {$DEFINE GLB_SUPPORT_JPEG_READ}
  299. {$ENDIF}
  300. // PNG Image
  301. {$IFDEF GLB_PNGIMAGE}
  302. {$IFDEF GLB_LIB_PNG}
  303. {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
  304. {$undef GLB_LIB_PNG}
  305. {$ENDIF}
  306. {$DEFINE GLB_SUPPORT_PNG_READ}
  307. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  308. {$ENDIF}
  309. // libPNG
  310. {$IFDEF GLB_LIB_PNG}
  311. {$DEFINE GLB_SUPPORT_PNG_READ}
  312. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  313. {$ENDIF}
  314. // JPEG Image
  315. {$IFDEF GLB_DELPHI_JPEG}
  316. {$IFDEF GLB_LIB_JPEG}
  317. {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
  318. {$undef GLB_LIB_JPEG}
  319. {$ENDIF}
  320. {$DEFINE GLB_SUPPORT_JPEG_READ}
  321. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  322. {$ENDIF}
  323. // libJPEG
  324. {$IFDEF GLB_LIB_JPEG}
  325. {$DEFINE GLB_SUPPORT_JPEG_READ}
  326. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  327. {$ENDIF}
  328. // native OpenGL
  329. {$IF DEFINED(GLB_NATIVE_OGL_STATIC) AND DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
  330. {$MESSAGE warn 'GLB_NATIVE_OGL_STATIC will be ignored because you enabled GLB_NATIVE_OGL_DYNAMIC'}
  331. {$ENDIF}
  332. // general options
  333. {$EXTENDEDSYNTAX ON}
  334. {$LONGSTRINGS ON}
  335. {$ALIGN ON}
  336. {$IFNDEF FPC}
  337. {$OPTIMIZATION ON}
  338. {$ENDIF}
  339. interface
  340. uses
  341. {$IFNDEF GLB_NATIVE_OGL} dglOpenGL, {$ENDIF}
  342. {$IF DEFINED(GLB_WIN) AND
  343. DEFINED(GLB_NATIVE_OGL)} windows, {$IFEND}
  344. {$IFDEF GLB_SDL} SDL, {$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. {$ELSE}
  510. TwglGetProcAddress = function (ProcName: PAnsiChar): Pointer; stdcall;
  511. {$ENDIF}
  512. {$ELSEIF DEFINED(GLB_NATIVE_OGL_STATIC)}
  513. procedure glEnable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  514. procedure glDisable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  515. function glGetString(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  516. procedure glGetIntegerv(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  517. procedure glTexParameteri(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  518. procedure glTexParameterfv(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  519. procedure glGetTexParameteriv(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  520. procedure glGetTexParameterfv(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  521. procedure glGetTexLevelParameteriv(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  522. procedure glGetTexLevelParameterfv(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  523. procedure glGenTextures(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  524. procedure glBindTexture(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  525. procedure glDeleteTextures(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  526. function glAreTexturesResident(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  527. 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;
  528. procedure glPixelStorei(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  529. 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;
  530. 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;
  531. procedure glGetTexImage(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  532. function gluBuild1DMipmaps(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
  533. function gluBuild2DMipmaps(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
  534. {$ENDIF}
  535. var
  536. GL_VERSION_1_2,
  537. GL_VERSION_1_3,
  538. GL_VERSION_1_4,
  539. GL_VERSION_2_0,
  540. GL_SGIS_generate_mipmap,
  541. GL_ARB_texture_border_clamp,
  542. GL_ARB_texture_mirrored_repeat,
  543. GL_ARB_texture_rectangle,
  544. GL_ARB_texture_non_power_of_two,
  545. GL_IBM_texture_mirrored_repeat,
  546. GL_NV_texture_rectangle,
  547. GL_EXT_texture_edge_clamp,
  548. GL_EXT_texture_rectangle,
  549. GL_EXT_texture_filter_anisotropic: Boolean;
  550. glCompressedTexImage1D: TglCompressedTexImage1D;
  551. glCompressedTexImage2D: TglCompressedTexImage2D;
  552. glGetCompressedTexImage: TglGetCompressedTexImage;
  553. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  554. glEnable: TglEnable;
  555. glDisable: TglDisable;
  556. glGetString: TglGetString;
  557. glGetIntegerv: TglGetIntegerv;
  558. glTexParameteri: TglTexParameteri;
  559. glTexParameterfv: TglTexParameterfv;
  560. glGetTexParameteriv: TglGetTexParameteriv;
  561. glGetTexParameterfv: TglGetTexParameterfv;
  562. glGetTexLevelParameteriv: TglGetTexLevelParameteriv;
  563. glGetTexLevelParameterfv: TglGetTexLevelParameterfv;
  564. glGenTextures: TglGenTextures;
  565. glBindTexture: TglBindTexture;
  566. glDeleteTextures: TglDeleteTextures;
  567. glAreTexturesResident: TglAreTexturesResident;
  568. glReadPixels: TglReadPixels;
  569. glPixelStorei: TglPixelStorei;
  570. glTexImage1D: TglTexImage1D;
  571. glTexImage2D: TglTexImage2D;
  572. glGetTexImage: TglGetTexImage;
  573. gluBuild1DMipmaps: TgluBuild1DMipmaps;
  574. gluBuild2DMipmaps: TgluBuild2DMipmaps;
  575. {$IF DEFINED(GLB_WIN)}
  576. wglGetProcAddress: TwglGetProcAddress;
  577. {$ELSEIF DEFINED(GLB_LINUX)}
  578. glXGetProcAddress: TglXGetProcAddress;
  579. glXGetProcAddressARB: TglXGetProcAddressARB;
  580. {$ENDIF}
  581. {$ENDIF}
  582. (*
  583. {$IFDEF GLB_DELPHI}
  584. var
  585. gLastContext: HGLRC;
  586. {$ENDIF}
  587. *)
  588. {$ENDIF}
  589. type
  590. ////////////////////////////////////////////////////////////////////////////////////////////////////
  591. TglBitmapFormat = (
  592. tfEmpty = 0, //must be smallest value!
  593. tfAlpha4,
  594. tfAlpha8,
  595. tfAlpha12,
  596. tfAlpha16,
  597. tfLuminance4,
  598. tfLuminance8,
  599. tfLuminance12,
  600. tfLuminance16,
  601. tfLuminance4Alpha4,
  602. tfLuminance6Alpha2,
  603. tfLuminance8Alpha8,
  604. tfLuminance12Alpha4,
  605. tfLuminance12Alpha12,
  606. tfLuminance16Alpha16,
  607. tfR3G3B2,
  608. tfRGB4,
  609. tfR5G6B5,
  610. tfRGB5,
  611. tfRGB8,
  612. tfRGB10,
  613. tfRGB12,
  614. tfRGB16,
  615. tfRGBA2,
  616. tfRGBA4,
  617. tfRGB5A1,
  618. tfRGBA8,
  619. tfRGB10A2,
  620. tfRGBA12,
  621. tfRGBA16,
  622. tfBGR4,
  623. tfB5G6R5,
  624. tfBGR5,
  625. tfBGR8,
  626. tfBGR10,
  627. tfBGR12,
  628. tfBGR16,
  629. tfBGRA2,
  630. tfBGRA4,
  631. tfBGR5A1,
  632. tfBGRA8,
  633. tfBGR10A2,
  634. tfBGRA12,
  635. tfBGRA16,
  636. tfDepth16,
  637. tfDepth24,
  638. tfDepth32,
  639. tfS3tcDtx1RGBA,
  640. tfS3tcDtx3RGBA,
  641. tfS3tcDtx5RGBA
  642. );
  643. TglBitmapFileType = (
  644. {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG, {$ENDIF}
  645. {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
  646. ftDDS,
  647. ftTGA,
  648. ftBMP);
  649. TglBitmapFileTypes = set of TglBitmapFileType;
  650. TglBitmapMipMap = (
  651. mmNone,
  652. mmMipmap,
  653. mmMipmapGlu);
  654. TglBitmapNormalMapFunc = (
  655. nm4Samples,
  656. nmSobel,
  657. nm3x3,
  658. nm5x5);
  659. ////////////////////////////////////////////////////////////////////////////////////////////////////
  660. EglBitmapException = class(Exception);
  661. EglBitmapSizeToLargeException = class(EglBitmapException);
  662. EglBitmapNonPowerOfTwoException = class(EglBitmapException);
  663. EglBitmapUnsupportedFormat = class(EglBitmapException)
  664. constructor Create(const aFormat: TglBitmapFormat);
  665. end;
  666. ////////////////////////////////////////////////////////////////////////////////////////////////////
  667. TglBitmapColorRec = packed record
  668. case Integer of
  669. 0: (r, g, b, a: Cardinal);
  670. 1: (arr: array[0..3] of Cardinal);
  671. end;
  672. TglBitmapPixelData = packed record
  673. Data, Range: TglBitmapColorRec;
  674. Format: TglBitmapFormat;
  675. end;
  676. PglBitmapPixelData = ^TglBitmapPixelData;
  677. ////////////////////////////////////////////////////////////////////////////////////////////////////
  678. TglBitmapPixelPositionFields = set of (ffX, ffY);
  679. TglBitmapPixelPosition = record
  680. Fields : TglBitmapPixelPositionFields;
  681. X : Word;
  682. Y : Word;
  683. end;
  684. ////////////////////////////////////////////////////////////////////////////////////////////////////
  685. TglBitmap = class;
  686. TglBitmapFunctionRec = record
  687. Sender: TglBitmap;
  688. Size: TglBitmapPixelPosition;
  689. Position: TglBitmapPixelPosition;
  690. Source: TglBitmapPixelData;
  691. Dest: TglBitmapPixelData;
  692. Args: Pointer;
  693. end;
  694. TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
  695. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  696. TglBitmap = class
  697. protected
  698. fID: GLuint;
  699. fTarget: GLuint;
  700. fAnisotropic: Integer;
  701. fDeleteTextureOnFree: Boolean;
  702. fFreeDataAfterGenTexture: Boolean;
  703. fData: PByte;
  704. fIsResident: Boolean;
  705. fBorderColor: array[0..3] of Single;
  706. fDimension: TglBitmapPixelPosition;
  707. fMipMap: TglBitmapMipMap;
  708. fFormat: TglBitmapFormat;
  709. // Mapping
  710. fPixelSize: Integer;
  711. fRowSize: Integer;
  712. // Filtering
  713. fFilterMin: Cardinal;
  714. fFilterMag: Cardinal;
  715. // TexturWarp
  716. fWrapS: Cardinal;
  717. fWrapT: Cardinal;
  718. fWrapR: Cardinal;
  719. // CustomData
  720. fFilename: String;
  721. fCustomName: String;
  722. fCustomNameW: WideString;
  723. fCustomData: Pointer;
  724. //Getter
  725. function GetWidth: Integer; virtual;
  726. function GetHeight: Integer; virtual;
  727. function GetFileWidth: Integer; virtual;
  728. function GetFileHeight: Integer; virtual;
  729. //Setter
  730. procedure SetCustomData(const aValue: Pointer);
  731. procedure SetCustomName(const aValue: String);
  732. procedure SetCustomNameW(const aValue: WideString);
  733. procedure SetDeleteTextureOnFree(const aValue: Boolean);
  734. procedure SetFormat(const aValue: TglBitmapFormat);
  735. procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
  736. procedure SetID(const aValue: Cardinal);
  737. procedure SetMipMap(const aValue: TglBitmapMipMap);
  738. procedure SetTarget(const aValue: Cardinal);
  739. procedure SetAnisotropic(const aValue: Integer);
  740. procedure CreateID;
  741. procedure SetupParameters(out aBuildWithGlu: Boolean);
  742. procedure SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
  743. const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;
  744. procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
  745. function FlipHorz: Boolean; virtual;
  746. function FlipVert: Boolean; virtual;
  747. property Width: Integer read GetWidth;
  748. property Height: Integer read GetHeight;
  749. property FileWidth: Integer read GetFileWidth;
  750. property FileHeight: Integer read GetFileHeight;
  751. public
  752. //Properties
  753. property ID: Cardinal read fID write SetID;
  754. property Target: Cardinal read fTarget write SetTarget;
  755. property Format: TglBitmapFormat read fFormat write SetFormat;
  756. property MipMap: TglBitmapMipMap read fMipMap write SetMipMap;
  757. property Anisotropic: Integer read fAnisotropic write SetAnisotropic;
  758. property Filename: String read fFilename;
  759. property CustomName: String read fCustomName write SetCustomName;
  760. property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
  761. property CustomData: Pointer read fCustomData write SetCustomData;
  762. property DeleteTextureOnFree: Boolean read fDeleteTextureOnFree write SetDeleteTextureOnFree;
  763. property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
  764. property Dimension: TglBitmapPixelPosition read fDimension;
  765. property Data: PByte read fData;
  766. property IsResident: Boolean read fIsResident;
  767. procedure AfterConstruction; override;
  768. procedure BeforeDestruction; override;
  769. //Load
  770. procedure LoadFromFile(const aFilename: String);
  771. procedure LoadFromStream(const aStream: TStream); virtual;
  772. procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  773. const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
  774. {$IFDEF GLB_DELPHI}
  775. procedure LoadFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil);
  776. procedure LoadFromResourceID(const sInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  777. {$ENDIF}
  778. //Save
  779. procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  780. procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
  781. //Convert
  782. function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
  783. function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  784. const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
  785. public
  786. //Alpha & Co
  787. {$IFDEF GLB_SDL}
  788. function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  789. function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  790. function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  791. function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
  792. const aArgs: Pointer = nil): Boolean;
  793. {$ENDIF}
  794. {$IFDEF GLB_DELPHI}
  795. function AssignToBitmap(const aBitmap: TBitmap): Boolean;
  796. function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  797. function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  798. function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
  799. const aArgs: Pointer = nil): Boolean;
  800. function AddAlphaFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil;
  801. const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  802. function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  803. const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  804. {$ENDIF}
  805. function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
  806. function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  807. function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  808. function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  809. function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
  810. function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
  811. function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
  812. function AddAlphaFromValue(const aAlpha: Byte): Boolean;
  813. function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  814. function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  815. function RemoveAlpha: Boolean; virtual;
  816. public
  817. //Common
  818. function Clone: TglBitmap;
  819. function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
  820. procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
  821. procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  822. procedure FreeData;
  823. //ColorFill
  824. procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
  825. procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
  826. procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
  827. //TexParameters
  828. procedure SetFilter(const aMin, aMag: Cardinal);
  829. procedure SetWrap(
  830. const S: Cardinal = GL_CLAMP_TO_EDGE;
  831. const T: Cardinal = GL_CLAMP_TO_EDGE;
  832. const R: Cardinal = GL_CLAMP_TO_EDGE);
  833. procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
  834. procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
  835. //Constructors
  836. constructor Create; overload;
  837. constructor Create(const aFileName: String); overload;
  838. constructor Create(const aStream: TStream); overload;
  839. constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat); overload;
  840. constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
  841. {$IFDEF GLB_DELPHI}
  842. constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
  843. constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
  844. {$ENDIF}
  845. private
  846. {$IFDEF GLB_SUPPORT_PNG_READ} function LoadPNG(const aStream: TStream): Boolean; virtual; {$ENDIF}
  847. {$ifdef GLB_SUPPORT_PNG_WRITE} procedure SavePNG(const aStream: TStream); virtual; {$ENDIF}
  848. {$IFDEF GLB_SUPPORT_JPEG_READ} function LoadJPEG(const aStream: TStream): Boolean; virtual; {$ENDIF}
  849. {$IFDEF GLB_SUPPORT_JPEG_WRITE} procedure SaveJPEG(const aStream: TStream); virtual; {$ENDIF}
  850. function LoadBMP(const aStream: TStream): Boolean; virtual;
  851. procedure SaveBMP(const aStream: TStream); virtual;
  852. function LoadTGA(const aStream: TStream): Boolean; virtual;
  853. procedure SaveTGA(const aStream: TStream); virtual;
  854. function LoadDDS(const aStream: TStream): Boolean; virtual;
  855. procedure SaveDDS(const aStream: TStream); virtual;
  856. end;
  857. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  858. TglBitmap2D = class(TglBitmap)
  859. protected
  860. // Bildeinstellungen
  861. fLines: array of PByte;
  862. (* TODO
  863. procedure GetDXTColorBlock(pData: pByte; relX, relY: Integer; var Pixel: TglBitmapPixelData);
  864. procedure GetPixel2DDXT1(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
  865. procedure GetPixel2DDXT3(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
  866. procedure GetPixel2DDXT5(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
  867. procedure GetPixel2DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
  868. procedure SetPixel2DUnmap(const Pos: TglBitmapPixelPosition; const Pixel: TglBitmapPixelData);
  869. *)
  870. function GetScanline(const aIndex: Integer): Pointer;
  871. procedure SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
  872. const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
  873. procedure UploadData(const aTarget: Cardinal; const aBuildWithGlu: Boolean);
  874. public
  875. property Width;
  876. property Height;
  877. property Scanline[const aIndex: Integer]: Pointer read GetScanline;
  878. procedure AfterConstruction; override;
  879. procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  880. procedure GetDataFromTexture;
  881. procedure GenTexture(const aTestTextureSize: Boolean = true); override;
  882. function FlipHorz: Boolean; override;
  883. function FlipVert: Boolean; override;
  884. procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
  885. const aScale: Single = 2; const aUseAlpha: Boolean = false);
  886. end;
  887. (* TODO
  888. TglBitmapCubeMap = class(TglBitmap2D)
  889. protected
  890. fGenMode: Integer;
  891. // Hide GenTexture
  892. procedure GenTexture(TestTextureSize: Boolean = true); reintroduce;
  893. public
  894. procedure AfterConstruction; override;
  895. procedure GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean = true);
  896. procedure Unbind(DisableTexCoordsGen: Boolean = true; DisableTextureUnit: Boolean = true); reintroduce; virtual;
  897. procedure Bind(EnableTexCoordsGen: Boolean = true; EnableTextureUnit: Boolean = true); reintroduce; virtual;
  898. end;
  899. TglBitmapNormalMap = class(TglBitmapCubeMap)
  900. public
  901. procedure AfterConstruction; override;
  902. procedure GenerateNormalMap(Size: Integer = 32; TestTextureSize: Boolean = true);
  903. end;
  904. TglBitmap1D = class(TglBitmap)
  905. protected
  906. procedure GetPixel1DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
  907. procedure SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width: Integer = -1; Height: Integer = -1); override;
  908. procedure UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
  909. public
  910. // propertys
  911. property Width;
  912. procedure AfterConstruction; override;
  913. // Other
  914. function FlipHorz: Boolean; override;
  915. // Generation
  916. procedure GenTexture(TestTextureSize: Boolean = true); override;
  917. end;
  918. *)
  919. const
  920. NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
  921. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  922. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  923. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  924. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  925. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  926. procedure glBitmapSetDefaultWrap(
  927. const S: Cardinal = GL_CLAMP_TO_EDGE;
  928. const T: Cardinal = GL_CLAMP_TO_EDGE;
  929. const R: Cardinal = GL_CLAMP_TO_EDGE);
  930. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  931. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  932. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  933. function glBitmapGetDefaultFormat: TglBitmapFormat;
  934. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  935. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  936. function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
  937. function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
  938. function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
  939. var
  940. glBitmapDefaultDeleteTextureOnFree: Boolean;
  941. glBitmapDefaultFreeDataAfterGenTextures: Boolean;
  942. glBitmapDefaultFormat: TglBitmapFormat;
  943. glBitmapDefaultMipmap: TglBitmapMipMap;
  944. glBitmapDefaultFilterMin: Cardinal;
  945. glBitmapDefaultFilterMag: Cardinal;
  946. glBitmapDefaultWrapS: Cardinal;
  947. glBitmapDefaultWrapT: Cardinal;
  948. glBitmapDefaultWrapR: Cardinal;
  949. {$IFDEF GLB_DELPHI}
  950. function CreateGrayPalette: HPALETTE;
  951. {$ENDIF}
  952. implementation
  953. (* TODO
  954. function FormatIsCompressed(Format: TglBitmapInternalFormat): boolean;
  955. function FormatIsUncompressed(Format: TglBitmapInternalFormat): boolean;
  956. function LoadTexture(Filename: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal = 0{$ENDIF}): Boolean;
  957. function LoadCubeMap(PositiveX, NegativeX, PositiveY, NegativeY, PositiveZ, NegativeZ: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal = 0{$ENDIF}): Boolean;
  958. function LoadNormalMap(Size: Integer; var Texture: Cardinal): Boolean;
  959. *)
  960. uses
  961. Math, syncobjs, typinfo;
  962. type
  963. ////////////////////////////////////////////////////////////////////////////////////////////////////
  964. TShiftRec = packed record
  965. case Integer of
  966. 0: (r, g, b, a: Byte);
  967. 1: (arr: array[0..3] of Byte);
  968. end;
  969. TFormatDescriptor = class(TObject)
  970. private
  971. function GetRedMask: QWord;
  972. function GetGreenMask: QWord;
  973. function GetBlueMask: QWord;
  974. function GetAlphaMask: QWord;
  975. protected
  976. fFormat: TglBitmapFormat;
  977. fWithAlpha: TglBitmapFormat;
  978. fWithoutAlpha: TglBitmapFormat;
  979. fRGBInverted: TglBitmapFormat;
  980. fUncompressed: TglBitmapFormat;
  981. fPixelSize: Single;
  982. fIsCompressed: Boolean;
  983. fRange: TglBitmapColorRec;
  984. fShift: TShiftRec;
  985. fglFormat: Cardinal;
  986. fglInternalFormat: Cardinal;
  987. fglDataFormat: Cardinal;
  988. function GetComponents: Integer; virtual;
  989. public
  990. property Format: TglBitmapFormat read fFormat;
  991. property WithAlpha: TglBitmapFormat read fWithAlpha;
  992. property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;
  993. property RGBInverted: TglBitmapFormat read fRGBInverted;
  994. property Components: Integer read GetComponents;
  995. property PixelSize: Single read fPixelSize;
  996. property IsCompressed: Boolean read fIsCompressed;
  997. property glFormat: Cardinal read fglFormat;
  998. property glInternalFormat: Cardinal read fglInternalFormat;
  999. property glDataFormat: Cardinal read fglDataFormat;
  1000. property Range: TglBitmapColorRec read fRange;
  1001. property Shift: TShiftRec read fShift;
  1002. property RedMask: QWord read GetRedMask;
  1003. property GreenMask: QWord read GetGreenMask;
  1004. property BlueMask: QWord read GetBlueMask;
  1005. property AlphaMask: QWord read GetAlphaMask;
  1006. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
  1007. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
  1008. function GetSize(const aSize: TglBitmapPixelPosition): Integer; virtual; overload;
  1009. function GetSize(const aWidth, aHeight: Integer): Integer; virtual; overload;
  1010. function CreateMappingData: Pointer; virtual;
  1011. procedure FreeMappingData(var aMappingData: Pointer); virtual;
  1012. function IsEmpty: Boolean; virtual;
  1013. function HasAlpha: Boolean; virtual;
  1014. function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean; virtual;
  1015. procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
  1016. constructor Create; virtual;
  1017. public
  1018. class procedure Init;
  1019. class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1020. class function GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1021. class procedure Clear;
  1022. class procedure Finalize;
  1023. end;
  1024. TFormatDescriptorClass = class of TFormatDescriptor;
  1025. TfdEmpty = class(TFormatDescriptor);
  1026. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1027. TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1028. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1029. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1030. constructor Create; override;
  1031. end;
  1032. TfdLuminance_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1033. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1034. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1035. constructor Create; override;
  1036. end;
  1037. TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1038. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1039. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1040. constructor Create; override;
  1041. end;
  1042. TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte
  1043. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1044. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1045. constructor Create; override;
  1046. end;
  1047. TfdRGB_UB3 = class(TFormatDescriptor) //3* unsigned byte
  1048. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1049. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1050. constructor Create; override;
  1051. end;
  1052. TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
  1053. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1054. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1055. constructor Create; override;
  1056. end;
  1057. TfdRGBA_UB4 = class(TfdRGB_UB3) //4* unsigned byte
  1058. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1059. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1060. constructor Create; override;
  1061. end;
  1062. TfdBGRA_UB4 = class(TfdBGR_UB3) //4* unsigned byte (inverse)
  1063. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1064. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1065. constructor Create; override;
  1066. end;
  1067. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1068. TfdAlpha_US1 = class(TFormatDescriptor) //1* unsigned short
  1069. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1070. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1071. constructor Create; override;
  1072. end;
  1073. TfdLuminance_US1 = class(TFormatDescriptor) //1* unsigned short
  1074. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1075. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1076. constructor Create; override;
  1077. end;
  1078. TfdUniversal_US1 = class(TFormatDescriptor) //1* unsigned short
  1079. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1080. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1081. constructor Create; override;
  1082. end;
  1083. TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short
  1084. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1085. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1086. constructor Create; override;
  1087. end;
  1088. TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short
  1089. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1090. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1091. constructor Create; override;
  1092. end;
  1093. TfdRGB_US3 = class(TFormatDescriptor) //3* unsigned short
  1094. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1095. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1096. constructor Create; override;
  1097. end;
  1098. TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)
  1099. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1100. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1101. constructor Create; override;
  1102. end;
  1103. TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
  1104. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1105. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1106. constructor Create; override;
  1107. end;
  1108. TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
  1109. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1110. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1111. constructor Create; override;
  1112. end;
  1113. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1114. TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int
  1115. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1116. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1117. constructor Create; override;
  1118. end;
  1119. TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int
  1120. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1121. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1122. constructor Create; override;
  1123. end;
  1124. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1125. TfdAlpha4 = class(TfdAlpha_UB1)
  1126. constructor Create; override;
  1127. end;
  1128. TfdAlpha8 = class(TfdAlpha_UB1)
  1129. constructor Create; override;
  1130. end;
  1131. TfdAlpha12 = class(TfdAlpha_US1)
  1132. constructor Create; override;
  1133. end;
  1134. TfdAlpha16 = class(TfdAlpha_US1)
  1135. constructor Create; override;
  1136. end;
  1137. TfdLuminance4 = class(TfdLuminance_UB1)
  1138. constructor Create; override;
  1139. end;
  1140. TfdLuminance8 = class(TfdLuminance_UB1)
  1141. constructor Create; override;
  1142. end;
  1143. TfdLuminance12 = class(TfdLuminance_US1)
  1144. constructor Create; override;
  1145. end;
  1146. TfdLuminance16 = class(TfdLuminance_US1)
  1147. constructor Create; override;
  1148. end;
  1149. TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
  1150. constructor Create; override;
  1151. end;
  1152. TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
  1153. constructor Create; override;
  1154. end;
  1155. TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
  1156. constructor Create; override;
  1157. end;
  1158. TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
  1159. constructor Create; override;
  1160. end;
  1161. TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)
  1162. constructor Create; override;
  1163. end;
  1164. TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
  1165. constructor Create; override;
  1166. end;
  1167. TfdR3G3B2 = class(TfdUniversal_UB1)
  1168. constructor Create; override;
  1169. end;
  1170. TfdRGB4 = class(TfdUniversal_US1)
  1171. constructor Create; override;
  1172. end;
  1173. TfdR5G6B5 = class(TfdUniversal_US1)
  1174. constructor Create; override;
  1175. end;
  1176. TfdRGB5 = class(TfdUniversal_US1)
  1177. constructor Create; override;
  1178. end;
  1179. TfdRGB8 = class(TfdRGB_UB3)
  1180. constructor Create; override;
  1181. end;
  1182. TfdRGB10 = class(TfdUniversal_UI1)
  1183. constructor Create; override;
  1184. end;
  1185. TfdRGB12 = class(TfdRGB_US3)
  1186. constructor Create; override;
  1187. end;
  1188. TfdRGB16 = class(TfdRGB_US3)
  1189. constructor Create; override;
  1190. end;
  1191. TfdRGBA2 = class(TfdRGBA_UB4)
  1192. constructor Create; override;
  1193. end;
  1194. TfdRGBA4 = class(TfdUniversal_US1)
  1195. constructor Create; override;
  1196. end;
  1197. TfdRGB5A1 = class(TfdUniversal_US1)
  1198. constructor Create; override;
  1199. end;
  1200. TfdRGBA8 = class(TfdRGBA_UB4)
  1201. constructor Create; override;
  1202. end;
  1203. TfdRGB10A2 = class(TfdUniversal_UI1)
  1204. constructor Create; override;
  1205. end;
  1206. TfdRGBA12 = class(TfdRGBA_US4)
  1207. constructor Create; override;
  1208. end;
  1209. TfdRGBA16 = class(TfdRGBA_US4)
  1210. constructor Create; override;
  1211. end;
  1212. TfdBGR4 = class(TfdUniversal_US1)
  1213. constructor Create; override;
  1214. end;
  1215. TfdB5G6R5 = class(TfdUniversal_US1)
  1216. constructor Create; override;
  1217. end;
  1218. TfdBGR5 = class(TfdUniversal_US1)
  1219. constructor Create; override;
  1220. end;
  1221. TfdBGR8 = class(TfdBGR_UB3)
  1222. constructor Create; override;
  1223. end;
  1224. TfdBGR10 = class(TfdUniversal_UI1)
  1225. constructor Create; override;
  1226. end;
  1227. TfdBGR12 = class(TfdBGR_US3)
  1228. constructor Create; override;
  1229. end;
  1230. TfdBGR16 = class(TfdBGR_US3)
  1231. constructor Create; override;
  1232. end;
  1233. TfdBGRA2 = class(TfdBGRA_UB4)
  1234. constructor Create; override;
  1235. end;
  1236. TfdBGRA4 = class(TfdUniversal_US1)
  1237. constructor Create; override;
  1238. end;
  1239. TfdBGR5A1 = class(TfdUniversal_US1)
  1240. constructor Create; override;
  1241. end;
  1242. TfdBGRA8 = class(TfdBGRA_UB4)
  1243. constructor Create; override;
  1244. end;
  1245. TfdBGR10A2 = class(TfdUniversal_UI1)
  1246. constructor Create; override;
  1247. end;
  1248. TfdBGRA12 = class(TfdBGRA_US4)
  1249. constructor Create; override;
  1250. end;
  1251. TfdBGRA16 = class(TfdBGRA_US4)
  1252. constructor Create; override;
  1253. end;
  1254. TfdDepth16 = class(TfdDepth_US1)
  1255. constructor Create; override;
  1256. end;
  1257. TfdDepth24 = class(TfdDepth_UI1)
  1258. constructor Create; override;
  1259. end;
  1260. TfdDepth32 = class(TfdDepth_UI1)
  1261. constructor Create; override;
  1262. end;
  1263. TfdS3tcDtx1RGBA = class(TFormatDescriptor)
  1264. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1265. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1266. constructor Create; override;
  1267. end;
  1268. TfdS3tcDtx3RGBA = class(TFormatDescriptor)
  1269. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1270. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1271. constructor Create; override;
  1272. end;
  1273. TfdS3tcDtx5RGBA = class(TFormatDescriptor)
  1274. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1275. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1276. constructor Create; override;
  1277. end;
  1278. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1279. TbmpBitfieldFormat = class(TFormatDescriptor)
  1280. private
  1281. procedure SetRedMask (const aValue: QWord);
  1282. procedure SetGreenMask(const aValue: QWord);
  1283. procedure SetBlueMask (const aValue: QWord);
  1284. procedure SetAlphaMask(const aValue: QWord);
  1285. procedure Update(aMask: QWord; out aRange: Cardinal; out aShift: Byte);
  1286. public
  1287. property RedMask: QWord read GetRedMask write SetRedMask;
  1288. property GreenMask: QWord read GetGreenMask write SetGreenMask;
  1289. property BlueMask: QWord read GetBlueMask write SetBlueMask;
  1290. property AlphaMask: QWord read GetAlphaMask write SetAlphaMask;
  1291. property PixelSize: Single read fPixelSize write fPixelSize;
  1292. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1293. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1294. end;
  1295. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1296. TbmpColorTableEnty = packed record
  1297. b, g, r, a: Byte;
  1298. end;
  1299. TbmpColorTable = array of TbmpColorTableEnty;
  1300. TbmpColorTableFormat = class(TFormatDescriptor)
  1301. private
  1302. fColorTable: TbmpColorTable;
  1303. public
  1304. property PixelSize: Single read fPixelSize write fPixelSize;
  1305. property ColorTable: TbmpColorTable read fColorTable write fColorTable;
  1306. property Range: TglBitmapColorRec read fRange write fRange;
  1307. property Shift: TShiftRec read fShift write fShift;
  1308. property Format: TglBitmapFormat read fFormat write fFormat;
  1309. procedure CreateColorTable;
  1310. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1311. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1312. destructor Destroy; override;
  1313. end;
  1314. const
  1315. LUMINANCE_WEIGHT_R = 0.30;
  1316. LUMINANCE_WEIGHT_G = 0.59;
  1317. LUMINANCE_WEIGHT_B = 0.11;
  1318. ALPHA_WEIGHT_R = 0.30;
  1319. ALPHA_WEIGHT_G = 0.59;
  1320. ALPHA_WEIGHT_B = 0.11;
  1321. DEPTH_WEIGHT_R = 0.333333333;
  1322. DEPTH_WEIGHT_G = 0.333333333;
  1323. DEPTH_WEIGHT_B = 0.333333333;
  1324. UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
  1325. FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
  1326. TfdEmpty,
  1327. TfdAlpha4,
  1328. TfdAlpha8,
  1329. TfdAlpha12,
  1330. TfdAlpha16,
  1331. TfdLuminance4,
  1332. TfdLuminance8,
  1333. TfdLuminance12,
  1334. TfdLuminance16,
  1335. TfdLuminance4Alpha4,
  1336. TfdLuminance6Alpha2,
  1337. TfdLuminance8Alpha8,
  1338. TfdLuminance12Alpha4,
  1339. TfdLuminance12Alpha12,
  1340. TfdLuminance16Alpha16,
  1341. TfdR3G3B2,
  1342. TfdRGB4,
  1343. TfdR5G6B5,
  1344. TfdRGB5,
  1345. TfdRGB8,
  1346. TfdRGB10,
  1347. TfdRGB12,
  1348. TfdRGB16,
  1349. TfdRGBA2,
  1350. TfdRGBA4,
  1351. TfdRGB5A1,
  1352. TfdRGBA8,
  1353. TfdRGB10A2,
  1354. TfdRGBA12,
  1355. TfdRGBA16,
  1356. TfdBGR4,
  1357. TfdB5G6R5,
  1358. TfdBGR5,
  1359. TfdBGR8,
  1360. TfdBGR10,
  1361. TfdBGR12,
  1362. TfdBGR16,
  1363. TfdBGRA2,
  1364. TfdBGRA4,
  1365. TfdBGR5A1,
  1366. TfdBGRA8,
  1367. TfdBGR10A2,
  1368. TfdBGRA12,
  1369. TfdBGRA16,
  1370. TfdDepth16,
  1371. TfdDepth24,
  1372. TfdDepth32,
  1373. TfdS3tcDtx1RGBA,
  1374. TfdS3tcDtx3RGBA,
  1375. TfdS3tcDtx5RGBA
  1376. );
  1377. var
  1378. FormatDescriptorCS: TCriticalSection;
  1379. FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
  1380. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1381. constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
  1382. begin
  1383. inherited Create(GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1384. end;
  1385. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1386. function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
  1387. begin
  1388. result.Fields := [];
  1389. if X >= 0 then
  1390. result.Fields := result.Fields + [ffX];
  1391. if Y >= 0 then
  1392. result.Fields := result.Fields + [ffY];
  1393. result.X := Max(0, X);
  1394. result.Y := Max(0, Y);
  1395. end;
  1396. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1397. function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
  1398. begin
  1399. result.r := r;
  1400. result.g := g;
  1401. result.b := b;
  1402. result.a := a;
  1403. end;
  1404. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1405. function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
  1406. var
  1407. i: Integer;
  1408. begin
  1409. result := false;
  1410. for i := 0 to high(r1.arr) do
  1411. if (r1.arr[i] <> r2.arr[i]) then
  1412. exit;
  1413. result := true;
  1414. end;
  1415. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1416. function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
  1417. begin
  1418. result.r := r;
  1419. result.g := g;
  1420. result.b := b;
  1421. result.a := a;
  1422. end;
  1423. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1424. function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
  1425. begin
  1426. result := [];
  1427. if (aFormat in [
  1428. //4 bbp
  1429. tfLuminance4,
  1430. //8bpp
  1431. tfR3G3B2, tfLuminance8,
  1432. //16bpp
  1433. tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
  1434. tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,
  1435. //24bpp
  1436. tfBGR8, tfRGB8,
  1437. //32bpp
  1438. tfRGB10, tfRGB10A2, tfRGBA8,
  1439. tfBGR10, tfBGR10A2, tfBGRA8]) then
  1440. result := result + [ftBMP];
  1441. if (aFormat in [
  1442. //8 bpp
  1443. tfLuminance8, tfAlpha8,
  1444. //16 bpp
  1445. tfLuminance16, tfLuminance8Alpha8,
  1446. tfRGB5, tfRGB5A1, tfRGBA4,
  1447. tfBGR5, tfBGR5A1, tfBGRA4,
  1448. //24 bpp
  1449. tfRGB8, tfBGR8,
  1450. //32 bpp
  1451. tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
  1452. result := result + [ftTGA];
  1453. if (aFormat in [
  1454. //8 bpp
  1455. tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,
  1456. tfR3G3B2, tfRGBA2, tfBGRA2,
  1457. //16 bpp
  1458. tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,
  1459. tfRGB4, tfR5G6B5, tfRGB5, tfRGBA4, tfRGB5A1,
  1460. tfBGR4, tfB5G6R5, tfBGR5, tfBGRA4, tfBGR5A1,
  1461. //24 bpp
  1462. tfRGB8, tfBGR8,
  1463. //32 bbp
  1464. tfLuminance16Alpha16,
  1465. tfRGBA8, tfRGB10A2,
  1466. tfBGRA8, tfBGR10A2,
  1467. //compressed
  1468. tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then
  1469. result := result + [ftDDS];
  1470. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  1471. if aFormat in [
  1472. tfAlpha8, tfLuminance8, tfLuminance8Alpha8,
  1473. tfRGB8, tfRGBA8,
  1474. tfBGR8, tfBGRA8] then
  1475. result := result + [ftPNG];
  1476. {$ENDIF}
  1477. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  1478. if aFormat in [tfAlpha8, tfLuminance8, tfRGB8, tfBGR8] then
  1479. result := result + [ftJPEG];
  1480. {$ENDIF}
  1481. end;
  1482. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1483. function IsPowerOfTwo(aNumber: Integer): Boolean;
  1484. begin
  1485. while (aNumber and 1) = 0 do
  1486. aNumber := aNumber shr 1;
  1487. result := aNumber = 1;
  1488. end;
  1489. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1490. function GetTopMostBit(aBitSet: QWord): Integer;
  1491. begin
  1492. result := 0;
  1493. while aBitSet > 0 do begin
  1494. inc(result);
  1495. aBitSet := aBitSet shr 1;
  1496. end;
  1497. end;
  1498. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1499. function CountSetBits(aBitSet: QWord): Integer;
  1500. begin
  1501. result := 0;
  1502. while aBitSet > 0 do begin
  1503. if (aBitSet and 1) = 1 then
  1504. inc(result);
  1505. aBitSet := aBitSet shr 1;
  1506. end;
  1507. end;
  1508. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1509. function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1510. begin
  1511. result := Trunc(
  1512. LUMINANCE_WEIGHT_R * aPixel.Data.r +
  1513. LUMINANCE_WEIGHT_G * aPixel.Data.g +
  1514. LUMINANCE_WEIGHT_B * aPixel.Data.b);
  1515. end;
  1516. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1517. function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1518. begin
  1519. result := Trunc(
  1520. DEPTH_WEIGHT_R * aPixel.Data.r +
  1521. DEPTH_WEIGHT_G * aPixel.Data.g +
  1522. DEPTH_WEIGHT_B * aPixel.Data.b);
  1523. end;
  1524. {$IFDEF GLB_NATIVE_OGL}
  1525. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1526. //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1527. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1528. var
  1529. GL_LibHandle: Pointer = nil;
  1530. function glbGetProcAddress(aProcName: PChar; aLibHandle: Pointer = nil): Pointer;
  1531. begin
  1532. result := nil;
  1533. if not Assigned(aLibHandle) then
  1534. aLibHandle := GL_LibHandle;
  1535. {$IF DEFINED(GLB_WIN)}
  1536. result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
  1537. if Assigned(result) then
  1538. exit;
  1539. if Assigned(wglGetProcAddress) then
  1540. result := wglGetProcAddress(aProcName);
  1541. {$ELSEIF DEFINED(GLB_LINUX)}
  1542. if Assigned(glXGetProcAddress) then begin
  1543. result := glXGetProcAddress(aProcName);
  1544. if Assigned(result) then
  1545. exit;
  1546. end;
  1547. if Assigned(glXGetProcAddressARB) then begin
  1548. result := glXGetProcAddressARB(aProcName);
  1549. if Assigned(result) then
  1550. exit;
  1551. end;
  1552. result := dlsym(aLibHandle, aProcName);
  1553. {$ENDIF}
  1554. if not Assigned(result) then
  1555. raise EglBitmapException.Create('unable to load procedure form library: ' + aProcName);
  1556. end;
  1557. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  1558. var
  1559. GLU_LibHandle: Pointer = nil;
  1560. OpenGLInitialized: Boolean;
  1561. InitOpenGLCS: TCriticalSection;
  1562. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1563. procedure glbInitOpenGL;
  1564. ////////////////////////////////////////////////////////////////////////////////
  1565. function glbLoadLibrary(const aName: PChar): Pointer;
  1566. begin
  1567. {$IF DEFINED(GLB_WIN)}
  1568. result := {%H-}Pointer(LoadLibrary(aName));
  1569. {$ELSEIF DEFINED(GLB_LINUX)}
  1570. result := dlopen(Name, RTLD_LAZY);
  1571. {$ELSE}
  1572. result := nil;
  1573. {$ENDIF}
  1574. end;
  1575. ////////////////////////////////////////////////////////////////////////////////
  1576. function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
  1577. begin
  1578. result := false;
  1579. if not Assigned(aLibHandle) then
  1580. exit;
  1581. {$IF DEFINED(GLB_WIN)}
  1582. Result := FreeLibrary({%H-}HINST(aLibHandle));
  1583. {$ELSEIF DEFINED(GLB_LINUX)}
  1584. Result := dlclose(aLibHandle) = 0;
  1585. {$ENDIF}
  1586. end;
  1587. begin
  1588. if Assigned(GL_LibHandle) then
  1589. glbFreeLibrary(GL_LibHandle);
  1590. if Assigned(GLU_LibHandle) then
  1591. glbFreeLibrary(GLU_LibHandle);
  1592. GL_LibHandle := glbLoadLibrary(libopengl);
  1593. if not Assigned(GL_LibHandle) then
  1594. raise EglBitmapException.Create('unable to load library: ' + libopengl);
  1595. GLU_LibHandle := glbLoadLibrary(libglu);
  1596. if not Assigned(GLU_LibHandle) then
  1597. raise EglBitmapException.Create('unable to load library: ' + libglu);
  1598. try
  1599. {$IF DEFINED(GLB_WIN)}
  1600. wglGetProcAddress := glbGetProcAddress('wglGetProcAddress');
  1601. {$ELSEIF DEFINED(GLB_LINUX)}
  1602. glXGetProcAddress := glbGetProcAddress('glXGetProcAddress');
  1603. glXGetProcAddressARB := dglGetProcAddress('glXGetProcAddressARB');
  1604. {$ENDIF}
  1605. glEnable := glbGetProcAddress('glEnable');
  1606. glDisable := glbGetProcAddress('glDisable');
  1607. glGetString := glbGetProcAddress('glGetString');
  1608. glGetIntegerv := glbGetProcAddress('glGetIntegerv');
  1609. glTexParameteri := glbGetProcAddress('glTexParameteri');
  1610. glTexParameterfv := glbGetProcAddress('glTexParameterfv');
  1611. glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
  1612. glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
  1613. glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
  1614. glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
  1615. glGenTextures := glbGetProcAddress('glGenTextures');
  1616. glBindTexture := glbGetProcAddress('glBindTexture');
  1617. glDeleteTextures := glbGetProcAddress('glDeleteTextures');
  1618. glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
  1619. glReadPixels := glbGetProcAddress('glReadPixels');
  1620. glPixelStorei := glbGetProcAddress('glPixelStorei');
  1621. glTexImage1D := glbGetProcAddress('glTexImage1D');
  1622. glTexImage2D := glbGetProcAddress('glTexImage2D');
  1623. glGetTexImage := glbGetProcAddress('glGetTexImage');
  1624. gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
  1625. gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
  1626. finally
  1627. glbFreeLibrary(GL_LibHandle);
  1628. glbFreeLibrary(GLU_LibHandle);
  1629. end;
  1630. end;
  1631. {$ENDIF}
  1632. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1633. procedure glbReadOpenGLExtensions;
  1634. var
  1635. {$IFDEF GLB_DELPHI}
  1636. Context: HGLRC;
  1637. {$ENDIF}
  1638. Buffer: AnsiString;
  1639. MajorVersion, MinorVersion: Integer;
  1640. ///////////////////////////////////////////////////////////////////////////////////////////
  1641. procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
  1642. var
  1643. Separator: Integer;
  1644. begin
  1645. aMinor := 0;
  1646. aMajor := 0;
  1647. Separator := Pos(AnsiString('.'), aBuffer);
  1648. if (Separator > 1) and (Separator < Length(aBuffer)) and
  1649. (aBuffer[Separator - 1] in ['0'..'9']) and
  1650. (aBuffer[Separator + 1] in ['0'..'9']) then begin
  1651. Dec(Separator);
  1652. while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
  1653. Dec(Separator);
  1654. Delete(aBuffer, 1, Separator);
  1655. Separator := Pos(AnsiString('.'), aBuffer) + 1;
  1656. while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
  1657. Inc(Separator);
  1658. Delete(aBuffer, Separator, 255);
  1659. Separator := Pos(AnsiString('.'), aBuffer);
  1660. aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
  1661. aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
  1662. end;
  1663. end;
  1664. ///////////////////////////////////////////////////////////////////////////////////////////
  1665. function CheckExtension(const Extension: AnsiString): Boolean;
  1666. var
  1667. ExtPos: Integer;
  1668. begin
  1669. ExtPos := Pos(Extension, Buffer);
  1670. result := ExtPos > 0;
  1671. if result then
  1672. result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
  1673. end;
  1674. begin
  1675. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  1676. InitOpenGLCS.Enter;
  1677. try
  1678. if not OpenGLInitialized then begin
  1679. glbInitOpenGL;
  1680. OpenGLInitialized := true;
  1681. end;
  1682. finally
  1683. InitOpenGLCS.Leave;
  1684. end;
  1685. {$ENDIF}
  1686. {$IFDEF GLB_DELPHI}
  1687. Context := wglGetCurrentContext;
  1688. if (Context <> gLastContext) then begin
  1689. gLastContext := Context;
  1690. {$ENDIF}
  1691. // Version
  1692. Buffer := glGetString(GL_VERSION);
  1693. TrimVersionString(Buffer, MajorVersion, MinorVersion);
  1694. GL_VERSION_1_2 := false;
  1695. GL_VERSION_1_3 := false;
  1696. GL_VERSION_1_4 := false;
  1697. GL_VERSION_2_0 := false;
  1698. if MajorVersion = 1 then begin
  1699. if MinorVersion >= 2 then
  1700. GL_VERSION_1_2 := true;
  1701. if MinorVersion >= 3 then
  1702. GL_VERSION_1_3 := true;
  1703. if MinorVersion >= 4 then
  1704. GL_VERSION_1_4 := true;
  1705. end else if MajorVersion >= 2 then begin
  1706. GL_VERSION_1_2 := true;
  1707. GL_VERSION_1_3 := true;
  1708. GL_VERSION_1_4 := true;
  1709. GL_VERSION_2_0 := true;
  1710. end;
  1711. // Extensions
  1712. Buffer := glGetString(GL_EXTENSIONS);
  1713. GL_ARB_texture_border_clamp := CheckExtension('GL_ARB_texture_border_clamp');
  1714. GL_ARB_texture_non_power_of_two := CheckExtension('GL_ARB_texture_non_power_of_two');
  1715. GL_ARB_texture_rectangle := CheckExtension('GL_ARB_texture_rectangle');
  1716. GL_ARB_texture_mirrored_repeat := CheckExtension('GL_ARB_texture_mirrored_repeat');
  1717. GL_EXT_texture_edge_clamp := CheckExtension('GL_EXT_texture_edge_clamp');
  1718. GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
  1719. GL_EXT_texture_rectangle := CheckExtension('GL_EXT_texture_rectangle');
  1720. GL_NV_texture_rectangle := CheckExtension('GL_NV_texture_rectangle');
  1721. GL_IBM_texture_mirrored_repeat := CheckExtension('GL_IBM_texture_mirrored_repeat');
  1722. GL_SGIS_generate_mipmap := CheckExtension('GL_SGIS_generate_mipmap');
  1723. if GL_VERSION_1_3 then begin
  1724. glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1D');
  1725. glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2D');
  1726. glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
  1727. end else begin
  1728. glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1DARB');
  1729. glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2DARB');
  1730. glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB');
  1731. end;
  1732. {$IFDEF GLB_DELPHI}
  1733. end;
  1734. {$ENDIF}
  1735. end;
  1736. {$ENDIF}
  1737. (* TODO GLB_DELPHI
  1738. {$IFDEF GLB_DELPHI}
  1739. function CreateGrayPalette: HPALETTE;
  1740. var
  1741. Idx: Integer;
  1742. Pal: PLogPalette;
  1743. begin
  1744. GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
  1745. Pal.palVersion := $300;
  1746. Pal.palNumEntries := 256;
  1747. {$IFOPT R+}
  1748. {$DEFINE GLB_TEMPRANGECHECK}
  1749. {$R-}
  1750. {$ENDIF}
  1751. for Idx := 0 to 256 - 1 do begin
  1752. Pal.palPalEntry[Idx].peRed := Idx;
  1753. Pal.palPalEntry[Idx].peGreen := Idx;
  1754. Pal.palPalEntry[Idx].peBlue := Idx;
  1755. Pal.palPalEntry[Idx].peFlags := 0;
  1756. end;
  1757. {$IFDEF GLB_TEMPRANGECHECK}
  1758. {$UNDEF GLB_TEMPRANGECHECK}
  1759. {$R+}
  1760. {$ENDIF}
  1761. result := CreatePalette(Pal^);
  1762. FreeMem(Pal);
  1763. end;
  1764. {$ENDIF}
  1765. *)
  1766. {$IFDEF GLB_SDL_IMAGE}
  1767. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1768. // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1769. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1770. function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
  1771. begin
  1772. result := TStream(context^.unknown.data1).Seek(offset, whence);
  1773. end;
  1774. function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
  1775. begin
  1776. result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
  1777. end;
  1778. function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
  1779. begin
  1780. result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
  1781. end;
  1782. function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
  1783. begin
  1784. result := 0;
  1785. end;
  1786. function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
  1787. begin
  1788. result := SDL_AllocRW;
  1789. if result = nil then
  1790. raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
  1791. result^.seek := glBitmapRWseek;
  1792. result^.read := glBitmapRWread;
  1793. result^.write := glBitmapRWwrite;
  1794. result^.close := glBitmapRWclose;
  1795. result^.unknown.data1 := Stream;
  1796. end;
  1797. {$ENDIF}
  1798. (* TODO LoadFuncs
  1799. function LoadTexture(Filename: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal{$ENDIF}): Boolean;
  1800. var
  1801. glBitmap: TglBitmap2D;
  1802. begin
  1803. result := false;
  1804. Texture := 0;
  1805. {$IFDEF GLB_DELPHI}
  1806. if Instance = 0 then
  1807. Instance := HInstance;
  1808. if (LoadFromRes) then
  1809. glBitmap := TglBitmap2D.CreateFromResourceName(Instance, FileName)
  1810. else
  1811. {$ENDIF}
  1812. glBitmap := TglBitmap2D.Create(FileName);
  1813. try
  1814. glBitmap.DeleteTextureOnFree := false;
  1815. glBitmap.FreeDataAfterGenTexture := false;
  1816. glBitmap.GenTexture(true);
  1817. if (glBitmap.ID > 0) then begin
  1818. Texture := glBitmap.ID;
  1819. result := true;
  1820. end;
  1821. finally
  1822. glBitmap.Free;
  1823. end;
  1824. end;
  1825. function LoadCubeMap(PositiveX, NegativeX, PositiveY, NegativeY, PositiveZ, NegativeZ: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal{$ENDIF}): Boolean;
  1826. var
  1827. CM: TglBitmapCubeMap;
  1828. begin
  1829. Texture := 0;
  1830. {$IFDEF GLB_DELPHI}
  1831. if Instance = 0 then
  1832. Instance := HInstance;
  1833. {$ENDIF}
  1834. CM := TglBitmapCubeMap.Create;
  1835. try
  1836. CM.DeleteTextureOnFree := false;
  1837. // Maps
  1838. {$IFDEF GLB_DELPHI}
  1839. if (LoadFromRes) then
  1840. CM.LoadFromResource(Instance, PositiveX)
  1841. else
  1842. {$ENDIF}
  1843. CM.LoadFromFile(PositiveX);
  1844. CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X);
  1845. {$IFDEF GLB_DELPHI}
  1846. if (LoadFromRes) then
  1847. CM.LoadFromResource(Instance, NegativeX)
  1848. else
  1849. {$ENDIF}
  1850. CM.LoadFromFile(NegativeX);
  1851. CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X);
  1852. {$IFDEF GLB_DELPHI}
  1853. if (LoadFromRes) then
  1854. CM.LoadFromResource(Instance, PositiveY)
  1855. else
  1856. {$ENDIF}
  1857. CM.LoadFromFile(PositiveY);
  1858. CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y);
  1859. {$IFDEF GLB_DELPHI}
  1860. if (LoadFromRes) then
  1861. CM.LoadFromResource(Instance, NegativeY)
  1862. else
  1863. {$ENDIF}
  1864. CM.LoadFromFile(NegativeY);
  1865. CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y);
  1866. {$IFDEF GLB_DELPHI}
  1867. if (LoadFromRes) then
  1868. CM.LoadFromResource(Instance, PositiveZ)
  1869. else
  1870. {$ENDIF}
  1871. CM.LoadFromFile(PositiveZ);
  1872. CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z);
  1873. {$IFDEF GLB_DELPHI}
  1874. if (LoadFromRes) then
  1875. CM.LoadFromResource(Instance, NegativeZ)
  1876. else
  1877. {$ENDIF}
  1878. CM.LoadFromFile(NegativeZ);
  1879. CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z);
  1880. Texture := CM.ID;
  1881. result := true;
  1882. finally
  1883. CM.Free;
  1884. end;
  1885. end;
  1886. function LoadNormalMap(Size: Integer; var Texture: Cardinal): Boolean;
  1887. var
  1888. NM: TglBitmapNormalMap;
  1889. begin
  1890. Texture := 0;
  1891. NM := TglBitmapNormalMap.Create;
  1892. try
  1893. NM.DeleteTextureOnFree := false;
  1894. NM.GenerateNormalMap(Size);
  1895. Texture := NM.ID;
  1896. result := true;
  1897. finally
  1898. NM.Free;
  1899. end;
  1900. end;
  1901. *)
  1902. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1903. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1904. begin
  1905. glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
  1906. end;
  1907. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1908. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1909. begin
  1910. glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
  1911. end;
  1912. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1913. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1914. begin
  1915. glBitmapDefaultMipmap := aValue;
  1916. end;
  1917. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1918. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1919. begin
  1920. glBitmapDefaultFormat := aFormat;
  1921. end;
  1922. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1923. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1924. begin
  1925. glBitmapDefaultFilterMin := aMin;
  1926. glBitmapDefaultFilterMag := aMag;
  1927. end;
  1928. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1929. procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
  1930. begin
  1931. glBitmapDefaultWrapS := S;
  1932. glBitmapDefaultWrapT := T;
  1933. glBitmapDefaultWrapR := R;
  1934. end;
  1935. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1936. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1937. begin
  1938. result := glBitmapDefaultDeleteTextureOnFree;
  1939. end;
  1940. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1941. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1942. begin
  1943. result := glBitmapDefaultFreeDataAfterGenTextures;
  1944. end;
  1945. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1946. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1947. begin
  1948. result := glBitmapDefaultMipmap;
  1949. end;
  1950. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1951. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1952. begin
  1953. result := glBitmapDefaultFormat;
  1954. end;
  1955. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1956. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  1957. begin
  1958. aMin := glBitmapDefaultFilterMin;
  1959. aMag := glBitmapDefaultFilterMag;
  1960. end;
  1961. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1962. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  1963. begin
  1964. S := glBitmapDefaultWrapS;
  1965. T := glBitmapDefaultWrapT;
  1966. R := glBitmapDefaultWrapR;
  1967. end;
  1968. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1969. //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1970. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1971. function TFormatDescriptor.GetRedMask: QWord;
  1972. begin
  1973. result := fRange.r shl fShift.r;
  1974. end;
  1975. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1976. function TFormatDescriptor.GetGreenMask: QWord;
  1977. begin
  1978. result := fRange.g shl fShift.g;
  1979. end;
  1980. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1981. function TFormatDescriptor.GetBlueMask: QWord;
  1982. begin
  1983. result := fRange.b shl fShift.b;
  1984. end;
  1985. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1986. function TFormatDescriptor.GetAlphaMask: QWord;
  1987. begin
  1988. result := fRange.a shl fShift.a;
  1989. end;
  1990. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1991. function TFormatDescriptor.GetComponents: Integer;
  1992. var
  1993. i: Integer;
  1994. begin
  1995. result := 0;
  1996. for i := 0 to 3 do
  1997. if (fRange.arr[i] > 0) then
  1998. inc(result);
  1999. end;
  2000. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2001. function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
  2002. var
  2003. w, h: Integer;
  2004. begin
  2005. if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
  2006. w := Max(1, aSize.X);
  2007. h := Max(1, aSize.Y);
  2008. result := GetSize(w, h);
  2009. end else
  2010. result := 0;
  2011. end;
  2012. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2013. function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
  2014. begin
  2015. result := 0;
  2016. if (aWidth <= 0) or (aHeight <= 0) then
  2017. exit;
  2018. result := Ceil(aWidth * aHeight * fPixelSize);
  2019. end;
  2020. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2021. function TFormatDescriptor.CreateMappingData: Pointer;
  2022. begin
  2023. result := nil;
  2024. end;
  2025. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2026. procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
  2027. begin
  2028. //DUMMY
  2029. end;
  2030. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2031. function TFormatDescriptor.IsEmpty: Boolean;
  2032. begin
  2033. result := (fFormat = tfEmpty);
  2034. end;
  2035. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2036. function TFormatDescriptor.HasAlpha: Boolean;
  2037. begin
  2038. result := (fRange.a > 0);
  2039. end;
  2040. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2041. function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean;
  2042. begin
  2043. result := false;
  2044. if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
  2045. raise EglBitmapException.Create('FormatCheckFormat - All Masks are 0');
  2046. if (aRedMask <> RedMask) then
  2047. exit;
  2048. if (aGreenMask <> GreenMask) then
  2049. exit;
  2050. if (aBlueMask <> BlueMask) then
  2051. exit;
  2052. if (aAlphaMask <> AlphaMask) then
  2053. exit;
  2054. result := true;
  2055. end;
  2056. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2057. procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
  2058. begin
  2059. FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
  2060. aPixel.Data := fRange;
  2061. aPixel.Range := fRange;
  2062. aPixel.Format := fFormat;
  2063. end;
  2064. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2065. constructor TFormatDescriptor.Create;
  2066. begin
  2067. inherited Create;
  2068. fFormat := tfEmpty;
  2069. fWithAlpha := tfEmpty;
  2070. fWithoutAlpha := tfEmpty;
  2071. fRGBInverted := tfEmpty;
  2072. fUncompressed := tfEmpty;
  2073. fPixelSize := 0.0;
  2074. fIsCompressed := false;
  2075. fglFormat := 0;
  2076. fglInternalFormat := 0;
  2077. fglDataFormat := 0;
  2078. FillChar(fRange, 0, SizeOf(fRange));
  2079. FillChar(fShift, 0, SizeOf(fShift));
  2080. end;
  2081. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2082. //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2083. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2084. procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2085. begin
  2086. aData^ := aPixel.Data.a;
  2087. inc(aData);
  2088. end;
  2089. procedure TfdAlpha_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2090. begin
  2091. aPixel.Data.r := 0;
  2092. aPixel.Data.g := 0;
  2093. aPixel.Data.b := 0;
  2094. aPixel.Data.a := aData^;
  2095. inc(aData^);
  2096. end;
  2097. constructor TfdAlpha_UB1.Create;
  2098. begin
  2099. inherited Create;
  2100. fPixelSize := 1.0;
  2101. fRange.a := $FF;
  2102. fglFormat := GL_ALPHA;
  2103. fglDataFormat := GL_UNSIGNED_BYTE;
  2104. end;
  2105. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2106. //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2107. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2108. procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2109. begin
  2110. aData^ := LuminanceWeight(aPixel);
  2111. inc(aData);
  2112. end;
  2113. procedure TfdLuminance_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2114. begin
  2115. aPixel.Data.r := aData^;
  2116. aPixel.Data.g := aData^;
  2117. aPixel.Data.b := aData^;
  2118. aPixel.Data.a := 0;
  2119. inc(aData);
  2120. end;
  2121. constructor TfdLuminance_UB1.Create;
  2122. begin
  2123. inherited Create;
  2124. fPixelSize := 1.0;
  2125. fRange.r := $FF;
  2126. fRange.g := $FF;
  2127. fRange.b := $FF;
  2128. fglFormat := GL_LUMINANCE;
  2129. fglDataFormat := GL_UNSIGNED_BYTE;
  2130. end;
  2131. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2132. //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2133. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2134. procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2135. var
  2136. i: Integer;
  2137. begin
  2138. aData^ := 0;
  2139. for i := 0 to 3 do
  2140. if (fRange.arr[i] > 0) then
  2141. aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2142. inc(aData);
  2143. end;
  2144. procedure TfdUniversal_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2145. var
  2146. i: Integer;
  2147. begin
  2148. for i := 0 to 3 do
  2149. aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
  2150. inc(aData);
  2151. end;
  2152. constructor TfdUniversal_UB1.Create;
  2153. begin
  2154. inherited Create;
  2155. fPixelSize := 1.0;
  2156. end;
  2157. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2158. //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2159. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2160. procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2161. begin
  2162. inherited Map(aPixel, aData, aMapData);
  2163. aData^ := aPixel.Data.a;
  2164. inc(aData);
  2165. end;
  2166. procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2167. begin
  2168. inherited Unmap(aData, aPixel, aMapData);
  2169. aPixel.Data.a := aData^;
  2170. inc(aData);
  2171. end;
  2172. constructor TfdLuminanceAlpha_UB2.Create;
  2173. begin
  2174. inherited Create;
  2175. fPixelSize := 2.0;
  2176. fRange.a := $FF;
  2177. fShift.a := 8;
  2178. fglFormat := GL_LUMINANCE_ALPHA;
  2179. fglDataFormat := GL_UNSIGNED_BYTE;
  2180. end;
  2181. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2182. //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2183. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2184. procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2185. begin
  2186. aData^ := aPixel.Data.r;
  2187. inc(aData);
  2188. aData^ := aPixel.Data.g;
  2189. inc(aData);
  2190. aData^ := aPixel.Data.b;
  2191. inc(aData);
  2192. end;
  2193. procedure TfdRGB_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2194. begin
  2195. aPixel.Data.r := aData^;
  2196. inc(aData);
  2197. aPixel.Data.g := aData^;
  2198. inc(aData);
  2199. aPixel.Data.b := aData^;
  2200. inc(aData);
  2201. aPixel.Data.a := 0;
  2202. end;
  2203. constructor TfdRGB_UB3.Create;
  2204. begin
  2205. inherited Create;
  2206. fPixelSize := 3.0;
  2207. fRange.r := $FF;
  2208. fRange.g := $FF;
  2209. fRange.b := $FF;
  2210. fShift.r := 0;
  2211. fShift.g := 8;
  2212. fShift.b := 16;
  2213. fglFormat := GL_RGB;
  2214. fglDataFormat := GL_UNSIGNED_BYTE;
  2215. end;
  2216. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2217. //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2218. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2219. procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2220. begin
  2221. aData^ := aPixel.Data.b;
  2222. inc(aData);
  2223. aData^ := aPixel.Data.g;
  2224. inc(aData);
  2225. aData^ := aPixel.Data.r;
  2226. inc(aData);
  2227. end;
  2228. procedure TfdBGR_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2229. begin
  2230. aPixel.Data.b := aData^;
  2231. inc(aData);
  2232. aPixel.Data.g := aData^;
  2233. inc(aData);
  2234. aPixel.Data.r := aData^;
  2235. inc(aData);
  2236. aPixel.Data.a := 0;
  2237. end;
  2238. constructor TfdBGR_UB3.Create;
  2239. begin
  2240. fPixelSize := 3.0;
  2241. fRange.r := $FF;
  2242. fRange.g := $FF;
  2243. fRange.b := $FF;
  2244. fShift.r := 16;
  2245. fShift.g := 8;
  2246. fShift.b := 0;
  2247. fglFormat := GL_BGR;
  2248. fglDataFormat := GL_UNSIGNED_BYTE;
  2249. end;
  2250. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2251. //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2252. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2253. procedure TfdRGBA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2254. begin
  2255. inherited Map(aPixel, aData, aMapData);
  2256. aData^ := aPixel.Data.a;
  2257. inc(aData);
  2258. end;
  2259. procedure TfdRGBA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2260. begin
  2261. inherited Unmap(aData, aPixel, aMapData);
  2262. aPixel.Data.a := aData^;
  2263. inc(aData);
  2264. end;
  2265. constructor TfdRGBA_UB4.Create;
  2266. begin
  2267. inherited Create;
  2268. fPixelSize := 4.0;
  2269. fRange.a := $FF;
  2270. fShift.a := 24;
  2271. fglFormat := GL_RGBA;
  2272. fglDataFormat := GL_UNSIGNED_BYTE;
  2273. end;
  2274. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2275. //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2276. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2277. procedure TfdBGRA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2278. begin
  2279. inherited Map(aPixel, aData, aMapData);
  2280. aData^ := aPixel.Data.a;
  2281. inc(aData);
  2282. end;
  2283. procedure TfdBGRA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2284. begin
  2285. inherited Unmap(aData, aPixel, aMapData);
  2286. aPixel.Data.a := aData^;
  2287. inc(aData);
  2288. end;
  2289. constructor TfdBGRA_UB4.Create;
  2290. begin
  2291. inherited Create;
  2292. fPixelSize := 4.0;
  2293. fRange.a := $FF;
  2294. fShift.a := 24;
  2295. fglFormat := GL_BGRA;
  2296. fglDataFormat := GL_UNSIGNED_BYTE;
  2297. end;
  2298. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2299. //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2300. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2301. procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2302. begin
  2303. PWord(aData)^ := aPixel.Data.a;
  2304. inc(aData, 2);
  2305. end;
  2306. procedure TfdAlpha_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2307. begin
  2308. aPixel.Data.r := 0;
  2309. aPixel.Data.g := 0;
  2310. aPixel.Data.b := 0;
  2311. aPixel.Data.a := PWord(aData)^;
  2312. inc(aData, 2);
  2313. end;
  2314. constructor TfdAlpha_US1.Create;
  2315. begin
  2316. inherited Create;
  2317. fPixelSize := 2.0;
  2318. fRange.a := $FFFF;
  2319. fglFormat := GL_ALPHA;
  2320. fglDataFormat := GL_UNSIGNED_SHORT;
  2321. end;
  2322. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2323. //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2324. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2325. procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2326. begin
  2327. PWord(aData)^ := LuminanceWeight(aPixel);
  2328. inc(aData, 2);
  2329. end;
  2330. procedure TfdLuminance_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2331. begin
  2332. aPixel.Data.r := PWord(aData)^;
  2333. aPixel.Data.g := PWord(aData)^;
  2334. aPixel.Data.b := PWord(aData)^;
  2335. aPixel.Data.a := 0;
  2336. inc(aData, 2);
  2337. end;
  2338. constructor TfdLuminance_US1.Create;
  2339. begin
  2340. inherited Create;
  2341. fPixelSize := 2.0;
  2342. fRange.r := $FFFF;
  2343. fRange.g := $FFFF;
  2344. fRange.b := $FFFF;
  2345. fglFormat := GL_LUMINANCE;
  2346. fglDataFormat := GL_UNSIGNED_SHORT;
  2347. end;
  2348. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2349. //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2350. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2351. procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2352. var
  2353. i: Integer;
  2354. begin
  2355. PWord(aData)^ := 0;
  2356. for i := 0 to 3 do
  2357. if (fRange.arr[i] > 0) then
  2358. PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2359. inc(aData, 2);
  2360. end;
  2361. procedure TfdUniversal_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2362. var
  2363. i: Integer;
  2364. begin
  2365. for i := 0 to 3 do
  2366. aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
  2367. inc(aData, 2);
  2368. end;
  2369. constructor TfdUniversal_US1.Create;
  2370. begin
  2371. inherited Create;
  2372. fPixelSize := 2.0;
  2373. end;
  2374. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2375. //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2376. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2377. procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2378. begin
  2379. PWord(aData)^ := DepthWeight(aPixel);
  2380. inc(aData, 2);
  2381. end;
  2382. procedure TfdDepth_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2383. begin
  2384. aPixel.Data.r := PWord(aData)^;
  2385. aPixel.Data.g := PWord(aData)^;
  2386. aPixel.Data.b := PWord(aData)^;
  2387. aPixel.Data.a := 0;
  2388. inc(aData, 2);
  2389. end;
  2390. constructor TfdDepth_US1.Create;
  2391. begin
  2392. inherited Create;
  2393. fPixelSize := 2.0;
  2394. fRange.r := $FFFF;
  2395. fRange.g := $FFFF;
  2396. fRange.b := $FFFF;
  2397. fglFormat := GL_DEPTH_COMPONENT;
  2398. fglDataFormat := GL_UNSIGNED_SHORT;
  2399. end;
  2400. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2401. //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2402. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2403. procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2404. begin
  2405. inherited Map(aPixel, aData, aMapData);
  2406. PWord(aData)^ := aPixel.Data.a;
  2407. inc(aData, 2);
  2408. end;
  2409. procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2410. begin
  2411. inherited Unmap(aData, aPixel, aMapData);
  2412. aPixel.Data.a := PWord(aData)^;
  2413. inc(aData, 2);
  2414. end;
  2415. constructor TfdLuminanceAlpha_US2.Create;
  2416. begin
  2417. inherited Create;
  2418. fPixelSize := 4.0;
  2419. fRange.a := $FFFF;
  2420. fShift.a := 16;
  2421. fglFormat := GL_LUMINANCE_ALPHA;
  2422. fglDataFormat := GL_UNSIGNED_SHORT;
  2423. end;
  2424. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2425. //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2426. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2427. procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2428. begin
  2429. PWord(aData)^ := aPixel.Data.r;
  2430. inc(aData, 2);
  2431. PWord(aData)^ := aPixel.Data.g;
  2432. inc(aData, 2);
  2433. PWord(aData)^ := aPixel.Data.b;
  2434. inc(aData, 2);
  2435. end;
  2436. procedure TfdRGB_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2437. begin
  2438. aPixel.Data.r := PWord(aData)^;
  2439. inc(aData, 2);
  2440. aPixel.Data.g := PWord(aData)^;
  2441. inc(aData, 2);
  2442. aPixel.Data.b := PWord(aData)^;
  2443. inc(aData, 2);
  2444. aPixel.Data.a := 0;
  2445. end;
  2446. constructor TfdRGB_US3.Create;
  2447. begin
  2448. inherited Create;
  2449. fPixelSize := 6.0;
  2450. fRange.r := $FFFF;
  2451. fRange.g := $FFFF;
  2452. fRange.b := $FFFF;
  2453. fShift.r := 0;
  2454. fShift.g := 16;
  2455. fShift.b := 32;
  2456. fglFormat := GL_RGB;
  2457. fglDataFormat := GL_UNSIGNED_SHORT;
  2458. end;
  2459. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2460. //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2461. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2462. procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2463. begin
  2464. PWord(aData)^ := aPixel.Data.b;
  2465. inc(aData, 2);
  2466. PWord(aData)^ := aPixel.Data.g;
  2467. inc(aData, 2);
  2468. PWord(aData)^ := aPixel.Data.r;
  2469. inc(aData, 2);
  2470. end;
  2471. procedure TfdBGR_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2472. begin
  2473. aPixel.Data.b := PWord(aData)^;
  2474. inc(aData, 2);
  2475. aPixel.Data.g := PWord(aData)^;
  2476. inc(aData, 2);
  2477. aPixel.Data.r := PWord(aData)^;
  2478. inc(aData, 2);
  2479. aPixel.Data.a := 0;
  2480. end;
  2481. constructor TfdBGR_US3.Create;
  2482. begin
  2483. inherited Create;
  2484. fPixelSize := 6.0;
  2485. fRange.r := $FFFF;
  2486. fRange.g := $FFFF;
  2487. fRange.b := $FFFF;
  2488. fShift.r := 32;
  2489. fShift.g := 16;
  2490. fShift.b := 0;
  2491. fglFormat := GL_BGR;
  2492. fglDataFormat := GL_UNSIGNED_SHORT;
  2493. end;
  2494. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2495. //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2496. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2497. procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2498. begin
  2499. inherited Map(aPixel, aData, aMapData);
  2500. PWord(aData)^ := aPixel.Data.a;
  2501. inc(aData, 2);
  2502. end;
  2503. procedure TfdRGBA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2504. begin
  2505. inherited Unmap(aData, aPixel, aMapData);
  2506. aPixel.Data.a := PWord(aData)^;
  2507. inc(aData, 2);
  2508. end;
  2509. constructor TfdRGBA_US4.Create;
  2510. begin
  2511. inherited Create;
  2512. fPixelSize := 8.0;
  2513. fRange.a := $FFFF;
  2514. fShift.a := 48;
  2515. fglFormat := GL_RGBA;
  2516. fglDataFormat := GL_UNSIGNED_SHORT;
  2517. end;
  2518. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2519. //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2520. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2521. procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2522. begin
  2523. inherited Map(aPixel, aData, aMapData);
  2524. PWord(aData)^ := aPixel.Data.a;
  2525. inc(aData, 2);
  2526. end;
  2527. procedure TfdBGRA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2528. begin
  2529. inherited Unmap(aData, aPixel, aMapData);
  2530. aPixel.Data.a := PWord(aData)^;
  2531. inc(aData, 2);
  2532. end;
  2533. constructor TfdBGRA_US4.Create;
  2534. begin
  2535. inherited Create;
  2536. fPixelSize := 8.0;
  2537. fRange.a := $FFFF;
  2538. fShift.a := 48;
  2539. fglFormat := GL_BGRA;
  2540. fglDataFormat := GL_UNSIGNED_SHORT;
  2541. end;
  2542. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2543. //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2544. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2545. procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2546. var
  2547. i: Integer;
  2548. begin
  2549. PCardinal(aData)^ := 0;
  2550. for i := 0 to 3 do
  2551. if (fRange.arr[i] > 0) then
  2552. PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2553. inc(aData, 4);
  2554. end;
  2555. procedure TfdUniversal_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2556. var
  2557. i: Integer;
  2558. begin
  2559. for i := 0 to 3 do
  2560. aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
  2561. inc(aData, 2);
  2562. end;
  2563. constructor TfdUniversal_UI1.Create;
  2564. begin
  2565. inherited Create;
  2566. fPixelSize := 4.0;
  2567. end;
  2568. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2569. //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2570. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2571. procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2572. begin
  2573. PCardinal(aData)^ := DepthWeight(aPixel);
  2574. inc(aData, 4);
  2575. end;
  2576. procedure TfdDepth_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2577. begin
  2578. aPixel.Data.r := PCardinal(aData)^;
  2579. aPixel.Data.g := PCardinal(aData)^;
  2580. aPixel.Data.b := PCardinal(aData)^;
  2581. aPixel.Data.a := 0;
  2582. inc(aData, 4);
  2583. end;
  2584. constructor TfdDepth_UI1.Create;
  2585. begin
  2586. inherited Create;
  2587. fPixelSize := 4.0;
  2588. fRange.r := $FFFFFFFF;
  2589. fRange.g := $FFFFFFFF;
  2590. fRange.b := $FFFFFFFF;
  2591. fglFormat := GL_DEPTH_COMPONENT;
  2592. fglDataFormat := GL_UNSIGNED_INT;
  2593. end;
  2594. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2595. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2596. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2597. constructor TfdAlpha4.Create;
  2598. begin
  2599. inherited Create;
  2600. fFormat := tfAlpha4;
  2601. fWithAlpha := tfAlpha4;
  2602. fglInternalFormat := GL_ALPHA4;
  2603. end;
  2604. constructor TfdAlpha8.Create;
  2605. begin
  2606. inherited Create;
  2607. fFormat := tfAlpha8;
  2608. fWithAlpha := tfAlpha8;
  2609. fglInternalFormat := GL_ALPHA8;
  2610. end;
  2611. constructor TfdAlpha12.Create;
  2612. begin
  2613. inherited Create;
  2614. fFormat := tfAlpha12;
  2615. fWithAlpha := tfAlpha12;
  2616. fglInternalFormat := GL_ALPHA12;
  2617. end;
  2618. constructor TfdAlpha16.Create;
  2619. begin
  2620. inherited Create;
  2621. fFormat := tfAlpha16;
  2622. fWithAlpha := tfAlpha16;
  2623. fglInternalFormat := GL_ALPHA16;
  2624. end;
  2625. constructor TfdLuminance4.Create;
  2626. begin
  2627. inherited Create;
  2628. fFormat := tfLuminance4;
  2629. fWithAlpha := tfLuminance4Alpha4;
  2630. fWithoutAlpha := tfLuminance4;
  2631. fglInternalFormat := GL_LUMINANCE4;
  2632. end;
  2633. constructor TfdLuminance8.Create;
  2634. begin
  2635. inherited Create;
  2636. fFormat := tfLuminance8;
  2637. fWithAlpha := tfLuminance8Alpha8;
  2638. fWithoutAlpha := tfLuminance8;
  2639. fglInternalFormat := GL_LUMINANCE8;
  2640. end;
  2641. constructor TfdLuminance12.Create;
  2642. begin
  2643. inherited Create;
  2644. fFormat := tfLuminance12;
  2645. fWithAlpha := tfLuminance12Alpha12;
  2646. fWithoutAlpha := tfLuminance12;
  2647. fglInternalFormat := GL_LUMINANCE12;
  2648. end;
  2649. constructor TfdLuminance16.Create;
  2650. begin
  2651. inherited Create;
  2652. fFormat := tfLuminance16;
  2653. fWithAlpha := tfLuminance16Alpha16;
  2654. fWithoutAlpha := tfLuminance16;
  2655. fglInternalFormat := GL_LUMINANCE16;
  2656. end;
  2657. constructor TfdLuminance4Alpha4.Create;
  2658. begin
  2659. inherited Create;
  2660. fFormat := tfLuminance4Alpha4;
  2661. fWithAlpha := tfLuminance4Alpha4;
  2662. fWithoutAlpha := tfLuminance4;
  2663. fglInternalFormat := GL_LUMINANCE4_ALPHA4;
  2664. end;
  2665. constructor TfdLuminance6Alpha2.Create;
  2666. begin
  2667. inherited Create;
  2668. fFormat := tfLuminance6Alpha2;
  2669. fWithAlpha := tfLuminance6Alpha2;
  2670. fWithoutAlpha := tfLuminance8;
  2671. fglInternalFormat := GL_LUMINANCE6_ALPHA2;
  2672. end;
  2673. constructor TfdLuminance8Alpha8.Create;
  2674. begin
  2675. inherited Create;
  2676. fFormat := tfLuminance8Alpha8;
  2677. fWithAlpha := tfLuminance8Alpha8;
  2678. fWithoutAlpha := tfLuminance8;
  2679. fglInternalFormat := GL_LUMINANCE8_ALPHA8;
  2680. end;
  2681. constructor TfdLuminance12Alpha4.Create;
  2682. begin
  2683. inherited Create;
  2684. fFormat := tfLuminance12Alpha4;
  2685. fWithAlpha := tfLuminance12Alpha4;
  2686. fWithoutAlpha := tfLuminance12;
  2687. fglInternalFormat := GL_LUMINANCE12_ALPHA4;
  2688. end;
  2689. constructor TfdLuminance12Alpha12.Create;
  2690. begin
  2691. inherited Create;
  2692. fFormat := tfLuminance12Alpha12;
  2693. fWithAlpha := tfLuminance12Alpha12;
  2694. fWithoutAlpha := tfLuminance12;
  2695. fglInternalFormat := GL_LUMINANCE12_ALPHA12;
  2696. end;
  2697. constructor TfdLuminance16Alpha16.Create;
  2698. begin
  2699. inherited Create;
  2700. fFormat := tfLuminance16Alpha16;
  2701. fWithAlpha := tfLuminance16Alpha16;
  2702. fWithoutAlpha := tfLuminance16;
  2703. fglInternalFormat := GL_LUMINANCE16_ALPHA16;
  2704. end;
  2705. constructor TfdR3G3B2.Create;
  2706. begin
  2707. inherited Create;
  2708. fFormat := tfR3G3B2;
  2709. fWithAlpha := tfRGBA2;
  2710. fWithoutAlpha := tfR3G3B2;
  2711. fRange.r := $7;
  2712. fRange.g := $7;
  2713. fRange.b := $3;
  2714. fShift.r := 0;
  2715. fShift.g := 3;
  2716. fShift.b := 6;
  2717. fglFormat := GL_RGB;
  2718. fglInternalFormat := GL_R3_G3_B2;
  2719. fglDataFormat := GL_UNSIGNED_BYTE_2_3_3_REV;
  2720. end;
  2721. constructor TfdRGB4.Create;
  2722. begin
  2723. inherited Create;
  2724. fFormat := tfRGB4;
  2725. fWithAlpha := tfRGBA4;
  2726. fWithoutAlpha := tfRGB4;
  2727. fRGBInverted := tfBGR4;
  2728. fRange.r := $F;
  2729. fRange.g := $F;
  2730. fRange.b := $F;
  2731. fShift.r := 0;
  2732. fShift.g := 4;
  2733. fShift.b := 8;
  2734. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2735. fglInternalFormat := GL_RGB4;
  2736. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2737. end;
  2738. constructor TfdR5G6B5.Create;
  2739. begin
  2740. inherited Create;
  2741. fFormat := tfR5G6B5;
  2742. fWithAlpha := tfRGBA4;
  2743. fWithoutAlpha := tfR5G6B5;
  2744. fRGBInverted := tfB5G6R5;
  2745. fRange.r := $1F;
  2746. fRange.g := $3F;
  2747. fRange.b := $1F;
  2748. fShift.r := 0;
  2749. fShift.g := 5;
  2750. fShift.b := 11;
  2751. fglFormat := GL_RGB;
  2752. fglInternalFormat := GL_RGB565;
  2753. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5_REV;
  2754. end;
  2755. constructor TfdRGB5.Create;
  2756. begin
  2757. inherited Create;
  2758. fFormat := tfRGB5;
  2759. fWithAlpha := tfRGB5A1;
  2760. fWithoutAlpha := tfRGB5;
  2761. fRGBInverted := tfBGR5;
  2762. fRange.r := $1F;
  2763. fRange.g := $1F;
  2764. fRange.b := $1F;
  2765. fShift.r := 0;
  2766. fShift.g := 5;
  2767. fShift.b := 10;
  2768. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2769. fglInternalFormat := GL_RGB5;
  2770. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2771. end;
  2772. constructor TfdRGB8.Create;
  2773. begin
  2774. inherited Create;
  2775. fFormat := tfRGB8;
  2776. fWithAlpha := tfRGBA8;
  2777. fWithoutAlpha := tfRGB8;
  2778. fRGBInverted := tfBGR8;
  2779. fglInternalFormat := GL_RGB8;
  2780. end;
  2781. constructor TfdRGB10.Create;
  2782. begin
  2783. inherited Create;
  2784. fFormat := tfRGB10;
  2785. fWithAlpha := tfRGB10A2;
  2786. fWithoutAlpha := tfRGB10;
  2787. fRGBInverted := tfBGR10;
  2788. fRange.r := $3FF;
  2789. fRange.g := $3FF;
  2790. fRange.b := $3FF;
  2791. fShift.r := 0;
  2792. fShift.g := 10;
  2793. fShift.b := 20;
  2794. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2795. fglInternalFormat := GL_RGB10;
  2796. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2797. end;
  2798. constructor TfdRGB12.Create;
  2799. begin
  2800. inherited Create;
  2801. fFormat := tfRGB12;
  2802. fWithAlpha := tfRGBA12;
  2803. fWithoutAlpha := tfRGB12;
  2804. fRGBInverted := tfBGR12;
  2805. fglInternalFormat := GL_RGB12;
  2806. end;
  2807. constructor TfdRGB16.Create;
  2808. begin
  2809. inherited Create;
  2810. fFormat := tfRGB16;
  2811. fWithAlpha := tfRGBA16;
  2812. fWithoutAlpha := tfRGB16;
  2813. fRGBInverted := tfBGR16;
  2814. fglInternalFormat := GL_RGB16;
  2815. end;
  2816. constructor TfdRGBA2.Create;
  2817. begin
  2818. inherited Create;
  2819. fFormat := tfRGBA2;
  2820. fWithAlpha := tfRGBA2;
  2821. fWithoutAlpha := tfR3G3B2;
  2822. fRGBInverted := tfBGRA2;
  2823. fglInternalFormat := GL_RGBA2;
  2824. end;
  2825. constructor TfdRGBA4.Create;
  2826. begin
  2827. inherited Create;
  2828. fFormat := tfRGBA4;
  2829. fWithAlpha := tfRGBA4;
  2830. fWithoutAlpha := tfRGB4;
  2831. fRGBInverted := tfBGRA4;
  2832. fRange.r := $F;
  2833. fRange.g := $F;
  2834. fRange.b := $F;
  2835. fRange.a := $F;
  2836. fShift.r := 0;
  2837. fShift.g := 4;
  2838. fShift.b := 8;
  2839. fShift.a := 12;
  2840. fglFormat := GL_RGBA;
  2841. fglInternalFormat := GL_RGBA4;
  2842. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2843. end;
  2844. constructor TfdRGB5A1.Create;
  2845. begin
  2846. inherited Create;
  2847. fFormat := tfRGB5A1;
  2848. fWithAlpha := tfRGB5A1;
  2849. fWithoutAlpha := tfRGB5;
  2850. fRGBInverted := tfBGR5A1;
  2851. fRange.r := $1F;
  2852. fRange.g := $1F;
  2853. fRange.b := $1F;
  2854. fRange.a := $01;
  2855. fShift.r := 0;
  2856. fShift.g := 5;
  2857. fShift.b := 10;
  2858. fShift.a := 15;
  2859. fglFormat := GL_RGBA;
  2860. fglInternalFormat := GL_RGB5_A1;
  2861. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2862. end;
  2863. constructor TfdRGBA8.Create;
  2864. begin
  2865. inherited Create;
  2866. fFormat := tfRGBA8;
  2867. fWithAlpha := tfRGBA8;
  2868. fWithoutAlpha := tfRGB8;
  2869. fRGBInverted := tfBGRA8;
  2870. fglInternalFormat := GL_RGBA8;
  2871. end;
  2872. constructor TfdRGB10A2.Create;
  2873. begin
  2874. inherited Create;
  2875. fFormat := tfRGB10A2;
  2876. fWithAlpha := tfRGB10A2;
  2877. fWithoutAlpha := tfRGB10;
  2878. fRGBInverted := tfBGR10A2;
  2879. fRange.r := $3FF;
  2880. fRange.g := $3FF;
  2881. fRange.b := $3FF;
  2882. fRange.a := $003;
  2883. fShift.r := 0;
  2884. fShift.g := 10;
  2885. fShift.b := 20;
  2886. fShift.a := 30;
  2887. fglFormat := GL_RGBA;
  2888. fglInternalFormat := GL_RGB10_A2;
  2889. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2890. end;
  2891. constructor TfdRGBA12.Create;
  2892. begin
  2893. inherited Create;
  2894. fFormat := tfRGBA12;
  2895. fWithAlpha := tfRGBA12;
  2896. fWithoutAlpha := tfRGB12;
  2897. fRGBInverted := tfBGRA12;
  2898. fglInternalFormat := GL_RGBA12;
  2899. end;
  2900. constructor TfdRGBA16.Create;
  2901. begin
  2902. inherited Create;
  2903. fFormat := tfRGBA16;
  2904. fWithAlpha := tfRGBA16;
  2905. fWithoutAlpha := tfRGB16;
  2906. fRGBInverted := tfBGRA16;
  2907. fglInternalFormat := GL_RGBA16;
  2908. end;
  2909. constructor TfdBGR4.Create;
  2910. begin
  2911. inherited Create;
  2912. fPixelSize := 2.0;
  2913. fFormat := tfBGR4;
  2914. fWithAlpha := tfBGRA4;
  2915. fWithoutAlpha := tfBGR4;
  2916. fRGBInverted := tfRGB4;
  2917. fRange.r := $F;
  2918. fRange.g := $F;
  2919. fRange.b := $F;
  2920. fRange.a := $0;
  2921. fShift.r := 8;
  2922. fShift.g := 4;
  2923. fShift.b := 0;
  2924. fShift.a := 0;
  2925. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2926. fglInternalFormat := GL_RGB4;
  2927. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2928. end;
  2929. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2930. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2931. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2932. constructor TfdB5G6R5.Create;
  2933. begin
  2934. inherited Create;
  2935. fFormat := tfB5G6R5;
  2936. fWithAlpha := tfBGRA4;
  2937. fWithoutAlpha := tfB5G6R5;
  2938. fRGBInverted := tfR5G6B5;
  2939. fRange.r := $1F;
  2940. fRange.g := $3F;
  2941. fRange.b := $1F;
  2942. fShift.r := 11;
  2943. fShift.g := 5;
  2944. fShift.b := 0;
  2945. fglFormat := GL_RGB; //B5G6R5 is only possible as R5G6B5 -> use reverted dataformat
  2946. fglInternalFormat := GL_RGB8;
  2947. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5;
  2948. end;
  2949. constructor TfdBGR5.Create;
  2950. begin
  2951. inherited Create;
  2952. fPixelSize := 2.0;
  2953. fFormat := tfBGR5;
  2954. fWithAlpha := tfBGR5A1;
  2955. fWithoutAlpha := tfBGR5;
  2956. fRGBInverted := tfRGB5;
  2957. fRange.r := $1F;
  2958. fRange.g := $1F;
  2959. fRange.b := $1F;
  2960. fRange.a := $00;
  2961. fShift.r := 10;
  2962. fShift.g := 5;
  2963. fShift.b := 0;
  2964. fShift.a := 0;
  2965. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2966. fglInternalFormat := GL_RGB5;
  2967. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2968. end;
  2969. constructor TfdBGR8.Create;
  2970. begin
  2971. inherited Create;
  2972. fFormat := tfBGR8;
  2973. fWithAlpha := tfBGRA8;
  2974. fWithoutAlpha := tfBGR8;
  2975. fRGBInverted := tfRGB8;
  2976. fglInternalFormat := GL_RGB8;
  2977. end;
  2978. constructor TfdBGR10.Create;
  2979. begin
  2980. inherited Create;
  2981. fFormat := tfBGR10;
  2982. fWithAlpha := tfBGR10A2;
  2983. fWithoutAlpha := tfBGR10;
  2984. fRGBInverted := tfRGB10;
  2985. fRange.r := $3FF;
  2986. fRange.g := $3FF;
  2987. fRange.b := $3FF;
  2988. fRange.a := $000;
  2989. fShift.r := 20;
  2990. fShift.g := 10;
  2991. fShift.b := 0;
  2992. fShift.a := 0;
  2993. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2994. fglInternalFormat := GL_RGB10;
  2995. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2996. end;
  2997. constructor TfdBGR12.Create;
  2998. begin
  2999. inherited Create;
  3000. fFormat := tfBGR12;
  3001. fWithAlpha := tfBGRA12;
  3002. fWithoutAlpha := tfBGR12;
  3003. fRGBInverted := tfRGB12;
  3004. fglInternalFormat := GL_RGB12;
  3005. end;
  3006. constructor TfdBGR16.Create;
  3007. begin
  3008. inherited Create;
  3009. fFormat := tfBGR16;
  3010. fWithAlpha := tfBGRA16;
  3011. fWithoutAlpha := tfBGR16;
  3012. fRGBInverted := tfRGB16;
  3013. fglInternalFormat := GL_RGB16;
  3014. end;
  3015. constructor TfdBGRA2.Create;
  3016. begin
  3017. inherited Create;
  3018. fFormat := tfBGRA2;
  3019. fWithAlpha := tfBGRA4;
  3020. fWithoutAlpha := tfBGR4;
  3021. fRGBInverted := tfRGBA2;
  3022. fglInternalFormat := GL_RGBA2;
  3023. end;
  3024. constructor TfdBGRA4.Create;
  3025. begin
  3026. inherited Create;
  3027. fFormat := tfBGRA4;
  3028. fWithAlpha := tfBGRA4;
  3029. fWithoutAlpha := tfBGR4;
  3030. fRGBInverted := tfRGBA4;
  3031. fRange.r := $F;
  3032. fRange.g := $F;
  3033. fRange.b := $F;
  3034. fRange.a := $F;
  3035. fShift.r := 8;
  3036. fShift.g := 4;
  3037. fShift.b := 0;
  3038. fShift.a := 12;
  3039. fglFormat := GL_BGRA;
  3040. fglInternalFormat := GL_RGBA4;
  3041. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  3042. end;
  3043. constructor TfdBGR5A1.Create;
  3044. begin
  3045. inherited Create;
  3046. fFormat := tfBGR5A1;
  3047. fWithAlpha := tfBGR5A1;
  3048. fWithoutAlpha := tfBGR5;
  3049. fRGBInverted := tfRGB5A1;
  3050. fRange.r := $1F;
  3051. fRange.g := $1F;
  3052. fRange.b := $1F;
  3053. fRange.a := $01;
  3054. fShift.r := 10;
  3055. fShift.g := 5;
  3056. fShift.b := 0;
  3057. fShift.a := 15;
  3058. fglFormat := GL_BGRA;
  3059. fglInternalFormat := GL_RGB5_A1;
  3060. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  3061. end;
  3062. constructor TfdBGRA8.Create;
  3063. begin
  3064. inherited Create;
  3065. fFormat := tfBGRA8;
  3066. fWithAlpha := tfBGRA8;
  3067. fWithoutAlpha := tfBGR8;
  3068. fRGBInverted := tfRGBA8;
  3069. fglInternalFormat := GL_RGBA8;
  3070. end;
  3071. constructor TfdBGR10A2.Create;
  3072. begin
  3073. inherited Create;
  3074. fFormat := tfBGR10A2;
  3075. fWithAlpha := tfBGR10A2;
  3076. fWithoutAlpha := tfBGR10;
  3077. fRGBInverted := tfRGB10A2;
  3078. fRange.r := $3FF;
  3079. fRange.g := $3FF;
  3080. fRange.b := $3FF;
  3081. fRange.a := $003;
  3082. fShift.r := 20;
  3083. fShift.g := 10;
  3084. fShift.b := 0;
  3085. fShift.a := 30;
  3086. fglFormat := GL_BGRA;
  3087. fglInternalFormat := GL_RGB10_A2;
  3088. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3089. end;
  3090. constructor TfdBGRA12.Create;
  3091. begin
  3092. inherited Create;
  3093. fFormat := tfBGRA12;
  3094. fWithAlpha := tfBGRA12;
  3095. fWithoutAlpha := tfBGR12;
  3096. fRGBInverted := tfRGBA12;
  3097. fglInternalFormat := GL_RGBA12;
  3098. end;
  3099. constructor TfdBGRA16.Create;
  3100. begin
  3101. inherited Create;
  3102. fFormat := tfBGRA16;
  3103. fWithAlpha := tfBGRA16;
  3104. fWithoutAlpha := tfBGR16;
  3105. fRGBInverted := tfRGBA16;
  3106. fglInternalFormat := GL_RGBA16;
  3107. end;
  3108. constructor TfdDepth16.Create;
  3109. begin
  3110. inherited Create;
  3111. fFormat := tfDepth16;
  3112. fWithAlpha := tfEmpty;
  3113. fWithoutAlpha := tfDepth16;
  3114. fglInternalFormat := GL_DEPTH_COMPONENT16;
  3115. end;
  3116. constructor TfdDepth24.Create;
  3117. begin
  3118. inherited Create;
  3119. fFormat := tfDepth24;
  3120. fWithAlpha := tfEmpty;
  3121. fWithoutAlpha := tfDepth24;
  3122. fglInternalFormat := GL_DEPTH_COMPONENT24;
  3123. end;
  3124. constructor TfdDepth32.Create;
  3125. begin
  3126. inherited Create;
  3127. fFormat := tfDepth32;
  3128. fWithAlpha := tfEmpty;
  3129. fWithoutAlpha := tfDepth32;
  3130. fglInternalFormat := GL_DEPTH_COMPONENT32;
  3131. end;
  3132. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3133. //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3134. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3135. procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3136. begin
  3137. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  3138. end;
  3139. procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3140. begin
  3141. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  3142. end;
  3143. constructor TfdS3tcDtx1RGBA.Create;
  3144. begin
  3145. inherited Create;
  3146. fFormat := tfS3tcDtx1RGBA;
  3147. fWithAlpha := tfS3tcDtx1RGBA;
  3148. fUncompressed := tfRGB5A1;
  3149. fPixelSize := 0.5;
  3150. fIsCompressed := true;
  3151. fglFormat := GL_COMPRESSED_RGBA;
  3152. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
  3153. fglDataFormat := GL_UNSIGNED_BYTE;
  3154. end;
  3155. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3156. //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3157. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3158. procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3159. begin
  3160. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  3161. end;
  3162. procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3163. begin
  3164. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  3165. end;
  3166. constructor TfdS3tcDtx3RGBA.Create;
  3167. begin
  3168. inherited Create;
  3169. fFormat := tfS3tcDtx3RGBA;
  3170. fWithAlpha := tfS3tcDtx3RGBA;
  3171. fUncompressed := tfRGBA8;
  3172. fPixelSize := 1.0;
  3173. fIsCompressed := true;
  3174. fglFormat := GL_COMPRESSED_RGBA;
  3175. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
  3176. fglDataFormat := GL_UNSIGNED_BYTE;
  3177. end;
  3178. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3179. //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3180. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3181. procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3182. begin
  3183. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  3184. end;
  3185. procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3186. begin
  3187. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  3188. end;
  3189. constructor TfdS3tcDtx5RGBA.Create;
  3190. begin
  3191. inherited Create;
  3192. fFormat := tfS3tcDtx3RGBA;
  3193. fWithAlpha := tfS3tcDtx3RGBA;
  3194. fUncompressed := tfRGBA8;
  3195. fPixelSize := 1.0;
  3196. fIsCompressed := true;
  3197. fglFormat := GL_COMPRESSED_RGBA;
  3198. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
  3199. fglDataFormat := GL_UNSIGNED_BYTE;
  3200. end;
  3201. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3202. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3203. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3204. class procedure TFormatDescriptor.Init;
  3205. begin
  3206. if not Assigned(FormatDescriptorCS) then
  3207. FormatDescriptorCS := TCriticalSection.Create;
  3208. end;
  3209. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3210. class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3211. begin
  3212. FormatDescriptorCS.Enter;
  3213. try
  3214. result := FormatDescriptors[aFormat];
  3215. if not Assigned(result) then begin
  3216. result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
  3217. FormatDescriptors[aFormat] := result;
  3218. end;
  3219. finally
  3220. FormatDescriptorCS.Leave;
  3221. end;
  3222. end;
  3223. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3224. class function TFormatDescriptor.GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3225. begin
  3226. result := Get(Get(aFormat).WithAlpha);
  3227. end;
  3228. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3229. class procedure TFormatDescriptor.Clear;
  3230. var
  3231. f: TglBitmapFormat;
  3232. begin
  3233. FormatDescriptorCS.Enter;
  3234. try
  3235. for f := low(FormatDescriptors) to high(FormatDescriptors) do
  3236. FreeAndNil(FormatDescriptors[f]);
  3237. finally
  3238. FormatDescriptorCS.Leave;
  3239. end;
  3240. end;
  3241. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3242. class procedure TFormatDescriptor.Finalize;
  3243. begin
  3244. Clear;
  3245. FreeAndNil(FormatDescriptorCS);
  3246. end;
  3247. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3248. //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3249. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3250. procedure TbmpBitfieldFormat.SetRedMask(const aValue: QWord);
  3251. begin
  3252. Update(aValue, fRange.r, fShift.r);
  3253. end;
  3254. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3255. procedure TbmpBitfieldFormat.SetGreenMask(const aValue: QWord);
  3256. begin
  3257. Update(aValue, fRange.g, fShift.g);
  3258. end;
  3259. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3260. procedure TbmpBitfieldFormat.SetBlueMask(const aValue: QWord);
  3261. begin
  3262. Update(aValue, fRange.b, fShift.b);
  3263. end;
  3264. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3265. procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: QWord);
  3266. begin
  3267. Update(aValue, fRange.a, fShift.a);
  3268. end;
  3269. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3270. procedure TbmpBitfieldFormat.Update(aMask: QWord; out aRange: Cardinal; out
  3271. aShift: Byte);
  3272. begin
  3273. aShift := 0;
  3274. aRange := 0;
  3275. if (aMask = 0) then
  3276. exit;
  3277. while (aMask > 0) and ((aMask and 1) = 0) do begin
  3278. inc(aShift);
  3279. aMask := aMask shr 1;
  3280. end;
  3281. aRange := 1;
  3282. while (aMask > 0) do begin
  3283. aRange := aRange shl 1;
  3284. aMask := aMask shr 1;
  3285. end;
  3286. dec(aRange);
  3287. fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
  3288. end;
  3289. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3290. procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3291. var
  3292. data: QWord;
  3293. s: Integer;
  3294. begin
  3295. data :=
  3296. ((aPixel.Data.r and fRange.r) shl fShift.r) or
  3297. ((aPixel.Data.g and fRange.g) shl fShift.g) or
  3298. ((aPixel.Data.b and fRange.b) shl fShift.b) or
  3299. ((aPixel.Data.a and fRange.a) shl fShift.a);
  3300. s := Round(fPixelSize);
  3301. case s of
  3302. 1: aData^ := data;
  3303. 2: PWord(aData)^ := data;
  3304. 4: PCardinal(aData)^ := data;
  3305. 8: PQWord(aData)^ := data;
  3306. else
  3307. raise EglBitmapException.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
  3308. end;
  3309. inc(aData, s);
  3310. end;
  3311. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3312. procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3313. var
  3314. data: QWord;
  3315. s, i: Integer;
  3316. begin
  3317. s := Round(fPixelSize);
  3318. case s of
  3319. 1: data := aData^;
  3320. 2: data := PWord(aData)^;
  3321. 4: data := PCardinal(aData)^;
  3322. 8: data := PQWord(aData)^;
  3323. else
  3324. raise EglBitmapException.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
  3325. end;
  3326. for i := 0 to 3 do
  3327. aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
  3328. inc(aData, s);
  3329. end;
  3330. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3331. //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3332. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3333. procedure TbmpColorTableFormat.CreateColorTable;
  3334. var
  3335. i: Integer;
  3336. begin
  3337. if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
  3338. raise EglBitmapException.Create(UNSUPPORTED_FORMAT);
  3339. if (Format = tfLuminance4) then
  3340. SetLength(fColorTable, 16)
  3341. else
  3342. SetLength(fColorTable, 256);
  3343. case Format of
  3344. tfLuminance4: begin
  3345. for i := 0 to High(fColorTable) do begin
  3346. fColorTable[i].r := 16 * i;
  3347. fColorTable[i].g := 16 * i;
  3348. fColorTable[i].b := 16 * i;
  3349. fColorTable[i].a := 0;
  3350. end;
  3351. end;
  3352. tfLuminance8: begin
  3353. for i := 0 to High(fColorTable) do begin
  3354. fColorTable[i].r := i;
  3355. fColorTable[i].g := i;
  3356. fColorTable[i].b := i;
  3357. fColorTable[i].a := 0;
  3358. end;
  3359. end;
  3360. tfR3G3B2: begin
  3361. for i := 0 to High(fColorTable) do begin
  3362. fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
  3363. fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
  3364. fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
  3365. fColorTable[i].a := 0;
  3366. end;
  3367. end;
  3368. end;
  3369. end;
  3370. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3371. procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3372. var
  3373. d: Byte;
  3374. begin
  3375. if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
  3376. raise EglBitmapException.Create(UNSUPPORTED_FORMAT);
  3377. case Format of
  3378. tfLuminance4: begin
  3379. if (aMapData = nil) then
  3380. aData^ := 0;
  3381. d := LuminanceWeight(aPixel) and Range.r;
  3382. aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData)));
  3383. inc(aMapData, 4);
  3384. if ({%H-}PtrUInt(aMapData) >= 8) then begin
  3385. inc(aData);
  3386. aMapData := nil;
  3387. end;
  3388. end;
  3389. tfLuminance8: begin
  3390. aData^ := LuminanceWeight(aPixel) and Range.r;
  3391. inc(aData);
  3392. end;
  3393. tfR3G3B2: begin
  3394. aData^ := Round(
  3395. ((aPixel.Data.r and Range.r) shl Shift.r) or
  3396. ((aPixel.Data.g and Range.g) shl Shift.g) or
  3397. ((aPixel.Data.b and Range.b) shl Shift.b));
  3398. inc(aData);
  3399. end;
  3400. end;
  3401. end;
  3402. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3403. procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3404. var
  3405. idx: QWord;
  3406. s: Integer;
  3407. bits: Byte;
  3408. f: Single;
  3409. begin
  3410. s := Trunc(fPixelSize);
  3411. f := fPixelSize - s;
  3412. bits := Round(8 * f);
  3413. case s of
  3414. 0: idx := (aData^ shr (8 - bits - {%H-}PtrUInt(aMapData))) and ((1 shl bits) - 1);
  3415. 1: idx := aData^;
  3416. 2: idx := PWord(aData)^;
  3417. 4: idx := PCardinal(aData)^;
  3418. 8: idx := PQWord(aData)^;
  3419. else
  3420. raise EglBitmapException.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
  3421. end;
  3422. if (idx >= Length(fColorTable)) then
  3423. raise EglBitmapException.CreateFmt('invalid color index: %d', [idx]);
  3424. with fColorTable[idx] do begin
  3425. aPixel.Data.r := r;
  3426. aPixel.Data.g := g;
  3427. aPixel.Data.b := b;
  3428. aPixel.Data.a := a;
  3429. end;
  3430. inc(aMapData, bits);
  3431. if ({%H-}PtrUInt(aMapData) >= 8) then begin
  3432. inc(aData, 1);
  3433. dec(aMapData, 8);
  3434. end;
  3435. inc(aData, s);
  3436. end;
  3437. destructor TbmpColorTableFormat.Destroy;
  3438. begin
  3439. SetLength(fColorTable, 0);
  3440. inherited Destroy;
  3441. end;
  3442. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3443. //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3444. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3445. procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
  3446. var
  3447. i: Integer;
  3448. begin
  3449. for i := 0 to 3 do begin
  3450. if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
  3451. if (aSourceFD.Range.arr[i] > 0) then
  3452. aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
  3453. else
  3454. aPixel.Data.arr[i] := aDestFD.Range.arr[i];
  3455. end;
  3456. end;
  3457. end;
  3458. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3459. procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
  3460. begin
  3461. with aFuncRec do begin
  3462. if (Source.Range.r > 0) then
  3463. Dest.Data.r := Source.Data.r;
  3464. if (Source.Range.g > 0) then
  3465. Dest.Data.g := Source.Data.g;
  3466. if (Source.Range.b > 0) then
  3467. Dest.Data.b := Source.Data.b;
  3468. if (Source.Range.a > 0) then
  3469. Dest.Data.a := Source.Data.a;
  3470. end;
  3471. end;
  3472. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3473. procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3474. var
  3475. i: Integer;
  3476. begin
  3477. with aFuncRec do begin
  3478. for i := 0 to 3 do
  3479. if (Source.Range.arr[i] > 0) then
  3480. Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
  3481. end;
  3482. end;
  3483. type
  3484. TShiftData = packed record
  3485. case Integer of
  3486. 0: (r, g, b, a: SmallInt);
  3487. 1: (arr: array[0..3] of SmallInt);
  3488. end;
  3489. PShiftData = ^TShiftData;
  3490. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3491. procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3492. var
  3493. i: Integer;
  3494. begin
  3495. with aFuncRec do
  3496. for i := 0 to 3 do
  3497. if (Source.Range.arr[i] > 0) then
  3498. Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
  3499. end;
  3500. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3501. procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
  3502. begin
  3503. with aFuncRec do begin
  3504. Dest.Data := Source.Data;
  3505. if ({%H-}PtrUInt(Args) and $1 > 0) then begin
  3506. Dest.Data.r := Dest.Data.r xor Dest.Range.r;
  3507. Dest.Data.g := Dest.Data.g xor Dest.Range.g;
  3508. Dest.Data.b := Dest.Data.b xor Dest.Range.b;
  3509. end;
  3510. if ({%H-}PtrUInt(Args) and $2 > 0) then begin
  3511. Dest.Data.a := Dest.Data.a xor Dest.Range.a;
  3512. end;
  3513. end;
  3514. end;
  3515. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3516. procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
  3517. var
  3518. i: Integer;
  3519. begin
  3520. with aFuncRec do begin
  3521. for i := 0 to 3 do
  3522. Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
  3523. end;
  3524. end;
  3525. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3526. procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3527. var
  3528. Temp: Single;
  3529. begin
  3530. with FuncRec do begin
  3531. if (FuncRec.Args = nil) then begin //source has no alpha
  3532. Temp :=
  3533. Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
  3534. Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
  3535. Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
  3536. Dest.Data.a := Round(Dest.Range.a * Temp);
  3537. end else
  3538. Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
  3539. end;
  3540. end;
  3541. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3542. procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3543. type
  3544. PglBitmapPixelData = ^TglBitmapPixelData;
  3545. begin
  3546. with FuncRec do begin
  3547. Dest.Data.r := Source.Data.r;
  3548. Dest.Data.g := Source.Data.g;
  3549. Dest.Data.b := Source.Data.b;
  3550. with PglBitmapPixelData(Args)^ do
  3551. if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
  3552. (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
  3553. (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
  3554. Dest.Data.a := 0
  3555. else
  3556. Dest.Data.a := Dest.Range.a;
  3557. end;
  3558. end;
  3559. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3560. procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3561. begin
  3562. with FuncRec do begin
  3563. Dest.Data.r := Source.Data.r;
  3564. Dest.Data.g := Source.Data.g;
  3565. Dest.Data.b := Source.Data.b;
  3566. Dest.Data.a := PCardinal(Args)^;
  3567. end;
  3568. end;
  3569. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3570. procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
  3571. type
  3572. PRGBPix = ^TRGBPix;
  3573. TRGBPix = array [0..2] of byte;
  3574. var
  3575. Temp: Byte;
  3576. begin
  3577. while aWidth > 0 do begin
  3578. Temp := PRGBPix(aData)^[0];
  3579. PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
  3580. PRGBPix(aData)^[2] := Temp;
  3581. if aHasAlpha then
  3582. Inc(aData, 4)
  3583. else
  3584. Inc(aData, 3);
  3585. dec(aWidth);
  3586. end;
  3587. end;
  3588. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3589. //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3590. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3591. function TglBitmap.GetWidth: Integer;
  3592. begin
  3593. if (ffX in fDimension.Fields) then
  3594. result := fDimension.X
  3595. else
  3596. result := -1;
  3597. end;
  3598. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3599. function TglBitmap.GetHeight: Integer;
  3600. begin
  3601. if (ffY in fDimension.Fields) then
  3602. result := fDimension.Y
  3603. else
  3604. result := -1;
  3605. end;
  3606. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3607. function TglBitmap.GetFileWidth: Integer;
  3608. begin
  3609. result := Max(1, Width);
  3610. end;
  3611. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3612. function TglBitmap.GetFileHeight: Integer;
  3613. begin
  3614. result := Max(1, Height);
  3615. end;
  3616. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3617. procedure TglBitmap.SetCustomData(const aValue: Pointer);
  3618. begin
  3619. if fCustomData = aValue then
  3620. exit;
  3621. fCustomData := aValue;
  3622. end;
  3623. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3624. procedure TglBitmap.SetCustomName(const aValue: String);
  3625. begin
  3626. if fCustomName = aValue then
  3627. exit;
  3628. fCustomName := aValue;
  3629. end;
  3630. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3631. procedure TglBitmap.SetCustomNameW(const aValue: WideString);
  3632. begin
  3633. if fCustomNameW = aValue then
  3634. exit;
  3635. fCustomNameW := aValue;
  3636. end;
  3637. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3638. procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
  3639. begin
  3640. if fDeleteTextureOnFree = aValue then
  3641. exit;
  3642. fDeleteTextureOnFree := aValue;
  3643. end;
  3644. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3645. procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
  3646. begin
  3647. if fFormat = aValue then
  3648. exit;
  3649. if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
  3650. raise EglBitmapUnsupportedFormat.Create(Format);
  3651. SetDataPointer(Data, aValue, Width, Height);
  3652. end;
  3653. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3654. procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
  3655. begin
  3656. if fFreeDataAfterGenTexture = aValue then
  3657. exit;
  3658. fFreeDataAfterGenTexture := aValue;
  3659. end;
  3660. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3661. procedure TglBitmap.SetID(const aValue: Cardinal);
  3662. begin
  3663. if fID = aValue then
  3664. exit;
  3665. fID := aValue;
  3666. end;
  3667. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3668. procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
  3669. begin
  3670. if fMipMap = aValue then
  3671. exit;
  3672. fMipMap := aValue;
  3673. end;
  3674. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3675. procedure TglBitmap.SetTarget(const aValue: Cardinal);
  3676. begin
  3677. if fTarget = aValue then
  3678. exit;
  3679. fTarget := aValue;
  3680. end;
  3681. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3682. procedure TglBitmap.SetAnisotropic(const aValue: Integer);
  3683. var
  3684. MaxAnisotropic: Integer;
  3685. begin
  3686. fAnisotropic := aValue;
  3687. if (ID > 0) then begin
  3688. if GL_EXT_texture_filter_anisotropic then begin
  3689. if fAnisotropic > 0 then begin
  3690. Bind(false);
  3691. glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
  3692. if aValue > MaxAnisotropic then
  3693. fAnisotropic := MaxAnisotropic;
  3694. glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
  3695. end;
  3696. end else begin
  3697. fAnisotropic := 0;
  3698. end;
  3699. end;
  3700. end;
  3701. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3702. procedure TglBitmap.CreateID;
  3703. begin
  3704. if (ID <> 0) then
  3705. glDeleteTextures(1, @fID);
  3706. glGenTextures(1, @fID);
  3707. Bind(false);
  3708. end;
  3709. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3710. procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
  3711. begin
  3712. // Set Up Parameters
  3713. SetWrap(fWrapS, fWrapT, fWrapR);
  3714. SetFilter(fFilterMin, fFilterMag);
  3715. SetAnisotropic(fAnisotropic);
  3716. SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
  3717. // Mip Maps Generation Mode
  3718. aBuildWithGlu := false;
  3719. if (MipMap = mmMipmap) then begin
  3720. if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
  3721. glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
  3722. else
  3723. aBuildWithGlu := true;
  3724. end else if (MipMap = mmMipmapGlu) then
  3725. aBuildWithGlu := true;
  3726. end;
  3727. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3728. procedure TglBitmap.SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
  3729. const aWidth: Integer; const aHeight: Integer);
  3730. var
  3731. s: Single;
  3732. begin
  3733. if (Data <> aData) then begin
  3734. if (Assigned(Data)) then
  3735. FreeMem(Data);
  3736. fData := aData;
  3737. end;
  3738. FillChar(fDimension, SizeOf(fDimension), 0);
  3739. if not Assigned(fData) then begin
  3740. fFormat := tfEmpty;
  3741. fPixelSize := 0;
  3742. fRowSize := 0;
  3743. end else begin
  3744. if aWidth <> -1 then begin
  3745. fDimension.Fields := fDimension.Fields + [ffX];
  3746. fDimension.X := aWidth;
  3747. end;
  3748. if aHeight <> -1 then begin
  3749. fDimension.Fields := fDimension.Fields + [ffY];
  3750. fDimension.Y := aHeight;
  3751. end;
  3752. s := TFormatDescriptor.Get(aFormat).PixelSize;
  3753. fFormat := aFormat;
  3754. fPixelSize := Ceil(s);
  3755. fRowSize := Ceil(s * aWidth);
  3756. end;
  3757. end;
  3758. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3759. function TglBitmap.FlipHorz: Boolean;
  3760. begin
  3761. result := false;
  3762. end;
  3763. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3764. function TglBitmap.FlipVert: Boolean;
  3765. begin
  3766. result := false;
  3767. end;
  3768. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3769. //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3770. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3771. procedure TglBitmap.AfterConstruction;
  3772. begin
  3773. inherited AfterConstruction;
  3774. fID := 0;
  3775. fTarget := 0;
  3776. fIsResident := false;
  3777. fFormat := glBitmapGetDefaultFormat;
  3778. fMipMap := glBitmapDefaultMipmap;
  3779. fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
  3780. fDeleteTextureOnFree := glBitmapGetDefaultDeleteTextureOnFree;
  3781. glBitmapGetDefaultFilter (fFilterMin, fFilterMag);
  3782. glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
  3783. end;
  3784. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3785. procedure TglBitmap.BeforeDestruction;
  3786. begin
  3787. SetDataPointer(nil, tfEmpty);
  3788. if (fID > 0) and fDeleteTextureOnFree then
  3789. glDeleteTextures(1, @fID);
  3790. inherited BeforeDestruction;
  3791. end;
  3792. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3793. procedure TglBitmap.LoadFromFile(const aFilename: String);
  3794. var
  3795. fs: TFileStream;
  3796. begin
  3797. if not FileExists(aFilename) then
  3798. raise EglBitmapException.Create('file does not exist: ' + aFilename);
  3799. fFilename := aFilename;
  3800. fs := TFileStream.Create(fFilename, fmOpenRead);
  3801. try
  3802. fs.Position := 0;
  3803. LoadFromStream(fs);
  3804. finally
  3805. fs.Free;
  3806. end;
  3807. end;
  3808. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3809. procedure TglBitmap.LoadFromStream(const aStream: TStream);
  3810. begin
  3811. {$IFDEF GLB_SUPPORT_PNG_READ}
  3812. if not LoadPNG(aStream) then
  3813. {$ENDIF}
  3814. {$IFDEF GLB_SUPPORT_JPEG_READ}
  3815. if not LoadJPEG(aStream) then
  3816. {$ENDIF}
  3817. if not LoadDDS(aStream) then
  3818. if not LoadTGA(aStream) then
  3819. if not LoadBMP(aStream) then
  3820. raise EglBitmapException.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
  3821. end;
  3822. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3823. procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  3824. const aFormat: TglBitmapFormat; const aArgs: Pointer);
  3825. var
  3826. tmpData: PByte;
  3827. size: Integer;
  3828. begin
  3829. size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  3830. GetMem(tmpData, size);
  3831. try
  3832. FillChar(tmpData^, size, #$FF);
  3833. SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y);
  3834. except
  3835. FreeMem(tmpData);
  3836. raise;
  3837. end;
  3838. AddFunc(Self, aFunc, false, Format, aArgs);
  3839. end;
  3840. {$IFDEF GLB_DELPHI}
  3841. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3842. procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil);
  3843. var
  3844. rs: TResourceStream;
  3845. TempPos: Integer;
  3846. ResTypeStr: String;
  3847. TempResType: PChar;
  3848. begin
  3849. if not Assigned(ResType) then begin
  3850. TempPos := Pos('.', Resource);
  3851. ResTypeStr := UpperCase(Copy(Resource, TempPos + 1, Length(Resource) - TempPos));
  3852. Resource := UpperCase(Copy(Resource, 0, TempPos -1));
  3853. TempResType := PChar(ResTypeStr);
  3854. end else
  3855. TempResType := ResType
  3856. rs := TResourceStream.Create(Instance, Resource, TempResType);
  3857. try
  3858. LoadFromStream(rs);
  3859. finally
  3860. rs.Free;
  3861. end;
  3862. end;
  3863. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3864. procedure TglBitmap.LoadFromResourceID(const sInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  3865. var
  3866. rs: TResourceStream;
  3867. begin
  3868. rs := TResourceStream.CreateFromID(Instance, ResourceID, ResType);
  3869. try
  3870. LoadFromStream(rs);
  3871. finally
  3872. rs.Free;
  3873. end;
  3874. end;
  3875. {$ENDIF}
  3876. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3877. procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  3878. var
  3879. fs: TFileStream;
  3880. begin
  3881. fs := TFileStream.Create(aFileName, fmCreate);
  3882. try
  3883. fs.Position := 0;
  3884. SaveToStream(fs, aFileType);
  3885. finally
  3886. fs.Free;
  3887. end;
  3888. end;
  3889. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3890. procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
  3891. begin
  3892. case aFileType of
  3893. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  3894. ftPNG: SavePNG(aStream);
  3895. {$ENDIF}
  3896. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  3897. ftJPEG: SaveJPEG(aStream);
  3898. {$ENDIF}
  3899. ftDDS: SaveDDS(aStream);
  3900. ftTGA: SaveTGA(aStream);
  3901. ftBMP: SaveBMP(aStream);
  3902. end;
  3903. end;
  3904. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3905. function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
  3906. begin
  3907. result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
  3908. end;
  3909. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3910. function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  3911. const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
  3912. var
  3913. DestData, TmpData, SourceData: pByte;
  3914. TempHeight, TempWidth: Integer;
  3915. SourceFD, DestFD: TFormatDescriptor;
  3916. SourceMD, DestMD: Pointer;
  3917. FuncRec: TglBitmapFunctionRec;
  3918. begin
  3919. Assert(Assigned(Data));
  3920. Assert(Assigned(aSource));
  3921. Assert(Assigned(aSource.Data));
  3922. result := false;
  3923. if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
  3924. SourceFD := TFormatDescriptor.Get(aSource.Format);
  3925. DestFD := TFormatDescriptor.Get(aFormat);
  3926. // inkompatible Formats so CreateTemp
  3927. if (SourceFD.PixelSize <> DestFD.PixelSize) then
  3928. aCreateTemp := true;
  3929. // Values
  3930. TempHeight := Max(1, aSource.Height);
  3931. TempWidth := Max(1, aSource.Width);
  3932. FuncRec.Sender := Self;
  3933. FuncRec.Args := aArgs;
  3934. TmpData := nil;
  3935. if aCreateTemp then begin
  3936. GetMem(TmpData, TFormatDescriptor.Get(aFormat).GetSize(TempWidth, TempHeight));
  3937. DestData := TmpData;
  3938. end else
  3939. DestData := Data;
  3940. try
  3941. SourceFD.PreparePixel(FuncRec.Source);
  3942. DestFD.PreparePixel (FuncRec.Dest);
  3943. SourceMD := SourceFD.CreateMappingData;
  3944. DestMD := DestFD.CreateMappingData;
  3945. FuncRec.Size := aSource.Dimension;
  3946. FuncRec.Position.Fields := FuncRec.Size.Fields;
  3947. try
  3948. SourceData := aSource.Data;
  3949. FuncRec.Position.Y := 0;
  3950. while FuncRec.Position.Y < TempHeight do begin
  3951. FuncRec.Position.X := 0;
  3952. while FuncRec.Position.X < TempWidth do begin
  3953. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  3954. aFunc(FuncRec);
  3955. DestFD.Map(FuncRec.Dest, DestData, DestMD);
  3956. inc(FuncRec.Position.X);
  3957. end;
  3958. inc(FuncRec.Position.Y);
  3959. end;
  3960. // Updating Image or InternalFormat
  3961. if aCreateTemp then
  3962. SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height)
  3963. else if (aFormat <> fFormat) then
  3964. Format := aFormat;
  3965. result := true;
  3966. finally
  3967. SourceFD.FreeMappingData(SourceMD);
  3968. DestFD.FreeMappingData(DestMD);
  3969. end;
  3970. except
  3971. if aCreateTemp then
  3972. FreeMem(TmpData);
  3973. raise;
  3974. end;
  3975. end;
  3976. end;
  3977. {$IFDEF GLB_SDL}
  3978. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3979. function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  3980. var
  3981. Row, RowSize: Integer;
  3982. SourceData, TmpData: PByte;
  3983. TempDepth: Integer;
  3984. FormatDesc: TFormatDescriptor;
  3985. function GetRowPointer(Row: Integer): pByte;
  3986. begin
  3987. result := aSurface.pixels;
  3988. Inc(result, Row * RowSize);
  3989. end;
  3990. begin
  3991. result := false;
  3992. FormatDesc := TFormatDescriptor.Get(Format);
  3993. if FormatDesc.IsCompressed then
  3994. raise EglBitmapUnsupportedFormat.Create(Format);
  3995. if Assigned(Data) then begin
  3996. case Trunc(FormatDesc.PixelSize) of
  3997. 1: TempDepth := 8;
  3998. 2: TempDepth := 16;
  3999. 3: TempDepth := 24;
  4000. 4: TempDepth := 32;
  4001. else
  4002. raise EglBitmapUnsupportedFormat.Create(Format);
  4003. end;
  4004. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
  4005. FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
  4006. SourceData := Data;
  4007. RowSize := FormatDesc.GetSize(FileWidth, 1);
  4008. for Row := 0 to FileHeight-1 do begin
  4009. TmpData := GetRowPointer(Row);
  4010. if Assigned(TmpData) then begin
  4011. Move(SourceData^, TmpData^, RowSize);
  4012. inc(SourceData, RowSize);
  4013. end;
  4014. end;
  4015. result := true;
  4016. end;
  4017. end;
  4018. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4019. function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  4020. var
  4021. pSource, pData, pTempData: PByte;
  4022. Row, RowSize, TempWidth, TempHeight: Integer;
  4023. IntFormat: TglBitmapFormat;
  4024. FormatDesc: TFormatDescriptor;
  4025. function GetRowPointer(Row: Integer): pByte;
  4026. begin
  4027. result := aSurface^.pixels;
  4028. Inc(result, Row * RowSize);
  4029. end;
  4030. begin
  4031. result := false;
  4032. if (Assigned(aSurface)) then begin
  4033. with aSurface^.format^ do begin
  4034. for IntFormat := High(TglBitmapFormat) to Low(TglBitmapFormat) do begin
  4035. FormatDesc := TFormatDescriptor.Get(IntFormat);
  4036. if (FormatDesc.MaskMatch(RMask, GMask, BMask, AMask)) then
  4037. break;
  4038. end;
  4039. if (IntFormat = tfEmpty) then
  4040. raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
  4041. end;
  4042. TempWidth := aSurface^.w;
  4043. TempHeight := aSurface^.h;
  4044. RowSize := FormatDesc.GetSize(TempWidth, 1);
  4045. GetMem(pData, TempHeight * RowSize);
  4046. try
  4047. pTempData := pData;
  4048. for Row := 0 to TempHeight -1 do begin
  4049. pSource := GetRowPointer(Row);
  4050. if (Assigned(pSource)) then begin
  4051. Move(pSource^, pTempData^, RowSize);
  4052. Inc(pTempData, RowSize);
  4053. end;
  4054. end;
  4055. SetDataPointer(pData, IntFormat, TempWidth, TempHeight);
  4056. result := true;
  4057. except
  4058. FreeMem(pData);
  4059. raise;
  4060. end;
  4061. end;
  4062. end;
  4063. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4064. function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  4065. var
  4066. Row, Col, AlphaInterleave: Integer;
  4067. pSource, pDest: PByte;
  4068. function GetRowPointer(Row: Integer): pByte;
  4069. begin
  4070. result := aSurface.pixels;
  4071. Inc(result, Row * Width);
  4072. end;
  4073. begin
  4074. result := false;
  4075. if Assigned(Data) then begin
  4076. if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
  4077. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
  4078. AlphaInterleave := 0;
  4079. case Format of
  4080. tfLuminance8Alpha8:
  4081. AlphaInterleave := 1;
  4082. tfBGRA8, tfRGBA8:
  4083. AlphaInterleave := 3;
  4084. end;
  4085. pSource := Data;
  4086. for Row := 0 to Height -1 do begin
  4087. pDest := GetRowPointer(Row);
  4088. if Assigned(pDest) then begin
  4089. for Col := 0 to Width -1 do begin
  4090. Inc(pSource, AlphaInterleave);
  4091. pDest^ := pSource^;
  4092. Inc(pDest);
  4093. Inc(pSource);
  4094. end;
  4095. end;
  4096. end;
  4097. result := true;
  4098. end;
  4099. end;
  4100. end;
  4101. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4102. function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  4103. var
  4104. bmp: TglBitmap2D;
  4105. begin
  4106. bmp := TglBitmap2D.Create;
  4107. try
  4108. bmp.AssignFromSurface(aSurface);
  4109. result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
  4110. finally
  4111. bmp.Free;
  4112. end;
  4113. end;
  4114. {$ENDIF}
  4115. {$IFDEF GLB_DELPHI}
  4116. //TODO rework & test
  4117. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4118. function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
  4119. var
  4120. Row: Integer;
  4121. pSource, pData: PByte;
  4122. begin
  4123. result := false;
  4124. if Assigned(Data) then begin
  4125. if Assigned(aBitmap) then begin
  4126. aBitmap.Width := Width;
  4127. aBitmap.Height := Height;
  4128. case Format of
  4129. tfAlpha8, ifLuminance, ifDepth8:
  4130. begin
  4131. Bitmap.PixelFormat := pf8bit;
  4132. Bitmap.Palette := CreateGrayPalette;
  4133. end;
  4134. ifRGB5A1:
  4135. Bitmap.PixelFormat := pf15bit;
  4136. ifR5G6B5:
  4137. Bitmap.PixelFormat := pf16bit;
  4138. ifRGB8, ifBGR8:
  4139. Bitmap.PixelFormat := pf24bit;
  4140. ifRGBA8, ifBGRA8:
  4141. Bitmap.PixelFormat := pf32bit;
  4142. else
  4143. raise EglBitmapException.Create('AssignToBitmap - Invalid Pixelformat.');
  4144. end;
  4145. pSource := Data;
  4146. for Row := 0 to FileHeight -1 do begin
  4147. pData := Bitmap.Scanline[Row];
  4148. Move(pSource^, pData^, fRowSize);
  4149. Inc(pSource, fRowSize);
  4150. // swap RGB(A) to BGR(A)
  4151. if InternalFormat in [ifRGB8, ifRGBA8] then
  4152. SwapRGB(pData, FileWidth, InternalFormat = ifRGBA8);
  4153. end;
  4154. result := true;
  4155. end;
  4156. end;
  4157. end;
  4158. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4159. function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  4160. var
  4161. pSource, pData, pTempData: PByte;
  4162. Row, RowSize, TempWidth, TempHeight: Integer;
  4163. IntFormat: TglBitmapInternalFormat;
  4164. begin
  4165. result := false;
  4166. if (Assigned(Bitmap)) then begin
  4167. case Bitmap.PixelFormat of
  4168. pf8bit:
  4169. IntFormat := ifLuminance;
  4170. pf15bit:
  4171. IntFormat := ifRGB5A1;
  4172. pf16bit:
  4173. IntFormat := ifR5G6B5;
  4174. pf24bit:
  4175. IntFormat := ifBGR8;
  4176. pf32bit:
  4177. IntFormat := ifBGRA8;
  4178. else
  4179. raise EglBitmapException.Create('AssignFromBitmap - Invalid Pixelformat.');
  4180. end;
  4181. TempWidth := Bitmap.Width;
  4182. TempHeight := Bitmap.Height;
  4183. RowSize := Trunc(TempWidth * FormatGetSize(IntFormat));
  4184. GetMem(pData, TempHeight * RowSize);
  4185. try
  4186. pTempData := pData;
  4187. for Row := 0 to TempHeight -1 do begin
  4188. pSource := Bitmap.Scanline[Row];
  4189. if (Assigned(pSource)) then begin
  4190. Move(pSource^, pTempData^, RowSize);
  4191. Inc(pTempData, RowSize);
  4192. end;
  4193. end;
  4194. SetDataPointer(pData, IntFormat, TempWidth, TempHeight);
  4195. result := true;
  4196. except
  4197. FreeMem(pData);
  4198. raise;
  4199. end;
  4200. end;
  4201. end;
  4202. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4203. function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  4204. var
  4205. Row, Col, AlphaInterleave: Integer;
  4206. pSource, pDest: PByte;
  4207. begin
  4208. result := false;
  4209. if Assigned(Data) then begin
  4210. if InternalFormat in [ifAlpha, ifLuminanceAlpha, ifRGBA8, ifBGRA8] then begin
  4211. if Assigned(Bitmap) then begin
  4212. Bitmap.PixelFormat := pf8bit;
  4213. Bitmap.Palette := CreateGrayPalette;
  4214. Bitmap.Width := Width;
  4215. Bitmap.Height := Height;
  4216. case InternalFormat of
  4217. ifLuminanceAlpha:
  4218. AlphaInterleave := 1;
  4219. ifRGBA8, ifBGRA8:
  4220. AlphaInterleave := 3;
  4221. else
  4222. AlphaInterleave := 0;
  4223. end;
  4224. // Copy Data
  4225. pSource := Data;
  4226. for Row := 0 to Height -1 do begin
  4227. pDest := Bitmap.Scanline[Row];
  4228. if Assigned(pDest) then begin
  4229. for Col := 0 to Width -1 do begin
  4230. Inc(pSource, AlphaInterleave);
  4231. pDest^ := pSource^;
  4232. Inc(pDest);
  4233. Inc(pSource);
  4234. end;
  4235. end;
  4236. end;
  4237. result := true;
  4238. end;
  4239. end;
  4240. end;
  4241. end;
  4242. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4243. function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
  4244. var
  4245. tex: TglBitmap2D;
  4246. begin
  4247. tex := TglBitmap2D.Create;
  4248. try
  4249. tex.AssignFromBitmap(Bitmap);
  4250. result := AddAlphaFromglBitmap(tex, Func, CustomData);
  4251. finally
  4252. tex.Free;
  4253. end;
  4254. end;
  4255. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4256. function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar;
  4257. const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
  4258. var
  4259. RS: TResourceStream;
  4260. TempPos: Integer;
  4261. ResTypeStr: String;
  4262. TempResType: PChar;
  4263. begin
  4264. if Assigned(ResType) then
  4265. TempResType := ResType
  4266. else
  4267. begin
  4268. TempPos := Pos('.', Resource);
  4269. ResTypeStr := UpperCase(Copy(Resource, TempPos + 1, Length(Resource) - TempPos));
  4270. Resource := UpperCase(Copy(Resource, 0, TempPos -1));
  4271. TempResType := PChar(ResTypeStr);
  4272. end;
  4273. RS := TResourceStream.Create(Instance, Resource, TempResType);
  4274. try
  4275. result := AddAlphaFromStream(RS, Func, CustomData);
  4276. finally
  4277. RS.Free;
  4278. end;
  4279. end;
  4280. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4281. function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  4282. const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
  4283. var
  4284. RS: TResourceStream;
  4285. begin
  4286. RS := TResourceStream.CreateFromID(Instance, ResourceID, ResType);
  4287. try
  4288. result := AddAlphaFromStream(RS, Func, CustomData);
  4289. finally
  4290. RS.Free;
  4291. end;
  4292. end;
  4293. {$ENDIF}
  4294. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4295. function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4296. begin
  4297. if TFormatDescriptor.Get(Format).IsCompressed then
  4298. raise EglBitmapUnsupportedFormat.Create(Format);
  4299. result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
  4300. end;
  4301. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4302. function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4303. var
  4304. FS: TFileStream;
  4305. begin
  4306. FS := TFileStream.Create(FileName, fmOpenRead);
  4307. try
  4308. result := AddAlphaFromStream(FS, aFunc, aArgs);
  4309. finally
  4310. FS.Free;
  4311. end;
  4312. end;
  4313. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4314. function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4315. var
  4316. tex: TglBitmap2D;
  4317. begin
  4318. tex := TglBitmap2D.Create(aStream);
  4319. try
  4320. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4321. finally
  4322. tex.Free;
  4323. end;
  4324. end;
  4325. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4326. function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4327. var
  4328. DestData, DestData2, SourceData: pByte;
  4329. TempHeight, TempWidth: Integer;
  4330. SourceFD, DestFD: TFormatDescriptor;
  4331. SourceMD, DestMD, DestMD2: Pointer;
  4332. FuncRec: TglBitmapFunctionRec;
  4333. begin
  4334. result := false;
  4335. Assert(Assigned(Data));
  4336. Assert(Assigned(aBitmap));
  4337. Assert(Assigned(aBitmap.Data));
  4338. if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
  4339. result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
  4340. SourceFD := TFormatDescriptor.Get(aBitmap.Format);
  4341. DestFD := TFormatDescriptor.Get(Format);
  4342. if not Assigned(aFunc) then begin
  4343. aFunc := glBitmapAlphaFunc;
  4344. FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
  4345. end else
  4346. FuncRec.Args := aArgs;
  4347. // Values
  4348. TempHeight := aBitmap.FileHeight;
  4349. TempWidth := aBitmap.FileWidth;
  4350. FuncRec.Sender := Self;
  4351. FuncRec.Size := Dimension;
  4352. FuncRec.Position.Fields := FuncRec.Size.Fields;
  4353. DestData := Data;
  4354. DestData2 := Data;
  4355. SourceData := aBitmap.Data;
  4356. // Mapping
  4357. SourceFD.PreparePixel(FuncRec.Source);
  4358. DestFD.PreparePixel (FuncRec.Dest);
  4359. SourceMD := SourceFD.CreateMappingData;
  4360. DestMD := DestFD.CreateMappingData;
  4361. DestMD2 := DestFD.CreateMappingData;
  4362. try
  4363. FuncRec.Position.Y := 0;
  4364. while FuncRec.Position.Y < TempHeight do begin
  4365. FuncRec.Position.X := 0;
  4366. while FuncRec.Position.X < TempWidth do begin
  4367. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  4368. DestFD.Unmap (DestData, FuncRec.Dest, DestMD);
  4369. aFunc(FuncRec);
  4370. DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
  4371. inc(FuncRec.Position.X);
  4372. end;
  4373. inc(FuncRec.Position.Y);
  4374. end;
  4375. finally
  4376. SourceFD.FreeMappingData(SourceMD);
  4377. DestFD.FreeMappingData(DestMD);
  4378. DestFD.FreeMappingData(DestMD2);
  4379. end;
  4380. end;
  4381. end;
  4382. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4383. function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
  4384. begin
  4385. result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
  4386. end;
  4387. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4388. function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
  4389. var
  4390. PixelData: TglBitmapPixelData;
  4391. begin
  4392. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4393. result := AddAlphaFromColorKeyFloat(
  4394. aRed / PixelData.Range.r,
  4395. aGreen / PixelData.Range.g,
  4396. aBlue / PixelData.Range.b,
  4397. aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
  4398. end;
  4399. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4400. function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
  4401. var
  4402. values: array[0..2] of Single;
  4403. tmp: Cardinal;
  4404. i: Integer;
  4405. PixelData: TglBitmapPixelData;
  4406. begin
  4407. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4408. with PixelData do begin
  4409. values[0] := aRed;
  4410. values[1] := aGreen;
  4411. values[2] := aBlue;
  4412. for i := 0 to 2 do begin
  4413. tmp := Trunc(Range.arr[i] * aDeviation);
  4414. Data.arr[i] := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
  4415. Range.arr[i] := Max(0, Trunc(Range.arr[i] * values[i] - tmp));
  4416. end;
  4417. Data.a := 0;
  4418. Range.a := 0;
  4419. end;
  4420. result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
  4421. end;
  4422. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4423. function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
  4424. begin
  4425. result := AddAlphaFromValueFloat(aAlpha / $FF);
  4426. end;
  4427. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4428. function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  4429. var
  4430. PixelData: TglBitmapPixelData;
  4431. begin
  4432. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4433. result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
  4434. end;
  4435. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4436. function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  4437. var
  4438. PixelData: TglBitmapPixelData;
  4439. begin
  4440. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4441. with PixelData do
  4442. Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
  4443. result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
  4444. end;
  4445. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4446. function TglBitmap.RemoveAlpha: Boolean;
  4447. var
  4448. FormatDesc: TFormatDescriptor;
  4449. begin
  4450. result := false;
  4451. FormatDesc := TFormatDescriptor.Get(Format);
  4452. if Assigned(Data) then begin
  4453. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  4454. raise EglBitmapUnsupportedFormat.Create(Format);
  4455. result := ConvertTo(FormatDesc.WithoutAlpha);
  4456. end;
  4457. end;
  4458. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4459. function TglBitmap.Clone: TglBitmap;
  4460. var
  4461. Temp: TglBitmap;
  4462. TempPtr: PByte;
  4463. Size: Integer;
  4464. begin
  4465. result := nil;
  4466. Temp := (ClassType.Create as TglBitmap);
  4467. try
  4468. // copy texture data if assigned
  4469. if Assigned(Data) then begin
  4470. Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
  4471. GetMem(TempPtr, Size);
  4472. try
  4473. Move(Data^, TempPtr^, Size);
  4474. Temp.SetDataPointer(TempPtr, Format, Width, Height);
  4475. except
  4476. FreeMem(TempPtr);
  4477. raise;
  4478. end;
  4479. end else
  4480. Temp.SetDataPointer(nil, Format, Width, Height);
  4481. // copy properties
  4482. Temp.fID := ID;
  4483. Temp.fTarget := Target;
  4484. Temp.fFormat := Format;
  4485. Temp.fMipMap := MipMap;
  4486. Temp.fAnisotropic := Anisotropic;
  4487. Temp.fBorderColor := fBorderColor;
  4488. Temp.fDeleteTextureOnFree := DeleteTextureOnFree;
  4489. Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
  4490. Temp.fFilterMin := fFilterMin;
  4491. Temp.fFilterMag := fFilterMag;
  4492. Temp.fWrapS := fWrapS;
  4493. Temp.fWrapT := fWrapT;
  4494. Temp.fWrapR := fWrapR;
  4495. Temp.fFilename := fFilename;
  4496. Temp.fCustomName := fCustomName;
  4497. Temp.fCustomNameW := fCustomNameW;
  4498. Temp.fCustomData := fCustomData;
  4499. result := Temp;
  4500. except
  4501. FreeAndNil(Temp);
  4502. raise;
  4503. end;
  4504. end;
  4505. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4506. function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
  4507. var
  4508. SourceFD, DestFD: TFormatDescriptor;
  4509. SourcePD, DestPD: TglBitmapPixelData;
  4510. ShiftData: TShiftData;
  4511. function CanCopyDirect: Boolean;
  4512. begin
  4513. result :=
  4514. ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  4515. ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  4516. ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  4517. ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  4518. end;
  4519. function CanShift: Boolean;
  4520. begin
  4521. result :=
  4522. ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  4523. ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  4524. ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  4525. ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  4526. end;
  4527. function GetShift(aSource, aDest: Cardinal) : ShortInt;
  4528. begin
  4529. result := 0;
  4530. while (aSource > aDest) and (aSource > 0) do begin
  4531. inc(result);
  4532. aSource := aSource shr 1;
  4533. end;
  4534. end;
  4535. begin
  4536. if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
  4537. SourceFD := TFormatDescriptor.Get(Format);
  4538. DestFD := TFormatDescriptor.Get(aFormat);
  4539. SourceFD.PreparePixel(SourcePD);
  4540. DestFD.PreparePixel (DestPD);
  4541. if CanCopyDirect then
  4542. result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
  4543. else if CanShift then begin
  4544. ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
  4545. ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
  4546. ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
  4547. ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
  4548. result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
  4549. end else
  4550. result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
  4551. end else
  4552. result := true;
  4553. end;
  4554. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4555. procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
  4556. begin
  4557. if aUseRGB or aUseAlpha then
  4558. AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
  4559. ((PtrInt(aUseAlpha) and 1) shl 1) or
  4560. (PtrInt(aUseRGB) and 1) ));
  4561. end;
  4562. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4563. procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  4564. begin
  4565. fBorderColor[0] := aRed;
  4566. fBorderColor[1] := aGreen;
  4567. fBorderColor[2] := aBlue;
  4568. fBorderColor[3] := aAlpha;
  4569. if (ID > 0) then begin
  4570. Bind(false);
  4571. glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
  4572. end;
  4573. end;
  4574. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4575. procedure TglBitmap.FreeData;
  4576. begin
  4577. SetDataPointer(nil, tfEmpty);
  4578. end;
  4579. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4580. procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
  4581. const aAlpha: Byte);
  4582. begin
  4583. FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
  4584. end;
  4585. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4586. procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
  4587. var
  4588. PixelData: TglBitmapPixelData;
  4589. begin
  4590. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4591. FillWithColorFloat(
  4592. aRed / PixelData.Range.r,
  4593. aGreen / PixelData.Range.g,
  4594. aBlue / PixelData.Range.b,
  4595. aAlpha / PixelData.Range.a);
  4596. end;
  4597. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4598. procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
  4599. var
  4600. PixelData: TglBitmapPixelData;
  4601. begin
  4602. TFormatDescriptor.Get(Format).PreparePixel(PixelData);
  4603. with PixelData do begin
  4604. Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
  4605. Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
  4606. Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
  4607. Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
  4608. end;
  4609. AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
  4610. end;
  4611. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4612. procedure TglBitmap.SetFilter(const aMin, aMag: Cardinal);
  4613. begin
  4614. //check MIN filter
  4615. case aMin of
  4616. GL_NEAREST:
  4617. fFilterMin := GL_NEAREST;
  4618. GL_LINEAR:
  4619. fFilterMin := GL_LINEAR;
  4620. GL_NEAREST_MIPMAP_NEAREST:
  4621. fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
  4622. GL_LINEAR_MIPMAP_NEAREST:
  4623. fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
  4624. GL_NEAREST_MIPMAP_LINEAR:
  4625. fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
  4626. GL_LINEAR_MIPMAP_LINEAR:
  4627. fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
  4628. else
  4629. raise EglBitmapException.Create('SetFilter - Unknow MIN filter.');
  4630. end;
  4631. //check MAG filter
  4632. case aMag of
  4633. GL_NEAREST:
  4634. fFilterMag := GL_NEAREST;
  4635. GL_LINEAR:
  4636. fFilterMag := GL_LINEAR;
  4637. else
  4638. raise EglBitmapException.Create('SetFilter - Unknow MAG filter.');
  4639. end;
  4640. //apply filter
  4641. if (ID > 0) then begin
  4642. Bind(false);
  4643. glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
  4644. if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
  4645. case fFilterMin of
  4646. GL_NEAREST, GL_LINEAR:
  4647. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  4648. GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
  4649. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
  4650. GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
  4651. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
  4652. end;
  4653. end else
  4654. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  4655. end;
  4656. end;
  4657. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4658. procedure TglBitmap.SetWrap(const S: Cardinal; const T: Cardinal; const R: Cardinal);
  4659. procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
  4660. begin
  4661. case aValue of
  4662. GL_CLAMP:
  4663. aTarget := GL_CLAMP;
  4664. GL_REPEAT:
  4665. aTarget := GL_REPEAT;
  4666. GL_CLAMP_TO_EDGE: begin
  4667. if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
  4668. aTarget := GL_CLAMP_TO_EDGE
  4669. else
  4670. aTarget := GL_CLAMP;
  4671. end;
  4672. GL_CLAMP_TO_BORDER: begin
  4673. if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
  4674. aTarget := GL_CLAMP_TO_BORDER
  4675. else
  4676. aTarget := GL_CLAMP;
  4677. end;
  4678. GL_MIRRORED_REPEAT: begin
  4679. if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
  4680. aTarget := GL_MIRRORED_REPEAT
  4681. else
  4682. raise EglBitmapException.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
  4683. end;
  4684. else
  4685. raise EglBitmapException.Create('SetWrap - Unknow Texturewrap (S).');
  4686. end;
  4687. end;
  4688. begin
  4689. CheckAndSetWrap(S, fWrapS);
  4690. CheckAndSetWrap(T, fWrapT);
  4691. CheckAndSetWrap(R, fWrapR);
  4692. if (ID > 0) then begin
  4693. Bind(false);
  4694. glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
  4695. glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
  4696. glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
  4697. end;
  4698. end;
  4699. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4700. procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
  4701. begin
  4702. if aEnableTextureUnit then
  4703. glEnable(Target);
  4704. if (ID > 0) then
  4705. glBindTexture(Target, ID);
  4706. end;
  4707. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4708. procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
  4709. begin
  4710. if aDisableTextureUnit then
  4711. glDisable(Target);
  4712. glBindTexture(Target, 0);
  4713. end;
  4714. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4715. constructor TglBitmap.Create;
  4716. begin
  4717. {$IFDEF GLB_NATIVE_OGL}
  4718. glbReadOpenGLExtensions;
  4719. {$ENDIF}
  4720. if (ClassType = TglBitmap) then
  4721. raise EglBitmapException.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
  4722. inherited Create;
  4723. end;
  4724. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4725. constructor TglBitmap.Create(const aFileName: String);
  4726. begin
  4727. Create;
  4728. LoadFromFile(FileName);
  4729. end;
  4730. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4731. constructor TglBitmap.Create(const aStream: TStream);
  4732. begin
  4733. Create;
  4734. LoadFromStream(aStream);
  4735. end;
  4736. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4737. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat);
  4738. var
  4739. Image: PByte;
  4740. ImageSize: Integer;
  4741. begin
  4742. Create;
  4743. ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  4744. GetMem(Image, ImageSize);
  4745. try
  4746. FillChar(Image^, ImageSize, #$FF);
  4747. SetDataPointer(Image, aFormat, aSize.X, aSize.Y);
  4748. except
  4749. FreeMem(Image);
  4750. raise;
  4751. end;
  4752. end;
  4753. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4754. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat;
  4755. const aFunc: TglBitmapFunction; const aArgs: Pointer);
  4756. begin
  4757. Create;
  4758. LoadFromFunc(aSize, aFunc, aFormat, aArgs);
  4759. end;
  4760. {$IFDEF GLB_DELPHI}
  4761. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4762. constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
  4763. begin
  4764. Create;
  4765. LoadFromResource(aInstance, aResource, aResType);
  4766. end;
  4767. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4768. constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  4769. begin
  4770. Create;
  4771. LoadFromResourceID(aInstance, aResourceID, aResType);
  4772. end;
  4773. {$ENDIF}
  4774. {$IFDEF GLB_SUPPORT_PNG_READ}
  4775. {$IF DEFINED(GLB_SDL_IMAGE)}
  4776. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4777. //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4778. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4779. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  4780. var
  4781. Surface: PSDL_Surface;
  4782. RWops: PSDL_RWops;
  4783. begin
  4784. result := false;
  4785. RWops := glBitmapCreateRWops(aStream);
  4786. try
  4787. if IMG_isPNG(RWops) > 0 then begin
  4788. Surface := IMG_LoadPNG_RW(RWops);
  4789. try
  4790. AssignFromSurface(Surface);
  4791. result := true;
  4792. finally
  4793. SDL_FreeSurface(Surface);
  4794. end;
  4795. end;
  4796. finally
  4797. SDL_FreeRW(RWops);
  4798. end;
  4799. end;
  4800. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  4801. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4802. procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  4803. begin
  4804. TStream(png_get_io_ptr(png)).Read(buffer^, size);
  4805. end;
  4806. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4807. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  4808. var
  4809. StreamPos: Int64;
  4810. signature: array [0..7] of byte;
  4811. png: png_structp;
  4812. png_info: png_infop;
  4813. TempHeight, TempWidth: Integer;
  4814. Format: TglBitmapFormat;
  4815. png_data: pByte;
  4816. png_rows: array of pByte;
  4817. Row, LineSize: Integer;
  4818. begin
  4819. result := false;
  4820. if not init_libPNG then
  4821. raise Exception.Create('LoadPNG - unable to initialize libPNG.');
  4822. try
  4823. // signature
  4824. StreamPos := aStream.Position;
  4825. aStream.Read(signature{%H-}, 8);
  4826. aStream.Position := StreamPos;
  4827. if png_check_sig(@signature, 8) <> 0 then begin
  4828. // png read struct
  4829. png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  4830. if png = nil then
  4831. raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
  4832. // png info
  4833. png_info := png_create_info_struct(png);
  4834. if png_info = nil then begin
  4835. png_destroy_read_struct(@png, nil, nil);
  4836. raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
  4837. end;
  4838. // set read callback
  4839. png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
  4840. // read informations
  4841. png_read_info(png, png_info);
  4842. // size
  4843. TempHeight := png_get_image_height(png, png_info);
  4844. TempWidth := png_get_image_width(png, png_info);
  4845. // format
  4846. case png_get_color_type(png, png_info) of
  4847. PNG_COLOR_TYPE_GRAY:
  4848. Format := tfLuminance8;
  4849. PNG_COLOR_TYPE_GRAY_ALPHA:
  4850. Format := tfLuminance8Alpha8;
  4851. PNG_COLOR_TYPE_RGB:
  4852. Format := tfRGB8;
  4853. PNG_COLOR_TYPE_RGB_ALPHA:
  4854. Format := tfRGBA8;
  4855. else
  4856. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  4857. end;
  4858. // cut upper 8 bit from 16 bit formats
  4859. if png_get_bit_depth(png, png_info) > 8 then
  4860. png_set_strip_16(png);
  4861. // expand bitdepth smaller than 8
  4862. if png_get_bit_depth(png, png_info) < 8 then
  4863. png_set_expand(png);
  4864. // allocating mem for scanlines
  4865. LineSize := png_get_rowbytes(png, png_info);
  4866. GetMem(png_data, TempHeight * LineSize);
  4867. try
  4868. SetLength(png_rows, TempHeight);
  4869. for Row := Low(png_rows) to High(png_rows) do begin
  4870. png_rows[Row] := png_data;
  4871. Inc(png_rows[Row], Row * LineSize);
  4872. end;
  4873. // read complete image into scanlines
  4874. png_read_image(png, @png_rows[0]);
  4875. // read end
  4876. png_read_end(png, png_info);
  4877. // destroy read struct
  4878. png_destroy_read_struct(@png, @png_info, nil);
  4879. SetLength(png_rows, 0);
  4880. // set new data
  4881. SetDataPointer(png_data, Format, TempWidth, TempHeight);
  4882. result := true;
  4883. except
  4884. FreeMem(png_data);
  4885. raise;
  4886. end;
  4887. end;
  4888. finally
  4889. quit_libPNG;
  4890. end;
  4891. end;
  4892. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  4893. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4894. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  4895. var
  4896. StreamPos: Int64;
  4897. Png: TPNGObject;
  4898. Header: Array[0..7] of Byte;
  4899. Row, Col, PixSize, LineSize: Integer;
  4900. NewImage, pSource, pDest, pAlpha: pByte;
  4901. Format: TglBitmapInternalFormat;
  4902. const
  4903. PngHeader: Array[0..7] of Byte = (#137, #80, #78, #71, #13, #10, #26, #10);
  4904. begin
  4905. result := false;
  4906. StreamPos := Stream.Position;
  4907. Stream.Read(Header[0], SizeOf(Header));
  4908. Stream.Position := StreamPos;
  4909. {Test if the header matches}
  4910. if Header = PngHeader then begin
  4911. Png := TPNGObject.Create;
  4912. try
  4913. Png.LoadFromStream(Stream);
  4914. case Png.Header.ColorType of
  4915. COLOR_GRAYSCALE:
  4916. Format := ifLuminance;
  4917. COLOR_GRAYSCALEALPHA:
  4918. Format := ifLuminanceAlpha;
  4919. COLOR_RGB:
  4920. Format := ifBGR8;
  4921. COLOR_RGBALPHA:
  4922. Format := ifBGRA8;
  4923. else
  4924. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  4925. end;
  4926. PixSize := Trunc(FormatGetSize(Format));
  4927. LineSize := Integer(Png.Header.Width) * PixSize;
  4928. GetMem(NewImage, LineSize * Integer(Png.Header.Height));
  4929. try
  4930. pDest := NewImage;
  4931. case Png.Header.ColorType of
  4932. COLOR_RGB, COLOR_GRAYSCALE:
  4933. begin
  4934. for Row := 0 to Png.Height -1 do begin
  4935. Move (Png.Scanline[Row]^, pDest^, LineSize);
  4936. Inc(pDest, LineSize);
  4937. end;
  4938. end;
  4939. COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
  4940. begin
  4941. PixSize := PixSize -1;
  4942. for Row := 0 to Png.Height -1 do begin
  4943. pSource := Png.Scanline[Row];
  4944. pAlpha := pByte(Png.AlphaScanline[Row]);
  4945. for Col := 0 to Png.Width -1 do begin
  4946. Move (pSource^, pDest^, PixSize);
  4947. Inc(pSource, PixSize);
  4948. Inc(pDest, PixSize);
  4949. pDest^ := pAlpha^;
  4950. inc(pAlpha);
  4951. Inc(pDest);
  4952. end;
  4953. end;
  4954. end;
  4955. else
  4956. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  4957. end;
  4958. SetDataPointer(NewImage, Format, Png.Header.Width, Png.Header.Height);
  4959. result := true;
  4960. except
  4961. FreeMem(NewImage);
  4962. raise;
  4963. end;
  4964. finally
  4965. Png.Free;
  4966. end;
  4967. end;
  4968. end;
  4969. {$IFEND}
  4970. {$ENDIF}
  4971. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  4972. {$IFDEF GLB_LIB_PNG}
  4973. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4974. procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  4975. begin
  4976. TStream(png_get_io_ptr(png)).Write(buffer^, size);
  4977. end;
  4978. {$ENDIF}
  4979. {$IF DEFINED(GLB_LIB_PNG)}
  4980. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4981. procedure TglBitmap.SavePNG(const aStream: TStream);
  4982. var
  4983. png: png_structp;
  4984. png_info: png_infop;
  4985. png_rows: array of pByte;
  4986. LineSize: Integer;
  4987. ColorType: Integer;
  4988. Row: Integer;
  4989. FormatDesc: TFormatDescriptor;
  4990. begin
  4991. if not (ftPNG in FormatGetSupportedFiles(Format)) then
  4992. raise EglBitmapUnsupportedFormat.Create(Format);
  4993. if not init_libPNG then
  4994. raise Exception.Create('unable to initialize libPNG.');
  4995. try
  4996. case Format of
  4997. tfAlpha8, tfLuminance8:
  4998. ColorType := PNG_COLOR_TYPE_GRAY;
  4999. tfLuminance8Alpha8:
  5000. ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
  5001. tfBGR8, tfRGB8:
  5002. ColorType := PNG_COLOR_TYPE_RGB;
  5003. tfBGRA8, tfRGBA8:
  5004. ColorType := PNG_COLOR_TYPE_RGBA;
  5005. else
  5006. raise EglBitmapUnsupportedFormat.Create(Format);
  5007. end;
  5008. FormatDesc := TFormatDescriptor.Get(Format);
  5009. LineSize := FormatDesc.GetSize(Width, 1);
  5010. // creating array for scanline
  5011. SetLength(png_rows, Height);
  5012. try
  5013. for Row := 0 to Height - 1 do begin
  5014. png_rows[Row] := Data;
  5015. Inc(png_rows[Row], Row * LineSize)
  5016. end;
  5017. // write struct
  5018. png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  5019. if png = nil then
  5020. raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
  5021. // create png info
  5022. png_info := png_create_info_struct(png);
  5023. if png_info = nil then begin
  5024. png_destroy_write_struct(@png, nil);
  5025. raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
  5026. end;
  5027. // set read callback
  5028. png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
  5029. // set compression
  5030. png_set_compression_level(png, 6);
  5031. if Format in [tfBGR8, tfBGRA8] then
  5032. png_set_bgr(png);
  5033. png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
  5034. png_write_info(png, png_info);
  5035. png_write_image(png, @png_rows[0]);
  5036. png_write_end(png, png_info);
  5037. png_destroy_write_struct(@png, @png_info);
  5038. finally
  5039. SetLength(png_rows, 0);
  5040. end;
  5041. finally
  5042. quit_libPNG;
  5043. end;
  5044. end;
  5045. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  5046. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5047. procedure TglBitmap.SavePNG(const aStream: TStream);
  5048. var
  5049. Png: TPNGObject;
  5050. pSource, pDest: pByte;
  5051. X, Y, PixSize: Integer;
  5052. ColorType: Cardinal;
  5053. Alpha: Boolean;
  5054. pTemp: pByte;
  5055. Temp: Byte;
  5056. begin
  5057. if not (ftPNG in FormatGetSupportedFiles (InternalFormat)) then
  5058. raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
  5059. case FInternalFormat of
  5060. ifAlpha, ifLuminance, ifDepth8: begin
  5061. ColorType := COLOR_GRAYSCALE;
  5062. PixSize := 1;
  5063. Alpha := false;
  5064. end;
  5065. ifLuminanceAlpha: begin
  5066. ColorType := COLOR_GRAYSCALEALPHA;
  5067. PixSize := 1;
  5068. Alpha := true;
  5069. end;
  5070. ifBGR8, ifRGB8: begin
  5071. ColorType := COLOR_RGB;
  5072. PixSize := 3;
  5073. Alpha := false;
  5074. end;
  5075. ifBGRA8, ifRGBA8: begin
  5076. ColorType := COLOR_RGBALPHA;
  5077. PixSize := 3;
  5078. Alpha := true
  5079. end;
  5080. else
  5081. raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
  5082. end;
  5083. Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
  5084. try
  5085. // Copy ImageData
  5086. pSource := Data;
  5087. for Y := 0 to Height -1 do begin
  5088. pDest := png.ScanLine[Y];
  5089. for X := 0 to Width -1 do begin
  5090. Move(pSource^, pDest^, PixSize);
  5091. Inc(pDest, PixSize);
  5092. Inc(pSource, PixSize);
  5093. if Alpha then begin
  5094. png.AlphaScanline[Y]^[X] := pSource^;
  5095. Inc(pSource);
  5096. end;
  5097. end;
  5098. // convert RGB line to BGR
  5099. if InternalFormat in [ifRGB8, ifRGBA8] then begin
  5100. pTemp := png.ScanLine[Y];
  5101. for X := 0 to Width -1 do begin
  5102. Temp := pByteArray(pTemp)^[0];
  5103. pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
  5104. pByteArray(pTemp)^[2] := Temp;
  5105. Inc(pTemp, 3);
  5106. end;
  5107. end;
  5108. end;
  5109. // Save to Stream
  5110. Png.CompressionLevel := 6;
  5111. Png.SaveToStream(Stream);
  5112. finally
  5113. FreeAndNil(Png);
  5114. end;
  5115. end;
  5116. {$IFEND}
  5117. {$ENDIF}
  5118. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5119. //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5120. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5121. {$IFDEF GLB_LIB_JPEG}
  5122. type
  5123. glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
  5124. glBitmap_libJPEG_source_mgr = record
  5125. pub: jpeg_source_mgr;
  5126. SrcStream: TStream;
  5127. SrcBuffer: array [1..4096] of byte;
  5128. end;
  5129. glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
  5130. glBitmap_libJPEG_dest_mgr = record
  5131. pub: jpeg_destination_mgr;
  5132. DestStream: TStream;
  5133. DestBuffer: array [1..4096] of byte;
  5134. end;
  5135. procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
  5136. begin
  5137. //DUMMY
  5138. end;
  5139. procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
  5140. begin
  5141. //DUMMY
  5142. end;
  5143. procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
  5144. begin
  5145. //DUMMY
  5146. end;
  5147. procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
  5148. begin
  5149. //DUMMY
  5150. end;
  5151. procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
  5152. begin
  5153. //DUMMY
  5154. end;
  5155. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5156. function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
  5157. var
  5158. src: glBitmap_libJPEG_source_mgr_ptr;
  5159. bytes: integer;
  5160. begin
  5161. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  5162. bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
  5163. if (bytes <= 0) then begin
  5164. src^.SrcBuffer[1] := $FF;
  5165. src^.SrcBuffer[2] := JPEG_EOI;
  5166. bytes := 2;
  5167. end;
  5168. src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
  5169. src^.pub.bytes_in_buffer := bytes;
  5170. result := true;
  5171. end;
  5172. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5173. procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
  5174. var
  5175. src: glBitmap_libJPEG_source_mgr_ptr;
  5176. begin
  5177. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  5178. if num_bytes > 0 then begin
  5179. // wanted byte isn't in buffer so set stream position and read buffer
  5180. if num_bytes > src^.pub.bytes_in_buffer then begin
  5181. src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
  5182. src^.pub.fill_input_buffer(cinfo);
  5183. end else begin
  5184. // wanted byte is in buffer so only skip
  5185. inc(src^.pub.next_input_byte, num_bytes);
  5186. dec(src^.pub.bytes_in_buffer, num_bytes);
  5187. end;
  5188. end;
  5189. end;
  5190. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5191. function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
  5192. var
  5193. dest: glBitmap_libJPEG_dest_mgr_ptr;
  5194. begin
  5195. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  5196. if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
  5197. // write complete buffer
  5198. dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
  5199. // reset buffer
  5200. dest^.pub.next_output_byte := @dest^.DestBuffer[1];
  5201. dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
  5202. end;
  5203. result := true;
  5204. end;
  5205. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5206. procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
  5207. var
  5208. Idx: Integer;
  5209. dest: glBitmap_libJPEG_dest_mgr_ptr;
  5210. begin
  5211. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  5212. for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
  5213. // check for endblock
  5214. if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
  5215. // write endblock
  5216. dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
  5217. // leave
  5218. break;
  5219. end else
  5220. dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
  5221. end;
  5222. end;
  5223. {$ENDIF}
  5224. {$IFDEF GLB_SUPPORT_JPEG_READ}
  5225. {$IF DEFINED(GLB_SDL_IMAGE)}
  5226. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5227. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5228. var
  5229. Surface: PSDL_Surface;
  5230. RWops: PSDL_RWops;
  5231. begin
  5232. result := false;
  5233. RWops := glBitmapCreateRWops(aStream);
  5234. try
  5235. if IMG_isJPG(RWops) > 0 then begin
  5236. Surface := IMG_LoadJPG_RW(RWops);
  5237. try
  5238. AssignFromSurface(Surface);
  5239. result := true;
  5240. finally
  5241. SDL_FreeSurface(Surface);
  5242. end;
  5243. end;
  5244. finally
  5245. SDL_FreeRW(RWops);
  5246. end;
  5247. end;
  5248. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  5249. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5250. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5251. var
  5252. StreamPos: Int64;
  5253. Temp: array[0..1]of Byte;
  5254. jpeg: jpeg_decompress_struct;
  5255. jpeg_err: jpeg_error_mgr;
  5256. IntFormat: TglBitmapFormat;
  5257. pImage: pByte;
  5258. TempHeight, TempWidth: Integer;
  5259. pTemp: pByte;
  5260. Row: Integer;
  5261. FormatDesc: TFormatDescriptor;
  5262. begin
  5263. result := false;
  5264. if not init_libJPEG then
  5265. raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
  5266. try
  5267. // reading first two bytes to test file and set cursor back to begin
  5268. StreamPos := aStream.Position;
  5269. aStream.Read({%H-}Temp[0], 2);
  5270. aStream.Position := StreamPos;
  5271. // if Bitmap then read file.
  5272. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  5273. FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
  5274. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  5275. // error managment
  5276. jpeg.err := jpeg_std_error(@jpeg_err);
  5277. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  5278. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  5279. // decompression struct
  5280. jpeg_create_decompress(@jpeg);
  5281. // allocation space for streaming methods
  5282. jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
  5283. // seeting up custom functions
  5284. with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
  5285. pub.init_source := glBitmap_libJPEG_init_source;
  5286. pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
  5287. pub.skip_input_data := glBitmap_libJPEG_skip_input_data;
  5288. pub.resync_to_restart := jpeg_resync_to_restart; // use default method
  5289. pub.term_source := glBitmap_libJPEG_term_source;
  5290. pub.bytes_in_buffer := 0; // forces fill_input_buffer on first read
  5291. pub.next_input_byte := nil; // until buffer loaded
  5292. SrcStream := aStream;
  5293. end;
  5294. // set global decoding state
  5295. jpeg.global_state := DSTATE_START;
  5296. // read header of jpeg
  5297. jpeg_read_header(@jpeg, false);
  5298. // setting output parameter
  5299. case jpeg.jpeg_color_space of
  5300. JCS_GRAYSCALE:
  5301. begin
  5302. jpeg.out_color_space := JCS_GRAYSCALE;
  5303. IntFormat := tfLuminance8;
  5304. end;
  5305. else
  5306. jpeg.out_color_space := JCS_RGB;
  5307. IntFormat := tfRGB8;
  5308. end;
  5309. // reading image
  5310. jpeg_start_decompress(@jpeg);
  5311. TempHeight := jpeg.output_height;
  5312. TempWidth := jpeg.output_width;
  5313. FormatDesc := TFormatDescriptor.Get(IntFormat);
  5314. // creating new image
  5315. GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
  5316. try
  5317. pTemp := pImage;
  5318. for Row := 0 to TempHeight -1 do begin
  5319. jpeg_read_scanlines(@jpeg, @pTemp, 1);
  5320. Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
  5321. end;
  5322. // finish decompression
  5323. jpeg_finish_decompress(@jpeg);
  5324. // destroy decompression
  5325. jpeg_destroy_decompress(@jpeg);
  5326. SetDataPointer(pImage, IntFormat, TempWidth, TempHeight);
  5327. result := true;
  5328. except
  5329. FreeMem(pImage);
  5330. raise;
  5331. end;
  5332. end;
  5333. finally
  5334. quit_libJPEG;
  5335. end;
  5336. end;
  5337. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  5338. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5339. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5340. var
  5341. bmp: TBitmap;
  5342. jpg: TJPEGImage;
  5343. StreamPos: Int64;
  5344. Temp: array[0..1]of Byte;
  5345. begin
  5346. result := false;
  5347. // reading first two bytes to test file and set cursor back to begin
  5348. StreamPos := Stream.Position;
  5349. Stream.Read(Temp[0], 2);
  5350. Stream.Position := StreamPos;
  5351. // if Bitmap then read file.
  5352. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  5353. bmp := TBitmap.Create;
  5354. try
  5355. jpg := TJPEGImage.Create;
  5356. try
  5357. jpg.LoadFromStream(Stream);
  5358. bmp.Assign(jpg);
  5359. result := AssignFromBitmap(bmp);
  5360. finally
  5361. jpg.Free;
  5362. end;
  5363. finally
  5364. bmp.Free;
  5365. end;
  5366. end;
  5367. end;
  5368. {$IFEND}
  5369. {$ENDIF}
  5370. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  5371. {$IF DEFINED(GLB_LIB_JPEG)}
  5372. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5373. procedure TglBitmap.SaveJPEG(const aStream: TStream);
  5374. var
  5375. jpeg: jpeg_compress_struct;
  5376. jpeg_err: jpeg_error_mgr;
  5377. Row: Integer;
  5378. pTemp, pTemp2: pByte;
  5379. procedure CopyRow(pDest, pSource: pByte);
  5380. var
  5381. X: Integer;
  5382. begin
  5383. for X := 0 to Width - 1 do begin
  5384. pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
  5385. pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
  5386. pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
  5387. Inc(pDest, 3);
  5388. Inc(pSource, 3);
  5389. end;
  5390. end;
  5391. begin
  5392. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  5393. raise EglBitmapUnsupportedFormat.Create(Format);
  5394. if not init_libJPEG then
  5395. raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
  5396. try
  5397. FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
  5398. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  5399. // error managment
  5400. jpeg.err := jpeg_std_error(@jpeg_err);
  5401. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  5402. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  5403. // compression struct
  5404. jpeg_create_compress(@jpeg);
  5405. // allocation space for streaming methods
  5406. jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
  5407. // seeting up custom functions
  5408. with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
  5409. pub.init_destination := glBitmap_libJPEG_init_destination;
  5410. pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
  5411. pub.term_destination := glBitmap_libJPEG_term_destination;
  5412. pub.next_output_byte := @DestBuffer[1];
  5413. pub.free_in_buffer := Length(DestBuffer);
  5414. DestStream := aStream;
  5415. end;
  5416. // very important state
  5417. jpeg.global_state := CSTATE_START;
  5418. jpeg.image_width := Width;
  5419. jpeg.image_height := Height;
  5420. case Format of
  5421. tfAlpha8, tfLuminance8: begin
  5422. jpeg.input_components := 1;
  5423. jpeg.in_color_space := JCS_GRAYSCALE;
  5424. end;
  5425. tfRGB8, tfBGR8: begin
  5426. jpeg.input_components := 3;
  5427. jpeg.in_color_space := JCS_RGB;
  5428. end;
  5429. end;
  5430. jpeg_set_defaults(@jpeg);
  5431. jpeg_set_quality(@jpeg, 95, true);
  5432. jpeg_start_compress(@jpeg, true);
  5433. pTemp := Data;
  5434. if Format = tfBGR8 then
  5435. GetMem(pTemp2, fRowSize)
  5436. else
  5437. pTemp2 := pTemp;
  5438. try
  5439. for Row := 0 to jpeg.image_height -1 do begin
  5440. // prepare row
  5441. if Format = tfBGR8 then
  5442. CopyRow(pTemp2, pTemp)
  5443. else
  5444. pTemp2 := pTemp;
  5445. // write row
  5446. jpeg_write_scanlines(@jpeg, @pTemp2, 1);
  5447. inc(pTemp, fRowSize);
  5448. end;
  5449. finally
  5450. // free memory
  5451. if Format = tfBGR8 then
  5452. FreeMem(pTemp2);
  5453. end;
  5454. jpeg_finish_compress(@jpeg);
  5455. jpeg_destroy_compress(@jpeg);
  5456. finally
  5457. quit_libJPEG;
  5458. end;
  5459. end;
  5460. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  5461. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5462. procedure TglBitmap.SaveJPEG(Stream: TStream);
  5463. var
  5464. Bmp: TBitmap;
  5465. Jpg: TJPEGImage;
  5466. begin
  5467. if not (ftJPEG in FormatGetSupportedFiles (InternalFormat)) then
  5468. raise EglBitmapUnsupportedInternalFormat.Create('SaveJpg - ' + UNSUPPORTED_INTERNAL_FORMAT);
  5469. Bmp := TBitmap.Create;
  5470. try
  5471. Jpg := TJPEGImage.Create;
  5472. try
  5473. AssignToBitmap(Bmp);
  5474. if FInternalFormat in [ifAlpha, ifLuminance, ifDepth8] then begin
  5475. Jpg.Grayscale := true;
  5476. Jpg.PixelFormat := jf8Bit;
  5477. end;
  5478. Jpg.Assign(Bmp);
  5479. Jpg.SaveToStream(Stream);
  5480. finally
  5481. FreeAndNil(Jpg);
  5482. end;
  5483. finally
  5484. FreeAndNil(Bmp);
  5485. end;
  5486. end;
  5487. {$ENDIF}
  5488. {$ENDIF}
  5489. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5490. //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5491. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5492. const
  5493. BMP_MAGIC = $4D42;
  5494. BMP_COMP_RGB = 0;
  5495. BMP_COMP_RLE8 = 1;
  5496. BMP_COMP_RLE4 = 2;
  5497. BMP_COMP_BITFIELDS = 3;
  5498. type
  5499. TBMPHeader = packed record
  5500. bfType: Word;
  5501. bfSize: Cardinal;
  5502. bfReserved1: Word;
  5503. bfReserved2: Word;
  5504. bfOffBits: Cardinal;
  5505. end;
  5506. TBMPInfo = packed record
  5507. biSize: Cardinal;
  5508. biWidth: Longint;
  5509. biHeight: Longint;
  5510. biPlanes: Word;
  5511. biBitCount: Word;
  5512. biCompression: Cardinal;
  5513. biSizeImage: Cardinal;
  5514. biXPelsPerMeter: Longint;
  5515. biYPelsPerMeter: Longint;
  5516. biClrUsed: Cardinal;
  5517. biClrImportant: Cardinal;
  5518. end;
  5519. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5520. function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
  5521. //////////////////////////////////////////////////////////////////////////////////////////////////
  5522. function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapColorRec): TglBitmapFormat;
  5523. begin
  5524. result := tfEmpty;
  5525. aStream.Read(aInfo{%H-}, SizeOf(aInfo));
  5526. FillChar(aMask{%H-}, SizeOf(aMask), 0);
  5527. //Read Compression
  5528. case aInfo.biCompression of
  5529. BMP_COMP_RLE4,
  5530. BMP_COMP_RLE8: begin
  5531. raise EglBitmapException.Create('RLE compression is not supported');
  5532. end;
  5533. BMP_COMP_BITFIELDS: begin
  5534. if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
  5535. aStream.Read(aMask.r, SizeOf(aMask.r));
  5536. aStream.Read(aMask.g, SizeOf(aMask.g));
  5537. aStream.Read(aMask.b, SizeOf(aMask.b));
  5538. aStream.Read(aMask.a, SizeOf(aMask.a));
  5539. end else
  5540. raise EglBitmapException.Create('Bitfields are only supported for 16bit and 32bit formats');
  5541. end;
  5542. end;
  5543. //get suitable format
  5544. case aInfo.biBitCount of
  5545. 8: result := tfLuminance8;
  5546. 16: result := tfBGR5;
  5547. 24: result := tfBGR8;
  5548. 32: result := tfBGRA8;
  5549. end;
  5550. end;
  5551. function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
  5552. var
  5553. i, c: Integer;
  5554. ColorTable: TbmpColorTable;
  5555. begin
  5556. result := nil;
  5557. if (aInfo.biBitCount >= 16) then
  5558. exit;
  5559. aFormat := tfLuminance8;
  5560. c := aInfo.biClrUsed;
  5561. if (c = 0) then
  5562. c := 1 shl aInfo.biBitCount;
  5563. SetLength(ColorTable, c);
  5564. for i := 0 to c-1 do begin
  5565. aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
  5566. if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
  5567. aFormat := tfRGB8;
  5568. end;
  5569. result := TbmpColorTableFormat.Create;
  5570. result.PixelSize := aInfo.biBitCount / 8;
  5571. result.ColorTable := ColorTable;
  5572. result.Range := glBitmapColorRec($FF, $FF, $FF, $00);
  5573. end;
  5574. //////////////////////////////////////////////////////////////////////////////////////////////////
  5575. function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
  5576. const aInfo: TBMPInfo): TbmpBitfieldFormat;
  5577. var
  5578. TmpFormat: TglBitmapFormat;
  5579. FormatDesc: TFormatDescriptor;
  5580. begin
  5581. result := nil;
  5582. if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
  5583. for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  5584. FormatDesc := TFormatDescriptor.Get(TmpFormat);
  5585. if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
  5586. aFormat := FormatDesc.Format;
  5587. exit;
  5588. end;
  5589. end;
  5590. if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
  5591. aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
  5592. if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
  5593. aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
  5594. result := TbmpBitfieldFormat.Create;
  5595. result.PixelSize := aInfo.biBitCount / 8;
  5596. result.RedMask := aMask.r;
  5597. result.GreenMask := aMask.g;
  5598. result.BlueMask := aMask.b;
  5599. result.AlphaMask := aMask.a;
  5600. end;
  5601. end;
  5602. var
  5603. //simple types
  5604. StartPos: Int64;
  5605. ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
  5606. PaddingBuff: Cardinal;
  5607. LineBuf, ImageData, TmpData: PByte;
  5608. SourceMD, DestMD: Pointer;
  5609. BmpFormat: TglBitmapFormat;
  5610. //records
  5611. Mask: TglBitmapColorRec;
  5612. Header: TBMPHeader;
  5613. Info: TBMPInfo;
  5614. //classes
  5615. SpecialFormat: TFormatDescriptor;
  5616. FormatDesc: TFormatDescriptor;
  5617. //////////////////////////////////////////////////////////////////////////////////////////////////
  5618. procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
  5619. var
  5620. i: Integer;
  5621. Pixel: TglBitmapPixelData;
  5622. begin
  5623. aStream.Read(aLineBuf^, rbLineSize);
  5624. SpecialFormat.PreparePixel(Pixel);
  5625. for i := 0 to Info.biWidth-1 do begin
  5626. SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
  5627. glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
  5628. FormatDesc.Map(Pixel, aData, DestMD);
  5629. end;
  5630. end;
  5631. begin
  5632. result := false;
  5633. BmpFormat := tfEmpty;
  5634. SpecialFormat := nil;
  5635. LineBuf := nil;
  5636. SourceMD := nil;
  5637. DestMD := nil;
  5638. // Header
  5639. StartPos := aStream.Position;
  5640. aStream.Read(Header{%H-}, SizeOf(Header));
  5641. if Header.bfType = BMP_MAGIC then begin
  5642. try try
  5643. BmpFormat := ReadInfo(Info, Mask);
  5644. SpecialFormat := ReadColorTable(BmpFormat, Info);
  5645. if not Assigned(SpecialFormat) then
  5646. SpecialFormat := CheckBitfields(BmpFormat, Mask, Info);
  5647. aStream.Position := StartPos + Header.bfOffBits;
  5648. if (BmpFormat <> tfEmpty) then begin
  5649. FormatDesc := TFormatDescriptor.Get(BmpFormat);
  5650. rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
  5651. wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
  5652. Padding := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
  5653. //get Memory
  5654. DestMD := FormatDesc.CreateMappingData;
  5655. ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
  5656. GetMem(ImageData, ImageSize);
  5657. if Assigned(SpecialFormat) then begin
  5658. GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
  5659. SourceMD := SpecialFormat.CreateMappingData;
  5660. end;
  5661. //read Data
  5662. try try
  5663. FillChar(ImageData^, ImageSize, $FF);
  5664. TmpData := ImageData;
  5665. if (Info.biHeight > 0) then
  5666. Inc(TmpData, wbLineSize * (Info.biHeight-1));
  5667. for i := 0 to Abs(Info.biHeight)-1 do begin
  5668. if Assigned(SpecialFormat) then
  5669. SpecialFormatReadLine(TmpData, LineBuf) //if is special format read and convert data
  5670. else
  5671. aStream.Read(TmpData^, wbLineSize); //else only read data
  5672. if (Info.biHeight > 0) then
  5673. dec(TmpData, wbLineSize)
  5674. else
  5675. inc(TmpData, wbLineSize);
  5676. aStream.Read(PaddingBuff{%H-}, Padding);
  5677. end;
  5678. SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight));
  5679. result := true;
  5680. finally
  5681. if Assigned(LineBuf) then
  5682. FreeMem(LineBuf);
  5683. if Assigned(SourceMD) then
  5684. SpecialFormat.FreeMappingData(SourceMD);
  5685. FormatDesc.FreeMappingData(DestMD);
  5686. end;
  5687. except
  5688. FreeMem(ImageData);
  5689. raise;
  5690. end;
  5691. end else
  5692. raise EglBitmapException.Create('LoadBMP - No suitable format found');
  5693. except
  5694. aStream.Position := StartPos;
  5695. raise;
  5696. end;
  5697. finally
  5698. FreeAndNil(SpecialFormat);
  5699. end;
  5700. end
  5701. else aStream.Position := StartPos;
  5702. end;
  5703. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5704. procedure TglBitmap.SaveBMP(const aStream: TStream);
  5705. var
  5706. Header: TBMPHeader;
  5707. Info: TBMPInfo;
  5708. Converter: TbmpColorTableFormat;
  5709. FormatDesc: TFormatDescriptor;
  5710. SourceFD, DestFD: Pointer;
  5711. pData, srcData, dstData, ConvertBuffer: pByte;
  5712. Pixel: TglBitmapPixelData;
  5713. ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
  5714. RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
  5715. PaddingBuff: Cardinal;
  5716. function GetLineWidth : Integer;
  5717. begin
  5718. result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
  5719. end;
  5720. begin
  5721. if not (ftBMP in FormatGetSupportedFiles(Format)) then
  5722. raise EglBitmapUnsupportedFormat.Create(Format);
  5723. Converter := nil;
  5724. FormatDesc := TFormatDescriptor.Get(Format);
  5725. ImageSize := FormatDesc.GetSize(Dimension);
  5726. FillChar(Header{%H-}, SizeOf(Header), 0);
  5727. Header.bfType := BMP_MAGIC;
  5728. Header.bfSize := SizeOf(Header) + SizeOf(Info) + ImageSize;
  5729. Header.bfReserved1 := 0;
  5730. Header.bfReserved2 := 0;
  5731. Header.bfOffBits := SizeOf(Header) + SizeOf(Info);
  5732. FillChar(Info{%H-}, SizeOf(Info), 0);
  5733. Info.biSize := SizeOf(Info);
  5734. Info.biWidth := Width;
  5735. Info.biHeight := Height;
  5736. Info.biPlanes := 1;
  5737. Info.biCompression := BMP_COMP_RGB;
  5738. Info.biSizeImage := ImageSize;
  5739. try
  5740. case Format of
  5741. tfLuminance4: begin
  5742. Info.biBitCount := 4;
  5743. Header.bfSize := Header.bfSize + 16 * SizeOf(Cardinal);
  5744. Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
  5745. Converter := TbmpColorTableFormat.Create;
  5746. Converter.PixelSize := 0.5;
  5747. Converter.Format := Format;
  5748. Converter.Range := glBitmapColorRec($F, $F, $F, $0);
  5749. Converter.CreateColorTable;
  5750. end;
  5751. tfR3G3B2, tfLuminance8: begin
  5752. Info.biBitCount := 8;
  5753. Header.bfSize := Header.bfSize + 256 * SizeOf(Cardinal);
  5754. Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
  5755. Converter := TbmpColorTableFormat.Create;
  5756. Converter.PixelSize := 1;
  5757. Converter.Format := Format;
  5758. if (Format = tfR3G3B2) then begin
  5759. Converter.Range := glBitmapColorRec($7, $7, $3, $0);
  5760. Converter.Shift := glBitmapShiftRec(0, 3, 6, 0);
  5761. end else
  5762. Converter.Range := glBitmapColorRec($FF, $FF, $FF, $0);
  5763. Converter.CreateColorTable;
  5764. end;
  5765. tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
  5766. tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin
  5767. Info.biBitCount := 16;
  5768. Info.biCompression := BMP_COMP_BITFIELDS;
  5769. end;
  5770. tfBGR8, tfRGB8: begin
  5771. Info.biBitCount := 24;
  5772. end;
  5773. tfRGB10, tfRGB10A2, tfRGBA8,
  5774. tfBGR10, tfBGR10A2, tfBGRA8: begin
  5775. Info.biBitCount := 32;
  5776. Info.biCompression := BMP_COMP_BITFIELDS;
  5777. end;
  5778. else
  5779. raise EglBitmapUnsupportedFormat.Create(Format);
  5780. end;
  5781. Info.biXPelsPerMeter := 2835;
  5782. Info.biYPelsPerMeter := 2835;
  5783. // prepare bitmasks
  5784. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  5785. Header.bfSize := Header.bfSize + 4 * SizeOf(Cardinal);
  5786. Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
  5787. RedMask := FormatDesc.RedMask;
  5788. GreenMask := FormatDesc.GreenMask;
  5789. BlueMask := FormatDesc.BlueMask;
  5790. AlphaMask := FormatDesc.AlphaMask;
  5791. end;
  5792. // headers
  5793. aStream.Write(Header, SizeOf(Header));
  5794. aStream.Write(Info, SizeOf(Info));
  5795. // colortable
  5796. if Assigned(Converter) then
  5797. aStream.Write(Converter.ColorTable[0].b,
  5798. SizeOf(TbmpColorTableEnty) * Length(Converter.ColorTable));
  5799. // bitmasks
  5800. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  5801. aStream.Write(RedMask, SizeOf(Cardinal));
  5802. aStream.Write(GreenMask, SizeOf(Cardinal));
  5803. aStream.Write(BlueMask, SizeOf(Cardinal));
  5804. aStream.Write(AlphaMask, SizeOf(Cardinal));
  5805. end;
  5806. // image data
  5807. rbLineSize := Round(Info.biWidth * FormatDesc.PixelSize);
  5808. wbLineSize := Round(Info.biWidth * Info.biBitCount / 8);
  5809. Padding := GetLineWidth - wbLineSize;
  5810. PaddingBuff := 0;
  5811. pData := Data;
  5812. inc(pData, (Height-1) * rbLineSize);
  5813. // prepare row buffer. But only for RGB because RGBA supports color masks
  5814. // so it's possible to change color within the image.
  5815. if Assigned(Converter) then begin
  5816. FormatDesc.PreparePixel(Pixel);
  5817. GetMem(ConvertBuffer, wbLineSize);
  5818. SourceFD := FormatDesc.CreateMappingData;
  5819. DestFD := Converter.CreateMappingData;
  5820. end else
  5821. ConvertBuffer := nil;
  5822. try
  5823. for LineIdx := 0 to Height - 1 do begin
  5824. // preparing row
  5825. if Assigned(Converter) then begin
  5826. srcData := pData;
  5827. dstData := ConvertBuffer;
  5828. for PixelIdx := 0 to Info.biWidth-1 do begin
  5829. FormatDesc.Unmap(srcData, Pixel, SourceFD);
  5830. glBitmapConvertPixel(Pixel, FormatDesc, Converter);
  5831. Converter.Map(Pixel, dstData, DestFD);
  5832. end;
  5833. aStream.Write(ConvertBuffer^, wbLineSize);
  5834. end else begin
  5835. aStream.Write(pData^, rbLineSize);
  5836. end;
  5837. dec(pData, rbLineSize);
  5838. if (Padding > 0) then
  5839. aStream.Write(PaddingBuff, Padding);
  5840. end;
  5841. finally
  5842. // destroy row buffer
  5843. if Assigned(ConvertBuffer) then begin
  5844. FormatDesc.FreeMappingData(SourceFD);
  5845. Converter.FreeMappingData(DestFD);
  5846. FreeMem(ConvertBuffer);
  5847. end;
  5848. end;
  5849. finally
  5850. if Assigned(Converter) then
  5851. Converter.Free;
  5852. end;
  5853. end;
  5854. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5855. //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5856. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5857. type
  5858. TTGAHeader = packed record
  5859. ImageID: Byte;
  5860. ColorMapType: Byte;
  5861. ImageType: Byte;
  5862. //ColorMapSpec: Array[0..4] of Byte;
  5863. ColorMapStart: Word;
  5864. ColorMapLength: Word;
  5865. ColorMapEntrySize: Byte;
  5866. OrigX: Word;
  5867. OrigY: Word;
  5868. Width: Word;
  5869. Height: Word;
  5870. Bpp: Byte;
  5871. ImageDesc: Byte;
  5872. end;
  5873. const
  5874. TGA_UNCOMPRESSED_RGB = 2;
  5875. TGA_UNCOMPRESSED_GRAY = 3;
  5876. TGA_COMPRESSED_RGB = 10;
  5877. TGA_COMPRESSED_GRAY = 11;
  5878. TGA_NONE_COLOR_TABLE = 0;
  5879. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5880. function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
  5881. var
  5882. Header: TTGAHeader;
  5883. ImageData: System.PByte;
  5884. StartPosition: Int64;
  5885. PixelSize, LineSize: Integer;
  5886. tgaFormat: TglBitmapFormat;
  5887. FormatDesc: TFormatDescriptor;
  5888. Counter: packed record
  5889. X, Y: packed record
  5890. low, high, dir: Integer;
  5891. end;
  5892. end;
  5893. const
  5894. CACHE_SIZE = $4000;
  5895. ////////////////////////////////////////////////////////////////////////////////////////
  5896. procedure ReadUncompressed;
  5897. var
  5898. i, j: Integer;
  5899. buf, tmp1, tmp2: System.PByte;
  5900. begin
  5901. buf := nil;
  5902. if (Counter.X.dir < 0) then
  5903. buf := GetMem(LineSize);
  5904. try
  5905. while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
  5906. tmp1 := ImageData + (Counter.Y.low * LineSize); //pointer to LineStart
  5907. if (Counter.X.dir < 0) then begin //flip X
  5908. aStream.Read(buf^, LineSize);
  5909. tmp2 := buf + LineSize - PixelSize; //pointer to last pixel in line
  5910. for i := 0 to Header.Width-1 do begin //for all pixels in line
  5911. for j := 0 to PixelSize-1 do begin //for all bytes in pixel
  5912. tmp1^ := tmp2^;
  5913. inc(tmp1);
  5914. inc(tmp2);
  5915. end;
  5916. dec(tmp2, 2*PixelSize); //move 2 backwards, because j-loop moved 1 forward
  5917. end;
  5918. end else
  5919. aStream.Read(tmp1^, LineSize);
  5920. inc(Counter.Y.low, Counter.Y.dir); //move to next line index
  5921. end;
  5922. finally
  5923. if Assigned(buf) then
  5924. FreeMem(buf);
  5925. end;
  5926. end;
  5927. ////////////////////////////////////////////////////////////////////////////////////////
  5928. procedure ReadCompressed;
  5929. /////////////////////////////////////////////////////////////////
  5930. var
  5931. TmpData: System.PByte;
  5932. LinePixelsRead: Integer;
  5933. procedure CheckLine;
  5934. begin
  5935. if (LinePixelsRead >= Header.Width) then begin
  5936. LinePixelsRead := 0;
  5937. inc(Counter.Y.low, Counter.Y.dir); //next line index
  5938. TmpData := ImageData + Counter.Y.low * LineSize; //set line
  5939. if (Counter.X.dir < 0) then //if x flipped then
  5940. TmpData := TmpData + LineSize - PixelSize; //set last pixel
  5941. end;
  5942. end;
  5943. /////////////////////////////////////////////////////////////////
  5944. var
  5945. Cache: PByte;
  5946. CacheSize, CachePos: Integer;
  5947. procedure CachedRead(out Buffer; Count: Integer);
  5948. var
  5949. BytesRead: Integer;
  5950. begin
  5951. if (CachePos + Count > CacheSize) then begin
  5952. //if buffer overflow save non read bytes
  5953. BytesRead := 0;
  5954. if (CacheSize - CachePos > 0) then begin
  5955. BytesRead := CacheSize - CachePos;
  5956. Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
  5957. inc(CachePos, BytesRead);
  5958. end;
  5959. //load cache from file
  5960. CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
  5961. aStream.Read(Cache^, CacheSize);
  5962. CachePos := 0;
  5963. //read rest of requested bytes
  5964. if (Count - BytesRead > 0) then begin
  5965. Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
  5966. inc(CachePos, Count - BytesRead);
  5967. end;
  5968. end else begin
  5969. //if no buffer overflow just read the data
  5970. Move(PByteArray(Cache)^[CachePos], Buffer, Count);
  5971. inc(CachePos, Count);
  5972. end;
  5973. end;
  5974. procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
  5975. begin
  5976. case PixelSize of
  5977. 1: begin
  5978. aBuffer^ := aData^;
  5979. inc(aBuffer, Counter.X.dir);
  5980. end;
  5981. 2: begin
  5982. PWord(aBuffer)^ := PWord(aData)^;
  5983. inc(aBuffer, 2 * Counter.X.dir);
  5984. end;
  5985. 3: begin
  5986. PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
  5987. PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
  5988. PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
  5989. inc(aBuffer, 3 * Counter.X.dir);
  5990. end;
  5991. 4: begin
  5992. PCardinal(aBuffer)^ := PCardinal(aData)^;
  5993. inc(aBuffer, 4 * Counter.X.dir);
  5994. end;
  5995. end;
  5996. end;
  5997. var
  5998. TotalPixelsToRead, TotalPixelsRead: Integer;
  5999. Temp: Byte;
  6000. buf: array [0..3] of Byte; //1 pixel is max 32bit long
  6001. PixelRepeat: Boolean;
  6002. PixelsToRead, PixelCount: Integer;
  6003. begin
  6004. CacheSize := 0;
  6005. CachePos := 0;
  6006. TotalPixelsToRead := Header.Width * Header.Height;
  6007. TotalPixelsRead := 0;
  6008. LinePixelsRead := 0;
  6009. GetMem(Cache, CACHE_SIZE);
  6010. try
  6011. TmpData := ImageData + Counter.Y.low * LineSize; //set line
  6012. if (Counter.X.dir < 0) then //if x flipped then
  6013. TmpData := TmpData + LineSize - PixelSize; //set last pixel
  6014. repeat
  6015. //read CommandByte
  6016. CachedRead(Temp, 1);
  6017. PixelRepeat := (Temp and $80) > 0;
  6018. PixelsToRead := (Temp and $7F) + 1;
  6019. inc(TotalPixelsRead, PixelsToRead);
  6020. if PixelRepeat then
  6021. CachedRead(buf[0], PixelSize);
  6022. while (PixelsToRead > 0) do begin
  6023. CheckLine;
  6024. PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
  6025. while (PixelCount > 0) do begin
  6026. if not PixelRepeat then
  6027. CachedRead(buf[0], PixelSize);
  6028. PixelToBuffer(@buf[0], TmpData);
  6029. inc(LinePixelsRead);
  6030. dec(PixelsToRead);
  6031. dec(PixelCount);
  6032. end;
  6033. end;
  6034. until (TotalPixelsRead >= TotalPixelsToRead);
  6035. finally
  6036. FreeMem(Cache);
  6037. end;
  6038. end;
  6039. function IsGrayFormat: Boolean;
  6040. begin
  6041. result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
  6042. end;
  6043. begin
  6044. result := false;
  6045. // reading header to test file and set cursor back to begin
  6046. StartPosition := aStream.Position;
  6047. aStream.Read(Header{%H-}, SizeOf(Header));
  6048. // no colormapped files
  6049. if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
  6050. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
  6051. begin
  6052. try
  6053. if Header.ImageID <> 0 then // skip image ID
  6054. aStream.Position := aStream.Position + Header.ImageID;
  6055. case Header.Bpp of
  6056. 8: if IsGrayFormat then case (Header.ImageDesc and $F) of
  6057. 0: tgaFormat := tfLuminance8;
  6058. 8: tgaFormat := tfAlpha8;
  6059. end;
  6060. 16: if IsGrayFormat then case (Header.ImageDesc and $F) of
  6061. 0: tgaFormat := tfLuminance16;
  6062. 8: tgaFormat := tfLuminance8Alpha8;
  6063. end else case (Header.ImageDesc and $F) of
  6064. 0: tgaFormat := tfBGR5;
  6065. 1: tgaFormat := tfBGR5A1;
  6066. 4: tgaFormat := tfBGRA4;
  6067. end;
  6068. 24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  6069. 0: tgaFormat := tfBGR8;
  6070. end;
  6071. 32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  6072. 2: tgaFormat := tfBGR10A2;
  6073. 8: tgaFormat := tfBGRA8;
  6074. end;
  6075. end;
  6076. if (tgaFormat = tfEmpty) then
  6077. raise EglBitmapException.Create('LoadTga - unsupported format');
  6078. FormatDesc := TFormatDescriptor.Get(tgaFormat);
  6079. PixelSize := FormatDesc.GetSize(1, 1);
  6080. LineSize := FormatDesc.GetSize(Header.Width, 1);
  6081. GetMem(ImageData, LineSize * Header.Height);
  6082. try
  6083. //column direction
  6084. if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
  6085. Counter.X.low := Header.Height-1;;
  6086. Counter.X.high := 0;
  6087. Counter.X.dir := -1;
  6088. end else begin
  6089. Counter.X.low := 0;
  6090. Counter.X.high := Header.Height-1;
  6091. Counter.X.dir := 1;
  6092. end;
  6093. // Row direction
  6094. if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
  6095. Counter.Y.low := 0;
  6096. Counter.Y.high := Header.Height-1;
  6097. Counter.Y.dir := 1;
  6098. end else begin
  6099. Counter.Y.low := Header.Height-1;;
  6100. Counter.Y.high := 0;
  6101. Counter.Y.dir := -1;
  6102. end;
  6103. // Read Image
  6104. case Header.ImageType of
  6105. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
  6106. ReadUncompressed;
  6107. TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
  6108. ReadCompressed;
  6109. end;
  6110. SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height);
  6111. result := true;
  6112. except
  6113. FreeMem(ImageData);
  6114. raise;
  6115. end;
  6116. finally
  6117. aStream.Position := StartPosition;
  6118. end;
  6119. end
  6120. else aStream.Position := StartPosition;
  6121. end;
  6122. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6123. procedure TglBitmap.SaveTGA(const aStream: TStream);
  6124. var
  6125. Header: TTGAHeader;
  6126. LineSize, Size, x, y: Integer;
  6127. Pixel: TglBitmapPixelData;
  6128. LineBuf, SourceData, DestData: PByte;
  6129. SourceMD, DestMD: Pointer;
  6130. FormatDesc: TFormatDescriptor;
  6131. Converter: TFormatDescriptor;
  6132. begin
  6133. if not (ftTGA in FormatGetSupportedFiles(Format)) then
  6134. raise EglBitmapUnsupportedFormat.Create(Format);
  6135. //prepare header
  6136. FillChar(Header{%H-}, SizeOf(Header), 0);
  6137. //set ImageType
  6138. if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
  6139. tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
  6140. Header.ImageType := TGA_UNCOMPRESSED_GRAY
  6141. else
  6142. Header.ImageType := TGA_UNCOMPRESSED_RGB;
  6143. //set BitsPerPixel
  6144. if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
  6145. Header.Bpp := 8
  6146. else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
  6147. tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
  6148. Header.Bpp := 16
  6149. else if (Format in [tfBGR8, tfRGB8]) then
  6150. Header.Bpp := 24
  6151. else
  6152. Header.Bpp := 32;
  6153. //set AlphaBitCount
  6154. case Format of
  6155. tfRGB5A1, tfBGR5A1:
  6156. Header.ImageDesc := 1 and $F;
  6157. tfRGB10A2, tfBGR10A2:
  6158. Header.ImageDesc := 2 and $F;
  6159. tfRGBA4, tfBGRA4:
  6160. Header.ImageDesc := 4 and $F;
  6161. tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
  6162. Header.ImageDesc := 8 and $F;
  6163. end;
  6164. Header.Width := Width;
  6165. Header.Height := Height;
  6166. Header.ImageDesc := Header.ImageDesc or $20; //flip y
  6167. aStream.Write(Header, SizeOf(Header));
  6168. // convert RGB(A) to BGR(A)
  6169. Converter := nil;
  6170. FormatDesc := TFormatDescriptor.Get(Format);
  6171. Size := FormatDesc.GetSize(Dimension);
  6172. if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
  6173. if (FormatDesc.RGBInverted = tfEmpty) then
  6174. raise EglBitmapException.Create('inverted RGB format is empty');
  6175. Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
  6176. if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
  6177. (Converter.PixelSize <> FormatDesc.PixelSize) then
  6178. raise EglBitmapException.Create('invalid inverted RGB format');
  6179. end;
  6180. if Assigned(Converter) then begin
  6181. LineSize := FormatDesc.GetSize(Width, 1);
  6182. LineBuf := GetMem(LineSize);
  6183. SourceMD := FormatDesc.CreateMappingData;
  6184. DestMD := Converter.CreateMappingData;
  6185. try
  6186. SourceData := Data;
  6187. for y := 0 to Height-1 do begin
  6188. DestData := LineBuf;
  6189. for x := 0 to Width-1 do begin
  6190. FormatDesc.Unmap(SourceData, Pixel, SourceMD);
  6191. Converter.Map(Pixel, DestData, DestMD);
  6192. end;
  6193. aStream.Write(LineBuf^, LineSize);
  6194. end;
  6195. finally
  6196. FreeMem(LineBuf);
  6197. FormatDesc.FreeMappingData(SourceMD);
  6198. FormatDesc.FreeMappingData(DestMD);
  6199. end;
  6200. end else
  6201. aStream.Write(Data^, Size);
  6202. end;
  6203. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6204. //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6205. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6206. const
  6207. DDS_MAGIC: Cardinal = $20534444;
  6208. // DDS_header.dwFlags
  6209. DDSD_CAPS = $00000001;
  6210. DDSD_HEIGHT = $00000002;
  6211. DDSD_WIDTH = $00000004;
  6212. DDSD_PIXELFORMAT = $00001000;
  6213. // DDS_header.sPixelFormat.dwFlags
  6214. DDPF_ALPHAPIXELS = $00000001;
  6215. DDPF_ALPHA = $00000002;
  6216. DDPF_FOURCC = $00000004;
  6217. DDPF_RGB = $00000040;
  6218. DDPF_LUMINANCE = $00020000;
  6219. // DDS_header.sCaps.dwCaps1
  6220. DDSCAPS_TEXTURE = $00001000;
  6221. // DDS_header.sCaps.dwCaps2
  6222. DDSCAPS2_CUBEMAP = $00000200;
  6223. D3DFMT_DXT1 = $31545844;
  6224. D3DFMT_DXT3 = $33545844;
  6225. D3DFMT_DXT5 = $35545844;
  6226. type
  6227. TDDSPixelFormat = packed record
  6228. dwSize: Cardinal;
  6229. dwFlags: Cardinal;
  6230. dwFourCC: Cardinal;
  6231. dwRGBBitCount: Cardinal;
  6232. dwRBitMask: Cardinal;
  6233. dwGBitMask: Cardinal;
  6234. dwBBitMask: Cardinal;
  6235. dwABitMask: Cardinal;
  6236. end;
  6237. TDDSCaps = packed record
  6238. dwCaps1: Cardinal;
  6239. dwCaps2: Cardinal;
  6240. dwDDSX: Cardinal;
  6241. dwReserved: Cardinal;
  6242. end;
  6243. TDDSHeader = packed record
  6244. dwSize: Cardinal;
  6245. dwFlags: Cardinal;
  6246. dwHeight: Cardinal;
  6247. dwWidth: Cardinal;
  6248. dwPitchOrLinearSize: Cardinal;
  6249. dwDepth: Cardinal;
  6250. dwMipMapCount: Cardinal;
  6251. dwReserved: array[0..10] of Cardinal;
  6252. PixelFormat: TDDSPixelFormat;
  6253. Caps: TDDSCaps;
  6254. dwReserved2: Cardinal;
  6255. end;
  6256. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6257. function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
  6258. var
  6259. Header: TDDSHeader;
  6260. Converter: TbmpBitfieldFormat;
  6261. function GetDDSFormat: TglBitmapFormat;
  6262. var
  6263. fd: TFormatDescriptor;
  6264. i: Integer;
  6265. Range: TglBitmapColorRec;
  6266. match: Boolean;
  6267. begin
  6268. result := tfEmpty;
  6269. with Header.PixelFormat do begin
  6270. // Compresses
  6271. if ((dwFlags and DDPF_FOURCC) > 0) then begin
  6272. case Header.PixelFormat.dwFourCC of
  6273. D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
  6274. D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
  6275. D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
  6276. end;
  6277. end else if ((Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin
  6278. //find matching format
  6279. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  6280. fd := TFormatDescriptor.Get(result);
  6281. if fd.MaskMatch(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask) and
  6282. (8 * fd.PixelSize = dwRGBBitCount) then
  6283. exit;
  6284. end;
  6285. //find format with same Range
  6286. Range.r := dwRBitMask;
  6287. Range.g := dwGBitMask;
  6288. Range.b := dwBBitMask;
  6289. Range.a := dwABitMask;
  6290. for i := 0 to 3 do begin
  6291. while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do
  6292. Range.arr[i] := Range.arr[i] shr 1;
  6293. end;
  6294. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  6295. fd := TFormatDescriptor.Get(result);
  6296. match := true;
  6297. for i := 0 to 3 do
  6298. if (fd.Range.arr[i] <> Range.arr[i]) then begin
  6299. match := false;
  6300. break;
  6301. end;
  6302. if match then
  6303. break;
  6304. end;
  6305. //no format with same range found -> use default
  6306. if (result = tfEmpty) then begin
  6307. if (dwABitMask > 0) then
  6308. result := tfBGRA8
  6309. else
  6310. result := tfBGR8;
  6311. end;
  6312. Converter := TbmpBitfieldFormat.Create;
  6313. Converter.RedMask := dwRBitMask;
  6314. Converter.GreenMask := dwGBitMask;
  6315. Converter.BlueMask := dwBBitMask;
  6316. Converter.AlphaMask := dwABitMask;
  6317. Converter.PixelSize := dwRGBBitCount / 8;
  6318. end;
  6319. end;
  6320. end;
  6321. var
  6322. StreamPos: Int64;
  6323. x, y, LineSize, RowSize, Magic: Cardinal;
  6324. NewImage, TmpData, RowData, SrcData: System.PByte;
  6325. SourceMD, DestMD: Pointer;
  6326. Pixel: TglBitmapPixelData;
  6327. ddsFormat: TglBitmapFormat;
  6328. FormatDesc: TFormatDescriptor;
  6329. begin
  6330. result := false;
  6331. Converter := nil;
  6332. StreamPos := aStream.Position;
  6333. // Magic
  6334. aStream.Read(Magic{%H-}, sizeof(Magic));
  6335. if (Magic <> DDS_MAGIC) then begin
  6336. aStream.Position := StreamPos;
  6337. exit;
  6338. end;
  6339. //Header
  6340. aStream.Read(Header{%H-}, sizeof(Header));
  6341. if (Header.dwSize <> SizeOf(Header)) or
  6342. ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
  6343. (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
  6344. begin
  6345. aStream.Position := StreamPos;
  6346. exit;
  6347. end;
  6348. if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
  6349. raise EglBitmapException.Create('LoadDDS - CubeMaps are not supported');
  6350. ddsFormat := GetDDSFormat;
  6351. try
  6352. if (ddsFormat = tfEmpty) then
  6353. raise EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');
  6354. FormatDesc := TFormatDescriptor.Get(ddsFormat);
  6355. LineSize := Trunc(Header.dwWidth * FormatDesc.PixelSize);
  6356. GetMem(NewImage, Header.dwHeight * LineSize);
  6357. try
  6358. TmpData := NewImage;
  6359. //Converter needed
  6360. if Assigned(Converter) then begin
  6361. RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
  6362. GetMem(RowData, RowSize);
  6363. SourceMD := Converter.CreateMappingData;
  6364. DestMD := FormatDesc.CreateMappingData;
  6365. try
  6366. for y := 0 to Header.dwHeight-1 do begin
  6367. TmpData := NewImage + y * LineSize;
  6368. SrcData := RowData;
  6369. aStream.Read(SrcData^, RowSize);
  6370. for x := 0 to Header.dwWidth-1 do begin
  6371. Converter.Unmap(SrcData, Pixel, SourceMD);
  6372. glBitmapConvertPixel(Pixel, Converter, FormatDesc);
  6373. FormatDesc.Map(Pixel, TmpData, DestMD);
  6374. end;
  6375. end;
  6376. finally
  6377. Converter.FreeMappingData(SourceMD);
  6378. FormatDesc.FreeMappingData(DestMD);
  6379. FreeMem(RowData);
  6380. end;
  6381. end else
  6382. // Compressed
  6383. if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
  6384. RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
  6385. for Y := 0 to Header.dwHeight-1 do begin
  6386. aStream.Read(TmpData^, RowSize);
  6387. Inc(TmpData, LineSize);
  6388. end;
  6389. end else
  6390. // Uncompressed
  6391. if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
  6392. RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
  6393. for Y := 0 to Header.dwHeight-1 do begin
  6394. aStream.Read(TmpData^, RowSize);
  6395. Inc(TmpData, LineSize);
  6396. end;
  6397. end else
  6398. raise EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');
  6399. SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight);
  6400. result := true;
  6401. except
  6402. FreeMem(NewImage);
  6403. raise;
  6404. end;
  6405. finally
  6406. FreeAndNil(Converter);
  6407. end;
  6408. end;
  6409. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6410. procedure TglBitmap.SaveDDS(const aStream: TStream);
  6411. var
  6412. Header: TDDSHeader;
  6413. FormatDesc: TFormatDescriptor;
  6414. begin
  6415. if not (ftDDS in FormatGetSupportedFiles(Format)) then
  6416. raise EglBitmapUnsupportedFormat.Create(Format);
  6417. FormatDesc := TFormatDescriptor.Get(Format);
  6418. // Generell
  6419. FillChar(Header{%H-}, SizeOf(Header), 0);
  6420. Header.dwSize := SizeOf(Header);
  6421. Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
  6422. Header.dwWidth := Max(1, Width);
  6423. Header.dwHeight := Max(1, Height);
  6424. // Caps
  6425. Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
  6426. // Pixelformat
  6427. Header.PixelFormat.dwSize := sizeof(Header);
  6428. if (FormatDesc.IsCompressed) then begin
  6429. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
  6430. case Format of
  6431. tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
  6432. tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
  6433. tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
  6434. end;
  6435. end else if (Format in [tfAlpha8, tfAlpha16]) then begin
  6436. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHA;
  6437. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6438. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6439. end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
  6440. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
  6441. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6442. Header.PixelFormat.dwRBitMask := FormatDesc.RedMask;
  6443. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6444. end else begin
  6445. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
  6446. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6447. Header.PixelFormat.dwRBitMask := FormatDesc.RedMask;
  6448. Header.PixelFormat.dwGBitMask := FormatDesc.GreenMask;
  6449. Header.PixelFormat.dwBBitMask := FormatDesc.BlueMask;
  6450. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6451. end;
  6452. if (FormatDesc.HasAlpha) then
  6453. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
  6454. aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
  6455. aStream.Write(Header, SizeOf(Header));
  6456. aStream.Write(Data^, FormatDesc.GetSize(Dimension));
  6457. end;
  6458. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6459. //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6460. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6461. function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
  6462. begin
  6463. if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
  6464. result := fLines[aIndex]
  6465. else
  6466. result := nil;
  6467. end;
  6468. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6469. procedure TglBitmap2D.SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
  6470. const aWidth: Integer; const aHeight: Integer);
  6471. var
  6472. Idx, LineWidth: Integer;
  6473. begin
  6474. inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
  6475. if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
  6476. (* TODO PixelFuncs
  6477. fGetPixelFunc := GetPixel2DUnmap;
  6478. fSetPixelFunc := SetPixel2DUnmap;
  6479. *)
  6480. // Assigning Data
  6481. if Assigned(Data) then begin
  6482. SetLength(fLines, GetHeight);
  6483. LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
  6484. for Idx := 0 to GetHeight -1 do begin
  6485. fLines[Idx] := Data;
  6486. Inc(fLines[Idx], Idx * LineWidth);
  6487. end;
  6488. end
  6489. else SetLength(fLines, 0);
  6490. end else begin
  6491. SetLength(fLines, 0);
  6492. (*
  6493. fSetPixelFunc := nil;
  6494. case Format of
  6495. ifDXT1:
  6496. fGetPixelFunc := GetPixel2DDXT1;
  6497. ifDXT3:
  6498. fGetPixelFunc := GetPixel2DDXT3;
  6499. ifDXT5:
  6500. fGetPixelFunc := GetPixel2DDXT5;
  6501. else
  6502. fGetPixelFunc := nil;
  6503. end;
  6504. *)
  6505. end;
  6506. end;
  6507. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6508. procedure TglBitmap2D.UploadData(const aTarget: Cardinal; const aBuildWithGlu: Boolean);
  6509. var
  6510. FormatDesc: TFormatDescriptor;
  6511. begin
  6512. glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
  6513. FormatDesc := TFormatDescriptor.Get(Format);
  6514. if FormatDesc.IsCompressed then begin
  6515. glCompressedTexImage2D(Target, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
  6516. end else if aBuildWithGlu then begin
  6517. gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
  6518. FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  6519. end else begin
  6520. glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
  6521. FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  6522. end;
  6523. // Freigeben
  6524. if (FreeDataAfterGenTexture) then
  6525. FreeData;
  6526. end;
  6527. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6528. procedure TglBitmap2D.AfterConstruction;
  6529. begin
  6530. inherited;
  6531. Target := GL_TEXTURE_2D;
  6532. end;
  6533. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6534. procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  6535. var
  6536. Temp: pByte;
  6537. Size, w, h: Integer;
  6538. FormatDesc: TFormatDescriptor;
  6539. begin
  6540. FormatDesc := TFormatDescriptor.Get(Format);
  6541. if FormatDesc.IsCompressed then
  6542. raise EglBitmapUnsupportedFormat.Create(Format);
  6543. w := aRight - aLeft;
  6544. h := aBottom - aTop;
  6545. Size := FormatDesc.GetSize(w, h);
  6546. GetMem(Temp, Size);
  6547. try
  6548. glPixelStorei(GL_PACK_ALIGNMENT, 1);
  6549. glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  6550. SetDataPointer(Temp, Format, w, h);
  6551. FlipVert;
  6552. except
  6553. FreeMem(Temp);
  6554. raise;
  6555. end;
  6556. end;
  6557. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6558. procedure TglBitmap2D.GetDataFromTexture;
  6559. var
  6560. Temp: PByte;
  6561. TempWidth, TempHeight: Integer;
  6562. TempIntFormat: Cardinal;
  6563. IntFormat, f: TglBitmapFormat;
  6564. FormatDesc: TFormatDescriptor;
  6565. begin
  6566. Bind;
  6567. // Request Data
  6568. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH, @TempWidth);
  6569. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT, @TempHeight);
  6570. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
  6571. IntFormat := tfEmpty;
  6572. for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
  6573. FormatDesc := TFormatDescriptor.Get(f);
  6574. if (FormatDesc.glInternalFormat = TempIntFormat) then begin
  6575. IntFormat := FormatDesc.Format;
  6576. break;
  6577. end;
  6578. end;
  6579. // Getting data from OpenGL
  6580. FormatDesc := TFormatDescriptor.Get(IntFormat);
  6581. GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
  6582. try
  6583. if FormatDesc.IsCompressed then
  6584. glGetCompressedTexImage(Target, 0, Temp)
  6585. else
  6586. glGetTexImage(Target, 0, FormatDesc.glInternalFormat, FormatDesc.glDataFormat, Temp);
  6587. SetDataPointer(Temp, IntFormat, TempWidth, TempHeight);
  6588. except
  6589. FreeMem(Temp);
  6590. raise;
  6591. end;
  6592. end;
  6593. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6594. procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
  6595. var
  6596. BuildWithGlu, PotTex, TexRec: Boolean;
  6597. TexSize: Integer;
  6598. begin
  6599. if Assigned(Data) then begin
  6600. // Check Texture Size
  6601. if (aTestTextureSize) then begin
  6602. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  6603. if ((Height > TexSize) or (Width > TexSize)) then
  6604. raise EglBitmapSizeToLargeException.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  6605. PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
  6606. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
  6607. if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  6608. raise EglBitmapNonPowerOfTwoException.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  6609. end;
  6610. CreateId;
  6611. SetupParameters(BuildWithGlu);
  6612. UploadData(Target, BuildWithGlu);
  6613. glAreTexturesResident(1, @fID, @fIsResident);
  6614. end;
  6615. end;
  6616. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6617. function TglBitmap2D.FlipHorz: Boolean;
  6618. var
  6619. Col, Row: Integer;
  6620. TempDestData, DestData, SourceData: PByte;
  6621. ImgSize: Integer;
  6622. begin
  6623. result := inherited FlipHorz;
  6624. if Assigned(Data) then begin
  6625. SourceData := Data;
  6626. ImgSize := Height * fRowSize;
  6627. GetMem(DestData, ImgSize);
  6628. try
  6629. TempDestData := DestData;
  6630. Dec(TempDestData, fRowSize + fPixelSize);
  6631. for Row := 0 to Height -1 do begin
  6632. Inc(TempDestData, fRowSize * 2);
  6633. for Col := 0 to Width -1 do begin
  6634. Move(SourceData^, TempDestData^, fPixelSize);
  6635. Inc(SourceData, fPixelSize);
  6636. Dec(TempDestData, fPixelSize);
  6637. end;
  6638. end;
  6639. SetDataPointer(DestData, Format);
  6640. result := true;
  6641. except
  6642. FreeMem(DestData);
  6643. raise;
  6644. end;
  6645. end;
  6646. end;
  6647. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6648. function TglBitmap2D.FlipVert: Boolean;
  6649. var
  6650. Row: Integer;
  6651. TempDestData, DestData, SourceData: PByte;
  6652. begin
  6653. result := inherited FlipVert;
  6654. if Assigned(Data) then begin
  6655. SourceData := Data;
  6656. GetMem(DestData, Height * fRowSize);
  6657. try
  6658. TempDestData := DestData;
  6659. Inc(TempDestData, Width * (Height -1) * fPixelSize);
  6660. for Row := 0 to Height -1 do begin
  6661. Move(SourceData^, TempDestData^, fRowSize);
  6662. Dec(TempDestData, fRowSize);
  6663. Inc(SourceData, fRowSize);
  6664. end;
  6665. SetDataPointer(DestData, Format);
  6666. result := true;
  6667. except
  6668. FreeMem(DestData);
  6669. raise;
  6670. end;
  6671. end;
  6672. end;
  6673. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6674. //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6675. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6676. type
  6677. TMatrixItem = record
  6678. X, Y: Integer;
  6679. W: Single;
  6680. end;
  6681. PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
  6682. TglBitmapToNormalMapRec = Record
  6683. Scale: Single;
  6684. Heights: array of Single;
  6685. MatrixU : array of TMatrixItem;
  6686. MatrixV : array of TMatrixItem;
  6687. end;
  6688. const
  6689. ONE_OVER_255 = 1 / 255;
  6690. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6691. procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
  6692. var
  6693. Val: Single;
  6694. begin
  6695. with FuncRec do begin
  6696. Val :=
  6697. Source.Data.r * LUMINANCE_WEIGHT_R +
  6698. Source.Data.g * LUMINANCE_WEIGHT_G +
  6699. Source.Data.b * LUMINANCE_WEIGHT_B;
  6700. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
  6701. end;
  6702. end;
  6703. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6704. procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  6705. begin
  6706. with FuncRec do
  6707. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
  6708. end;
  6709. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6710. procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
  6711. type
  6712. TVec = Array[0..2] of Single;
  6713. var
  6714. Idx: Integer;
  6715. du, dv: Double;
  6716. Len: Single;
  6717. Vec: TVec;
  6718. function GetHeight(X, Y: Integer): Single;
  6719. begin
  6720. with FuncRec do begin
  6721. X := Max(0, Min(Size.X -1, X));
  6722. Y := Max(0, Min(Size.Y -1, Y));
  6723. result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
  6724. end;
  6725. end;
  6726. begin
  6727. with FuncRec do begin
  6728. with PglBitmapToNormalMapRec(Args)^ do begin
  6729. du := 0;
  6730. for Idx := Low(MatrixU) to High(MatrixU) do
  6731. du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
  6732. dv := 0;
  6733. for Idx := Low(MatrixU) to High(MatrixU) do
  6734. dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
  6735. Vec[0] := -du * Scale;
  6736. Vec[1] := -dv * Scale;
  6737. Vec[2] := 1;
  6738. end;
  6739. // Normalize
  6740. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  6741. if Len <> 0 then begin
  6742. Vec[0] := Vec[0] * Len;
  6743. Vec[1] := Vec[1] * Len;
  6744. Vec[2] := Vec[2] * Len;
  6745. end;
  6746. // Farbe zuweisem
  6747. Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
  6748. Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
  6749. Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
  6750. end;
  6751. end;
  6752. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6753. procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
  6754. var
  6755. Rec: TglBitmapToNormalMapRec;
  6756. procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
  6757. begin
  6758. if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
  6759. Matrix[Index].X := X;
  6760. Matrix[Index].Y := Y;
  6761. Matrix[Index].W := W;
  6762. end;
  6763. end;
  6764. begin
  6765. if TFormatDescriptor.Get(Format).IsCompressed then
  6766. raise EglBitmapUnsupportedFormat.Create(Format);
  6767. if aScale > 100 then
  6768. Rec.Scale := 100
  6769. else if aScale < -100 then
  6770. Rec.Scale := -100
  6771. else
  6772. Rec.Scale := aScale;
  6773. SetLength(Rec.Heights, Width * Height);
  6774. try
  6775. case aFunc of
  6776. nm4Samples: begin
  6777. SetLength(Rec.MatrixU, 2);
  6778. SetEntry(Rec.MatrixU, 0, -1, 0, -0.5);
  6779. SetEntry(Rec.MatrixU, 1, 1, 0, 0.5);
  6780. SetLength(Rec.MatrixV, 2);
  6781. SetEntry(Rec.MatrixV, 0, 0, 1, 0.5);
  6782. SetEntry(Rec.MatrixV, 1, 0, -1, -0.5);
  6783. end;
  6784. nmSobel: begin
  6785. SetLength(Rec.MatrixU, 6);
  6786. SetEntry(Rec.MatrixU, 0, -1, 1, -1.0);
  6787. SetEntry(Rec.MatrixU, 1, -1, 0, -2.0);
  6788. SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
  6789. SetEntry(Rec.MatrixU, 3, 1, 1, 1.0);
  6790. SetEntry(Rec.MatrixU, 4, 1, 0, 2.0);
  6791. SetEntry(Rec.MatrixU, 5, 1, -1, 1.0);
  6792. SetLength(Rec.MatrixV, 6);
  6793. SetEntry(Rec.MatrixV, 0, -1, 1, 1.0);
  6794. SetEntry(Rec.MatrixV, 1, 0, 1, 2.0);
  6795. SetEntry(Rec.MatrixV, 2, 1, 1, 1.0);
  6796. SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
  6797. SetEntry(Rec.MatrixV, 4, 0, -1, -2.0);
  6798. SetEntry(Rec.MatrixV, 5, 1, -1, -1.0);
  6799. end;
  6800. nm3x3: begin
  6801. SetLength(Rec.MatrixU, 6);
  6802. SetEntry(Rec.MatrixU, 0, -1, 1, -1/6);
  6803. SetEntry(Rec.MatrixU, 1, -1, 0, -1/6);
  6804. SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
  6805. SetEntry(Rec.MatrixU, 3, 1, 1, 1/6);
  6806. SetEntry(Rec.MatrixU, 4, 1, 0, 1/6);
  6807. SetEntry(Rec.MatrixU, 5, 1, -1, 1/6);
  6808. SetLength(Rec.MatrixV, 6);
  6809. SetEntry(Rec.MatrixV, 0, -1, 1, 1/6);
  6810. SetEntry(Rec.MatrixV, 1, 0, 1, 1/6);
  6811. SetEntry(Rec.MatrixV, 2, 1, 1, 1/6);
  6812. SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
  6813. SetEntry(Rec.MatrixV, 4, 0, -1, -1/6);
  6814. SetEntry(Rec.MatrixV, 5, 1, -1, -1/6);
  6815. end;
  6816. nm5x5: begin
  6817. SetLength(Rec.MatrixU, 20);
  6818. SetEntry(Rec.MatrixU, 0, -2, 2, -1 / 16);
  6819. SetEntry(Rec.MatrixU, 1, -1, 2, -1 / 10);
  6820. SetEntry(Rec.MatrixU, 2, 1, 2, 1 / 10);
  6821. SetEntry(Rec.MatrixU, 3, 2, 2, 1 / 16);
  6822. SetEntry(Rec.MatrixU, 4, -2, 1, -1 / 10);
  6823. SetEntry(Rec.MatrixU, 5, -1, 1, -1 / 8);
  6824. SetEntry(Rec.MatrixU, 6, 1, 1, 1 / 8);
  6825. SetEntry(Rec.MatrixU, 7, 2, 1, 1 / 10);
  6826. SetEntry(Rec.MatrixU, 8, -2, 0, -1 / 2.8);
  6827. SetEntry(Rec.MatrixU, 9, -1, 0, -0.5);
  6828. SetEntry(Rec.MatrixU, 10, 1, 0, 0.5);
  6829. SetEntry(Rec.MatrixU, 11, 2, 0, 1 / 2.8);
  6830. SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
  6831. SetEntry(Rec.MatrixU, 13, -1, -1, -1 / 8);
  6832. SetEntry(Rec.MatrixU, 14, 1, -1, 1 / 8);
  6833. SetEntry(Rec.MatrixU, 15, 2, -1, 1 / 10);
  6834. SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
  6835. SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
  6836. SetEntry(Rec.MatrixU, 18, 1, -2, 1 / 10);
  6837. SetEntry(Rec.MatrixU, 19, 2, -2, 1 / 16);
  6838. SetLength(Rec.MatrixV, 20);
  6839. SetEntry(Rec.MatrixV, 0, -2, 2, 1 / 16);
  6840. SetEntry(Rec.MatrixV, 1, -1, 2, 1 / 10);
  6841. SetEntry(Rec.MatrixV, 2, 0, 2, 0.25);
  6842. SetEntry(Rec.MatrixV, 3, 1, 2, 1 / 10);
  6843. SetEntry(Rec.MatrixV, 4, 2, 2, 1 / 16);
  6844. SetEntry(Rec.MatrixV, 5, -2, 1, 1 / 10);
  6845. SetEntry(Rec.MatrixV, 6, -1, 1, 1 / 8);
  6846. SetEntry(Rec.MatrixV, 7, 0, 1, 0.5);
  6847. SetEntry(Rec.MatrixV, 8, 1, 1, 1 / 8);
  6848. SetEntry(Rec.MatrixV, 9, 2, 1, 1 / 16);
  6849. SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
  6850. SetEntry(Rec.MatrixV, 11, -1, -1, -1 / 8);
  6851. SetEntry(Rec.MatrixV, 12, 0, -1, -0.5);
  6852. SetEntry(Rec.MatrixV, 13, 1, -1, -1 / 8);
  6853. SetEntry(Rec.MatrixV, 14, 2, -1, -1 / 10);
  6854. SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
  6855. SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
  6856. SetEntry(Rec.MatrixV, 17, 0, -2, -0.25);
  6857. SetEntry(Rec.MatrixV, 18, 1, -2, -1 / 10);
  6858. SetEntry(Rec.MatrixV, 19, 2, -2, -1 / 16);
  6859. end;
  6860. end;
  6861. // Daten Sammeln
  6862. if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
  6863. AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
  6864. else
  6865. AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
  6866. AddFunc(glBitmapToNormalMapFunc, false, @Rec);
  6867. finally
  6868. SetLength(Rec.Heights, 0);
  6869. end;
  6870. end;
  6871. (*
  6872. procedure TglBitmap1D.SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width, Height: Integer);
  6873. var
  6874. pTemp: pByte;
  6875. Size: Integer;
  6876. begin
  6877. if Height > 1 then begin
  6878. // extract first line of the data
  6879. Size := FormatGetImageSize(glBitmapPosition(Width), Format);
  6880. GetMem(pTemp, Size);
  6881. Move(Data^, pTemp^, Size);
  6882. FreeMem(Data);
  6883. end else
  6884. pTemp := Data;
  6885. // set data pointer
  6886. inherited SetDataPointer(pTemp, Format, Width);
  6887. if FormatIsUncompressed(Format) then begin
  6888. fUnmapFunc := FormatGetUnMapFunc(Format);
  6889. fGetPixelFunc := GetPixel1DUnmap;
  6890. end;
  6891. end;
  6892. procedure TglBitmap1D.GetPixel1DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
  6893. var
  6894. pTemp: pByte;
  6895. begin
  6896. pTemp := Data;
  6897. Inc(pTemp, Pos.X * fPixelSize);
  6898. fUnmapFunc(pTemp, Pixel);
  6899. end;
  6900. function TglBitmap1D.FlipHorz: Boolean;
  6901. var
  6902. Col: Integer;
  6903. pTempDest, pDest, pSource: pByte;
  6904. begin
  6905. result := inherited FlipHorz;
  6906. if Assigned(Data) and FormatIsUncompressed(InternalFormat) then begin
  6907. pSource := Data;
  6908. GetMem(pDest, fRowSize);
  6909. try
  6910. pTempDest := pDest;
  6911. Inc(pTempDest, fRowSize);
  6912. for Col := 0 to Width -1 do begin
  6913. Move(pSource^, pTempDest^, fPixelSize);
  6914. Inc(pSource, fPixelSize);
  6915. Dec(pTempDest, fPixelSize);
  6916. end;
  6917. SetDataPointer(pDest, InternalFormat);
  6918. result := true;
  6919. finally
  6920. FreeMem(pDest);
  6921. end;
  6922. end;
  6923. end;
  6924. procedure TglBitmap1D.UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
  6925. begin
  6926. // Upload data
  6927. if Self.InternalFormat in [ifDXT1, ifDXT3, ifDXT5] then
  6928. glCompressedTexImage1D(Target, 0, InternalFormat, Width, 0, Trunc(Width * FormatGetSize(Self.InternalFormat)), Data)
  6929. else
  6930. // Upload data
  6931. if BuildWithGlu then
  6932. gluBuild1DMipmaps(Target, InternalFormat, Width, Format, Typ, Data)
  6933. else
  6934. glTexImage1D(Target, 0, InternalFormat, Width, 0, Format, Typ, Data);
  6935. // Freigeben
  6936. if (FreeDataAfterGenTexture) then
  6937. FreeData;
  6938. end;
  6939. procedure TglBitmap1D.GenTexture(TestTextureSize: Boolean);
  6940. var
  6941. BuildWithGlu, TexRec: Boolean;
  6942. glFormat, glInternalFormat, glType: Cardinal;
  6943. TexSize: Integer;
  6944. begin
  6945. if Assigned(Data) then begin
  6946. // Check Texture Size
  6947. if (TestTextureSize) then begin
  6948. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  6949. if (Width > TexSize) then
  6950. raise EglBitmapSizeToLargeException.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  6951. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
  6952. (Target = GL_TEXTURE_RECTANGLE_ARB);
  6953. if not (IsPowerOfTwo (Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  6954. raise EglBitmapNonPowerOfTwoException.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  6955. end;
  6956. CreateId;
  6957. SetupParameters(BuildWithGlu);
  6958. SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
  6959. UploadData(Target, glFormat, glInternalFormat, glType, BuildWithGlu);
  6960. // Infos sammeln
  6961. glAreTexturesResident(1, @fID, @fIsResident);
  6962. end;
  6963. end;
  6964. procedure TglBitmap1D.AfterConstruction;
  6965. begin
  6966. inherited;
  6967. Target := GL_TEXTURE_1D;
  6968. end;
  6969. { TglBitmapCubeMap }
  6970. procedure TglBitmapCubeMap.AfterConstruction;
  6971. begin
  6972. inherited;
  6973. if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
  6974. raise EglBitmapException.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
  6975. SetWrap; // set all to GL_CLAMP_TO_EDGE
  6976. Target := GL_TEXTURE_CUBE_MAP;
  6977. fGenMode := GL_REFLECTION_MAP;
  6978. end;
  6979. procedure TglBitmapCubeMap.Bind(EnableTexCoordsGen, EnableTextureUnit: Boolean);
  6980. begin
  6981. inherited Bind (EnableTextureUnit);
  6982. if EnableTexCoordsGen then begin
  6983. glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
  6984. glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
  6985. glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
  6986. glEnable(GL_TEXTURE_GEN_S);
  6987. glEnable(GL_TEXTURE_GEN_T);
  6988. glEnable(GL_TEXTURE_GEN_R);
  6989. end;
  6990. end;
  6991. procedure TglBitmapCubeMap.GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean);
  6992. var
  6993. glFormat, glInternalFormat, glType: Cardinal;
  6994. BuildWithGlu: Boolean;
  6995. TexSize: Integer;
  6996. begin
  6997. // Check Texture Size
  6998. if (TestTextureSize) then begin
  6999. glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
  7000. if ((Height > TexSize) or (Width > TexSize)) then
  7001. raise EglBitmapSizeToLargeException.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
  7002. if not ((IsPowerOfTwo (Height) and IsPowerOfTwo (Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
  7003. raise EglBitmapNonPowerOfTwoException.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
  7004. end;
  7005. // create Texture
  7006. if ID = 0 then begin
  7007. CreateID;
  7008. SetupParameters(BuildWithGlu);
  7009. end;
  7010. SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
  7011. UploadData (CubeTarget, glFormat, glInternalFormat, glType, BuildWithGlu);
  7012. end;
  7013. procedure TglBitmapCubeMap.GenTexture(TestTextureSize: Boolean);
  7014. begin
  7015. Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
  7016. end;
  7017. procedure TglBitmapCubeMap.Unbind(DisableTexCoordsGen,
  7018. DisableTextureUnit: Boolean);
  7019. begin
  7020. inherited Unbind (DisableTextureUnit);
  7021. if DisableTexCoordsGen then begin
  7022. glDisable(GL_TEXTURE_GEN_S);
  7023. glDisable(GL_TEXTURE_GEN_T);
  7024. glDisable(GL_TEXTURE_GEN_R);
  7025. end;
  7026. end;
  7027. { TglBitmapNormalMap }
  7028. type
  7029. TVec = Array[0..2] of Single;
  7030. TglBitmapNormalMapGetVectorFunc = procedure (var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  7031. PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
  7032. TglBitmapNormalMapRec = record
  7033. HalfSize : Integer;
  7034. Func: TglBitmapNormalMapGetVectorFunc;
  7035. end;
  7036. procedure glBitmapNormalMapPosX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  7037. begin
  7038. Vec[0] := HalfSize;
  7039. Vec[1] := - (Position.Y + 0.5 - HalfSize);
  7040. Vec[2] := - (Position.X + 0.5 - HalfSize);
  7041. end;
  7042. procedure glBitmapNormalMapNegX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  7043. begin
  7044. Vec[0] := - HalfSize;
  7045. Vec[1] := - (Position.Y + 0.5 - HalfSize);
  7046. Vec[2] := Position.X + 0.5 - HalfSize;
  7047. end;
  7048. procedure glBitmapNormalMapPosY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  7049. begin
  7050. Vec[0] := Position.X + 0.5 - HalfSize;
  7051. Vec[1] := HalfSize;
  7052. Vec[2] := Position.Y + 0.5 - HalfSize;
  7053. end;
  7054. procedure glBitmapNormalMapNegY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  7055. begin
  7056. Vec[0] := Position.X + 0.5 - HalfSize;
  7057. Vec[1] := - HalfSize;
  7058. Vec[2] := - (Position.Y + 0.5 - HalfSize);
  7059. end;
  7060. procedure glBitmapNormalMapPosZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  7061. begin
  7062. Vec[0] := Position.X + 0.5 - HalfSize;
  7063. Vec[1] := - (Position.Y + 0.5 - HalfSize);
  7064. Vec[2] := HalfSize;
  7065. end;
  7066. procedure glBitmapNormalMapNegZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  7067. begin
  7068. Vec[0] := - (Position.X + 0.5 - HalfSize);
  7069. Vec[1] := - (Position.Y + 0.5 - HalfSize);
  7070. Vec[2] := - HalfSize;
  7071. end;
  7072. procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
  7073. var
  7074. Vec : TVec;
  7075. Len: Single;
  7076. begin
  7077. with FuncRec do begin
  7078. with PglBitmapNormalMapRec (CustomData)^ do begin
  7079. Func(Vec, Position, HalfSize);
  7080. // Normalize
  7081. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  7082. if Len <> 0 then begin
  7083. Vec[0] := Vec[0] * Len;
  7084. Vec[1] := Vec[1] * Len;
  7085. Vec[2] := Vec[2] * Len;
  7086. end;
  7087. // Scale Vector and AddVectro
  7088. Vec[0] := Vec[0] * 0.5 + 0.5;
  7089. Vec[1] := Vec[1] * 0.5 + 0.5;
  7090. Vec[2] := Vec[2] * 0.5 + 0.5;
  7091. end;
  7092. // Set Color
  7093. Dest.Red := Round(Vec[0] * 255);
  7094. Dest.Green := Round(Vec[1] * 255);
  7095. Dest.Blue := Round(Vec[2] * 255);
  7096. end;
  7097. end;
  7098. procedure TglBitmapNormalMap.AfterConstruction;
  7099. begin
  7100. inherited;
  7101. fGenMode := GL_NORMAL_MAP;
  7102. end;
  7103. procedure TglBitmapNormalMap.GenerateNormalMap(Size: Integer;
  7104. TestTextureSize: Boolean);
  7105. var
  7106. Rec: TglBitmapNormalMapRec;
  7107. SizeRec: TglBitmapPixelPosition;
  7108. begin
  7109. Rec.HalfSize := Size div 2;
  7110. FreeDataAfterGenTexture := false;
  7111. SizeRec.Fields := [ffX, ffY];
  7112. SizeRec.X := Size;
  7113. SizeRec.Y := Size;
  7114. // Positive X
  7115. Rec.Func := glBitmapNormalMapPosX;
  7116. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  7117. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, TestTextureSize);
  7118. // Negative X
  7119. Rec.Func := glBitmapNormalMapNegX;
  7120. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  7121. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, TestTextureSize);
  7122. // Positive Y
  7123. Rec.Func := glBitmapNormalMapPosY;
  7124. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  7125. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, TestTextureSize);
  7126. // Negative Y
  7127. Rec.Func := glBitmapNormalMapNegY;
  7128. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  7129. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, TestTextureSize);
  7130. // Positive Z
  7131. Rec.Func := glBitmapNormalMapPosZ;
  7132. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  7133. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, TestTextureSize);
  7134. // Negative Z
  7135. Rec.Func := glBitmapNormalMapNegZ;
  7136. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  7137. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, TestTextureSize);
  7138. end;
  7139. *)
  7140. initialization
  7141. glBitmapSetDefaultFormat(tfEmpty);
  7142. glBitmapSetDefaultMipmap(mmMipmap);
  7143. glBitmapSetDefaultFilter(GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
  7144. glBitmapSetDefaultWrap (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
  7145. glBitmapSetDefaultFreeDataAfterGenTexture(true);
  7146. glBitmapSetDefaultDeleteTextureOnFree (true);
  7147. TFormatDescriptor.Init;
  7148. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  7149. OpenGLInitialized := false;
  7150. InitOpenGLCS := TCriticalSection.Create;
  7151. {$ENDIF}
  7152. finalization
  7153. TFormatDescriptor.Finalize;
  7154. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  7155. FreeAndNil(InitOpenGLCS);
  7156. {$ENDIF}
  7157. end.