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

8302 rindas
278 KiB

  1. {***********************************************************
  2. glBitmap by Steffen Xonna aka Lossy eX (2003-2008)
  3. http://www.opengl24.de/index.php?cat=header&file=glbitmap
  4. ------------------------------------------------------------
  5. The contents of this file are used with permission, subject to
  6. the Mozilla Public License Version 1.1 (the "License"); you may
  7. not use this file except in compliance with the License. You may
  8. obtain a copy of the License at
  9. http://www.mozilla.org/MPL/MPL-1.1.html
  10. ------------------------------------------------------------
  11. Version 2.0.3
  12. ------------------------------------------------------------
  13. History
  14. 21-03-2010
  15. - The define GLB_DELPHI dosn't check versions anymore. If you say you are using delphi
  16. then it's your problem if that isn't true. This prevents the unit for incompatibility
  17. with newer versions of Delphi.
  18. - Problems with D2009+ resolved (Thanks noeska and all i forgot)
  19. - GetPixel isn't set if you are loading textures inside the constructor (Thanks Wilson)
  20. 10-08-2008
  21. - AddAlphaFromglBitmap used the custom pointer instead the imagedatapointer (Thanks Wilson)
  22. - Additional Datapointer for functioninterface now has the name CustomData
  23. 24-07-2008
  24. - AssigneAlphaToBitmap overwrites his own palette (Thanks Wilson)
  25. - If you load an texture from an file the property Filename will be set to the name of the file
  26. - Three new properties to attach custom data to the Texture objects
  27. - CustomName (free for use string)
  28. - CustomNameW (free for use widestring)
  29. - CustomDataPointer (free for use pointer to attach other objects or complex structures)
  30. 27-05-2008
  31. - RLE TGAs loaded much faster
  32. 26-05-2008
  33. - fixed some problem with reading RLE TGAs.
  34. 21-05-2008
  35. - function clone now only copys data if it's assigned and now it also copies the ID
  36. - it seems that lazarus dont like comments in comments.
  37. 01-05-2008
  38. - It's possible to set the id of the texture
  39. - define GLB_NO_NATIVE_GL deactivated by default
  40. 27-04-2008
  41. - Now supports the following libraries
  42. - SDL and SDL_image
  43. - libPNG
  44. - libJPEG
  45. - Linux compatibillity via free pascal compatibility (delphi sources optional)
  46. - BMPs now loaded manuel
  47. - Large restructuring
  48. - Property DataPtr now has the name Data
  49. - Functions are more flexible between RGB(A) and BGR(A). RGB can be saved as Bitmap and will be saved as BGR
  50. - Unused Depth removed
  51. - Function FreeData to freeing image data added
  52. 24-10-2007
  53. - ImageID flag of TGAs was ignored. (Thanks Zwoetzen)
  54. 15-11-2006
  55. - Function SetBorderColor implemented (only used by opengl if wrap is set to GL_CLAMP_TO_BORDER)
  56. - Function AddAlphaFromValue implemented to use an fixed Value as Alphachannel
  57. - Function ReadOpenGLExtension is now only intern
  58. 29-06-2006
  59. - pngimage now disabled by default like all other versions.
  60. 26-06-2006
  61. - Setting up an anisotropic filter of 0 isnt allowed by nvidia (Thanks Ogridi)
  62. 22-06-2006
  63. - Fixed some Problem with Delphi 5
  64. - Now uses the newest version of pngimage. Makes saving pngs much easier.
  65. 22-03-2006
  66. - Property IsCompressed and Size removed. Not really supported by Spec (Thanks Ogridi)
  67. 09-03-2006
  68. - Internal Format ifDepth8 added
  69. - function GrabScreen now supports all uncompressed formats
  70. 31-01-2006
  71. - AddAlphaFromglBitmap implemented
  72. 29-12-2005
  73. - LoadFromResource and LoadFromResourceId now needs an Instance and an ResourceType (for ID)
  74. 28-12-2005
  75. - Width, Height and Depth internal changed to TglBitmapPixelPosition.
  76. property Width, Height, Depth are still existing and new property Dimension are avail
  77. 11-12-2005
  78. - Added native OpenGL Support. Breaking the dglOpenGL "barrier".
  79. 19-10-2005
  80. - Added function GrabScreen to class TglBitmap2D
  81. 18-10-2005
  82. - Added support to Save images
  83. - Added function Clone to Clone Instance
  84. 11-10-2005
  85. - Functions now works with Cardinals for each channel. Up to 32 Bits per channel.
  86. Usefull for Future
  87. - Several speed optimizations
  88. 09-10-2005
  89. - Internal structure change. Loading of TGA, PNG and DDS improved.
  90. Data, format and size will now set directly with SetDataPtr.
  91. - AddFunc now works with all Types of Images and Formats
  92. - Some Funtions moved to Baseclass TglBitmap
  93. 06-10-2005
  94. - Added Support to decompress DXT3 and DXT5 compressed Images.
  95. - Added Mapping to convert data from one format into an other.
  96. 05-10-2005
  97. - Added method ConvertTo in Class TglBitmap2D. Method allows to convert every
  98. supported Input format (supported by GetPixel) into any uncompresed Format
  99. - Added Support to decompress DXT1 compressed Images.
  100. - SwapColors replaced by ConvertTo
  101. 04-10-2005
  102. - Added Support for compressed DDSs
  103. - Added new internal formats (DXT1, DXT3, DXT5)
  104. 29-09-2005
  105. - Parameter Components renamed to InternalFormat
  106. 23-09-2005
  107. - Some AllocMem replaced with GetMem (little speed change)
  108. - better exception handling. Better protection from memory leaks.
  109. 22-09-2005
  110. - Added support for Direct Draw Surfaces (.DDS) (uncompressed images only)
  111. - Added new internal formats (RGB8, RGBA8, RGBA4, RGB5A1, RGB10A2, R5G6B5)
  112. 07-09-2005
  113. - Added support for Grayscale textures
  114. - Added internal formats (Alpha, Luminance, LuminanceAlpha, BGR8, BGRA8)
  115. 10-07-2005
  116. - Added support for GL_VERSION_2_0
  117. - Added support for GL_EXT_texture_filter_anisotropic
  118. 04-07-2005
  119. - Function FillWithColor fills the Image with one Color
  120. - Function LoadNormalMap added
  121. 30-06-2005
  122. - ToNormalMap allows to Create an NormalMap from the Alphachannel
  123. - ToNormalMap now supports Sobel (nmSobel) function.
  124. 29-06-2005
  125. - support for RLE Compressed RGB TGAs added
  126. 28-06-2005
  127. - Class TglBitmapNormalMap added to support Normalmap generation
  128. - Added function ToNormalMap in class TglBitmap2D to genereate normal maps from textures.
  129. 3 Filters are supported. (4 Samples, 3x3 and 5x5)
  130. 16-06-2005
  131. - Method LoadCubeMapClass removed
  132. - LoadCubeMap returnvalue is now the Texture paramter. Such as LoadTextures
  133. - virtual abstract method GenTexture in class TglBitmap now is protected
  134. 12-06-2005
  135. - now support DescriptionFlag in LoadTga. Allows vertical flipped images to be loaded as normal
  136. 10-06-2005
  137. - little enhancement for IsPowerOfTwo
  138. - TglBitmap1D.GenTexture now tests NPOT Textures
  139. 06-06-2005
  140. - some little name changes. All properties or function with Texture in name are
  141. now without texture in name. We have allways texture so we dosn't name it.
  142. 03-06-2005
  143. - GenTexture now tests if texture is NPOT and NPOT-Texture are supported or
  144. TextureTarget is GL_TEXTURE_RECTANGLE. Else it raised an exception.
  145. 02-06-2005
  146. - added support for GL_ARB_texture_rectangle, GL_EXT_texture_rectangle and GL_NV_texture_rectangle
  147. 25-04-2005
  148. - Function Unbind added
  149. - call of SetFilter or SetTextureWrap if TextureID exists results in setting properties to opengl texture.
  150. 21-04-2005
  151. - class TglBitmapCubeMap added (allows to Create Cubemaps)
  152. 29-03-2005
  153. - Added Support for PNG Images. (http://pngdelphi.sourceforge.net/)
  154. To Enable png's use the define pngimage
  155. 22-03-2005
  156. - New Functioninterface added
  157. - Function GetPixel added
  158. 27-11-2004
  159. - Property BuildMipMaps renamed to MipMap
  160. 21-11-2004
  161. - property Name removed.
  162. - BuildMipMaps is now a set of 3 values. None, GluBuildMipmaps and SGIS_generate_mipmap
  163. 22-05-2004
  164. - property name added. Only used in glForms!
  165. 26-11-2003
  166. - property FreeDataAfterGenTexture is now available as default (default = true)
  167. - BuildMipmaps now implemented in TglBitmap1D (i've forgotten it)
  168. - function MoveMemory replaced with function Move (little speed change)
  169. - several calculations stored in variables (little speed change)
  170. 29-09-2003
  171. - property BuildMipsMaps added (default = true)
  172. if BuildMipMaps isn't set GenTextures uses glTexImage[12]D else it use gluBuild[12]dMipmaps
  173. - property FreeDataAfterGenTexture added (default = true)
  174. if FreeDataAfterGenTexture is set the texturedata were deleted after the texture was generated.
  175. - parameter DisableOtherTextureUnits of Bind removed
  176. - parameter FreeDataAfterGeneration of GenTextures removed
  177. 12-09-2003
  178. - TglBitmap dosn't delete data if class was destroyed (fixed)
  179. 09-09-2003
  180. - Bind now enables TextureUnits (by params)
  181. - GenTextures can leave data (by param)
  182. - LoadTextures now optimal
  183. 03-09-2003
  184. - Performance optimization in AddFunc
  185. - procedure Bind moved to subclasses
  186. - Added new Class TglBitmap1D to support real OpenGL 1D Textures
  187. 19-08-2003
  188. - Texturefilter and texturewrap now also as defaults
  189. Minfilter = GL_LINEAR_MIPMAP_LINEAR
  190. Magfilter = GL_LINEAR
  191. Wrap(str) = GL_CLAMP_TO_EDGE
  192. - Added new format tfCompressed to create a compressed texture.
  193. - propertys IsCompressed, TextureSize and IsResident added
  194. IsCompressed and TextureSize only contains data from level 0
  195. 18-08-2003
  196. - Added function AddFunc to add PerPixelEffects to Image
  197. - LoadFromFunc now based on AddFunc
  198. - Invert now based on AddFunc
  199. - SwapColors now based on AddFunc
  200. 16-08-2003
  201. - Added function FlipHorz
  202. 15-08-2003
  203. - Added function LaodFromFunc to create images with function
  204. - Added function FlipVert
  205. - Added internal format RGB(A) if GL_EXT_bgra or OpenGL 1.2 isn't supported
  206. 29-07-2003
  207. - Added Alphafunctions to calculate alpha per function
  208. - Added Alpha from ColorKey using alphafunctions
  209. 28-07-2003
  210. - First full functionally Version of glBitmap
  211. - Support for 24Bit and 32Bit TGA Pictures added
  212. 25-07-2003
  213. - begin of programming
  214. ***********************************************************}
  215. unit glBitmap;
  216. {.$MESSAGE warn 'Hey. I''m the glBitmap.pas and i need to be configured. My master tell me your preferences! ;)'}
  217. // Please uncomment the defines below to configure the glBitmap to your preferences.
  218. // If you have configured the unit you can uncomment the warning above.
  219. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  220. // Preferences ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  221. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  222. // activate to enable build-in OpenGL support with statically linked methods
  223. // use dglOpenGL.pas if not enabled
  224. {.$DEFINE GLB_NATIVE_OGL_STATIC}
  225. // activate to enable build-in OpenGL support with dynamically linked methods
  226. // use dglOpenGL.pas if not enabled
  227. {$DEFINE GLB_NATIVE_OGL_DYNAMIC}
  228. // activate to enable the support for SDL_surfaces
  229. {.$DEFINE GLB_SDL}
  230. // activate to enable the support for TBitmap from Delphi (not lazarus)
  231. {.$DEFINE GLB_DELPHI}
  232. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  233. // activate to enable the support of SDL_image to load files. (READ ONLY)
  234. // If you enable SDL_image all other libraries will be ignored!
  235. {.$DEFINE GLB_SDL_IMAGE}
  236. // activate to enable png support with the unit pngimage. You can download it from http://pngdelphi.sourceforge.net/
  237. // if you enable pngimage the libPNG will be ignored
  238. {.$DEFINE GLB_PNGIMAGE}
  239. // activate to use the libPNG http://www.libpng.org/
  240. // You will need an aditional header.
  241. // http://www.opengl24.de/index.php?cat=header&file=libpng
  242. {.$DEFINE GLB_LIB_PNG}
  243. // if you enable delphi jpegs the libJPEG will be ignored
  244. {.$DEFINE GLB_DELPHI_JPEG}
  245. // activateto use the libJPEG http://www.ijg.org/
  246. // You will need an aditional header.
  247. // http://www.opengl24.de/index.php?cat=header&file=libjpeg
  248. {.$DEFINE GLB_LIB_JPEG}
  249. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  250. // PRIVATE: DO not change anything! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  251. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  252. // Delphi Versions
  253. {$IFDEF fpc}
  254. {$MODE Delphi}
  255. {$IFDEF CPUI386}
  256. {$DEFINE CPU386}
  257. {$ASMMODE INTEL}
  258. {$ENDIF}
  259. {$IFNDEF WINDOWS}
  260. {$linklib c}
  261. {$ENDIF}
  262. {$ENDIF}
  263. // Operation System
  264. {$IF DEFINED(WIN32) or DEFINED(WIN64)}
  265. {$DEFINE GLB_WIN}
  266. {$ELSEIF DEFINED(LINUX)}
  267. {$DEFINE GLB_LINUX}
  268. {$IFEND}
  269. // native OpenGL Support
  270. {$IF DEFINED(GLB_NATIVE_OGL_STATIC) OR DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
  271. {$DEFINE GLB_NATIVE_OGL}
  272. {$IFEND}
  273. // checking define combinations
  274. //SDL Image
  275. {$IFDEF GLB_SDL_IMAGE}
  276. {$IFNDEF GLB_SDL}
  277. {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
  278. {$DEFINE GLB_SDL}
  279. {$ENDIF}
  280. {$IFDEF GLB_PNGIMAGE}
  281. {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
  282. {$undef GLB_PNGIMAGE}
  283. {$ENDIF}
  284. {$IFDEF GLB_DELPHI_JPEG}
  285. {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
  286. {$undef GLB_DELPHI_JPEG}
  287. {$ENDIF}
  288. {$IFDEF GLB_LIB_PNG}
  289. {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
  290. {$undef GLB_LIB_PNG}
  291. {$ENDIF}
  292. {$IFDEF GLB_LIB_JPEG}
  293. {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
  294. {$undef GLB_LIB_JPEG}
  295. {$ENDIF}
  296. {$DEFINE GLB_SUPPORT_PNG_READ}
  297. {$DEFINE GLB_SUPPORT_JPEG_READ}
  298. {$ENDIF}
  299. // PNG Image
  300. {$IFDEF GLB_PNGIMAGE}
  301. {$IFDEF GLB_LIB_PNG}
  302. {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
  303. {$undef GLB_LIB_PNG}
  304. {$ENDIF}
  305. {$DEFINE GLB_SUPPORT_PNG_READ}
  306. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  307. {$ENDIF}
  308. // libPNG
  309. {$IFDEF GLB_LIB_PNG}
  310. {$DEFINE GLB_SUPPORT_PNG_READ}
  311. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  312. {$ENDIF}
  313. // JPEG Image
  314. {$IFDEF GLB_DELPHI_JPEG}
  315. {$IFDEF GLB_LIB_JPEG}
  316. {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
  317. {$undef GLB_LIB_JPEG}
  318. {$ENDIF}
  319. {$DEFINE GLB_SUPPORT_JPEG_READ}
  320. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  321. {$ENDIF}
  322. // libJPEG
  323. {$IFDEF GLB_LIB_JPEG}
  324. {$DEFINE GLB_SUPPORT_JPEG_READ}
  325. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  326. {$ENDIF}
  327. // native OpenGL
  328. {$IF DEFINED(GLB_NATIVE_OGL_STATIC) AND DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
  329. {$MESSAGE warn 'GLB_NATIVE_OGL_STATIC will be ignored because you enabled GLB_NATIVE_OGL_DYNAMIC'}
  330. {$ENDIF}
  331. // general options
  332. {$EXTENDEDSYNTAX ON}
  333. {$LONGSTRINGS ON}
  334. {$ALIGN ON}
  335. {$IFNDEF FPC}
  336. {$OPTIMIZATION ON}
  337. {$ENDIF}
  338. interface
  339. uses
  340. {$IFNDEF GLB_NATIVE_OGL} dglOpenGL, {$ENDIF}
  341. {$IF DEFINED(GLB_WIN) AND
  342. DEFINED(GLB_NATIVE_OGL)} windows, {$IFEND}
  343. {$IFDEF GLB_SDL} SDL, {$ENDIF}
  344. {$IFDEF GLB_DELPHI} Dialogs, Graphics, {$ENDIF}
  345. {$IFDEF GLB_SDL_IMAGE} SDL_image, {$ENDIF}
  346. {$IFDEF GLB_PNGIMAGE} pngimage, {$ENDIF}
  347. {$IFDEF GLB_LIB_PNG} libPNG, {$ENDIF}
  348. {$IFDEF GLB_DELPHI_JPEG} JPEG, {$ENDIF}
  349. {$IFDEF GLB_LIB_JPEG} libJPEG, {$ENDIF}
  350. Classes, SysUtils;
  351. {$IFNDEF GLB_DELPHI}
  352. type
  353. HGLRC = Cardinal;
  354. DWORD = Cardinal;
  355. PDWORD = ^DWORD;
  356. TRGBQuad = packed record
  357. rgbBlue: Byte;
  358. rgbGreen: Byte;
  359. rgbRed: Byte;
  360. rgbReserved: Byte;
  361. end;
  362. {$ENDIF}
  363. {$IFDEF GLB_NATIVE_OGL}
  364. const
  365. GL_TRUE = 1;
  366. GL_FALSE = 0;
  367. GL_VERSION = $1F02;
  368. GL_EXTENSIONS = $1F03;
  369. GL_TEXTURE_1D = $0DE0;
  370. GL_TEXTURE_2D = $0DE1;
  371. GL_TEXTURE_RECTANGLE = $84F5;
  372. GL_TEXTURE_WIDTH = $1000;
  373. GL_TEXTURE_HEIGHT = $1001;
  374. GL_TEXTURE_INTERNAL_FORMAT = $1003;
  375. GL_ALPHA = $1906;
  376. GL_ALPHA4 = $803B;
  377. GL_ALPHA8 = $803C;
  378. GL_ALPHA12 = $803D;
  379. GL_ALPHA16 = $803E;
  380. GL_LUMINANCE = $1909;
  381. GL_LUMINANCE4 = $803F;
  382. GL_LUMINANCE8 = $8040;
  383. GL_LUMINANCE12 = $8041;
  384. GL_LUMINANCE16 = $8042;
  385. GL_LUMINANCE_ALPHA = $190A;
  386. GL_LUMINANCE4_ALPHA4 = $8043;
  387. GL_LUMINANCE6_ALPHA2 = $8044;
  388. GL_LUMINANCE8_ALPHA8 = $8045;
  389. GL_LUMINANCE12_ALPHA4 = $8046;
  390. GL_LUMINANCE12_ALPHA12 = $8047;
  391. GL_LUMINANCE16_ALPHA16 = $8048;
  392. GL_RGB = $1907;
  393. GL_BGR = $80E0;
  394. GL_R3_G3_B2 = $2A10;
  395. GL_RGB4 = $804F;
  396. GL_RGB5 = $8050;
  397. GL_RGB565 = $8D62;
  398. GL_RGB8 = $8051;
  399. GL_RGB10 = $8052;
  400. GL_RGB12 = $8053;
  401. GL_RGB16 = $8054;
  402. GL_RGBA = $1908;
  403. GL_BGRA = $80E1;
  404. GL_RGBA2 = $8055;
  405. GL_RGBA4 = $8056;
  406. GL_RGB5_A1 = $8057;
  407. GL_RGBA8 = $8058;
  408. GL_RGB10_A2 = $8059;
  409. GL_RGBA12 = $805A;
  410. GL_RGBA16 = $805B;
  411. GL_DEPTH_COMPONENT = $1902;
  412. GL_DEPTH_COMPONENT16 = $81A5;
  413. GL_DEPTH_COMPONENT24 = $81A6;
  414. GL_DEPTH_COMPONENT32 = $81A7;
  415. GL_COMPRESSED_RGB = $84ED;
  416. GL_COMPRESSED_RGBA = $84EE;
  417. GL_COMPRESSED_RGB_S3TC_DXT1_EXT = $83F0;
  418. GL_COMPRESSED_RGBA_S3TC_DXT1_EXT = $83F1;
  419. GL_COMPRESSED_RGBA_S3TC_DXT3_EXT = $83F2;
  420. GL_COMPRESSED_RGBA_S3TC_DXT5_EXT = $83F3;
  421. GL_UNSIGNED_BYTE = $1401;
  422. GL_UNSIGNED_BYTE_3_3_2 = $8032;
  423. GL_UNSIGNED_BYTE_2_3_3_REV = $8362;
  424. GL_UNSIGNED_SHORT = $1403;
  425. GL_UNSIGNED_SHORT_5_6_5 = $8363;
  426. GL_UNSIGNED_SHORT_4_4_4_4 = $8033;
  427. GL_UNSIGNED_SHORT_5_5_5_1 = $8034;
  428. GL_UNSIGNED_SHORT_5_6_5_REV = $8364;
  429. GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;
  430. GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;
  431. GL_UNSIGNED_INT = $1405;
  432. GL_UNSIGNED_INT_8_8_8_8 = $8035;
  433. GL_UNSIGNED_INT_10_10_10_2 = $8036;
  434. GL_UNSIGNED_INT_8_8_8_8_REV = $8367;
  435. GL_UNSIGNED_INT_2_10_10_10_REV = $8368;
  436. { Texture Filter }
  437. GL_TEXTURE_MAG_FILTER = $2800;
  438. GL_TEXTURE_MIN_FILTER = $2801;
  439. GL_NEAREST = $2600;
  440. GL_NEAREST_MIPMAP_NEAREST = $2700;
  441. GL_NEAREST_MIPMAP_LINEAR = $2702;
  442. GL_LINEAR = $2601;
  443. GL_LINEAR_MIPMAP_NEAREST = $2701;
  444. GL_LINEAR_MIPMAP_LINEAR = $2703;
  445. { Texture Wrap }
  446. GL_TEXTURE_WRAP_S = $2802;
  447. GL_TEXTURE_WRAP_T = $2803;
  448. GL_TEXTURE_WRAP_R = $8072;
  449. GL_CLAMP = $2900;
  450. GL_REPEAT = $2901;
  451. GL_CLAMP_TO_EDGE = $812F;
  452. GL_CLAMP_TO_BORDER = $812D;
  453. GL_MIRRORED_REPEAT = $8370;
  454. { Other }
  455. GL_GENERATE_MIPMAP = $8191;
  456. GL_TEXTURE_BORDER_COLOR = $1004;
  457. GL_MAX_TEXTURE_SIZE = $0D33;
  458. GL_PACK_ALIGNMENT = $0D05;
  459. GL_UNPACK_ALIGNMENT = $0CF5;
  460. GL_TEXTURE_MAX_ANISOTROPY_EXT = $84FE;
  461. GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;
  462. {$ifdef LINUX}
  463. libglu = 'libGLU.so.1';
  464. libopengl = 'libGL.so.1';
  465. {$else}
  466. libglu = 'glu32.dll';
  467. libopengl = 'opengl32.dll';
  468. {$endif}
  469. type
  470. GLboolean = BYTEBOOL;
  471. GLint = Integer;
  472. GLsizei = Integer;
  473. GLuint = Cardinal;
  474. GLfloat = Single;
  475. GLenum = Cardinal;
  476. PGLvoid = Pointer;
  477. PGLboolean = ^GLboolean;
  478. PGLint = ^GLint;
  479. PGLuint = ^GLuint;
  480. PGLfloat = ^GLfloat;
  481. TglCompressedTexImage1D = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  482. 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}
  483. TglGetCompressedTexImage = procedure(target: GLenum; level: GLint; img: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  484. {$IF DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
  485. TglEnable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  486. TglDisable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  487. TglGetString = function(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  488. TglGetIntegerv = procedure(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  489. TglTexParameteri = procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  490. TglTexParameterfv = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  491. TglGetTexParameteriv = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  492. TglGetTexParameterfv = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  493. TglGetTexLevelParameteriv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  494. TglGetTexLevelParameterfv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  495. TglGenTextures = procedure(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  496. TglBindTexture = procedure(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  497. TglDeleteTextures = procedure(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  498. TglAreTexturesResident = function(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  499. TglReadPixels = procedure(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  500. TglPixelStorei = procedure(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  501. 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}
  502. 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}
  503. TglGetTexImage = procedure(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  504. TgluBuild1DMipmaps = function(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  505. TgluBuild2DMipmaps = function(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  506. {$IFDEF GLB_LINUX}
  507. TglXGetProcAddress = function(ProcName: PAnsiChar): Pointer; cdecl;
  508. {$ELSE}
  509. TwglGetProcAddress = function (ProcName: PAnsiChar): Pointer; stdcall;
  510. {$ENDIF}
  511. {$ELSEIF DEFINED(GLB_NATIVE_OGL_STATIC)}
  512. procedure glEnable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  513. procedure glDisable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  514. function glGetString(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  515. procedure glGetIntegerv(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  516. procedure glTexParameteri(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  517. procedure glTexParameterfv(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  518. procedure glGetTexParameteriv(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  519. procedure glGetTexParameterfv(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  520. procedure glGetTexLevelParameteriv(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  521. procedure glGetTexLevelParameterfv(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  522. procedure glGenTextures(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  523. procedure glBindTexture(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  524. procedure glDeleteTextures(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  525. function glAreTexturesResident(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  526. 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;
  527. procedure glPixelStorei(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  528. 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;
  529. 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;
  530. procedure glGetTexImage(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  531. function gluBuild1DMipmaps(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
  532. function gluBuild2DMipmaps(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
  533. {$ENDIF}
  534. var
  535. GL_VERSION_1_2,
  536. GL_VERSION_1_3,
  537. GL_VERSION_1_4,
  538. GL_VERSION_2_0,
  539. GL_SGIS_generate_mipmap,
  540. GL_ARB_texture_border_clamp,
  541. GL_ARB_texture_mirrored_repeat,
  542. GL_ARB_texture_rectangle,
  543. GL_ARB_texture_non_power_of_two,
  544. GL_IBM_texture_mirrored_repeat,
  545. GL_NV_texture_rectangle,
  546. GL_EXT_texture_edge_clamp,
  547. GL_EXT_texture_rectangle,
  548. GL_EXT_texture_filter_anisotropic: Boolean;
  549. glCompressedTexImage1D: TglCompressedTexImage1D;
  550. glCompressedTexImage2D: TglCompressedTexImage2D;
  551. glGetCompressedTexImage: TglGetCompressedTexImage;
  552. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  553. glEnable: TglEnable;
  554. glDisable: TglDisable;
  555. glGetString: TglGetString;
  556. glGetIntegerv: TglGetIntegerv;
  557. glTexParameteri: TglTexParameteri;
  558. glTexParameterfv: TglTexParameterfv;
  559. glGetTexParameteriv: TglGetTexParameteriv;
  560. glGetTexParameterfv: TglGetTexParameterfv;
  561. glGetTexLevelParameteriv: TglGetTexLevelParameteriv;
  562. glGetTexLevelParameterfv: TglGetTexLevelParameterfv;
  563. glGenTextures: TglGenTextures;
  564. glBindTexture: TglBindTexture;
  565. glDeleteTextures: TglDeleteTextures;
  566. glAreTexturesResident: TglAreTexturesResident;
  567. glReadPixels: TglReadPixels;
  568. glPixelStorei: TglPixelStorei;
  569. glTexImage1D: TglTexImage1D;
  570. glTexImage2D: TglTexImage2D;
  571. glGetTexImage: TglGetTexImage;
  572. gluBuild1DMipmaps: TgluBuild1DMipmaps;
  573. gluBuild2DMipmaps: TgluBuild2DMipmaps;
  574. {$IF DEFINED(GLB_WIN)}
  575. wglGetProcAddress: TwglGetProcAddress;
  576. {$ELSEIF DEFINED(GLB_LINUX)}
  577. glXGetProcAddress: TglXGetProcAddress;
  578. glXGetProcAddressARB: TglXGetProcAddressARB;
  579. {$ENDIF}
  580. {$ENDIF}
  581. (*
  582. {$IFDEF GLB_DELPHI}
  583. var
  584. gLastContext: HGLRC;
  585. {$ENDIF}
  586. *)
  587. {$ENDIF}
  588. type
  589. ////////////////////////////////////////////////////////////////////////////////////////////////////
  590. EglBitmapException = class(Exception);
  591. EglBitmapSizeToLargeException = class(EglBitmapException);
  592. EglBitmapNonPowerOfTwoException = class(EglBitmapException);
  593. EglBitmapUnsupportedFormatFormat = class(EglBitmapException);
  594. ////////////////////////////////////////////////////////////////////////////////////////////////////
  595. TglBitmapFormat = (
  596. tfEmpty = 0, //must be smallest value!
  597. tfAlpha4,
  598. tfAlpha8,
  599. tfAlpha12,
  600. tfAlpha16,
  601. tfLuminance4,
  602. tfLuminance8,
  603. tfLuminance12,
  604. tfLuminance16,
  605. tfLuminance4Alpha4,
  606. tfLuminance6Alpha2,
  607. tfLuminance8Alpha8,
  608. tfLuminance12Alpha4,
  609. tfLuminance12Alpha12,
  610. tfLuminance16Alpha16,
  611. tfR3G3B2,
  612. tfRGB4,
  613. tfR5G6B5,
  614. tfRGB5,
  615. tfRGB8,
  616. tfRGB10,
  617. tfRGB12,
  618. tfRGB16,
  619. tfRGBA2,
  620. tfRGBA4,
  621. tfRGB5A1,
  622. tfRGBA8,
  623. tfRGB10A2,
  624. tfRGBA12,
  625. tfRGBA16,
  626. tfBGR4,
  627. tfB5G6R5,
  628. tfBGR5,
  629. tfBGR8,
  630. tfBGR10,
  631. tfBGR12,
  632. tfBGR16,
  633. tfBGRA2,
  634. tfBGRA4,
  635. tfBGR5A1,
  636. tfBGRA8,
  637. tfBGR10A2,
  638. tfBGRA12,
  639. tfBGRA16,
  640. tfDepth16,
  641. tfDepth24,
  642. tfDepth32,
  643. tfS3tcDtx1RGBA,
  644. tfS3tcDtx3RGBA,
  645. tfS3tcDtx5RGBA
  646. );
  647. TglBitmapFileType = (
  648. {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG, {$ENDIF}
  649. {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
  650. ftDDS,
  651. ftTGA,
  652. ftBMP);
  653. TglBitmapFileTypes = set of TglBitmapFileType;
  654. TglBitmapMipMap = (
  655. mmNone,
  656. mmMipmap,
  657. mmMipmapGlu);
  658. TglBitmapNormalMapFunc = (
  659. nm4Samples,
  660. nmSobel,
  661. nm3x3,
  662. nm5x5);
  663. ////////////////////////////////////////////////////////////////////////////////////////////////////
  664. TglBitmapColorRec = packed record
  665. case Integer of
  666. 0: (r, g, b, a: Cardinal);
  667. 1: (arr: array[0..3] of Cardinal);
  668. end;
  669. TglBitmapPixelData = packed record
  670. Data, Range: TglBitmapColorRec;
  671. Format: TglBitmapFormat;
  672. end;
  673. PglBitmapPixelData = ^TglBitmapPixelData;
  674. ////////////////////////////////////////////////////////////////////////////////////////////////////
  675. TglBitmapPixelPositionFields = set of (ffX, ffY);
  676. TglBitmapPixelPosition = record
  677. Fields : TglBitmapPixelPositionFields;
  678. X : Word;
  679. Y : Word;
  680. end;
  681. ////////////////////////////////////////////////////////////////////////////////////////////////////
  682. TglBitmap = class;
  683. TglBitmapFunctionRec = record
  684. Sender: TglBitmap;
  685. Size: TglBitmapPixelPosition;
  686. Position: TglBitmapPixelPosition;
  687. Source: TglBitmapPixelData;
  688. Dest: TglBitmapPixelData;
  689. Args: Pointer;
  690. end;
  691. TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
  692. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  693. TglBitmap = class
  694. protected
  695. fID: GLuint;
  696. fTarget: GLuint;
  697. fAnisotropic: Integer;
  698. fDeleteTextureOnFree: Boolean;
  699. fFreeDataAfterGenTexture: Boolean;
  700. fData: PByte;
  701. fIsResident: Boolean;
  702. fBorderColor: array[0..3] of Single;
  703. fDimension: TglBitmapPixelPosition;
  704. fMipMap: TglBitmapMipMap;
  705. fFormat: TglBitmapFormat;
  706. // Mapping
  707. fPixelSize: Integer;
  708. fRowSize: Integer;
  709. // Filtering
  710. fFilterMin: Cardinal;
  711. fFilterMag: Cardinal;
  712. // TexturWarp
  713. fWrapS: Cardinal;
  714. fWrapT: Cardinal;
  715. fWrapR: Cardinal;
  716. // CustomData
  717. fFilename: String;
  718. fCustomName: String;
  719. fCustomNameW: WideString;
  720. fCustomData: Pointer;
  721. //Getter
  722. function GetWidth: Integer; virtual;
  723. function GetHeight: Integer; virtual;
  724. function GetFileWidth: Integer; virtual;
  725. function GetFileHeight: Integer; virtual;
  726. //Setter
  727. procedure SetCustomData(const aValue: Pointer);
  728. procedure SetCustomName(const aValue: String);
  729. procedure SetCustomNameW(const aValue: WideString);
  730. procedure SetDeleteTextureOnFree(const aValue: Boolean);
  731. procedure SetFormat(const aValue: TglBitmapFormat);
  732. procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
  733. procedure SetID(const aValue: Cardinal);
  734. procedure SetMipMap(const aValue: TglBitmapMipMap);
  735. procedure SetTarget(const aValue: Cardinal);
  736. procedure SetAnisotropic(const aValue: Integer);
  737. procedure CreateID;
  738. procedure SetupParameters(out aBuildWithGlu: Boolean);
  739. procedure SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
  740. const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;
  741. procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
  742. function FlipHorz: Boolean; virtual;
  743. function FlipVert: Boolean; virtual;
  744. property Width: Integer read GetWidth;
  745. property Height: Integer read GetHeight;
  746. property FileWidth: Integer read GetFileWidth;
  747. property FileHeight: Integer read GetFileHeight;
  748. public
  749. //Properties
  750. property ID: Cardinal read fID write SetID;
  751. property Target: Cardinal read fTarget write SetTarget;
  752. property Format: TglBitmapFormat read fFormat write SetFormat;
  753. property MipMap: TglBitmapMipMap read fMipMap write SetMipMap;
  754. property Anisotropic: Integer read fAnisotropic write SetAnisotropic;
  755. property Filename: String read fFilename;
  756. property CustomName: String read fCustomName write SetCustomName;
  757. property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
  758. property CustomData: Pointer read fCustomData write SetCustomData;
  759. property DeleteTextureOnFree: Boolean read fDeleteTextureOnFree write SetDeleteTextureOnFree;
  760. property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
  761. property Dimension: TglBitmapPixelPosition read fDimension;
  762. property Data: PByte read fData;
  763. property IsResident: Boolean read fIsResident;
  764. procedure AfterConstruction; override;
  765. procedure BeforeDestruction; override;
  766. //Load
  767. procedure LoadFromFile(const aFilename: String);
  768. procedure LoadFromStream(const aStream: TStream); virtual;
  769. procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  770. const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
  771. {$IFDEF GLB_DELPHI}
  772. procedure LoadFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil);
  773. procedure LoadFromResourceID(const sInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  774. {$ENDIF}
  775. //Save
  776. procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  777. procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
  778. //Convert
  779. function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
  780. function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  781. const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
  782. public
  783. //Alpha & Co
  784. {$IFDEF GLB_SDL}
  785. function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  786. function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  787. function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  788. function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
  789. const aArgs: Pointer = nil): Boolean;
  790. {$ENDIF}
  791. {$IFDEF GLB_DELPHI}
  792. function AssignToBitmap(const aBitmap: TBitmap): Boolean;
  793. function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  794. function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  795. function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
  796. const aArgs: Pointer = nil): Boolean;
  797. function AddAlphaFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil;
  798. const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  799. function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  800. const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  801. {$ENDIF}
  802. function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
  803. function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  804. function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  805. function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  806. function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
  807. function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
  808. function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
  809. function AddAlphaFromValue(const aAlpha: Byte): Boolean;
  810. function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  811. function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  812. function RemoveAlpha: Boolean; virtual;
  813. public
  814. //Common
  815. function Clone: TglBitmap;
  816. function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
  817. procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
  818. procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  819. procedure FreeData;
  820. //ColorFill
  821. procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
  822. procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
  823. procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
  824. //TexParameters
  825. procedure SetFilter(const aMin, aMag: Cardinal);
  826. procedure SetWrap(
  827. const S: Cardinal = GL_CLAMP_TO_EDGE;
  828. const T: Cardinal = GL_CLAMP_TO_EDGE;
  829. const R: Cardinal = GL_CLAMP_TO_EDGE);
  830. procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
  831. procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
  832. //Constructors
  833. constructor Create; overload;
  834. constructor Create(const aFileName: String); overload;
  835. constructor Create(const aStream: TStream); overload;
  836. constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat); overload;
  837. constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
  838. {$IFDEF GLB_DELPHI}
  839. constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
  840. constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
  841. {$ENDIF}
  842. private
  843. {$IFDEF GLB_SUPPORT_PNG_READ}
  844. function LoadPNG(const aStream: TStream): Boolean; virtual;
  845. procedure SavePNG(const aStream: TStream); virtual;
  846. {$ENDIF}
  847. {$IFDEF GLB_SUPPORT_JPEG_READ}
  848. function LoadJPEG(const aStream: TStream): Boolean; virtual;
  849. procedure SaveJPEG(const aStream: TStream); virtual;
  850. {$ENDIF}
  851. function LoadBMP(const aStream: TStream): Boolean; virtual;
  852. procedure SaveBMP(const aStream: TStream); virtual;
  853. function LoadTGA(const aStream: TStream): Boolean; virtual;
  854. procedure SaveTGA(const aStream: TStream); virtual;
  855. function LoadDDS(const aStream: TStream): Boolean; virtual;
  856. procedure SaveDDS(const aStream: TStream); virtual;
  857. end;
  858. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  859. TglBitmap2D = class(TglBitmap)
  860. protected
  861. // Bildeinstellungen
  862. fLines: array of PByte;
  863. (* TODO
  864. procedure GetDXTColorBlock(pData: pByte; relX, relY: Integer; var Pixel: TglBitmapPixelData);
  865. procedure GetPixel2DDXT1(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
  866. procedure GetPixel2DDXT3(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
  867. procedure GetPixel2DDXT5(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
  868. procedure GetPixel2DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
  869. procedure SetPixel2DUnmap(const Pos: TglBitmapPixelPosition; const Pixel: TglBitmapPixelData);
  870. *)
  871. function GetScanline(const aIndex: Integer): Pointer;
  872. procedure SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
  873. const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
  874. procedure UploadData(const aTarget: Cardinal; const aBuildWithGlu: Boolean);
  875. public
  876. property Width;
  877. property Height;
  878. property Scanline[const aIndex: Integer]: Pointer read GetScanline;
  879. procedure AfterConstruction; override;
  880. procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  881. procedure GetDataFromTexture;
  882. procedure GenTexture(const aTestTextureSize: Boolean = true); override;
  883. function FlipHorz: Boolean; override;
  884. function FlipVert: Boolean; override;
  885. procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
  886. const aScale: Single = 2; const aUseAlpha: Boolean = false);
  887. end;
  888. (* TODO
  889. TglBitmapCubeMap = class(TglBitmap2D)
  890. protected
  891. fGenMode: Integer;
  892. // Hide GenTexture
  893. procedure GenTexture(TestTextureSize: Boolean = true); reintroduce;
  894. public
  895. procedure AfterConstruction; override;
  896. procedure GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean = true);
  897. procedure Unbind(DisableTexCoordsGen: Boolean = true; DisableTextureUnit: Boolean = true); reintroduce; virtual;
  898. procedure Bind(EnableTexCoordsGen: Boolean = true; EnableTextureUnit: Boolean = true); reintroduce; virtual;
  899. end;
  900. TglBitmapNormalMap = class(TglBitmapCubeMap)
  901. public
  902. procedure AfterConstruction; override;
  903. procedure GenerateNormalMap(Size: Integer = 32; TestTextureSize: Boolean = true);
  904. end;
  905. TglBitmap1D = class(TglBitmap)
  906. protected
  907. procedure GetPixel1DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
  908. procedure SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width: Integer = -1; Height: Integer = -1); override;
  909. procedure UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
  910. public
  911. // propertys
  912. property Width;
  913. procedure AfterConstruction; override;
  914. // Other
  915. function FlipHorz: Boolean; override;
  916. // Generation
  917. procedure GenTexture(TestTextureSize: Boolean = true); override;
  918. end;
  919. *)
  920. const
  921. NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
  922. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  923. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  924. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  925. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  926. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  927. procedure glBitmapSetDefaultWrap(
  928. const S: Cardinal = GL_CLAMP_TO_EDGE;
  929. const T: Cardinal = GL_CLAMP_TO_EDGE;
  930. const R: Cardinal = GL_CLAMP_TO_EDGE);
  931. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  932. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  933. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  934. function glBitmapGetDefaultFormat: TglBitmapFormat;
  935. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  936. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  937. function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
  938. function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
  939. function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
  940. var
  941. glBitmapDefaultDeleteTextureOnFree: Boolean;
  942. glBitmapDefaultFreeDataAfterGenTextures: Boolean;
  943. glBitmapDefaultFormat: TglBitmapFormat;
  944. glBitmapDefaultMipmap: TglBitmapMipMap;
  945. glBitmapDefaultFilterMin: Cardinal;
  946. glBitmapDefaultFilterMag: Cardinal;
  947. glBitmapDefaultWrapS: Cardinal;
  948. glBitmapDefaultWrapT: Cardinal;
  949. glBitmapDefaultWrapR: Cardinal;
  950. {$IFDEF GLB_DELPHI}
  951. function CreateGrayPalette: HPALETTE;
  952. {$ENDIF}
  953. implementation
  954. (* TODO
  955. function FormatIsCompressed(Format: TglBitmapInternalFormat): boolean;
  956. function FormatIsUncompressed(Format: TglBitmapInternalFormat): boolean;
  957. function LoadTexture(Filename: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal = 0{$ENDIF}): Boolean;
  958. function LoadCubeMap(PositiveX, NegativeX, PositiveY, NegativeY, PositiveZ, NegativeZ: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal = 0{$ENDIF}): Boolean;
  959. function LoadNormalMap(Size: Integer; var Texture: Cardinal): Boolean;
  960. *)
  961. uses
  962. Math, syncobjs;
  963. type
  964. ////////////////////////////////////////////////////////////////////////////////////////////////////
  965. TShiftRec = packed record
  966. case Integer of
  967. 0: (r, g, b, a: Byte);
  968. 1: (arr: array[0..3] of Byte);
  969. end;
  970. TFormatDescriptor = class(TObject)
  971. private
  972. function GetRedMask: UInt64;
  973. function GetGreenMask: UInt64;
  974. function GetBlueMask: UInt64;
  975. function GetAlphaMask: UInt64;
  976. protected
  977. fFormat: TglBitmapFormat;
  978. fWithAlpha: TglBitmapFormat;
  979. fWithoutAlpha: TglBitmapFormat;
  980. fRGBInverted: TglBitmapFormat;
  981. fUncompressed: TglBitmapFormat;
  982. fPixelSize: Single;
  983. fIsCompressed: Boolean;
  984. fRange: TglBitmapColorRec;
  985. fShift: TShiftRec;
  986. fglFormat: Cardinal;
  987. fglInternalFormat: Cardinal;
  988. fglDataFormat: Cardinal;
  989. function GetComponents: Integer; virtual;
  990. public
  991. property Format: TglBitmapFormat read fFormat;
  992. property WithAlpha: TglBitmapFormat read fWithAlpha;
  993. property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;
  994. property RGBInverted: TglBitmapFormat read fRGBInverted;
  995. property Components: Integer read GetComponents;
  996. property PixelSize: Single read fPixelSize;
  997. property IsCompressed: Boolean read fIsCompressed;
  998. property glFormat: Cardinal read fglFormat;
  999. property glInternalFormat: Cardinal read fglInternalFormat;
  1000. property glDataFormat: Cardinal read fglDataFormat;
  1001. property Range: TglBitmapColorRec read fRange;
  1002. property Shift: TShiftRec read fShift;
  1003. property RedMask: UInt64 read GetRedMask;
  1004. property GreenMask: UInt64 read GetGreenMask;
  1005. property BlueMask: UInt64 read GetBlueMask;
  1006. property AlphaMask: UInt64 read GetAlphaMask;
  1007. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
  1008. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
  1009. function GetSize(const aSize: TglBitmapPixelPosition): Integer; virtual; overload;
  1010. function GetSize(const aWidth, aHeight: Integer): Integer; virtual; overload;
  1011. function CreateMappingData: Pointer; virtual;
  1012. procedure FreeMappingData(var aMappingData: Pointer); virtual;
  1013. function IsEmpty: Boolean; virtual;
  1014. function HasAlpha: Boolean; virtual;
  1015. function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: UInt64): Boolean; virtual;
  1016. procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
  1017. constructor Create; virtual;
  1018. public
  1019. class procedure Init;
  1020. class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1021. class function GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1022. class procedure Clear;
  1023. class procedure Finalize;
  1024. end;
  1025. TFormatDescriptorClass = class of TFormatDescriptor;
  1026. TfdEmpty = class(TFormatDescriptor);
  1027. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1028. TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1029. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1030. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1031. constructor Create; override;
  1032. end;
  1033. TfdLuminance_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1034. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1035. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1036. constructor Create; override;
  1037. end;
  1038. TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1039. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1040. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1041. constructor Create; override;
  1042. end;
  1043. TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte
  1044. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1045. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1046. constructor Create; override;
  1047. end;
  1048. TfdRGB_UB3 = class(TFormatDescriptor) //3* unsigned byte
  1049. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1050. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1051. constructor Create; override;
  1052. end;
  1053. TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
  1054. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1055. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1056. constructor Create; override;
  1057. end;
  1058. TfdRGBA_UB4 = class(TfdRGB_UB3) //4* unsigned byte
  1059. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1060. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1061. constructor Create; override;
  1062. end;
  1063. TfdBGRA_UB4 = class(TfdBGR_UB3) //4* unsigned byte (inverse)
  1064. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1065. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1066. constructor Create; override;
  1067. end;
  1068. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1069. TfdAlpha_US1 = class(TFormatDescriptor) //1* unsigned short
  1070. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1071. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1072. constructor Create; override;
  1073. end;
  1074. TfdLuminance_US1 = class(TFormatDescriptor) //1* unsigned short
  1075. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1076. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1077. constructor Create; override;
  1078. end;
  1079. TfdUniversal_US1 = class(TFormatDescriptor) //1* unsigned short
  1080. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1081. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1082. constructor Create; override;
  1083. end;
  1084. TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short
  1085. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1086. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1087. constructor Create; override;
  1088. end;
  1089. TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short
  1090. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1091. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1092. constructor Create; override;
  1093. end;
  1094. TfdRGB_US3 = class(TFormatDescriptor) //3* unsigned short
  1095. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1096. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1097. constructor Create; override;
  1098. end;
  1099. TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)
  1100. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1101. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1102. constructor Create; override;
  1103. end;
  1104. TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
  1105. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1106. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1107. constructor Create; override;
  1108. end;
  1109. TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
  1110. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1111. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1112. constructor Create; override;
  1113. end;
  1114. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1115. TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int
  1116. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1117. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1118. constructor Create; override;
  1119. end;
  1120. TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int
  1121. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1122. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1123. constructor Create; override;
  1124. end;
  1125. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1126. TfdAlpha4 = class(TfdAlpha_UB1)
  1127. constructor Create; override;
  1128. end;
  1129. TfdAlpha8 = class(TfdAlpha_UB1)
  1130. constructor Create; override;
  1131. end;
  1132. TfdAlpha12 = class(TfdAlpha_US1)
  1133. constructor Create; override;
  1134. end;
  1135. TfdAlpha16 = class(TfdAlpha_US1)
  1136. constructor Create; override;
  1137. end;
  1138. TfdLuminance4 = class(TfdLuminance_UB1)
  1139. constructor Create; override;
  1140. end;
  1141. TfdLuminance8 = class(TfdLuminance_UB1)
  1142. constructor Create; override;
  1143. end;
  1144. TfdLuminance12 = class(TfdLuminance_US1)
  1145. constructor Create; override;
  1146. end;
  1147. TfdLuminance16 = class(TfdLuminance_US1)
  1148. constructor Create; override;
  1149. end;
  1150. TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
  1151. constructor Create; override;
  1152. end;
  1153. TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
  1154. constructor Create; override;
  1155. end;
  1156. TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
  1157. constructor Create; override;
  1158. end;
  1159. TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
  1160. constructor Create; override;
  1161. end;
  1162. TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)
  1163. constructor Create; override;
  1164. end;
  1165. TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
  1166. constructor Create; override;
  1167. end;
  1168. TfdR3G3B2 = class(TfdUniversal_UB1)
  1169. constructor Create; override;
  1170. end;
  1171. TfdRGB4 = class(TfdUniversal_US1)
  1172. constructor Create; override;
  1173. end;
  1174. TfdR5G6B5 = class(TfdUniversal_US1)
  1175. constructor Create; override;
  1176. end;
  1177. TfdRGB5 = class(TfdUniversal_US1)
  1178. constructor Create; override;
  1179. end;
  1180. TfdRGB8 = class(TfdRGB_UB3)
  1181. constructor Create; override;
  1182. end;
  1183. TfdRGB10 = class(TfdUniversal_UI1)
  1184. constructor Create; override;
  1185. end;
  1186. TfdRGB12 = class(TfdRGB_US3)
  1187. constructor Create; override;
  1188. end;
  1189. TfdRGB16 = class(TfdRGB_US3)
  1190. constructor Create; override;
  1191. end;
  1192. TfdRGBA2 = class(TfdRGBA_UB4)
  1193. constructor Create; override;
  1194. end;
  1195. TfdRGBA4 = class(TfdUniversal_US1)
  1196. constructor Create; override;
  1197. end;
  1198. TfdRGB5A1 = class(TfdUniversal_US1)
  1199. constructor Create; override;
  1200. end;
  1201. TfdRGBA8 = class(TfdRGBA_UB4)
  1202. constructor Create; override;
  1203. end;
  1204. TfdRGB10A2 = class(TfdUniversal_UI1)
  1205. constructor Create; override;
  1206. end;
  1207. TfdRGBA12 = class(TfdRGBA_US4)
  1208. constructor Create; override;
  1209. end;
  1210. TfdRGBA16 = class(TfdRGBA_US4)
  1211. constructor Create; override;
  1212. end;
  1213. TfdBGR4 = class(TfdUniversal_US1)
  1214. constructor Create; override;
  1215. end;
  1216. TfdB5G6R5 = class(TfdUniversal_US1)
  1217. constructor Create; override;
  1218. end;
  1219. TfdBGR5 = class(TfdUniversal_US1)
  1220. constructor Create; override;
  1221. end;
  1222. TfdBGR8 = class(TfdBGR_UB3)
  1223. constructor Create; override;
  1224. end;
  1225. TfdBGR10 = class(TfdUniversal_UI1)
  1226. constructor Create; override;
  1227. end;
  1228. TfdBGR12 = class(TfdBGR_US3)
  1229. constructor Create; override;
  1230. end;
  1231. TfdBGR16 = class(TfdBGR_US3)
  1232. constructor Create; override;
  1233. end;
  1234. TfdBGRA2 = class(TfdBGRA_UB4)
  1235. constructor Create; override;
  1236. end;
  1237. TfdBGRA4 = class(TfdUniversal_US1)
  1238. constructor Create; override;
  1239. end;
  1240. TfdBGR5A1 = class(TfdUniversal_US1)
  1241. constructor Create; override;
  1242. end;
  1243. TfdBGRA8 = class(TfdBGRA_UB4)
  1244. constructor Create; override;
  1245. end;
  1246. TfdBGR10A2 = class(TfdUniversal_UI1)
  1247. constructor Create; override;
  1248. end;
  1249. TfdBGRA12 = class(TfdBGRA_US4)
  1250. constructor Create; override;
  1251. end;
  1252. TfdBGRA16 = class(TfdBGRA_US4)
  1253. constructor Create; override;
  1254. end;
  1255. TfdDepth16 = class(TfdDepth_US1)
  1256. constructor Create; override;
  1257. end;
  1258. TfdDepth24 = class(TfdDepth_UI1)
  1259. constructor Create; override;
  1260. end;
  1261. TfdDepth32 = class(TfdDepth_UI1)
  1262. constructor Create; override;
  1263. end;
  1264. TfdS3tcDtx1RGBA = class(TFormatDescriptor)
  1265. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1266. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1267. constructor Create; override;
  1268. end;
  1269. TfdS3tcDtx3RGBA = class(TFormatDescriptor)
  1270. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1271. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1272. constructor Create; override;
  1273. end;
  1274. TfdS3tcDtx5RGBA = class(TFormatDescriptor)
  1275. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1276. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1277. constructor Create; override;
  1278. end;
  1279. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1280. TbmpBitfieldFormat = class(TFormatDescriptor)
  1281. private
  1282. procedure SetRedMask (const aValue: UInt64);
  1283. procedure SetGreenMask(const aValue: UInt64);
  1284. procedure SetBlueMask (const aValue: UInt64);
  1285. procedure SetAlphaMask(const aValue: UInt64);
  1286. procedure Update(aMask: UInt64; out aRange: Cardinal; out aShift: Byte);
  1287. public
  1288. property RedMask: UInt64 read GetRedMask write SetRedMask;
  1289. property GreenMask: UInt64 read GetGreenMask write SetGreenMask;
  1290. property BlueMask: UInt64 read GetBlueMask write SetBlueMask;
  1291. property AlphaMask: UInt64 read GetAlphaMask write SetAlphaMask;
  1292. property PixelSize: Single read fPixelSize write fPixelSize;
  1293. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1294. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1295. end;
  1296. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1297. TbmpColorTableEnty = packed record
  1298. b, g, r, a: Byte;
  1299. end;
  1300. TbmpColorTable = array of TbmpColorTableEnty;
  1301. TbmpColorTableFormat = class(TFormatDescriptor)
  1302. private
  1303. fColorTable: TbmpColorTable;
  1304. public
  1305. property PixelSize: Single read fPixelSize write fPixelSize;
  1306. property ColorTable: TbmpColorTable read fColorTable write fColorTable;
  1307. property Range: TglBitmapColorRec read fRange write fRange;
  1308. property Shift: TShiftRec read fShift write fShift;
  1309. property Format: TglBitmapFormat read fFormat write fFormat;
  1310. procedure CreateColorTable;
  1311. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1312. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1313. destructor Destroy; override;
  1314. end;
  1315. const
  1316. LUMINANCE_WEIGHT_R = 0.30;
  1317. LUMINANCE_WEIGHT_G = 0.59;
  1318. LUMINANCE_WEIGHT_B = 0.11;
  1319. ALPHA_WEIGHT_R = 0.30;
  1320. ALPHA_WEIGHT_G = 0.59;
  1321. ALPHA_WEIGHT_B = 0.11;
  1322. DEPTH_WEIGHT_R = 0.333333333;
  1323. DEPTH_WEIGHT_G = 0.333333333;
  1324. DEPTH_WEIGHT_B = 0.333333333;
  1325. UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
  1326. FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
  1327. TfdEmpty,
  1328. TfdAlpha4,
  1329. TfdAlpha8,
  1330. TfdAlpha12,
  1331. TfdAlpha16,
  1332. TfdLuminance4,
  1333. TfdLuminance8,
  1334. TfdLuminance12,
  1335. TfdLuminance16,
  1336. TfdLuminance4Alpha4,
  1337. TfdLuminance6Alpha2,
  1338. TfdLuminance8Alpha8,
  1339. TfdLuminance12Alpha4,
  1340. TfdLuminance12Alpha12,
  1341. TfdLuminance16Alpha16,
  1342. TfdR3G3B2,
  1343. TfdRGB4,
  1344. TfdR5G6B5,
  1345. TfdRGB5,
  1346. TfdRGB8,
  1347. TfdRGB10,
  1348. TfdRGB12,
  1349. TfdRGB16,
  1350. TfdRGBA2,
  1351. TfdRGBA4,
  1352. TfdRGB5A1,
  1353. TfdRGBA8,
  1354. TfdRGB10A2,
  1355. TfdRGBA12,
  1356. TfdRGBA16,
  1357. TfdBGR4,
  1358. TfdB5G6R5,
  1359. TfdBGR5,
  1360. TfdBGR8,
  1361. TfdBGR10,
  1362. TfdBGR12,
  1363. TfdBGR16,
  1364. TfdBGRA2,
  1365. TfdBGRA4,
  1366. TfdBGR5A1,
  1367. TfdBGRA8,
  1368. TfdBGR10A2,
  1369. TfdBGRA12,
  1370. TfdBGRA16,
  1371. TfdDepth16,
  1372. TfdDepth24,
  1373. TfdDepth32,
  1374. TfdS3tcDtx1RGBA,
  1375. TfdS3tcDtx3RGBA,
  1376. TfdS3tcDtx5RGBA
  1377. );
  1378. var
  1379. FormatDescriptorCS: TCriticalSection;
  1380. FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
  1381. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1382. function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
  1383. begin
  1384. result.Fields := [];
  1385. if X >= 0 then
  1386. result.Fields := result.Fields + [ffX];
  1387. if Y >= 0 then
  1388. result.Fields := result.Fields + [ffY];
  1389. result.X := Max(0, X);
  1390. result.Y := Max(0, Y);
  1391. end;
  1392. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1393. function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
  1394. begin
  1395. result.r := r;
  1396. result.g := g;
  1397. result.b := b;
  1398. result.a := a;
  1399. end;
  1400. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1401. function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
  1402. var
  1403. i: Integer;
  1404. begin
  1405. result := false;
  1406. for i := 0 to high(r1.arr) do
  1407. if (r1.arr[i] <> r2.arr[i]) then
  1408. exit;
  1409. result := true;
  1410. end;
  1411. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1412. function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
  1413. begin
  1414. result.r := r;
  1415. result.g := g;
  1416. result.b := b;
  1417. result.a := a;
  1418. end;
  1419. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1420. function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
  1421. begin
  1422. result := [];
  1423. if (aFormat in [
  1424. //4 bbp
  1425. tfLuminance4,
  1426. //8bpp
  1427. tfR3G3B2, tfLuminance8,
  1428. //16bpp
  1429. tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
  1430. tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,
  1431. //24bpp
  1432. tfBGR8, tfRGB8,
  1433. //32bpp
  1434. tfRGB10, tfRGB10A2, tfRGBA8,
  1435. tfBGR10, tfBGR10A2, tfBGRA8]) then
  1436. result := result + [ftBMP];
  1437. if (aFormat in [
  1438. //8 bpp
  1439. tfLuminance8, tfAlpha8,
  1440. //16 bpp
  1441. tfLuminance16, tfLuminance8Alpha8,
  1442. tfRGB5, tfRGB5A1, tfRGBA4,
  1443. tfBGR5, tfBGR5A1, tfBGRA4,
  1444. //24 bpp
  1445. tfRGB8, tfBGR8,
  1446. //32 bpp
  1447. tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
  1448. result := result + [ftTGA];
  1449. if (aFormat in [
  1450. //8 bpp
  1451. tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,
  1452. tfR3G3B2, tfRGBA2, tfBGRA2,
  1453. //16 bpp
  1454. tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,
  1455. tfRGB4, tfR5G6B5, tfRGB5, tfRGBA4, tfRGB5A1,
  1456. tfBGR4, tfB5G6R5, tfBGR5, tfBGRA4, tfBGR5A1,
  1457. //24 bpp
  1458. tfRGB8, tfBGR8,
  1459. //32 bbp
  1460. tfLuminance16Alpha16,
  1461. tfRGBA8, tfRGB10A2,
  1462. tfBGRA8, tfBGR10A2,
  1463. //compressed
  1464. tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then
  1465. result := result + [ftDDS];
  1466. (* TODO
  1467. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  1468. if aFormat in [
  1469. tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
  1470. tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
  1471. tfuminance4Alpha4, tfLuminance6Alpha2, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16,
  1472. tfR3G3B2, tfRGB4, tfRGB5, tfRGB8, tfRGB10, tfRGB12, tfRGB16,
  1473. tfRGBA2, tfRGBA4, tfRGB5A1, tfRGBA8, tfRGB10A2, tfRGBA12, tfRGBA16,
  1474. tfDepth16, tfDepth24, tfDepth32]
  1475. then
  1476. result := result + [ftPNG];
  1477. {$ENDIF}
  1478. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  1479. if Format in [
  1480. tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
  1481. tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
  1482. tfR3G3B2, tfRGB4, tfRGB5, tfRGB8, tfRGB10, tfRGB12, tfRGB16,
  1483. tfDepth16, tfDepth24, tfDepth32]
  1484. then
  1485. result := result + [ftJPEG];
  1486. {$ENDIF}
  1487. if aFormat in [
  1488. tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
  1489. tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
  1490. tfuminance4Alpha4, tfLuminance6Alpha2, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16,
  1491. tfR3G3B2, tfRGB4, tfRGB5, tfRGB8, tfRGB10, tfRGB12, tfRGB16,
  1492. tfRGBA2, tfRGBA4, tfRGB5A1, tfRGBA8, tfRGB10A2, tfRGBA12, tfRGBA16,
  1493. tfDepth16, tfDepth24, tfDepth32]
  1494. then
  1495. result := result + [ftDDS, ftTGA, ftBMP];
  1496. *)
  1497. end;
  1498. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1499. function IsPowerOfTwo(aNumber: Integer): Boolean;
  1500. begin
  1501. while (aNumber and 1) = 0 do
  1502. aNumber := aNumber shr 1;
  1503. result := aNumber = 1;
  1504. end;
  1505. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1506. function GetTopMostBit(aBitSet: UInt64): Integer;
  1507. begin
  1508. result := 0;
  1509. while aBitSet > 0 do begin
  1510. inc(result);
  1511. aBitSet := aBitSet shr 1;
  1512. end;
  1513. end;
  1514. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1515. function CountSetBits(aBitSet: UInt64): Integer;
  1516. begin
  1517. result := 0;
  1518. while aBitSet > 0 do begin
  1519. if (aBitSet and 1) = 1 then
  1520. inc(result);
  1521. aBitSet := aBitSet shr 1;
  1522. end;
  1523. end;
  1524. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1525. function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1526. begin
  1527. result := Trunc(
  1528. LUMINANCE_WEIGHT_R * aPixel.Data.r +
  1529. LUMINANCE_WEIGHT_G * aPixel.Data.g +
  1530. LUMINANCE_WEIGHT_B * aPixel.Data.b);
  1531. end;
  1532. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1533. function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1534. begin
  1535. result := Trunc(
  1536. DEPTH_WEIGHT_R * aPixel.Data.r +
  1537. DEPTH_WEIGHT_G * aPixel.Data.g +
  1538. DEPTH_WEIGHT_B * aPixel.Data.b);
  1539. end;
  1540. {$IFDEF GLB_NATIVE_OGL}
  1541. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1542. //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1543. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1544. var
  1545. GL_LibHandle: Pointer = nil;
  1546. function glbGetProcAddress(aProcName: PChar; aLibHandle: Pointer = nil): Pointer;
  1547. begin
  1548. result := nil;
  1549. if not Assigned(aLibHandle) then
  1550. aLibHandle := GL_LibHandle;
  1551. {$IF DEFINED(GLB_WIN)}
  1552. result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
  1553. if Assigned(result) then
  1554. exit;
  1555. if Assigned(wglGetProcAddress) then
  1556. result := wglGetProcAddress(aProcName);
  1557. {$ELSEIF DEFINED(GLB_LINUX)}
  1558. if Assigned(glXGetProcAddress) then begin
  1559. result := glXGetProcAddress(aProcName);
  1560. if Assigned(result) then
  1561. exit;
  1562. end;
  1563. if Assigned(glXGetProcAddressARB) then begin
  1564. result := glXGetProcAddressARB(aProcName);
  1565. if Assigned(result) then
  1566. exit;
  1567. end;
  1568. result := dlsym(aLibHandle, aProcName);
  1569. {$ENDIF}
  1570. if not Assigned(result) then
  1571. raise EglBitmapException.Create('unable to load procedure form library: ' + aProcName);
  1572. end;
  1573. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  1574. var
  1575. GLU_LibHandle: Pointer = nil;
  1576. OpenGLInitialized: Boolean;
  1577. InitOpenGLCS: TCriticalSection;
  1578. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1579. procedure glbInitOpenGL;
  1580. ////////////////////////////////////////////////////////////////////////////////
  1581. function glbLoadLibrary(const aName: PChar): Pointer;
  1582. begin
  1583. {$IF DEFINED(GLB_WIN)}
  1584. result := {%H-}Pointer(LoadLibrary(aName));
  1585. {$ELSEIF DEFINED(GLB_LINUX)}
  1586. result := dlopen(Name, RTLD_LAZY);
  1587. {$ELSE}
  1588. result := nil;
  1589. {$ENDIF}
  1590. end;
  1591. ////////////////////////////////////////////////////////////////////////////////
  1592. function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
  1593. begin
  1594. result := false;
  1595. if not Assigned(aLibHandle) then
  1596. exit;
  1597. {$IF DEFINED(GLB_WIN)}
  1598. Result := FreeLibrary({%H-}HINST(aLibHandle));
  1599. {$ELSEIF DEFINED(GLB_LINUX)}
  1600. Result := dlclose(aLibHandle) = 0;
  1601. {$ENDIF}
  1602. end;
  1603. begin
  1604. if Assigned(GL_LibHandle) then
  1605. glbFreeLibrary(GL_LibHandle);
  1606. if Assigned(GLU_LibHandle) then
  1607. glbFreeLibrary(GLU_LibHandle);
  1608. GL_LibHandle := glbLoadLibrary(libopengl);
  1609. if not Assigned(GL_LibHandle) then
  1610. raise EglBitmapException.Create('unable to load library: ' + libopengl);
  1611. GLU_LibHandle := glbLoadLibrary(libglu);
  1612. if not Assigned(GLU_LibHandle) then
  1613. raise EglBitmapException.Create('unable to load library: ' + libglu);
  1614. try
  1615. {$IF DEFINED(GLB_WIN)}
  1616. wglGetProcAddress := glbGetProcAddress('wglGetProcAddress');
  1617. {$ELSEIF DEFINED(GLB_LINUX)}
  1618. glXGetProcAddress := glbGetProcAddress('glXGetProcAddress');
  1619. glXGetProcAddressARB := dglGetProcAddress('glXGetProcAddressARB');
  1620. {$ENDIF}
  1621. glEnable := glbGetProcAddress('glEnable');
  1622. glDisable := glbGetProcAddress('glDisable');
  1623. glGetString := glbGetProcAddress('glGetString');
  1624. glGetIntegerv := glbGetProcAddress('glGetIntegerv');
  1625. glTexParameteri := glbGetProcAddress('glTexParameteri');
  1626. glTexParameterfv := glbGetProcAddress('glTexParameterfv');
  1627. glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
  1628. glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
  1629. glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
  1630. glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
  1631. glGenTextures := glbGetProcAddress('glGenTextures');
  1632. glBindTexture := glbGetProcAddress('glBindTexture');
  1633. glDeleteTextures := glbGetProcAddress('glDeleteTextures');
  1634. glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
  1635. glReadPixels := glbGetProcAddress('glReadPixels');
  1636. glPixelStorei := glbGetProcAddress('glPixelStorei');
  1637. glTexImage1D := glbGetProcAddress('glTexImage1D');
  1638. glTexImage2D := glbGetProcAddress('glTexImage2D');
  1639. glGetTexImage := glbGetProcAddress('glGetTexImage');
  1640. gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
  1641. gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
  1642. finally
  1643. glbFreeLibrary(GL_LibHandle);
  1644. glbFreeLibrary(GLU_LibHandle);
  1645. end;
  1646. end;
  1647. {$ENDIF}
  1648. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1649. procedure glbReadOpenGLExtensions;
  1650. var
  1651. {$IFDEF GLB_DELPHI}
  1652. Context: HGLRC;
  1653. {$ENDIF}
  1654. Buffer: AnsiString;
  1655. MajorVersion, MinorVersion: Integer;
  1656. ///////////////////////////////////////////////////////////////////////////////////////////
  1657. procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
  1658. var
  1659. Separator: Integer;
  1660. begin
  1661. aMinor := 0;
  1662. aMajor := 0;
  1663. Separator := Pos(AnsiString('.'), aBuffer);
  1664. if (Separator > 1) and (Separator < Length(aBuffer)) and
  1665. (aBuffer[Separator - 1] in ['0'..'9']) and
  1666. (aBuffer[Separator + 1] in ['0'..'9']) then begin
  1667. Dec(Separator);
  1668. while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
  1669. Dec(Separator);
  1670. Delete(aBuffer, 1, Separator);
  1671. Separator := Pos(AnsiString('.'), aBuffer) + 1;
  1672. while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
  1673. Inc(Separator);
  1674. Delete(aBuffer, Separator, 255);
  1675. Separator := Pos(AnsiString('.'), aBuffer);
  1676. aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
  1677. aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
  1678. end;
  1679. end;
  1680. ///////////////////////////////////////////////////////////////////////////////////////////
  1681. function CheckExtension(const Extension: AnsiString): Boolean;
  1682. var
  1683. ExtPos: Integer;
  1684. begin
  1685. ExtPos := Pos(Extension, Buffer);
  1686. result := ExtPos > 0;
  1687. if result then
  1688. result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
  1689. end;
  1690. begin
  1691. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  1692. InitOpenGLCS.Enter;
  1693. try
  1694. if not OpenGLInitialized then begin
  1695. glbInitOpenGL;
  1696. OpenGLInitialized := true;
  1697. end;
  1698. finally
  1699. InitOpenGLCS.Leave;
  1700. end;
  1701. {$ENDIF}
  1702. {$IFDEF GLB_DELPHI}
  1703. Context := wglGetCurrentContext;
  1704. if (Context <> gLastContext) then begin
  1705. gLastContext := Context;
  1706. {$ENDIF}
  1707. // Version
  1708. Buffer := glGetString(GL_VERSION);
  1709. TrimVersionString(Buffer, MajorVersion, MinorVersion);
  1710. GL_VERSION_1_2 := false;
  1711. GL_VERSION_1_3 := false;
  1712. GL_VERSION_1_4 := false;
  1713. GL_VERSION_2_0 := false;
  1714. if MajorVersion = 1 then begin
  1715. if MinorVersion >= 2 then
  1716. GL_VERSION_1_2 := true;
  1717. if MinorVersion >= 3 then
  1718. GL_VERSION_1_3 := true;
  1719. if MinorVersion >= 4 then
  1720. GL_VERSION_1_4 := true;
  1721. end else if MajorVersion >= 2 then begin
  1722. GL_VERSION_1_2 := true;
  1723. GL_VERSION_1_3 := true;
  1724. GL_VERSION_1_4 := true;
  1725. GL_VERSION_2_0 := true;
  1726. end;
  1727. // Extensions
  1728. Buffer := glGetString(GL_EXTENSIONS);
  1729. GL_ARB_texture_border_clamp := CheckExtension('GL_ARB_texture_border_clamp');
  1730. GL_ARB_texture_non_power_of_two := CheckExtension('GL_ARB_texture_non_power_of_two');
  1731. GL_ARB_texture_rectangle := CheckExtension('GL_ARB_texture_rectangle');
  1732. GL_ARB_texture_mirrored_repeat := CheckExtension('GL_ARB_texture_mirrored_repeat');
  1733. GL_EXT_texture_edge_clamp := CheckExtension('GL_EXT_texture_edge_clamp');
  1734. GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
  1735. GL_EXT_texture_rectangle := CheckExtension('GL_EXT_texture_rectangle');
  1736. GL_NV_texture_rectangle := CheckExtension('GL_NV_texture_rectangle');
  1737. GL_IBM_texture_mirrored_repeat := CheckExtension('GL_IBM_texture_mirrored_repeat');
  1738. GL_SGIS_generate_mipmap := CheckExtension('GL_SGIS_generate_mipmap');
  1739. if GL_VERSION_1_3 then begin
  1740. glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1D');
  1741. glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2D');
  1742. glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
  1743. end else begin
  1744. glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1DARB');
  1745. glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2DARB');
  1746. glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB');
  1747. end;
  1748. {$IFDEF GLB_DELPHI}
  1749. end;
  1750. {$ENDIF}
  1751. end;
  1752. {$ENDIF}
  1753. (* TODO GLB_DELPHI
  1754. {$IFDEF GLB_DELPHI}
  1755. function CreateGrayPalette: HPALETTE;
  1756. var
  1757. Idx: Integer;
  1758. Pal: PLogPalette;
  1759. begin
  1760. GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
  1761. Pal.palVersion := $300;
  1762. Pal.palNumEntries := 256;
  1763. {$IFOPT R+}
  1764. {$DEFINE GLB_TEMPRANGECHECK}
  1765. {$R-}
  1766. {$ENDIF}
  1767. for Idx := 0 to 256 - 1 do begin
  1768. Pal.palPalEntry[Idx].peRed := Idx;
  1769. Pal.palPalEntry[Idx].peGreen := Idx;
  1770. Pal.palPalEntry[Idx].peBlue := Idx;
  1771. Pal.palPalEntry[Idx].peFlags := 0;
  1772. end;
  1773. {$IFDEF GLB_TEMPRANGECHECK}
  1774. {$UNDEF GLB_TEMPRANGECHECK}
  1775. {$R+}
  1776. {$ENDIF}
  1777. result := CreatePalette(Pal^);
  1778. FreeMem(Pal);
  1779. end;
  1780. {$ENDIF}
  1781. *)
  1782. (* TODO GLB_SDL_IMAGE
  1783. {$IFDEF GLB_SDL_IMAGE}
  1784. function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
  1785. begin
  1786. result := TStream(context^.unknown.data1).Seek(offset, whence);
  1787. end;
  1788. function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
  1789. begin
  1790. result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
  1791. end;
  1792. function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
  1793. begin
  1794. result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
  1795. end;
  1796. function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
  1797. begin
  1798. result := 0;
  1799. end;
  1800. function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
  1801. begin
  1802. result := SDL_AllocRW;
  1803. if result = nil then
  1804. raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
  1805. result^.seek := glBitmapRWseek;
  1806. result^.read := glBitmapRWread;
  1807. result^.write := glBitmapRWwrite;
  1808. result^.close := glBitmapRWclose;
  1809. result^.unknown.data1 := Stream;
  1810. end;
  1811. {$ENDIF}
  1812. *)
  1813. (* TODO LoadFuncs
  1814. function LoadTexture(Filename: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal{$ENDIF}): Boolean;
  1815. var
  1816. glBitmap: TglBitmap2D;
  1817. begin
  1818. result := false;
  1819. Texture := 0;
  1820. {$IFDEF GLB_DELPHI}
  1821. if Instance = 0 then
  1822. Instance := HInstance;
  1823. if (LoadFromRes) then
  1824. glBitmap := TglBitmap2D.CreateFromResourceName(Instance, FileName)
  1825. else
  1826. {$ENDIF}
  1827. glBitmap := TglBitmap2D.Create(FileName);
  1828. try
  1829. glBitmap.DeleteTextureOnFree := false;
  1830. glBitmap.FreeDataAfterGenTexture := false;
  1831. glBitmap.GenTexture(true);
  1832. if (glBitmap.ID > 0) then begin
  1833. Texture := glBitmap.ID;
  1834. result := true;
  1835. end;
  1836. finally
  1837. glBitmap.Free;
  1838. end;
  1839. end;
  1840. function LoadCubeMap(PositiveX, NegativeX, PositiveY, NegativeY, PositiveZ, NegativeZ: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal{$ENDIF}): Boolean;
  1841. var
  1842. CM: TglBitmapCubeMap;
  1843. begin
  1844. Texture := 0;
  1845. {$IFDEF GLB_DELPHI}
  1846. if Instance = 0 then
  1847. Instance := HInstance;
  1848. {$ENDIF}
  1849. CM := TglBitmapCubeMap.Create;
  1850. try
  1851. CM.DeleteTextureOnFree := false;
  1852. // Maps
  1853. {$IFDEF GLB_DELPHI}
  1854. if (LoadFromRes) then
  1855. CM.LoadFromResource(Instance, PositiveX)
  1856. else
  1857. {$ENDIF}
  1858. CM.LoadFromFile(PositiveX);
  1859. CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X);
  1860. {$IFDEF GLB_DELPHI}
  1861. if (LoadFromRes) then
  1862. CM.LoadFromResource(Instance, NegativeX)
  1863. else
  1864. {$ENDIF}
  1865. CM.LoadFromFile(NegativeX);
  1866. CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X);
  1867. {$IFDEF GLB_DELPHI}
  1868. if (LoadFromRes) then
  1869. CM.LoadFromResource(Instance, PositiveY)
  1870. else
  1871. {$ENDIF}
  1872. CM.LoadFromFile(PositiveY);
  1873. CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y);
  1874. {$IFDEF GLB_DELPHI}
  1875. if (LoadFromRes) then
  1876. CM.LoadFromResource(Instance, NegativeY)
  1877. else
  1878. {$ENDIF}
  1879. CM.LoadFromFile(NegativeY);
  1880. CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y);
  1881. {$IFDEF GLB_DELPHI}
  1882. if (LoadFromRes) then
  1883. CM.LoadFromResource(Instance, PositiveZ)
  1884. else
  1885. {$ENDIF}
  1886. CM.LoadFromFile(PositiveZ);
  1887. CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z);
  1888. {$IFDEF GLB_DELPHI}
  1889. if (LoadFromRes) then
  1890. CM.LoadFromResource(Instance, NegativeZ)
  1891. else
  1892. {$ENDIF}
  1893. CM.LoadFromFile(NegativeZ);
  1894. CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z);
  1895. Texture := CM.ID;
  1896. result := true;
  1897. finally
  1898. CM.Free;
  1899. end;
  1900. end;
  1901. function LoadNormalMap(Size: Integer; var Texture: Cardinal): Boolean;
  1902. var
  1903. NM: TglBitmapNormalMap;
  1904. begin
  1905. Texture := 0;
  1906. NM := TglBitmapNormalMap.Create;
  1907. try
  1908. NM.DeleteTextureOnFree := false;
  1909. NM.GenerateNormalMap(Size);
  1910. Texture := NM.ID;
  1911. result := true;
  1912. finally
  1913. NM.Free;
  1914. end;
  1915. end;
  1916. *)
  1917. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1918. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1919. begin
  1920. glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
  1921. end;
  1922. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1923. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1924. begin
  1925. glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
  1926. end;
  1927. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1928. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1929. begin
  1930. glBitmapDefaultMipmap := aValue;
  1931. end;
  1932. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1933. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1934. begin
  1935. glBitmapDefaultFormat := aFormat;
  1936. end;
  1937. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1938. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1939. begin
  1940. glBitmapDefaultFilterMin := aMin;
  1941. glBitmapDefaultFilterMag := aMag;
  1942. end;
  1943. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1944. procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
  1945. begin
  1946. glBitmapDefaultWrapS := S;
  1947. glBitmapDefaultWrapT := T;
  1948. glBitmapDefaultWrapR := R;
  1949. end;
  1950. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1951. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1952. begin
  1953. result := glBitmapDefaultDeleteTextureOnFree;
  1954. end;
  1955. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1956. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1957. begin
  1958. result := glBitmapDefaultFreeDataAfterGenTextures;
  1959. end;
  1960. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1961. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1962. begin
  1963. result := glBitmapDefaultMipmap;
  1964. end;
  1965. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1966. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1967. begin
  1968. result := glBitmapDefaultFormat;
  1969. end;
  1970. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1971. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  1972. begin
  1973. aMin := glBitmapDefaultFilterMin;
  1974. aMag := glBitmapDefaultFilterMag;
  1975. end;
  1976. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1977. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  1978. begin
  1979. S := glBitmapDefaultWrapS;
  1980. T := glBitmapDefaultWrapT;
  1981. R := glBitmapDefaultWrapR;
  1982. end;
  1983. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1984. //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1985. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1986. function TFormatDescriptor.GetRedMask: UInt64;
  1987. begin
  1988. result := fRange.r shl fShift.r;
  1989. end;
  1990. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1991. function TFormatDescriptor.GetGreenMask: UInt64;
  1992. begin
  1993. result := fRange.g shl fShift.g;
  1994. end;
  1995. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1996. function TFormatDescriptor.GetBlueMask: UInt64;
  1997. begin
  1998. result := fRange.b shl fShift.b;
  1999. end;
  2000. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2001. function TFormatDescriptor.GetAlphaMask: UInt64;
  2002. begin
  2003. result := fRange.a shl fShift.a;
  2004. end;
  2005. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2006. function TFormatDescriptor.GetComponents: Integer;
  2007. var
  2008. i: Integer;
  2009. begin
  2010. result := 0;
  2011. for i := 0 to 3 do
  2012. if (fRange.arr[i] > 0) then
  2013. inc(result);
  2014. end;
  2015. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2016. function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
  2017. var
  2018. w, h: Integer;
  2019. begin
  2020. if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
  2021. w := Max(1, aSize.X);
  2022. h := Max(1, aSize.Y);
  2023. result := GetSize(w, h);
  2024. end else
  2025. result := 0;
  2026. end;
  2027. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2028. function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
  2029. begin
  2030. result := 0;
  2031. if (aWidth <= 0) or (aHeight <= 0) then
  2032. exit;
  2033. result := Ceil(aWidth * aHeight * fPixelSize);
  2034. end;
  2035. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2036. function TFormatDescriptor.CreateMappingData: Pointer;
  2037. begin
  2038. result := nil;
  2039. end;
  2040. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2041. procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
  2042. begin
  2043. //DUMMY
  2044. end;
  2045. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2046. function TFormatDescriptor.IsEmpty: Boolean;
  2047. begin
  2048. result := (fFormat = tfEmpty);
  2049. end;
  2050. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2051. function TFormatDescriptor.HasAlpha: Boolean;
  2052. begin
  2053. result := (fRange.a > 0);
  2054. end;
  2055. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2056. function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: UInt64): Boolean;
  2057. begin
  2058. result := false;
  2059. if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
  2060. raise EglBitmapException.Create('FormatCheckFormat - All Masks are 0');
  2061. if (aRedMask <> RedMask) then
  2062. exit;
  2063. if (aGreenMask <> GreenMask) then
  2064. exit;
  2065. if (aBlueMask <> BlueMask) then
  2066. exit;
  2067. if (aAlphaMask <> AlphaMask) then
  2068. exit;
  2069. result := true;
  2070. end;
  2071. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2072. procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
  2073. begin
  2074. FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
  2075. aPixel.Data := fRange;
  2076. aPixel.Range := fRange;
  2077. aPixel.Format := fFormat;
  2078. end;
  2079. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2080. constructor TFormatDescriptor.Create;
  2081. begin
  2082. inherited Create;
  2083. fFormat := tfEmpty;
  2084. fWithAlpha := tfEmpty;
  2085. fWithoutAlpha := tfEmpty;
  2086. fRGBInverted := tfEmpty;
  2087. fUncompressed := tfEmpty;
  2088. fPixelSize := 0.0;
  2089. fIsCompressed := false;
  2090. fglFormat := 0;
  2091. fglInternalFormat := 0;
  2092. fglDataFormat := 0;
  2093. FillChar(fRange, 0, SizeOf(fRange));
  2094. FillChar(fShift, 0, SizeOf(fShift));
  2095. end;
  2096. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2097. //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2098. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2099. procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2100. begin
  2101. aData^ := aPixel.Data.a;
  2102. inc(aData);
  2103. end;
  2104. procedure TfdAlpha_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2105. begin
  2106. aPixel.Data.r := 0;
  2107. aPixel.Data.g := 0;
  2108. aPixel.Data.b := 0;
  2109. aPixel.Data.a := aData^;
  2110. inc(aData^);
  2111. end;
  2112. constructor TfdAlpha_UB1.Create;
  2113. begin
  2114. inherited Create;
  2115. fPixelSize := 1.0;
  2116. fRange.a := $FF;
  2117. fglFormat := GL_ALPHA;
  2118. fglDataFormat := GL_UNSIGNED_BYTE;
  2119. end;
  2120. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2121. //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2122. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2123. procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2124. begin
  2125. aData^ := LuminanceWeight(aPixel);
  2126. inc(aData);
  2127. end;
  2128. procedure TfdLuminance_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2129. begin
  2130. aPixel.Data.r := aData^;
  2131. aPixel.Data.g := aData^;
  2132. aPixel.Data.b := aData^;
  2133. aPixel.Data.a := 0;
  2134. inc(aData);
  2135. end;
  2136. constructor TfdLuminance_UB1.Create;
  2137. begin
  2138. inherited Create;
  2139. fPixelSize := 1.0;
  2140. fRange.r := $FF;
  2141. fRange.g := $FF;
  2142. fRange.b := $FF;
  2143. fglFormat := GL_LUMINANCE;
  2144. fglDataFormat := GL_UNSIGNED_BYTE;
  2145. end;
  2146. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2147. //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2148. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2149. procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2150. var
  2151. i: Integer;
  2152. begin
  2153. aData^ := 0;
  2154. for i := 0 to 3 do
  2155. if (fRange.arr[i] > 0) then
  2156. aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2157. inc(aData);
  2158. end;
  2159. procedure TfdUniversal_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2160. var
  2161. i: Integer;
  2162. begin
  2163. for i := 0 to 3 do
  2164. aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
  2165. inc(aData);
  2166. end;
  2167. constructor TfdUniversal_UB1.Create;
  2168. begin
  2169. inherited Create;
  2170. fPixelSize := 1.0;
  2171. end;
  2172. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2173. //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2174. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2175. procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2176. begin
  2177. inherited Map(aPixel, aData, aMapData);
  2178. aData^ := aPixel.Data.a;
  2179. inc(aData);
  2180. end;
  2181. procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2182. begin
  2183. inherited Unmap(aData, aPixel, aMapData);
  2184. aPixel.Data.a := aData^;
  2185. inc(aData);
  2186. end;
  2187. constructor TfdLuminanceAlpha_UB2.Create;
  2188. begin
  2189. inherited Create;
  2190. fPixelSize := 2.0;
  2191. fRange.a := $FF;
  2192. fShift.a := 8;
  2193. fglFormat := GL_LUMINANCE_ALPHA;
  2194. fglDataFormat := GL_UNSIGNED_BYTE;
  2195. end;
  2196. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2197. //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2198. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2199. procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2200. begin
  2201. aData^ := aPixel.Data.r;
  2202. inc(aData);
  2203. aData^ := aPixel.Data.g;
  2204. inc(aData);
  2205. aData^ := aPixel.Data.b;
  2206. inc(aData);
  2207. end;
  2208. procedure TfdRGB_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2209. begin
  2210. aPixel.Data.r := aData^;
  2211. inc(aData);
  2212. aPixel.Data.g := aData^;
  2213. inc(aData);
  2214. aPixel.Data.b := aData^;
  2215. inc(aData);
  2216. aPixel.Data.a := 0;
  2217. end;
  2218. constructor TfdRGB_UB3.Create;
  2219. begin
  2220. inherited Create;
  2221. fPixelSize := 3.0;
  2222. fRange.r := $FF;
  2223. fRange.g := $FF;
  2224. fRange.b := $FF;
  2225. fShift.r := 0;
  2226. fShift.g := 8;
  2227. fShift.b := 16;
  2228. fglFormat := GL_RGB;
  2229. fglDataFormat := GL_UNSIGNED_BYTE;
  2230. end;
  2231. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2232. //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2233. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2234. procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2235. begin
  2236. aData^ := aPixel.Data.b;
  2237. inc(aData);
  2238. aData^ := aPixel.Data.g;
  2239. inc(aData);
  2240. aData^ := aPixel.Data.r;
  2241. inc(aData);
  2242. end;
  2243. procedure TfdBGR_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2244. begin
  2245. aPixel.Data.b := aData^;
  2246. inc(aData);
  2247. aPixel.Data.g := aData^;
  2248. inc(aData);
  2249. aPixel.Data.r := aData^;
  2250. inc(aData);
  2251. aPixel.Data.a := 0;
  2252. end;
  2253. constructor TfdBGR_UB3.Create;
  2254. begin
  2255. fPixelSize := 3.0;
  2256. fRange.r := $FF;
  2257. fRange.g := $FF;
  2258. fRange.b := $FF;
  2259. fShift.r := 16;
  2260. fShift.g := 8;
  2261. fShift.b := 0;
  2262. fglFormat := GL_BGR;
  2263. fglDataFormat := GL_UNSIGNED_BYTE;
  2264. end;
  2265. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2266. //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2267. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2268. procedure TfdRGBA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2269. begin
  2270. inherited Map(aPixel, aData, aMapData);
  2271. aData^ := aPixel.Data.a;
  2272. inc(aData);
  2273. end;
  2274. procedure TfdRGBA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2275. begin
  2276. inherited Unmap(aData, aPixel, aMapData);
  2277. aPixel.Data.a := aData^;
  2278. inc(aData);
  2279. end;
  2280. constructor TfdRGBA_UB4.Create;
  2281. begin
  2282. inherited Create;
  2283. fPixelSize := 4.0;
  2284. fRange.a := $FF;
  2285. fShift.a := 24;
  2286. fglFormat := GL_RGBA;
  2287. fglDataFormat := GL_UNSIGNED_BYTE;
  2288. end;
  2289. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2290. //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2291. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2292. procedure TfdBGRA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2293. begin
  2294. inherited Map(aPixel, aData, aMapData);
  2295. aData^ := aPixel.Data.a;
  2296. inc(aData);
  2297. end;
  2298. procedure TfdBGRA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2299. begin
  2300. inherited Unmap(aData, aPixel, aMapData);
  2301. aPixel.Data.a := aData^;
  2302. inc(aData);
  2303. end;
  2304. constructor TfdBGRA_UB4.Create;
  2305. begin
  2306. inherited Create;
  2307. fPixelSize := 4.0;
  2308. fRange.a := $FF;
  2309. fShift.a := 24;
  2310. fglFormat := GL_BGRA;
  2311. fglDataFormat := GL_UNSIGNED_BYTE;
  2312. end;
  2313. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2314. //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2315. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2316. procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2317. begin
  2318. PWord(aData)^ := aPixel.Data.a;
  2319. inc(aData, 2);
  2320. end;
  2321. procedure TfdAlpha_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2322. begin
  2323. aPixel.Data.r := 0;
  2324. aPixel.Data.g := 0;
  2325. aPixel.Data.b := 0;
  2326. aPixel.Data.a := PWord(aData)^;
  2327. inc(aData, 2);
  2328. end;
  2329. constructor TfdAlpha_US1.Create;
  2330. begin
  2331. inherited Create;
  2332. fPixelSize := 2.0;
  2333. fRange.a := $FFFF;
  2334. fglFormat := GL_ALPHA;
  2335. fglDataFormat := GL_UNSIGNED_SHORT;
  2336. end;
  2337. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2338. //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2339. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2340. procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2341. begin
  2342. PWord(aData)^ := LuminanceWeight(aPixel);
  2343. inc(aData, 2);
  2344. end;
  2345. procedure TfdLuminance_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2346. begin
  2347. aPixel.Data.r := PWord(aData)^;
  2348. aPixel.Data.g := PWord(aData)^;
  2349. aPixel.Data.b := PWord(aData)^;
  2350. aPixel.Data.a := 0;
  2351. inc(aData, 2);
  2352. end;
  2353. constructor TfdLuminance_US1.Create;
  2354. begin
  2355. inherited Create;
  2356. fPixelSize := 2.0;
  2357. fRange.r := $FFFF;
  2358. fRange.g := $FFFF;
  2359. fRange.b := $FFFF;
  2360. fglFormat := GL_LUMINANCE;
  2361. fglDataFormat := GL_UNSIGNED_SHORT;
  2362. end;
  2363. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2364. //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2365. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2366. procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2367. var
  2368. i: Integer;
  2369. begin
  2370. PWord(aData)^ := 0;
  2371. for i := 0 to 3 do
  2372. if (fRange.arr[i] > 0) then
  2373. PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2374. inc(aData, 2);
  2375. end;
  2376. procedure TfdUniversal_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2377. var
  2378. i: Integer;
  2379. begin
  2380. for i := 0 to 3 do
  2381. aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
  2382. inc(aData, 2);
  2383. end;
  2384. constructor TfdUniversal_US1.Create;
  2385. begin
  2386. inherited Create;
  2387. fPixelSize := 2.0;
  2388. end;
  2389. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2390. //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2391. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2392. procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2393. begin
  2394. PWord(aData)^ := DepthWeight(aPixel);
  2395. inc(aData, 2);
  2396. end;
  2397. procedure TfdDepth_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2398. begin
  2399. aPixel.Data.r := PWord(aData)^;
  2400. aPixel.Data.g := PWord(aData)^;
  2401. aPixel.Data.b := PWord(aData)^;
  2402. aPixel.Data.a := 0;
  2403. inc(aData, 2);
  2404. end;
  2405. constructor TfdDepth_US1.Create;
  2406. begin
  2407. inherited Create;
  2408. fPixelSize := 2.0;
  2409. fRange.r := $FFFF;
  2410. fRange.g := $FFFF;
  2411. fRange.b := $FFFF;
  2412. fglFormat := GL_DEPTH_COMPONENT;
  2413. fglDataFormat := GL_UNSIGNED_SHORT;
  2414. end;
  2415. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2416. //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2417. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2418. procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2419. begin
  2420. inherited Map(aPixel, aData, aMapData);
  2421. PWord(aData)^ := aPixel.Data.a;
  2422. inc(aData, 2);
  2423. end;
  2424. procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2425. begin
  2426. inherited Unmap(aData, aPixel, aMapData);
  2427. aPixel.Data.a := PWord(aData)^;
  2428. inc(aData, 2);
  2429. end;
  2430. constructor TfdLuminanceAlpha_US2.Create;
  2431. begin
  2432. inherited Create;
  2433. fPixelSize := 4.0;
  2434. fRange.a := $FFFF;
  2435. fShift.a := 16;
  2436. fglFormat := GL_LUMINANCE_ALPHA;
  2437. fglDataFormat := GL_UNSIGNED_SHORT;
  2438. end;
  2439. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2440. //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2441. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2442. procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2443. begin
  2444. PWord(aData)^ := aPixel.Data.r;
  2445. inc(aData, 2);
  2446. PWord(aData)^ := aPixel.Data.g;
  2447. inc(aData, 2);
  2448. PWord(aData)^ := aPixel.Data.b;
  2449. inc(aData, 2);
  2450. end;
  2451. procedure TfdRGB_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2452. begin
  2453. aPixel.Data.r := PWord(aData)^;
  2454. inc(aData, 2);
  2455. aPixel.Data.g := PWord(aData)^;
  2456. inc(aData, 2);
  2457. aPixel.Data.b := PWord(aData)^;
  2458. inc(aData, 2);
  2459. aPixel.Data.a := 0;
  2460. end;
  2461. constructor TfdRGB_US3.Create;
  2462. begin
  2463. inherited Create;
  2464. fPixelSize := 6.0;
  2465. fRange.r := $FFFF;
  2466. fRange.g := $FFFF;
  2467. fRange.b := $FFFF;
  2468. fShift.r := 0;
  2469. fShift.g := 16;
  2470. fShift.b := 32;
  2471. fglFormat := GL_RGB;
  2472. fglDataFormat := GL_UNSIGNED_SHORT;
  2473. end;
  2474. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2475. //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2476. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2477. procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2478. begin
  2479. PWord(aData)^ := aPixel.Data.b;
  2480. inc(aData, 2);
  2481. PWord(aData)^ := aPixel.Data.g;
  2482. inc(aData, 2);
  2483. PWord(aData)^ := aPixel.Data.r;
  2484. inc(aData, 2);
  2485. end;
  2486. procedure TfdBGR_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2487. begin
  2488. aPixel.Data.b := PWord(aData)^;
  2489. inc(aData, 2);
  2490. aPixel.Data.g := PWord(aData)^;
  2491. inc(aData, 2);
  2492. aPixel.Data.r := PWord(aData)^;
  2493. inc(aData, 2);
  2494. aPixel.Data.a := 0;
  2495. end;
  2496. constructor TfdBGR_US3.Create;
  2497. begin
  2498. inherited Create;
  2499. fPixelSize := 6.0;
  2500. fRange.r := $FFFF;
  2501. fRange.g := $FFFF;
  2502. fRange.b := $FFFF;
  2503. fShift.r := 32;
  2504. fShift.g := 16;
  2505. fShift.b := 0;
  2506. fglFormat := GL_BGR;
  2507. fglDataFormat := GL_UNSIGNED_SHORT;
  2508. end;
  2509. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2510. //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2511. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2512. procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2513. begin
  2514. inherited Map(aPixel, aData, aMapData);
  2515. PWord(aData)^ := aPixel.Data.a;
  2516. inc(aData, 2);
  2517. end;
  2518. procedure TfdRGBA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2519. begin
  2520. inherited Unmap(aData, aPixel, aMapData);
  2521. aPixel.Data.a := PWord(aData)^;
  2522. inc(aData, 2);
  2523. end;
  2524. constructor TfdRGBA_US4.Create;
  2525. begin
  2526. inherited Create;
  2527. fPixelSize := 8.0;
  2528. fRange.a := $FFFF;
  2529. fShift.a := 48;
  2530. fglFormat := GL_RGBA;
  2531. fglDataFormat := GL_UNSIGNED_SHORT;
  2532. end;
  2533. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2534. //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2535. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2536. procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2537. begin
  2538. inherited Map(aPixel, aData, aMapData);
  2539. PWord(aData)^ := aPixel.Data.a;
  2540. inc(aData, 2);
  2541. end;
  2542. procedure TfdBGRA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2543. begin
  2544. inherited Unmap(aData, aPixel, aMapData);
  2545. aPixel.Data.a := PWord(aData)^;
  2546. inc(aData, 2);
  2547. end;
  2548. constructor TfdBGRA_US4.Create;
  2549. begin
  2550. inherited Create;
  2551. fPixelSize := 8.0;
  2552. fRange.a := $FFFF;
  2553. fShift.a := 48;
  2554. fglFormat := GL_BGRA;
  2555. fglDataFormat := GL_UNSIGNED_SHORT;
  2556. end;
  2557. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2558. //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2559. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2560. procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2561. var
  2562. i: Integer;
  2563. begin
  2564. PCardinal(aData)^ := 0;
  2565. for i := 0 to 3 do
  2566. if (fRange.arr[i] > 0) then
  2567. PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2568. inc(aData, 4);
  2569. end;
  2570. procedure TfdUniversal_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2571. var
  2572. i: Integer;
  2573. begin
  2574. for i := 0 to 3 do
  2575. aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
  2576. inc(aData, 2);
  2577. end;
  2578. constructor TfdUniversal_UI1.Create;
  2579. begin
  2580. inherited Create;
  2581. fPixelSize := 4.0;
  2582. end;
  2583. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2584. //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2585. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2586. procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2587. begin
  2588. PCardinal(aData)^ := DepthWeight(aPixel);
  2589. inc(aData, 4);
  2590. end;
  2591. procedure TfdDepth_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2592. begin
  2593. aPixel.Data.r := PCardinal(aData)^;
  2594. aPixel.Data.g := PCardinal(aData)^;
  2595. aPixel.Data.b := PCardinal(aData)^;
  2596. aPixel.Data.a := 0;
  2597. inc(aData, 4);
  2598. end;
  2599. constructor TfdDepth_UI1.Create;
  2600. begin
  2601. inherited Create;
  2602. fPixelSize := 4.0;
  2603. fRange.r := $FFFFFFFF;
  2604. fRange.g := $FFFFFFFF;
  2605. fRange.b := $FFFFFFFF;
  2606. fglFormat := GL_DEPTH_COMPONENT;
  2607. fglDataFormat := GL_UNSIGNED_INT;
  2608. end;
  2609. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2610. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2611. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2612. constructor TfdAlpha4.Create;
  2613. begin
  2614. inherited Create;
  2615. fFormat := tfAlpha4;
  2616. fWithAlpha := tfAlpha4;
  2617. fglInternalFormat := GL_ALPHA4;
  2618. end;
  2619. constructor TfdAlpha8.Create;
  2620. begin
  2621. inherited Create;
  2622. fFormat := tfAlpha8;
  2623. fWithAlpha := tfAlpha8;
  2624. fglInternalFormat := GL_ALPHA8;
  2625. end;
  2626. constructor TfdAlpha12.Create;
  2627. begin
  2628. inherited Create;
  2629. fFormat := tfAlpha12;
  2630. fWithAlpha := tfAlpha12;
  2631. fglInternalFormat := GL_ALPHA12;
  2632. end;
  2633. constructor TfdAlpha16.Create;
  2634. begin
  2635. inherited Create;
  2636. fFormat := tfAlpha16;
  2637. fWithAlpha := tfAlpha16;
  2638. fglInternalFormat := GL_ALPHA16;
  2639. end;
  2640. constructor TfdLuminance4.Create;
  2641. begin
  2642. inherited Create;
  2643. fFormat := tfLuminance4;
  2644. fWithAlpha := tfLuminance4Alpha4;
  2645. fWithoutAlpha := tfLuminance4;
  2646. fglInternalFormat := GL_LUMINANCE4;
  2647. end;
  2648. constructor TfdLuminance8.Create;
  2649. begin
  2650. inherited Create;
  2651. fFormat := tfLuminance8;
  2652. fWithAlpha := tfLuminance8Alpha8;
  2653. fWithoutAlpha := tfLuminance8;
  2654. fglInternalFormat := GL_LUMINANCE8;
  2655. end;
  2656. constructor TfdLuminance12.Create;
  2657. begin
  2658. inherited Create;
  2659. fFormat := tfLuminance12;
  2660. fWithAlpha := tfLuminance12Alpha12;
  2661. fWithoutAlpha := tfLuminance12;
  2662. fglInternalFormat := GL_LUMINANCE12;
  2663. end;
  2664. constructor TfdLuminance16.Create;
  2665. begin
  2666. inherited Create;
  2667. fFormat := tfLuminance16;
  2668. fWithAlpha := tfLuminance16Alpha16;
  2669. fWithoutAlpha := tfLuminance16;
  2670. fglInternalFormat := GL_LUMINANCE16;
  2671. end;
  2672. constructor TfdLuminance4Alpha4.Create;
  2673. begin
  2674. inherited Create;
  2675. fFormat := tfLuminance4Alpha4;
  2676. fWithAlpha := tfLuminance4Alpha4;
  2677. fWithoutAlpha := tfLuminance4;
  2678. fglInternalFormat := GL_LUMINANCE4_ALPHA4;
  2679. end;
  2680. constructor TfdLuminance6Alpha2.Create;
  2681. begin
  2682. inherited Create;
  2683. fFormat := tfLuminance6Alpha2;
  2684. fWithAlpha := tfLuminance6Alpha2;
  2685. fWithoutAlpha := tfLuminance8;
  2686. fglInternalFormat := GL_LUMINANCE6_ALPHA2;
  2687. end;
  2688. constructor TfdLuminance8Alpha8.Create;
  2689. begin
  2690. inherited Create;
  2691. fFormat := tfLuminance8Alpha8;
  2692. fWithAlpha := tfLuminance8Alpha8;
  2693. fWithoutAlpha := tfLuminance8;
  2694. fglInternalFormat := GL_LUMINANCE8_ALPHA8;
  2695. end;
  2696. constructor TfdLuminance12Alpha4.Create;
  2697. begin
  2698. inherited Create;
  2699. fFormat := tfLuminance12Alpha4;
  2700. fWithAlpha := tfLuminance12Alpha4;
  2701. fWithoutAlpha := tfLuminance12;
  2702. fglInternalFormat := GL_LUMINANCE12_ALPHA4;
  2703. end;
  2704. constructor TfdLuminance12Alpha12.Create;
  2705. begin
  2706. inherited Create;
  2707. fFormat := tfLuminance12Alpha12;
  2708. fWithAlpha := tfLuminance12Alpha12;
  2709. fWithoutAlpha := tfLuminance12;
  2710. fglInternalFormat := GL_LUMINANCE12_ALPHA12;
  2711. end;
  2712. constructor TfdLuminance16Alpha16.Create;
  2713. begin
  2714. inherited Create;
  2715. fFormat := tfLuminance16Alpha16;
  2716. fWithAlpha := tfLuminance16Alpha16;
  2717. fWithoutAlpha := tfLuminance16;
  2718. fglInternalFormat := GL_LUMINANCE16_ALPHA16;
  2719. end;
  2720. constructor TfdR3G3B2.Create;
  2721. begin
  2722. inherited Create;
  2723. fFormat := tfR3G3B2;
  2724. fWithAlpha := tfRGBA2;
  2725. fWithoutAlpha := tfR3G3B2;
  2726. fRange.r := $7;
  2727. fRange.g := $7;
  2728. fRange.b := $3;
  2729. fShift.r := 0;
  2730. fShift.g := 3;
  2731. fShift.b := 6;
  2732. fglFormat := GL_RGB;
  2733. fglInternalFormat := GL_R3_G3_B2;
  2734. fglDataFormat := GL_UNSIGNED_BYTE_2_3_3_REV;
  2735. end;
  2736. constructor TfdRGB4.Create;
  2737. begin
  2738. inherited Create;
  2739. fFormat := tfRGB4;
  2740. fWithAlpha := tfRGBA4;
  2741. fWithoutAlpha := tfRGB4;
  2742. fRGBInverted := tfBGR4;
  2743. fRange.r := $F;
  2744. fRange.g := $F;
  2745. fRange.b := $F;
  2746. fShift.r := 0;
  2747. fShift.g := 4;
  2748. fShift.b := 8;
  2749. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2750. fglInternalFormat := GL_RGB4;
  2751. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2752. end;
  2753. constructor TfdR5G6B5.Create;
  2754. begin
  2755. inherited Create;
  2756. fFormat := tfR5G6B5;
  2757. fWithAlpha := tfRGBA4;
  2758. fWithoutAlpha := tfR5G6B5;
  2759. fRGBInverted := tfB5G6R5;
  2760. fRange.r := $1F;
  2761. fRange.g := $3F;
  2762. fRange.b := $1F;
  2763. fShift.r := 0;
  2764. fShift.g := 5;
  2765. fShift.b := 11;
  2766. fglFormat := GL_RGB;
  2767. fglInternalFormat := GL_RGB565;
  2768. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5_REV;
  2769. end;
  2770. constructor TfdRGB5.Create;
  2771. begin
  2772. inherited Create;
  2773. fFormat := tfRGB5;
  2774. fWithAlpha := tfRGB5A1;
  2775. fWithoutAlpha := tfRGB5;
  2776. fRGBInverted := tfBGR5;
  2777. fRange.r := $1F;
  2778. fRange.g := $1F;
  2779. fRange.b := $1F;
  2780. fShift.r := 0;
  2781. fShift.g := 5;
  2782. fShift.b := 10;
  2783. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2784. fglInternalFormat := GL_RGB5;
  2785. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2786. end;
  2787. constructor TfdRGB8.Create;
  2788. begin
  2789. inherited Create;
  2790. fFormat := tfRGB8;
  2791. fWithAlpha := tfRGBA8;
  2792. fWithoutAlpha := tfRGB8;
  2793. fRGBInverted := tfBGR8;
  2794. fglInternalFormat := GL_RGB8;
  2795. end;
  2796. constructor TfdRGB10.Create;
  2797. begin
  2798. inherited Create;
  2799. fFormat := tfRGB10;
  2800. fWithAlpha := tfRGB10A2;
  2801. fWithoutAlpha := tfRGB10;
  2802. fRGBInverted := tfBGR10;
  2803. fRange.r := $3FF;
  2804. fRange.g := $3FF;
  2805. fRange.b := $3FF;
  2806. fShift.r := 0;
  2807. fShift.g := 10;
  2808. fShift.b := 20;
  2809. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2810. fglInternalFormat := GL_RGB10;
  2811. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2812. end;
  2813. constructor TfdRGB12.Create;
  2814. begin
  2815. inherited Create;
  2816. fFormat := tfRGB12;
  2817. fWithAlpha := tfRGBA12;
  2818. fWithoutAlpha := tfRGB12;
  2819. fRGBInverted := tfBGR12;
  2820. fglInternalFormat := GL_RGB12;
  2821. end;
  2822. constructor TfdRGB16.Create;
  2823. begin
  2824. inherited Create;
  2825. fFormat := tfRGB16;
  2826. fWithAlpha := tfRGBA16;
  2827. fWithoutAlpha := tfRGB16;
  2828. fRGBInverted := tfBGR16;
  2829. fglInternalFormat := GL_RGB16;
  2830. end;
  2831. constructor TfdRGBA2.Create;
  2832. begin
  2833. inherited Create;
  2834. fFormat := tfRGBA2;
  2835. fWithAlpha := tfRGBA2;
  2836. fWithoutAlpha := tfR3G3B2;
  2837. fRGBInverted := tfBGRA2;
  2838. fglInternalFormat := GL_RGBA2;
  2839. end;
  2840. constructor TfdRGBA4.Create;
  2841. begin
  2842. inherited Create;
  2843. fFormat := tfRGBA4;
  2844. fWithAlpha := tfRGBA4;
  2845. fWithoutAlpha := tfRGB4;
  2846. fRGBInverted := tfBGRA4;
  2847. fRange.r := $F;
  2848. fRange.g := $F;
  2849. fRange.b := $F;
  2850. fRange.a := $F;
  2851. fShift.r := 0;
  2852. fShift.g := 4;
  2853. fShift.b := 8;
  2854. fShift.a := 12;
  2855. fglFormat := GL_RGBA;
  2856. fglInternalFormat := GL_RGBA4;
  2857. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2858. end;
  2859. constructor TfdRGB5A1.Create;
  2860. begin
  2861. inherited Create;
  2862. fFormat := tfRGB5A1;
  2863. fWithAlpha := tfRGB5A1;
  2864. fWithoutAlpha := tfRGB5;
  2865. fRGBInverted := tfBGR5A1;
  2866. fRange.r := $1F;
  2867. fRange.g := $1F;
  2868. fRange.b := $1F;
  2869. fRange.a := $01;
  2870. fShift.r := 0;
  2871. fShift.g := 5;
  2872. fShift.b := 10;
  2873. fShift.a := 15;
  2874. fglFormat := GL_RGBA;
  2875. fglInternalFormat := GL_RGB5_A1;
  2876. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2877. end;
  2878. constructor TfdRGBA8.Create;
  2879. begin
  2880. inherited Create;
  2881. fFormat := tfRGBA8;
  2882. fWithAlpha := tfRGBA8;
  2883. fWithoutAlpha := tfRGB8;
  2884. fRGBInverted := tfBGRA8;
  2885. fglInternalFormat := GL_RGBA8;
  2886. end;
  2887. constructor TfdRGB10A2.Create;
  2888. begin
  2889. inherited Create;
  2890. fFormat := tfRGB10A2;
  2891. fWithAlpha := tfRGB10A2;
  2892. fWithoutAlpha := tfRGB10;
  2893. fRGBInverted := tfBGR10A2;
  2894. fRange.r := $3FF;
  2895. fRange.g := $3FF;
  2896. fRange.b := $3FF;
  2897. fRange.a := $003;
  2898. fShift.r := 0;
  2899. fShift.g := 10;
  2900. fShift.b := 20;
  2901. fShift.a := 30;
  2902. fglFormat := GL_RGBA;
  2903. fglInternalFormat := GL_RGB10_A2;
  2904. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2905. end;
  2906. constructor TfdRGBA12.Create;
  2907. begin
  2908. inherited Create;
  2909. fFormat := tfRGBA12;
  2910. fWithAlpha := tfRGBA12;
  2911. fWithoutAlpha := tfRGB12;
  2912. fRGBInverted := tfBGRA12;
  2913. fglInternalFormat := GL_RGBA12;
  2914. end;
  2915. constructor TfdRGBA16.Create;
  2916. begin
  2917. inherited Create;
  2918. fFormat := tfRGBA16;
  2919. fWithAlpha := tfRGBA16;
  2920. fWithoutAlpha := tfRGB16;
  2921. fRGBInverted := tfBGRA16;
  2922. fglInternalFormat := GL_RGBA16;
  2923. end;
  2924. constructor TfdBGR4.Create;
  2925. begin
  2926. inherited Create;
  2927. fPixelSize := 2.0;
  2928. fFormat := tfBGR4;
  2929. fWithAlpha := tfBGRA4;
  2930. fWithoutAlpha := tfBGR4;
  2931. fRGBInverted := tfRGB4;
  2932. fRange.r := $F;
  2933. fRange.g := $F;
  2934. fRange.b := $F;
  2935. fRange.a := $0;
  2936. fShift.r := 8;
  2937. fShift.g := 4;
  2938. fShift.b := 0;
  2939. fShift.a := 0;
  2940. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2941. fglInternalFormat := GL_RGB4;
  2942. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2943. end;
  2944. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2945. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2946. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2947. constructor TfdB5G6R5.Create;
  2948. begin
  2949. inherited Create;
  2950. fFormat := tfB5G6R5;
  2951. fWithAlpha := tfBGRA4;
  2952. fWithoutAlpha := tfB5G6R5;
  2953. fRGBInverted := tfR5G6B5;
  2954. fRange.r := $1F;
  2955. fRange.g := $3F;
  2956. fRange.b := $1F;
  2957. fShift.r := 11;
  2958. fShift.g := 5;
  2959. fShift.b := 0;
  2960. fglFormat := GL_RGB; //B5G6R5 is only possible as R5G6B5 -> use reverted dataformat
  2961. fglInternalFormat := GL_RGB8;
  2962. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5;
  2963. end;
  2964. constructor TfdBGR5.Create;
  2965. begin
  2966. inherited Create;
  2967. fPixelSize := 2.0;
  2968. fFormat := tfBGR5;
  2969. fWithAlpha := tfBGR5A1;
  2970. fWithoutAlpha := tfBGR5;
  2971. fRGBInverted := tfRGB5;
  2972. fRange.r := $1F;
  2973. fRange.g := $1F;
  2974. fRange.b := $1F;
  2975. fRange.a := $00;
  2976. fShift.r := 10;
  2977. fShift.g := 5;
  2978. fShift.b := 0;
  2979. fShift.a := 0;
  2980. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2981. fglInternalFormat := GL_RGB5;
  2982. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2983. end;
  2984. constructor TfdBGR8.Create;
  2985. begin
  2986. inherited Create;
  2987. fFormat := tfBGR8;
  2988. fWithAlpha := tfBGRA8;
  2989. fWithoutAlpha := tfBGR8;
  2990. fRGBInverted := tfRGB8;
  2991. fglInternalFormat := GL_RGB8;
  2992. end;
  2993. constructor TfdBGR10.Create;
  2994. begin
  2995. inherited Create;
  2996. fFormat := tfBGR10;
  2997. fWithAlpha := tfBGR10A2;
  2998. fWithoutAlpha := tfBGR10;
  2999. fRGBInverted := tfRGB10;
  3000. fRange.r := $3FF;
  3001. fRange.g := $3FF;
  3002. fRange.b := $3FF;
  3003. fRange.a := $000;
  3004. fShift.r := 20;
  3005. fShift.g := 10;
  3006. fShift.b := 0;
  3007. fShift.a := 0;
  3008. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3009. fglInternalFormat := GL_RGB10;
  3010. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3011. end;
  3012. constructor TfdBGR12.Create;
  3013. begin
  3014. inherited Create;
  3015. fFormat := tfBGR12;
  3016. fWithAlpha := tfBGRA12;
  3017. fWithoutAlpha := tfBGR12;
  3018. fRGBInverted := tfRGB12;
  3019. fglInternalFormat := GL_RGB12;
  3020. end;
  3021. constructor TfdBGR16.Create;
  3022. begin
  3023. inherited Create;
  3024. fFormat := tfBGR16;
  3025. fWithAlpha := tfBGRA16;
  3026. fWithoutAlpha := tfBGR16;
  3027. fRGBInverted := tfRGB16;
  3028. fglInternalFormat := GL_RGB16;
  3029. end;
  3030. constructor TfdBGRA2.Create;
  3031. begin
  3032. inherited Create;
  3033. fFormat := tfBGRA2;
  3034. fWithAlpha := tfBGRA4;
  3035. fWithoutAlpha := tfBGR4;
  3036. fRGBInverted := tfRGBA2;
  3037. fglInternalFormat := GL_RGBA2;
  3038. end;
  3039. constructor TfdBGRA4.Create;
  3040. begin
  3041. inherited Create;
  3042. fFormat := tfBGRA4;
  3043. fWithAlpha := tfBGRA4;
  3044. fWithoutAlpha := tfBGR4;
  3045. fRGBInverted := tfRGBA4;
  3046. fRange.r := $F;
  3047. fRange.g := $F;
  3048. fRange.b := $F;
  3049. fRange.a := $F;
  3050. fShift.r := 8;
  3051. fShift.g := 4;
  3052. fShift.b := 0;
  3053. fShift.a := 12;
  3054. fglFormat := GL_BGRA;
  3055. fglInternalFormat := GL_RGBA4;
  3056. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  3057. end;
  3058. constructor TfdBGR5A1.Create;
  3059. begin
  3060. inherited Create;
  3061. fFormat := tfBGR5A1;
  3062. fWithAlpha := tfBGR5A1;
  3063. fWithoutAlpha := tfBGR5;
  3064. fRGBInverted := tfRGB5A1;
  3065. fRange.r := $1F;
  3066. fRange.g := $1F;
  3067. fRange.b := $1F;
  3068. fRange.a := $01;
  3069. fShift.r := 10;
  3070. fShift.g := 5;
  3071. fShift.b := 0;
  3072. fShift.a := 15;
  3073. fglFormat := GL_BGRA;
  3074. fglInternalFormat := GL_RGB5_A1;
  3075. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  3076. end;
  3077. constructor TfdBGRA8.Create;
  3078. begin
  3079. inherited Create;
  3080. fFormat := tfBGRA8;
  3081. fWithAlpha := tfBGRA8;
  3082. fWithoutAlpha := tfBGR8;
  3083. fRGBInverted := tfRGBA8;
  3084. fglInternalFormat := GL_RGBA8;
  3085. end;
  3086. constructor TfdBGR10A2.Create;
  3087. begin
  3088. inherited Create;
  3089. fFormat := tfBGR10A2;
  3090. fWithAlpha := tfBGR10A2;
  3091. fWithoutAlpha := tfBGR10;
  3092. fRGBInverted := tfRGB10A2;
  3093. fRange.r := $3FF;
  3094. fRange.g := $3FF;
  3095. fRange.b := $3FF;
  3096. fRange.a := $003;
  3097. fShift.r := 20;
  3098. fShift.g := 10;
  3099. fShift.b := 0;
  3100. fShift.a := 30;
  3101. fglFormat := GL_BGRA;
  3102. fglInternalFormat := GL_RGB10_A2;
  3103. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3104. end;
  3105. constructor TfdBGRA12.Create;
  3106. begin
  3107. inherited Create;
  3108. fFormat := tfBGRA12;
  3109. fWithAlpha := tfBGRA12;
  3110. fWithoutAlpha := tfBGR12;
  3111. fRGBInverted := tfRGBA12;
  3112. fglInternalFormat := GL_RGBA12;
  3113. end;
  3114. constructor TfdBGRA16.Create;
  3115. begin
  3116. inherited Create;
  3117. fFormat := tfBGRA16;
  3118. fWithAlpha := tfBGRA16;
  3119. fWithoutAlpha := tfBGR16;
  3120. fRGBInverted := tfRGBA16;
  3121. fglInternalFormat := GL_RGBA16;
  3122. end;
  3123. constructor TfdDepth16.Create;
  3124. begin
  3125. inherited Create;
  3126. fFormat := tfDepth16;
  3127. fWithAlpha := tfEmpty;
  3128. fWithoutAlpha := tfDepth16;
  3129. fglInternalFormat := GL_DEPTH_COMPONENT16;
  3130. end;
  3131. constructor TfdDepth24.Create;
  3132. begin
  3133. inherited Create;
  3134. fFormat := tfDepth24;
  3135. fWithAlpha := tfEmpty;
  3136. fWithoutAlpha := tfDepth24;
  3137. fglInternalFormat := GL_DEPTH_COMPONENT24;
  3138. end;
  3139. constructor TfdDepth32.Create;
  3140. begin
  3141. inherited Create;
  3142. fFormat := tfDepth32;
  3143. fWithAlpha := tfEmpty;
  3144. fWithoutAlpha := tfDepth32;
  3145. fglInternalFormat := GL_DEPTH_COMPONENT32;
  3146. end;
  3147. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3148. //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3149. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3150. procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3151. begin
  3152. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  3153. end;
  3154. procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3155. begin
  3156. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  3157. end;
  3158. constructor TfdS3tcDtx1RGBA.Create;
  3159. begin
  3160. inherited Create;
  3161. fFormat := tfS3tcDtx1RGBA;
  3162. fWithAlpha := tfS3tcDtx1RGBA;
  3163. fUncompressed := tfRGB5A1;
  3164. fPixelSize := 0.5;
  3165. fIsCompressed := true;
  3166. fglFormat := GL_COMPRESSED_RGBA;
  3167. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
  3168. fglDataFormat := GL_UNSIGNED_BYTE;
  3169. end;
  3170. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3171. //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3172. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3173. procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3174. begin
  3175. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  3176. end;
  3177. procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3178. begin
  3179. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  3180. end;
  3181. constructor TfdS3tcDtx3RGBA.Create;
  3182. begin
  3183. inherited Create;
  3184. fFormat := tfS3tcDtx3RGBA;
  3185. fWithAlpha := tfS3tcDtx3RGBA;
  3186. fUncompressed := tfRGBA8;
  3187. fPixelSize := 1.0;
  3188. fIsCompressed := true;
  3189. fglFormat := GL_COMPRESSED_RGBA;
  3190. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
  3191. fglDataFormat := GL_UNSIGNED_BYTE;
  3192. end;
  3193. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3194. //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3195. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3196. procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3197. begin
  3198. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  3199. end;
  3200. procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3201. begin
  3202. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  3203. end;
  3204. constructor TfdS3tcDtx5RGBA.Create;
  3205. begin
  3206. inherited Create;
  3207. fFormat := tfS3tcDtx3RGBA;
  3208. fWithAlpha := tfS3tcDtx3RGBA;
  3209. fUncompressed := tfRGBA8;
  3210. fPixelSize := 1.0;
  3211. fIsCompressed := true;
  3212. fglFormat := GL_COMPRESSED_RGBA;
  3213. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
  3214. fglDataFormat := GL_UNSIGNED_BYTE;
  3215. end;
  3216. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3217. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3218. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3219. class procedure TFormatDescriptor.Init;
  3220. begin
  3221. if not Assigned(FormatDescriptorCS) then
  3222. FormatDescriptorCS := TCriticalSection.Create;
  3223. end;
  3224. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3225. class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3226. begin
  3227. FormatDescriptorCS.Enter;
  3228. try
  3229. result := FormatDescriptors[aFormat];
  3230. if not Assigned(result) then begin
  3231. result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
  3232. FormatDescriptors[aFormat] := result;
  3233. end;
  3234. finally
  3235. FormatDescriptorCS.Leave;
  3236. end;
  3237. end;
  3238. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3239. class function TFormatDescriptor.GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3240. begin
  3241. result := Get(Get(aFormat).WithAlpha);
  3242. end;
  3243. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3244. class procedure TFormatDescriptor.Clear;
  3245. var
  3246. f: TglBitmapFormat;
  3247. begin
  3248. FormatDescriptorCS.Enter;
  3249. try
  3250. for f := low(FormatDescriptors) to high(FormatDescriptors) do
  3251. FreeAndNil(FormatDescriptors[f]);
  3252. finally
  3253. FormatDescriptorCS.Leave;
  3254. end;
  3255. end;
  3256. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3257. class procedure TFormatDescriptor.Finalize;
  3258. begin
  3259. Clear;
  3260. FreeAndNil(FormatDescriptorCS);
  3261. end;
  3262. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3263. //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3264. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3265. procedure TbmpBitfieldFormat.SetRedMask(const aValue: UInt64);
  3266. begin
  3267. Update(aValue, fRange.r, fShift.r);
  3268. end;
  3269. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3270. procedure TbmpBitfieldFormat.SetGreenMask(const aValue: UInt64);
  3271. begin
  3272. Update(aValue, fRange.g, fShift.g);
  3273. end;
  3274. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3275. procedure TbmpBitfieldFormat.SetBlueMask(const aValue: UInt64);
  3276. begin
  3277. Update(aValue, fRange.b, fShift.b);
  3278. end;
  3279. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3280. procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: UInt64);
  3281. begin
  3282. Update(aValue, fRange.a, fShift.a);
  3283. end;
  3284. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3285. procedure TbmpBitfieldFormat.Update(aMask: UInt64; out aRange: Cardinal; out
  3286. aShift: Byte);
  3287. begin
  3288. aShift := 0;
  3289. aRange := 0;
  3290. if (aMask = 0) then
  3291. exit;
  3292. while (aMask > 0) and ((aMask and 1) = 0) do begin
  3293. inc(aShift);
  3294. aMask := aMask shr 1;
  3295. end;
  3296. aRange := 1;
  3297. while (aMask > 0) do begin
  3298. aRange := aRange shl 1;
  3299. aMask := aMask shr 1;
  3300. end;
  3301. dec(aRange);
  3302. fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
  3303. end;
  3304. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3305. procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3306. var
  3307. data: UInt64;
  3308. s: Integer;
  3309. type
  3310. PUInt64 = ^UInt64;
  3311. begin
  3312. data :=
  3313. ((aPixel.Data.r and fRange.r) shl fShift.r) or
  3314. ((aPixel.Data.g and fRange.g) shl fShift.g) or
  3315. ((aPixel.Data.b and fRange.b) shl fShift.b) or
  3316. ((aPixel.Data.a and fRange.a) shl fShift.a);
  3317. s := Round(fPixelSize);
  3318. case s of
  3319. 1: aData^ := data;
  3320. 2: PWord(aData)^ := data;
  3321. 4: PCardinal(aData)^ := data;
  3322. 8: PUInt64(aData)^ := data;
  3323. else
  3324. raise EglBitmapException.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
  3325. end;
  3326. inc(aData, s);
  3327. end;
  3328. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3329. procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3330. var
  3331. data: UInt64;
  3332. s, i: Integer;
  3333. type
  3334. PUInt64 = ^UInt64;
  3335. begin
  3336. s := Round(fPixelSize);
  3337. case s of
  3338. 1: data := aData^;
  3339. 2: data := PWord(aData)^;
  3340. 4: data := PCardinal(aData)^;
  3341. 8: data := PUInt64(aData)^;
  3342. else
  3343. raise EglBitmapException.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
  3344. end;
  3345. for i := 0 to 3 do
  3346. aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
  3347. inc(aData, s);
  3348. end;
  3349. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3350. //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3351. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3352. procedure TbmpColorTableFormat.CreateColorTable;
  3353. var
  3354. i: Integer;
  3355. begin
  3356. if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
  3357. raise EglBitmapException.Create(UNSUPPORTED_FORMAT);
  3358. if (Format = tfLuminance4) then
  3359. SetLength(fColorTable, 16)
  3360. else
  3361. SetLength(fColorTable, 256);
  3362. case Format of
  3363. tfLuminance4: begin
  3364. for i := 0 to High(fColorTable) do begin
  3365. fColorTable[i].r := 16 * i;
  3366. fColorTable[i].g := 16 * i;
  3367. fColorTable[i].b := 16 * i;
  3368. fColorTable[i].a := 0;
  3369. end;
  3370. end;
  3371. tfLuminance8: begin
  3372. for i := 0 to High(fColorTable) do begin
  3373. fColorTable[i].r := i;
  3374. fColorTable[i].g := i;
  3375. fColorTable[i].b := i;
  3376. fColorTable[i].a := 0;
  3377. end;
  3378. end;
  3379. tfR3G3B2: begin
  3380. for i := 0 to High(fColorTable) do begin
  3381. fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
  3382. fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
  3383. fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
  3384. fColorTable[i].a := 0;
  3385. end;
  3386. end;
  3387. end;
  3388. end;
  3389. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3390. procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3391. var
  3392. d: Byte;
  3393. begin
  3394. if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
  3395. raise EglBitmapException.Create(UNSUPPORTED_FORMAT);
  3396. case Format of
  3397. tfLuminance4: begin
  3398. if (aMapData = nil) then
  3399. aData^ := 0;
  3400. d := LuminanceWeight(aPixel) and Range.r;
  3401. aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData)));
  3402. inc(aMapData, 4);
  3403. if ({%H-}PtrUInt(aMapData) >= 8) then begin
  3404. inc(aData);
  3405. aMapData := nil;
  3406. end;
  3407. end;
  3408. tfLuminance8: begin
  3409. aData^ := LuminanceWeight(aPixel) and Range.r;
  3410. inc(aData);
  3411. end;
  3412. tfR3G3B2: begin
  3413. aData^ := Round(
  3414. ((aPixel.Data.r and Range.r) shl Shift.r) or
  3415. ((aPixel.Data.g and Range.g) shl Shift.g) or
  3416. ((aPixel.Data.b and Range.b) shl Shift.b));
  3417. inc(aData);
  3418. end;
  3419. end;
  3420. end;
  3421. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3422. procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3423. type
  3424. PUInt64 = ^UInt64;
  3425. var
  3426. idx: UInt64;
  3427. s: Integer;
  3428. bits: Byte;
  3429. f: Single;
  3430. begin
  3431. s := Trunc(fPixelSize);
  3432. f := fPixelSize - s;
  3433. bits := Round(8 * f);
  3434. case s of
  3435. 0: idx := (aData^ shr (8 - bits - {%H-}PtrUInt(aMapData))) and ((1 shl bits) - 1);
  3436. 1: idx := aData^;
  3437. 2: idx := PWord(aData)^;
  3438. 4: idx := PCardinal(aData)^;
  3439. 8: idx := PUInt64(aData)^;
  3440. else
  3441. raise EglBitmapException.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
  3442. end;
  3443. if (idx >= Length(fColorTable)) then
  3444. raise EglBitmapException.CreateFmt('invalid color index: %d', [idx]);
  3445. with fColorTable[idx] do begin
  3446. aPixel.Data.r := r;
  3447. aPixel.Data.g := g;
  3448. aPixel.Data.b := b;
  3449. aPixel.Data.a := a;
  3450. end;
  3451. inc(aMapData, bits);
  3452. if ({%H-}PtrUInt(aMapData) >= 8) then begin
  3453. inc(aData, 1);
  3454. dec(aMapData, 8);
  3455. end;
  3456. inc(aData, s);
  3457. end;
  3458. destructor TbmpColorTableFormat.Destroy;
  3459. begin
  3460. SetLength(fColorTable, 0);
  3461. inherited Destroy;
  3462. end;
  3463. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3464. //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3465. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3466. procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
  3467. var
  3468. i: Integer;
  3469. begin
  3470. for i := 0 to 3 do begin
  3471. if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
  3472. if (aSourceFD.Range.arr[i] > 0) then
  3473. aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
  3474. else
  3475. aPixel.Data.arr[i] := aDestFD.Range.arr[i];
  3476. end;
  3477. end;
  3478. end;
  3479. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3480. procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
  3481. begin
  3482. with aFuncRec do begin
  3483. if (Source.Range.r > 0) then
  3484. Dest.Data.r := Source.Data.r;
  3485. if (Source.Range.g > 0) then
  3486. Dest.Data.g := Source.Data.g;
  3487. if (Source.Range.b > 0) then
  3488. Dest.Data.b := Source.Data.b;
  3489. if (Source.Range.a > 0) then
  3490. Dest.Data.a := Source.Data.a;
  3491. end;
  3492. end;
  3493. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3494. procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3495. var
  3496. i: Integer;
  3497. begin
  3498. with aFuncRec do begin
  3499. for i := 0 to 3 do
  3500. if (Source.Range.arr[i] > 0) then
  3501. Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
  3502. end;
  3503. end;
  3504. type
  3505. TShiftData = packed record
  3506. case Integer of
  3507. 0: (r, g, b, a: SmallInt);
  3508. 1: (arr: array[0..3] of SmallInt);
  3509. end;
  3510. PShiftData = ^TShiftData;
  3511. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3512. procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3513. var
  3514. i: Integer;
  3515. begin
  3516. with aFuncRec do
  3517. for i := 0 to 3 do
  3518. if (Source.Range.arr[i] > 0) then
  3519. Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
  3520. end;
  3521. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3522. procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
  3523. begin
  3524. with aFuncRec do begin
  3525. Dest.Data := Source.Data;
  3526. if ({%H-}PtrUInt(Args) and $1 > 0) then begin
  3527. Dest.Data.r := Dest.Data.r xor Dest.Range.r;
  3528. Dest.Data.g := Dest.Data.g xor Dest.Range.g;
  3529. Dest.Data.b := Dest.Data.b xor Dest.Range.b;
  3530. end;
  3531. if ({%H-}PtrUInt(Args) and $2 > 0) then begin
  3532. Dest.Data.a := Dest.Data.a xor Dest.Range.a;
  3533. end;
  3534. end;
  3535. end;
  3536. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3537. procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
  3538. var
  3539. i: Integer;
  3540. begin
  3541. with aFuncRec do begin
  3542. for i := 0 to 3 do
  3543. Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
  3544. end;
  3545. end;
  3546. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3547. procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3548. var
  3549. Temp: Single;
  3550. begin
  3551. with FuncRec do begin
  3552. if (FuncRec.Args = nil) then begin //source has no alpha
  3553. Temp :=
  3554. Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
  3555. Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
  3556. Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
  3557. Dest.Data.a := Round(Dest.Range.a * Temp);
  3558. end else
  3559. Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
  3560. end;
  3561. end;
  3562. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3563. procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3564. type
  3565. PglBitmapPixelData = ^TglBitmapPixelData;
  3566. begin
  3567. with FuncRec do begin
  3568. Dest.Data.r := Source.Data.r;
  3569. Dest.Data.g := Source.Data.g;
  3570. Dest.Data.b := Source.Data.b;
  3571. with PglBitmapPixelData(Args)^ do
  3572. if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
  3573. (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
  3574. (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
  3575. Dest.Data.a := 0
  3576. else
  3577. Dest.Data.a := Dest.Range.a;
  3578. end;
  3579. end;
  3580. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3581. procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3582. begin
  3583. with FuncRec do begin
  3584. Dest.Data.r := Source.Data.r;
  3585. Dest.Data.g := Source.Data.g;
  3586. Dest.Data.b := Source.Data.b;
  3587. Dest.Data.a := PCardinal(Args)^;
  3588. end;
  3589. end;
  3590. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3591. procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
  3592. type
  3593. PRGBPix = ^TRGBPix;
  3594. TRGBPix = array [0..2] of byte;
  3595. var
  3596. Temp: Byte;
  3597. begin
  3598. while aWidth > 0 do begin
  3599. Temp := PRGBPix(aData)^[0];
  3600. PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
  3601. PRGBPix(aData)^[2] := Temp;
  3602. if aHasAlpha then
  3603. Inc(aData, 4)
  3604. else
  3605. Inc(aData, 3);
  3606. dec(aWidth);
  3607. end;
  3608. end;
  3609. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3610. //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3611. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3612. function TglBitmap.GetWidth: Integer;
  3613. begin
  3614. if (ffX in fDimension.Fields) then
  3615. result := fDimension.X
  3616. else
  3617. result := -1;
  3618. end;
  3619. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3620. function TglBitmap.GetHeight: Integer;
  3621. begin
  3622. if (ffY in fDimension.Fields) then
  3623. result := fDimension.Y
  3624. else
  3625. result := -1;
  3626. end;
  3627. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3628. function TglBitmap.GetFileWidth: Integer;
  3629. begin
  3630. result := Max(1, Width);
  3631. end;
  3632. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3633. function TglBitmap.GetFileHeight: Integer;
  3634. begin
  3635. result := Max(1, Height);
  3636. end;
  3637. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3638. procedure TglBitmap.SetCustomData(const aValue: Pointer);
  3639. begin
  3640. if fCustomData = aValue then
  3641. exit;
  3642. fCustomData := aValue;
  3643. end;
  3644. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3645. procedure TglBitmap.SetCustomName(const aValue: String);
  3646. begin
  3647. if fCustomName = aValue then
  3648. exit;
  3649. fCustomName := aValue;
  3650. end;
  3651. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3652. procedure TglBitmap.SetCustomNameW(const aValue: WideString);
  3653. begin
  3654. if fCustomNameW = aValue then
  3655. exit;
  3656. fCustomNameW := aValue;
  3657. end;
  3658. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3659. procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
  3660. begin
  3661. if fDeleteTextureOnFree = aValue then
  3662. exit;
  3663. fDeleteTextureOnFree := aValue;
  3664. end;
  3665. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3666. procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
  3667. begin
  3668. if fFormat = aValue then
  3669. exit;
  3670. if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
  3671. raise EglBitmapUnsupportedFormatFormat.Create('SetInternalFormat - ' + UNSUPPORTED_FORMAT);
  3672. SetDataPointer(Data, aValue, Width, Height);
  3673. end;
  3674. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3675. procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
  3676. begin
  3677. if fFreeDataAfterGenTexture = aValue then
  3678. exit;
  3679. fFreeDataAfterGenTexture := aValue;
  3680. end;
  3681. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3682. procedure TglBitmap.SetID(const aValue: Cardinal);
  3683. begin
  3684. if fID = aValue then
  3685. exit;
  3686. fID := aValue;
  3687. end;
  3688. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3689. procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
  3690. begin
  3691. if fMipMap = aValue then
  3692. exit;
  3693. fMipMap := aValue;
  3694. end;
  3695. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3696. procedure TglBitmap.SetTarget(const aValue: Cardinal);
  3697. begin
  3698. if fTarget = aValue then
  3699. exit;
  3700. fTarget := aValue;
  3701. end;
  3702. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3703. procedure TglBitmap.SetAnisotropic(const aValue: Integer);
  3704. var
  3705. MaxAnisotropic: Integer;
  3706. begin
  3707. fAnisotropic := aValue;
  3708. if (ID > 0) then begin
  3709. if GL_EXT_texture_filter_anisotropic then begin
  3710. if fAnisotropic > 0 then begin
  3711. Bind(false);
  3712. glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
  3713. if aValue > MaxAnisotropic then
  3714. fAnisotropic := MaxAnisotropic;
  3715. glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
  3716. end;
  3717. end else begin
  3718. fAnisotropic := 0;
  3719. end;
  3720. end;
  3721. end;
  3722. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3723. procedure TglBitmap.CreateID;
  3724. begin
  3725. if (ID <> 0) then
  3726. glDeleteTextures(1, @fID);
  3727. glGenTextures(1, @fID);
  3728. Bind(false);
  3729. end;
  3730. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3731. procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
  3732. begin
  3733. // Set Up Parameters
  3734. SetWrap(fWrapS, fWrapT, fWrapR);
  3735. SetFilter(fFilterMin, fFilterMag);
  3736. SetAnisotropic(fAnisotropic);
  3737. SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
  3738. // Mip Maps Generation Mode
  3739. aBuildWithGlu := false;
  3740. if (MipMap = mmMipmap) then begin
  3741. if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
  3742. glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
  3743. else
  3744. aBuildWithGlu := true;
  3745. end else if (MipMap = mmMipmapGlu) then
  3746. aBuildWithGlu := true;
  3747. end;
  3748. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3749. procedure TglBitmap.SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
  3750. const aWidth: Integer; const aHeight: Integer);
  3751. var
  3752. s: Single;
  3753. begin
  3754. if (Data <> aData) then begin
  3755. if (Assigned(Data)) then
  3756. FreeMem(Data);
  3757. fData := aData;
  3758. end;
  3759. FillChar(fDimension, SizeOf(fDimension), 0);
  3760. if not Assigned(fData) then begin
  3761. fFormat := tfEmpty;
  3762. fPixelSize := 0;
  3763. fRowSize := 0;
  3764. end else begin
  3765. if aWidth <> -1 then begin
  3766. fDimension.Fields := fDimension.Fields + [ffX];
  3767. fDimension.X := aWidth;
  3768. end;
  3769. if aHeight <> -1 then begin
  3770. fDimension.Fields := fDimension.Fields + [ffY];
  3771. fDimension.Y := aHeight;
  3772. end;
  3773. s := TFormatDescriptor.Get(aFormat).PixelSize;
  3774. fFormat := aFormat;
  3775. fPixelSize := Ceil(s);
  3776. fRowSize := Ceil(s * aWidth);
  3777. end;
  3778. end;
  3779. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3780. function TglBitmap.FlipHorz: Boolean;
  3781. begin
  3782. result := false;
  3783. end;
  3784. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3785. function TglBitmap.FlipVert: Boolean;
  3786. begin
  3787. result := false;
  3788. end;
  3789. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3790. //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3791. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3792. procedure TglBitmap.AfterConstruction;
  3793. begin
  3794. inherited AfterConstruction;
  3795. fID := 0;
  3796. fTarget := 0;
  3797. fIsResident := false;
  3798. fFormat := glBitmapGetDefaultFormat;
  3799. fMipMap := glBitmapDefaultMipmap;
  3800. fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
  3801. fDeleteTextureOnFree := glBitmapGetDefaultDeleteTextureOnFree;
  3802. glBitmapGetDefaultFilter (fFilterMin, fFilterMag);
  3803. glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
  3804. end;
  3805. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3806. procedure TglBitmap.BeforeDestruction;
  3807. begin
  3808. SetDataPointer(nil, tfEmpty);
  3809. if (fID > 0) and fDeleteTextureOnFree then
  3810. glDeleteTextures(1, @fID);
  3811. inherited BeforeDestruction;
  3812. end;
  3813. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3814. procedure TglBitmap.LoadFromFile(const aFilename: String);
  3815. var
  3816. fs: TFileStream;
  3817. begin
  3818. if not FileExists(aFilename) then
  3819. raise EglBitmapException.Create('file does not exist: ' + aFilename);
  3820. fFilename := aFilename;
  3821. fs := TFileStream.Create(fFilename, fmOpenRead);
  3822. try
  3823. fs.Position := 0;
  3824. LoadFromStream(fs);
  3825. finally
  3826. fs.Free;
  3827. end;
  3828. end;
  3829. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3830. procedure TglBitmap.LoadFromStream(const aStream: TStream);
  3831. begin
  3832. {$IFDEF GLB_SUPPORT_PNG_READ}
  3833. if not LoadPNG(aStream) then
  3834. {$ENDIF}
  3835. {$IFDEF GLB_SUPPORT_JPEG_READ}
  3836. if not LoadJPEG(aStream) then
  3837. {$ENDIF}
  3838. if not LoadDDS(aStream) then
  3839. if not LoadTGA(aStream) then
  3840. if not LoadBMP(aStream) then
  3841. raise EglBitmapException.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
  3842. end;
  3843. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3844. procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  3845. const aFormat: TglBitmapFormat; const aArgs: Pointer);
  3846. var
  3847. tmpData: PByte;
  3848. size: Integer;
  3849. begin
  3850. size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  3851. GetMem(tmpData, size);
  3852. try
  3853. FillChar(tmpData^, size, #$FF);
  3854. SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y);
  3855. except
  3856. FreeMem(tmpData);
  3857. raise;
  3858. end;
  3859. AddFunc(Self, aFunc, false, Format, aArgs);
  3860. end;
  3861. {$IFDEF GLB_DELPHI}
  3862. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3863. procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil);
  3864. var
  3865. rs: TResourceStream;
  3866. TempPos: Integer;
  3867. ResTypeStr: String;
  3868. TempResType: PChar;
  3869. begin
  3870. if not Assigned(ResType) then begin
  3871. TempPos := Pos('.', Resource);
  3872. ResTypeStr := UpperCase(Copy(Resource, TempPos + 1, Length(Resource) - TempPos));
  3873. Resource := UpperCase(Copy(Resource, 0, TempPos -1));
  3874. TempResType := PChar(ResTypeStr);
  3875. end else
  3876. TempResType := ResType
  3877. rs := TResourceStream.Create(Instance, Resource, TempResType);
  3878. try
  3879. LoadFromStream(rs);
  3880. finally
  3881. rs.Free;
  3882. end;
  3883. end;
  3884. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3885. procedure TglBitmap.LoadFromResourceID(const sInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  3886. var
  3887. rs: TResourceStream;
  3888. begin
  3889. rs := TResourceStream.CreateFromID(Instance, ResourceID, ResType);
  3890. try
  3891. LoadFromStream(rs);
  3892. finally
  3893. rs.Free;
  3894. end;
  3895. end;
  3896. {$ENDIF}
  3897. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3898. procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  3899. var
  3900. fs: TFileStream;
  3901. begin
  3902. fs := TFileStream.Create(aFileName, fmCreate);
  3903. try
  3904. fs.Position := 0;
  3905. SaveToStream(fs, aFileType);
  3906. finally
  3907. fs.Free;
  3908. end;
  3909. end;
  3910. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3911. procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
  3912. begin
  3913. case aFileType of
  3914. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  3915. ftPNG: SavePng(aStream);
  3916. {$ENDIF}
  3917. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  3918. ftJPEG: SaveJPEG(aStream);
  3919. {$ENDIF}
  3920. ftDDS: SaveDDS(aStream);
  3921. ftTGA: SaveTGA(aStream);
  3922. ftBMP: SaveBMP(aStream);
  3923. end;
  3924. end;
  3925. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3926. function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
  3927. begin
  3928. result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
  3929. end;
  3930. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3931. function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  3932. const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
  3933. var
  3934. DestData, TmpData, SourceData: pByte;
  3935. TempHeight, TempWidth: Integer;
  3936. SourceFD, DestFD: TFormatDescriptor;
  3937. SourceMD, DestMD: Pointer;
  3938. FuncRec: TglBitmapFunctionRec;
  3939. begin
  3940. Assert(Assigned(Data));
  3941. Assert(Assigned(aSource));
  3942. Assert(Assigned(aSource.Data));
  3943. result := false;
  3944. if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
  3945. SourceFD := TFormatDescriptor.Get(aSource.Format);
  3946. DestFD := TFormatDescriptor.Get(aFormat);
  3947. // inkompatible Formats so CreateTemp
  3948. if (SourceFD.PixelSize <> DestFD.PixelSize) then
  3949. aCreateTemp := true;
  3950. // Values
  3951. TempHeight := Max(1, aSource.Height);
  3952. TempWidth := Max(1, aSource.Width);
  3953. FuncRec.Sender := Self;
  3954. FuncRec.Args := aArgs;
  3955. TmpData := nil;
  3956. if aCreateTemp then begin
  3957. GetMem(TmpData, TFormatDescriptor.Get(aFormat).GetSize(TempWidth, TempHeight));
  3958. DestData := TmpData;
  3959. end else
  3960. DestData := Data;
  3961. try
  3962. SourceFD.PreparePixel(FuncRec.Source);
  3963. DestFD.PreparePixel (FuncRec.Dest);
  3964. SourceMD := SourceFD.CreateMappingData;
  3965. DestMD := DestFD.CreateMappingData;
  3966. FuncRec.Size := aSource.Dimension;
  3967. FuncRec.Position.Fields := FuncRec.Size.Fields;
  3968. try
  3969. SourceData := aSource.Data;
  3970. FuncRec.Position.Y := 0;
  3971. while FuncRec.Position.Y < TempHeight do begin
  3972. FuncRec.Position.X := 0;
  3973. while FuncRec.Position.X < TempWidth do begin
  3974. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  3975. aFunc(FuncRec);
  3976. DestFD.Map(FuncRec.Dest, DestData, DestMD);
  3977. inc(FuncRec.Position.X);
  3978. end;
  3979. inc(FuncRec.Position.Y);
  3980. end;
  3981. // Updating Image or InternalFormat
  3982. if aCreateTemp then
  3983. SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height)
  3984. else if (aFormat <> fFormat) then
  3985. Format := aFormat;
  3986. result := true;
  3987. finally
  3988. SourceFD.FreeMappingData(SourceMD);
  3989. DestFD.FreeMappingData(DestMD);
  3990. end;
  3991. except
  3992. if aCreateTemp then
  3993. FreeMem(TmpData);
  3994. raise;
  3995. end;
  3996. end;
  3997. end;
  3998. {$IFDEF GLB_SDL}
  3999. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4000. function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  4001. var
  4002. Row, RowSize: Integer;
  4003. SourceData, TmpData: PByte;
  4004. TempDepth: Integer;
  4005. Pix: TglBitmapPixelData;
  4006. FormatDesc: TglBitmapFormatDescriptor;
  4007. function GetRowPointer(Row: Integer): pByte;
  4008. begin
  4009. result := Surface.pixels;
  4010. Inc(result, Row * RowSize);
  4011. end;
  4012. begin
  4013. result := false;
  4014. (* TODO
  4015. if not FormatIsUncompressed(InternalFormat) then
  4016. raise EglBitmapUnsupportedInternalFormat.Create('AssignToSurface - ' + UNSUPPORTED_INTERNAL_FORMAT);
  4017. *)
  4018. FormatDesc := FORMAT_DESCRIPTORS[Format];
  4019. if Assigned(Data) then begin
  4020. case Trunc(FormatDesc.GetSize) of
  4021. 1: TempDepth := 8;
  4022. 2: TempDepth := 16;
  4023. 3: TempDepth := 24;
  4024. 4: TempDepth := 32;
  4025. else
  4026. raise EglBitmapException.Create('AssignToSurface - ' + UNSUPPORTED_INTERNAL_FORMAT);
  4027. end;
  4028. FormatDesc.PreparePixel(Pix);
  4029. with Pix.PixelDesc do
  4030. Surface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
  4031. RedRange shl RedShift, GreenRange shl GreenShift, BlueRange shl BlueShift, AlphaRange shl AlphaShift);
  4032. SourceData := Data;
  4033. RowSize := Ceil(FileWidth * FormatDesc.GetSize);
  4034. for Row := 0 to FileHeight -1 do begin
  4035. TmpData := GetRowPointer(Row);
  4036. if Assigned(TmpData) then begin
  4037. Move(SourceData^, TmpData^, RowSize);
  4038. inc(SourceData, RowSize);
  4039. end;
  4040. end;
  4041. result := true;
  4042. end;
  4043. end;
  4044. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4045. function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  4046. var
  4047. pSource, pData, pTempData: PByte;
  4048. Row, RowSize, TempWidth, TempHeight: Integer;
  4049. IntFormat, f: TglBitmapInternalFormat;
  4050. FormatDesc: TglBitmapFormatDescriptor;
  4051. function GetRowPointer(Row: Integer): pByte;
  4052. begin
  4053. result := Surface^.pixels;
  4054. Inc(result, Row * RowSize);
  4055. end;
  4056. begin
  4057. result := false;
  4058. if (Assigned(Surface)) then begin
  4059. with Surface^.format^ do begin
  4060. IntFormat := tfEmpty;
  4061. for f := Low(f) to High(f) do begin
  4062. if FORMAT_DESCRIPTORS[f].MaskMatch(RMask, GMask, BMask, AMask) then begin
  4063. IntFormat := f;
  4064. break;
  4065. end;
  4066. end;
  4067. if (IntFormat = tfEmpty) then
  4068. raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
  4069. end;
  4070. FormatDesc := FORMAT_DESCRIPTORS[IntFormat];
  4071. TempWidth := Surface^.w;
  4072. TempHeight := Surface^.h;
  4073. RowSize := Trunc(TempWidth * FormatDesc.GetSize);
  4074. GetMem(pData, TempHeight * RowSize);
  4075. try
  4076. pTempData := pData;
  4077. for Row := 0 to TempHeight -1 do begin
  4078. pSource := GetRowPointer(Row);
  4079. if (Assigned(pSource)) then begin
  4080. Move(pSource^, pTempData^, RowSize);
  4081. Inc(pTempData, RowSize);
  4082. end;
  4083. end;
  4084. SetDataPointer(pData, IntFormat, TempWidth, TempHeight);
  4085. result := true;
  4086. except
  4087. FreeMem(pData);
  4088. raise;
  4089. end;
  4090. end;
  4091. end;
  4092. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4093. function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  4094. var
  4095. Row, Col, AlphaInterleave: Integer;
  4096. pSource, pDest: PByte;
  4097. function GetRowPointer(Row: Integer): pByte;
  4098. begin
  4099. result := aSurface.pixels;
  4100. Inc(result, Row * Width);
  4101. end;
  4102. begin
  4103. result := false;
  4104. if Assigned(Data) then begin
  4105. if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
  4106. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
  4107. AlphaInterleave := 0;
  4108. case Format of
  4109. ifLuminance8Alpha8:
  4110. AlphaInterleave := 1;
  4111. ifBGRA8, ifRGBA8:
  4112. AlphaInterleave := 3;
  4113. end;
  4114. pSource := Data;
  4115. for Row := 0 to Height -1 do begin
  4116. pDest := GetRowPointer(Row);
  4117. if Assigned(pDest) then begin
  4118. for Col := 0 to Width -1 do begin
  4119. Inc(pSource, AlphaInterleave);
  4120. pDest^ := pSource^;
  4121. Inc(pDest);
  4122. Inc(pSource);
  4123. end;
  4124. end;
  4125. end;
  4126. result := true;
  4127. end;
  4128. end;
  4129. end;
  4130. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4131. function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
  4132. var
  4133. bmp: TglBitmap2D;
  4134. begin
  4135. bmp := TglBitmap2D.Create;
  4136. try
  4137. bmp.AssignFromSurface(Surface);
  4138. result := AddAlphaFromGlBitmap(bmp, Func, CustomData);
  4139. finally
  4140. bmp.Free;
  4141. end;
  4142. end;
  4143. {$ENDIF}
  4144. {$IFDEF GLB_DELPHI}
  4145. //TODO rework & test
  4146. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4147. function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
  4148. var
  4149. Row: Integer;
  4150. pSource, pData: PByte;
  4151. begin
  4152. result := false;
  4153. if Assigned(Data) then begin
  4154. if Assigned(aBitmap) then begin
  4155. aBitmap.Width := Width;
  4156. aBitmap.Height := Height;
  4157. case Format of
  4158. tfAlpha8, ifLuminance, ifDepth8:
  4159. begin
  4160. Bitmap.PixelFormat := pf8bit;
  4161. Bitmap.Palette := CreateGrayPalette;
  4162. end;
  4163. ifRGB5A1:
  4164. Bitmap.PixelFormat := pf15bit;
  4165. ifR5G6B5:
  4166. Bitmap.PixelFormat := pf16bit;
  4167. ifRGB8, ifBGR8:
  4168. Bitmap.PixelFormat := pf24bit;
  4169. ifRGBA8, ifBGRA8:
  4170. Bitmap.PixelFormat := pf32bit;
  4171. else
  4172. raise EglBitmapException.Create('AssignToBitmap - Invalid Pixelformat.');
  4173. end;
  4174. pSource := Data;
  4175. for Row := 0 to FileHeight -1 do begin
  4176. pData := Bitmap.Scanline[Row];
  4177. Move(pSource^, pData^, fRowSize);
  4178. Inc(pSource, fRowSize);
  4179. // swap RGB(A) to BGR(A)
  4180. if InternalFormat in [ifRGB8, ifRGBA8] then
  4181. SwapRGB(pData, FileWidth, InternalFormat = ifRGBA8);
  4182. end;
  4183. result := true;
  4184. end;
  4185. end;
  4186. end;
  4187. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4188. function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  4189. var
  4190. pSource, pData, pTempData: PByte;
  4191. Row, RowSize, TempWidth, TempHeight: Integer;
  4192. IntFormat: TglBitmapInternalFormat;
  4193. begin
  4194. result := false;
  4195. if (Assigned(Bitmap)) then begin
  4196. case Bitmap.PixelFormat of
  4197. pf8bit:
  4198. IntFormat := ifLuminance;
  4199. pf15bit:
  4200. IntFormat := ifRGB5A1;
  4201. pf16bit:
  4202. IntFormat := ifR5G6B5;
  4203. pf24bit:
  4204. IntFormat := ifBGR8;
  4205. pf32bit:
  4206. IntFormat := ifBGRA8;
  4207. else
  4208. raise EglBitmapException.Create('AssignFromBitmap - Invalid Pixelformat.');
  4209. end;
  4210. TempWidth := Bitmap.Width;
  4211. TempHeight := Bitmap.Height;
  4212. RowSize := Trunc(TempWidth * FormatGetSize(IntFormat));
  4213. GetMem(pData, TempHeight * RowSize);
  4214. try
  4215. pTempData := pData;
  4216. for Row := 0 to TempHeight -1 do begin
  4217. pSource := Bitmap.Scanline[Row];
  4218. if (Assigned(pSource)) then begin
  4219. Move(pSource^, pTempData^, RowSize);
  4220. Inc(pTempData, RowSize);
  4221. end;
  4222. end;
  4223. SetDataPointer(pData, IntFormat, TempWidth, TempHeight);
  4224. result := true;
  4225. except
  4226. FreeMem(pData);
  4227. raise;
  4228. end;
  4229. end;
  4230. end;
  4231. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4232. function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  4233. var
  4234. Row, Col, AlphaInterleave: Integer;
  4235. pSource, pDest: PByte;
  4236. begin
  4237. result := false;
  4238. if Assigned(Data) then begin
  4239. if InternalFormat in [ifAlpha, ifLuminanceAlpha, ifRGBA8, ifBGRA8] then begin
  4240. if Assigned(Bitmap) then begin
  4241. Bitmap.PixelFormat := pf8bit;
  4242. Bitmap.Palette := CreateGrayPalette;
  4243. Bitmap.Width := Width;
  4244. Bitmap.Height := Height;
  4245. case InternalFormat of
  4246. ifLuminanceAlpha:
  4247. AlphaInterleave := 1;
  4248. ifRGBA8, ifBGRA8:
  4249. AlphaInterleave := 3;
  4250. else
  4251. AlphaInterleave := 0;
  4252. end;
  4253. // Copy Data
  4254. pSource := Data;
  4255. for Row := 0 to Height -1 do begin
  4256. pDest := Bitmap.Scanline[Row];
  4257. if Assigned(pDest) then begin
  4258. for Col := 0 to Width -1 do begin
  4259. Inc(pSource, AlphaInterleave);
  4260. pDest^ := pSource^;
  4261. Inc(pDest);
  4262. Inc(pSource);
  4263. end;
  4264. end;
  4265. end;
  4266. result := true;
  4267. end;
  4268. end;
  4269. end;
  4270. end;
  4271. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4272. function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
  4273. var
  4274. tex: TglBitmap2D;
  4275. begin
  4276. tex := TglBitmap2D.Create;
  4277. try
  4278. tex.AssignFromBitmap(Bitmap);
  4279. result := AddAlphaFromglBitmap(tex, Func, CustomData);
  4280. finally
  4281. tex.Free;
  4282. end;
  4283. end;
  4284. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4285. function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar;
  4286. const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
  4287. var
  4288. RS: TResourceStream;
  4289. TempPos: Integer;
  4290. ResTypeStr: String;
  4291. TempResType: PChar;
  4292. begin
  4293. if Assigned(ResType) then
  4294. TempResType := ResType
  4295. else
  4296. begin
  4297. TempPos := Pos('.', Resource);
  4298. ResTypeStr := UpperCase(Copy(Resource, TempPos + 1, Length(Resource) - TempPos));
  4299. Resource := UpperCase(Copy(Resource, 0, TempPos -1));
  4300. TempResType := PChar(ResTypeStr);
  4301. end;
  4302. RS := TResourceStream.Create(Instance, Resource, TempResType);
  4303. try
  4304. result := AddAlphaFromStream(RS, Func, CustomData);
  4305. finally
  4306. RS.Free;
  4307. end;
  4308. end;
  4309. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4310. function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  4311. const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
  4312. var
  4313. RS: TResourceStream;
  4314. begin
  4315. RS := TResourceStream.CreateFromID(Instance, ResourceID, ResType);
  4316. try
  4317. result := AddAlphaFromStream(RS, Func, CustomData);
  4318. finally
  4319. RS.Free;
  4320. end;
  4321. end;
  4322. {$ENDIF}
  4323. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4324. function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4325. begin
  4326. (* TODO
  4327. if not FormatIsUncompressed(InternalFormat) then
  4328. raise EglBitmapUnsupportedFormatFormat.Create('AddAlphaFromFunc - ' + UNSUPPORTED_FORMAT);
  4329. *)
  4330. result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
  4331. end;
  4332. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4333. function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4334. var
  4335. FS: TFileStream;
  4336. begin
  4337. FS := TFileStream.Create(FileName, fmOpenRead);
  4338. try
  4339. result := AddAlphaFromStream(FS, aFunc, aArgs);
  4340. finally
  4341. FS.Free;
  4342. end;
  4343. end;
  4344. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4345. function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4346. var
  4347. tex: TglBitmap2D;
  4348. begin
  4349. tex := TglBitmap2D.Create(aStream);
  4350. try
  4351. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4352. finally
  4353. tex.Free;
  4354. end;
  4355. end;
  4356. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4357. function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4358. var
  4359. DestData, DestData2, SourceData: pByte;
  4360. TempHeight, TempWidth: Integer;
  4361. SourceFD, DestFD: TFormatDescriptor;
  4362. SourceMD, DestMD, DestMD2: Pointer;
  4363. FuncRec: TglBitmapFunctionRec;
  4364. begin
  4365. result := false;
  4366. Assert(Assigned(Data));
  4367. Assert(Assigned(aBitmap));
  4368. Assert(Assigned(aBitmap.Data));
  4369. if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
  4370. result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
  4371. SourceFD := TFormatDescriptor.Get(aBitmap.Format);
  4372. DestFD := TFormatDescriptor.Get(Format);
  4373. if not Assigned(aFunc) then begin
  4374. aFunc := glBitmapAlphaFunc;
  4375. FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
  4376. end else
  4377. FuncRec.Args := aArgs;
  4378. // Values
  4379. TempHeight := aBitmap.FileHeight;
  4380. TempWidth := aBitmap.FileWidth;
  4381. FuncRec.Sender := Self;
  4382. FuncRec.Size := Dimension;
  4383. FuncRec.Position.Fields := FuncRec.Size.Fields;
  4384. DestData := Data;
  4385. DestData2 := Data;
  4386. SourceData := aBitmap.Data;
  4387. // Mapping
  4388. SourceFD.PreparePixel(FuncRec.Source);
  4389. DestFD.PreparePixel (FuncRec.Dest);
  4390. SourceMD := SourceFD.CreateMappingData;
  4391. DestMD := DestFD.CreateMappingData;
  4392. DestMD2 := DestFD.CreateMappingData;
  4393. try
  4394. FuncRec.Position.Y := 0;
  4395. while FuncRec.Position.Y < TempHeight do begin
  4396. FuncRec.Position.X := 0;
  4397. while FuncRec.Position.X < TempWidth do begin
  4398. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  4399. DestFD.Unmap (DestData, FuncRec.Dest, DestMD);
  4400. aFunc(FuncRec);
  4401. DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
  4402. inc(FuncRec.Position.X);
  4403. end;
  4404. inc(FuncRec.Position.Y);
  4405. end;
  4406. finally
  4407. SourceFD.FreeMappingData(SourceMD);
  4408. DestFD.FreeMappingData(DestMD);
  4409. DestFD.FreeMappingData(DestMD2);
  4410. end;
  4411. end;
  4412. end;
  4413. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4414. function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
  4415. begin
  4416. result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
  4417. end;
  4418. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4419. function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
  4420. var
  4421. PixelData: TglBitmapPixelData;
  4422. begin
  4423. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4424. result := AddAlphaFromColorKeyFloat(
  4425. aRed / PixelData.Range.r,
  4426. aGreen / PixelData.Range.g,
  4427. aBlue / PixelData.Range.b,
  4428. aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
  4429. end;
  4430. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4431. function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
  4432. var
  4433. values: array[0..2] of Single;
  4434. tmp: Cardinal;
  4435. i: Integer;
  4436. PixelData: TglBitmapPixelData;
  4437. begin
  4438. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4439. with PixelData do begin
  4440. values[0] := aRed;
  4441. values[1] := aGreen;
  4442. values[2] := aBlue;
  4443. for i := 0 to 2 do begin
  4444. tmp := Trunc(Range.arr[i] * aDeviation);
  4445. Data.arr[i] := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
  4446. Range.arr[i] := Max(0, Trunc(Range.arr[i] * values[i] - tmp));
  4447. end;
  4448. Data.a := 0;
  4449. Range.a := 0;
  4450. end;
  4451. result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
  4452. end;
  4453. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4454. function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
  4455. begin
  4456. result := AddAlphaFromValueFloat(aAlpha / $FF);
  4457. end;
  4458. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4459. function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  4460. var
  4461. PixelData: TglBitmapPixelData;
  4462. begin
  4463. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4464. result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
  4465. end;
  4466. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4467. function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  4468. var
  4469. PixelData: TglBitmapPixelData;
  4470. begin
  4471. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4472. with PixelData do
  4473. Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
  4474. result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
  4475. end;
  4476. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4477. function TglBitmap.RemoveAlpha: Boolean;
  4478. var
  4479. FormatDesc: TFormatDescriptor;
  4480. begin
  4481. result := false;
  4482. FormatDesc := TFormatDescriptor.Get(Format);
  4483. if Assigned(Data) then begin
  4484. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  4485. raise EglBitmapUnsupportedFormatFormat.Create('RemoveAlpha - ' + UNSUPPORTED_FORMAT);
  4486. result := ConvertTo(FormatDesc.WithoutAlpha);
  4487. end;
  4488. end;
  4489. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4490. function TglBitmap.Clone: TglBitmap;
  4491. var
  4492. Temp: TglBitmap;
  4493. TempPtr: PByte;
  4494. Size: Integer;
  4495. begin
  4496. result := nil;
  4497. Temp := (ClassType.Create as TglBitmap);
  4498. try
  4499. // copy texture data if assigned
  4500. if Assigned(Data) then begin
  4501. Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
  4502. GetMem(TempPtr, Size);
  4503. try
  4504. Move(Data^, TempPtr^, Size);
  4505. Temp.SetDataPointer(TempPtr, Format, Width, Height);
  4506. except
  4507. FreeMem(TempPtr);
  4508. raise;
  4509. end;
  4510. end else
  4511. Temp.SetDataPointer(nil, Format, Width, Height);
  4512. // copy properties
  4513. Temp.fID := ID;
  4514. Temp.fTarget := Target;
  4515. Temp.fFormat := Format;
  4516. Temp.fMipMap := MipMap;
  4517. Temp.fAnisotropic := Anisotropic;
  4518. Temp.fBorderColor := fBorderColor;
  4519. Temp.fDeleteTextureOnFree := DeleteTextureOnFree;
  4520. Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
  4521. Temp.fFilterMin := fFilterMin;
  4522. Temp.fFilterMag := fFilterMag;
  4523. Temp.fWrapS := fWrapS;
  4524. Temp.fWrapT := fWrapT;
  4525. Temp.fWrapR := fWrapR;
  4526. Temp.fFilename := fFilename;
  4527. Temp.fCustomName := fCustomName;
  4528. Temp.fCustomNameW := fCustomNameW;
  4529. Temp.fCustomData := fCustomData;
  4530. result := Temp;
  4531. except
  4532. FreeAndNil(Temp);
  4533. raise;
  4534. end;
  4535. end;
  4536. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4537. function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
  4538. var
  4539. SourceFD, DestFD: TFormatDescriptor;
  4540. SourcePD, DestPD: TglBitmapPixelData;
  4541. ShiftData: TShiftData;
  4542. function CanCopyDirect: Boolean;
  4543. begin
  4544. result :=
  4545. ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  4546. ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  4547. ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  4548. ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  4549. end;
  4550. function CanShift: Boolean;
  4551. begin
  4552. result :=
  4553. ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  4554. ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  4555. ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  4556. ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  4557. end;
  4558. function GetShift(aSource, aDest: Cardinal) : ShortInt;
  4559. begin
  4560. result := 0;
  4561. while (aSource > aDest) and (aSource > 0) do begin
  4562. inc(result);
  4563. aSource := aSource shr 1;
  4564. end;
  4565. end;
  4566. begin
  4567. if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
  4568. SourceFD := TFormatDescriptor.Get(Format);
  4569. DestFD := TFormatDescriptor.Get(aFormat);
  4570. SourceFD.PreparePixel(SourcePD);
  4571. DestFD.PreparePixel (DestPD);
  4572. if CanCopyDirect then
  4573. result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
  4574. else if CanShift then begin
  4575. ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
  4576. ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
  4577. ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
  4578. ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
  4579. result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
  4580. end else
  4581. result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
  4582. end else
  4583. result := true;
  4584. end;
  4585. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4586. procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
  4587. begin
  4588. if aUseRGB or aUseAlpha then
  4589. AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
  4590. ((PtrInt(aUseAlpha) and 1) shl 1) or
  4591. (PtrInt(aUseRGB) and 1) ));
  4592. end;
  4593. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4594. procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  4595. begin
  4596. fBorderColor[0] := aRed;
  4597. fBorderColor[1] := aGreen;
  4598. fBorderColor[2] := aBlue;
  4599. fBorderColor[3] := aAlpha;
  4600. if (ID > 0) then begin
  4601. Bind(false);
  4602. glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
  4603. end;
  4604. end;
  4605. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4606. procedure TglBitmap.FreeData;
  4607. begin
  4608. SetDataPointer(nil, tfEmpty);
  4609. end;
  4610. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4611. procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
  4612. const aAlpha: Byte);
  4613. begin
  4614. FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
  4615. end;
  4616. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4617. procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
  4618. var
  4619. PixelData: TglBitmapPixelData;
  4620. begin
  4621. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4622. FillWithColorFloat(
  4623. aRed / PixelData.Range.r,
  4624. aGreen / PixelData.Range.g,
  4625. aBlue / PixelData.Range.b,
  4626. aAlpha / PixelData.Range.a);
  4627. end;
  4628. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4629. procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
  4630. var
  4631. PixelData: TglBitmapPixelData;
  4632. begin
  4633. TFormatDescriptor.Get(Format).PreparePixel(PixelData);
  4634. with PixelData do begin
  4635. Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
  4636. Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
  4637. Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
  4638. Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
  4639. end;
  4640. AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
  4641. end;
  4642. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4643. procedure TglBitmap.SetFilter(const aMin, aMag: Cardinal);
  4644. begin
  4645. //check MIN filter
  4646. case aMin of
  4647. GL_NEAREST:
  4648. fFilterMin := GL_NEAREST;
  4649. GL_LINEAR:
  4650. fFilterMin := GL_LINEAR;
  4651. GL_NEAREST_MIPMAP_NEAREST:
  4652. fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
  4653. GL_LINEAR_MIPMAP_NEAREST:
  4654. fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
  4655. GL_NEAREST_MIPMAP_LINEAR:
  4656. fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
  4657. GL_LINEAR_MIPMAP_LINEAR:
  4658. fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
  4659. else
  4660. raise EglBitmapException.Create('SetFilter - Unknow MIN filter.');
  4661. end;
  4662. //check MAG filter
  4663. case aMag of
  4664. GL_NEAREST:
  4665. fFilterMag := GL_NEAREST;
  4666. GL_LINEAR:
  4667. fFilterMag := GL_LINEAR;
  4668. else
  4669. raise EglBitmapException.Create('SetFilter - Unknow MAG filter.');
  4670. end;
  4671. //apply filter
  4672. if (ID > 0) then begin
  4673. Bind(false);
  4674. glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
  4675. if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
  4676. case fFilterMin of
  4677. GL_NEAREST, GL_LINEAR:
  4678. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  4679. GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
  4680. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
  4681. GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
  4682. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
  4683. end;
  4684. end else
  4685. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  4686. end;
  4687. end;
  4688. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4689. procedure TglBitmap.SetWrap(const S: Cardinal; const T: Cardinal; const R: Cardinal);
  4690. procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
  4691. begin
  4692. case aValue of
  4693. GL_CLAMP:
  4694. aTarget := GL_CLAMP;
  4695. GL_REPEAT:
  4696. aTarget := GL_REPEAT;
  4697. GL_CLAMP_TO_EDGE: begin
  4698. if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
  4699. aTarget := GL_CLAMP_TO_EDGE
  4700. else
  4701. aTarget := GL_CLAMP;
  4702. end;
  4703. GL_CLAMP_TO_BORDER: begin
  4704. if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
  4705. aTarget := GL_CLAMP_TO_BORDER
  4706. else
  4707. aTarget := GL_CLAMP;
  4708. end;
  4709. GL_MIRRORED_REPEAT: begin
  4710. if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
  4711. aTarget := GL_MIRRORED_REPEAT
  4712. else
  4713. raise EglBitmapException.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
  4714. end;
  4715. else
  4716. raise EglBitmapException.Create('SetWrap - Unknow Texturewrap (S).');
  4717. end;
  4718. end;
  4719. begin
  4720. CheckAndSetWrap(S, fWrapS);
  4721. CheckAndSetWrap(T, fWrapT);
  4722. CheckAndSetWrap(R, fWrapR);
  4723. if (ID > 0) then begin
  4724. Bind(false);
  4725. glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
  4726. glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
  4727. glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
  4728. end;
  4729. end;
  4730. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4731. procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
  4732. begin
  4733. if aEnableTextureUnit then
  4734. glEnable(Target);
  4735. if (ID > 0) then
  4736. glBindTexture(Target, ID);
  4737. end;
  4738. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4739. procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
  4740. begin
  4741. if aDisableTextureUnit then
  4742. glDisable(Target);
  4743. glBindTexture(Target, 0);
  4744. end;
  4745. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4746. constructor TglBitmap.Create;
  4747. begin
  4748. {$IFDEF GLB_NATIVE_OGL}
  4749. glbReadOpenGLExtensions;
  4750. {$ENDIF}
  4751. if (ClassType = TglBitmap) then
  4752. raise EglBitmapException.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
  4753. inherited Create;
  4754. end;
  4755. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4756. constructor TglBitmap.Create(const aFileName: String);
  4757. begin
  4758. Create;
  4759. LoadFromFile(FileName);
  4760. end;
  4761. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4762. constructor TglBitmap.Create(const aStream: TStream);
  4763. begin
  4764. Create;
  4765. LoadFromStream(aStream);
  4766. end;
  4767. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4768. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat);
  4769. var
  4770. Image: PByte;
  4771. ImageSize: Integer;
  4772. begin
  4773. Create;
  4774. ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  4775. GetMem(Image, ImageSize);
  4776. try
  4777. FillChar(Image^, ImageSize, #$FF);
  4778. SetDataPointer(Image, aFormat, aSize.X, aSize.Y);
  4779. except
  4780. FreeMem(Image);
  4781. raise;
  4782. end;
  4783. end;
  4784. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4785. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat;
  4786. const aFunc: TglBitmapFunction; const aArgs: Pointer);
  4787. begin
  4788. Create;
  4789. LoadFromFunc(aSize, aFunc, aFormat, aArgs);
  4790. end;
  4791. {$IFDEF GLB_DELPHI}
  4792. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4793. constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
  4794. begin
  4795. Create;
  4796. LoadFromResource(aInstance, aResource, aResType);
  4797. end;
  4798. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4799. constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  4800. begin
  4801. Create;
  4802. LoadFromResourceID(aInstance, aResourceID, aResType);
  4803. end;
  4804. {$ENDIF}
  4805. {$IFDEF GLB_SUPPORT_PNG_READ}
  4806. {$IF DEFINED(GLB_SDL_IMAGE)}
  4807. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4808. //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4809. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4810. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  4811. var
  4812. Surface: PSDL_Surface;
  4813. RWops: PSDL_RWops;
  4814. begin
  4815. result := false;
  4816. RWops := glBitmapCreateRWops(aStream);
  4817. try
  4818. if IMG_isPNG(RWops) > 0 then begin
  4819. Surface := IMG_LoadPNG_RW(RWops);
  4820. try
  4821. AssignFromSurface(Surface);
  4822. Rresult := true;
  4823. finally
  4824. SDL_FreeSurface(Surface);
  4825. end;
  4826. end;
  4827. finally
  4828. SDL_FreeRW(RWops);
  4829. end;
  4830. end;
  4831. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  4832. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4833. procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  4834. begin
  4835. TStream(png_get_io_ptr(png)).Read(buffer^, size);
  4836. end;
  4837. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4838. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  4839. var
  4840. StreamPos: Int64;
  4841. signature: array [0..7] of byte;
  4842. png: png_structp;
  4843. png_info: png_infop;
  4844. TempHeight, TempWidth: Integer;
  4845. Format: TglBitmapInternalFormat;
  4846. png_data: pByte;
  4847. png_rows: array of pByte;
  4848. Row, LineSize: Integer;
  4849. begin
  4850. result := false;
  4851. if not init_libPNG then
  4852. raise Exception.Create('LoadPNG - unable to initialize libPNG.');
  4853. try
  4854. // signature
  4855. StreamPos := Stream.Position;
  4856. Stream.Read(signature, 8);
  4857. Stream.Position := StreamPos;
  4858. if png_check_sig(@signature, 8) <> 0 then begin
  4859. // png read struct
  4860. png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  4861. if png = nil then
  4862. raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
  4863. // png info
  4864. png_info := png_create_info_struct(png);
  4865. if png_info = nil then begin
  4866. png_destroy_read_struct(@png, nil, nil);
  4867. raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
  4868. end;
  4869. // set read callback
  4870. png_set_read_fn(png, stream, glBitmap_libPNG_read_func);
  4871. // read informations
  4872. png_read_info(png, png_info);
  4873. // size
  4874. TempHeight := png_get_image_height(png, png_info);
  4875. TempWidth := png_get_image_width(png, png_info);
  4876. // format
  4877. case png_get_color_type(png, png_info) of
  4878. PNG_COLOR_TYPE_GRAY:
  4879. Format := tfLuminance8;
  4880. PNG_COLOR_TYPE_GRAY_ALPHA:
  4881. Format := tfLuminance8Alpha8;
  4882. PNG_COLOR_TYPE_RGB:
  4883. Format := tfRGB8;
  4884. PNG_COLOR_TYPE_RGB_ALPHA:
  4885. Format := tfRGBA8;
  4886. else
  4887. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  4888. end;
  4889. // cut upper 8 bit from 16 bit formats
  4890. if png_get_bit_depth(png, png_info) > 8 then
  4891. png_set_strip_16(png);
  4892. // expand bitdepth smaller than 8
  4893. if png_get_bit_depth(png, png_info) < 8 then
  4894. png_set_expand(png);
  4895. // allocating mem for scanlines
  4896. LineSize := png_get_rowbytes(png, png_info);
  4897. GetMem(png_data, TempHeight * LineSize);
  4898. try
  4899. SetLength(png_rows, TempHeight);
  4900. for Row := Low(png_rows) to High(png_rows) do begin
  4901. png_rows[Row] := png_data;
  4902. Inc(png_rows[Row], Row * LineSize);
  4903. end;
  4904. // read complete image into scanlines
  4905. png_read_image(png, @png_rows[0]);
  4906. // read end
  4907. png_read_end(png, png_info);
  4908. // destroy read struct
  4909. png_destroy_read_struct(@png, @png_info, nil);
  4910. SetLength(png_rows, 0);
  4911. // set new data
  4912. SetDataPointer(png_data, Format, TempWidth, TempHeight);
  4913. result := true;
  4914. except
  4915. FreeMem(png_data);
  4916. raise;
  4917. end;
  4918. end;
  4919. finally
  4920. quit_libPNG;
  4921. end;
  4922. end;
  4923. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  4924. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4925. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  4926. var
  4927. StreamPos: Int64;
  4928. Png: TPNGObject;
  4929. Header: Array[0..7] of Byte;
  4930. Row, Col, PixSize, LineSize: Integer;
  4931. NewImage, pSource, pDest, pAlpha: pByte;
  4932. Format: TglBitmapInternalFormat;
  4933. const
  4934. PngHeader: Array[0..7] of Byte = (#137, #80, #78, #71, #13, #10, #26, #10);
  4935. begin
  4936. result := false;
  4937. StreamPos := Stream.Position;
  4938. Stream.Read(Header[0], SizeOf(Header));
  4939. Stream.Position := StreamPos;
  4940. {Test if the header matches}
  4941. if Header = PngHeader then begin
  4942. Png := TPNGObject.Create;
  4943. try
  4944. Png.LoadFromStream(Stream);
  4945. case Png.Header.ColorType of
  4946. COLOR_GRAYSCALE:
  4947. Format := ifLuminance;
  4948. COLOR_GRAYSCALEALPHA:
  4949. Format := ifLuminanceAlpha;
  4950. COLOR_RGB:
  4951. Format := ifBGR8;
  4952. COLOR_RGBALPHA:
  4953. Format := ifBGRA8;
  4954. else
  4955. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  4956. end;
  4957. PixSize := Trunc(FormatGetSize(Format));
  4958. LineSize := Integer(Png.Header.Width) * PixSize;
  4959. GetMem(NewImage, LineSize * Integer(Png.Header.Height));
  4960. try
  4961. pDest := NewImage;
  4962. case Png.Header.ColorType of
  4963. COLOR_RGB, COLOR_GRAYSCALE:
  4964. begin
  4965. for Row := 0 to Png.Height -1 do begin
  4966. Move (Png.Scanline[Row]^, pDest^, LineSize);
  4967. Inc(pDest, LineSize);
  4968. end;
  4969. end;
  4970. COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
  4971. begin
  4972. PixSize := PixSize -1;
  4973. for Row := 0 to Png.Height -1 do begin
  4974. pSource := Png.Scanline[Row];
  4975. pAlpha := pByte(Png.AlphaScanline[Row]);
  4976. for Col := 0 to Png.Width -1 do begin
  4977. Move (pSource^, pDest^, PixSize);
  4978. Inc(pSource, PixSize);
  4979. Inc(pDest, PixSize);
  4980. pDest^ := pAlpha^;
  4981. inc(pAlpha);
  4982. Inc(pDest);
  4983. end;
  4984. end;
  4985. end;
  4986. else
  4987. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  4988. end;
  4989. SetDataPointer(NewImage, Format, Png.Header.Width, Png.Header.Height);
  4990. result := true;
  4991. except
  4992. FreeMem(NewImage);
  4993. raise;
  4994. end;
  4995. finally
  4996. Png.Free;
  4997. end;
  4998. end;
  4999. end;
  5000. {$IFEND}
  5001. {$ENDIF}
  5002. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  5003. {$IFDEF GLB_LIB_PNG}
  5004. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5005. procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  5006. begin
  5007. TStream(png_get_io_ptr(png)).Write(buffer^, size);
  5008. end;
  5009. {$ENDIF}
  5010. {$IF DEFINED(GLB_LIB_PNG)}
  5011. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5012. procedure TglBitmap.SavePNG(const aStream: TStream);
  5013. var
  5014. png: png_structp;
  5015. png_info: png_infop;
  5016. png_rows: array of pByte;
  5017. LineSize: Integer;
  5018. ColorType: Integer;
  5019. Row: Integer;
  5020. begin
  5021. if not (ftPNG in FormatGetSupportedFiles (InternalFormat)) then
  5022. raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
  5023. if not init_libPNG then
  5024. raise Exception.Create('SavePNG - unable to initialize libPNG.');
  5025. try
  5026. case FInternalFormat of
  5027. ifAlpha, ifLuminance, ifDepth8:
  5028. ColorType := PNG_COLOR_TYPE_GRAY;
  5029. ifLuminanceAlpha:
  5030. ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
  5031. ifBGR8, ifRGB8:
  5032. ColorType := PNG_COLOR_TYPE_RGB;
  5033. ifBGRA8, ifRGBA8:
  5034. ColorType := PNG_COLOR_TYPE_RGBA;
  5035. else
  5036. raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
  5037. end;
  5038. LineSize := Trunc(FormatGetSize(FInternalFormat) * Width);
  5039. // creating array for scanline
  5040. SetLength(png_rows, Height);
  5041. try
  5042. for Row := 0 to Height - 1 do begin
  5043. png_rows[Row] := Data;
  5044. Inc(png_rows[Row], Row * LineSize)
  5045. end;
  5046. // write struct
  5047. png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  5048. if png = nil then
  5049. raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
  5050. // create png info
  5051. png_info := png_create_info_struct(png);
  5052. if png_info = nil then begin
  5053. png_destroy_write_struct(@png, nil);
  5054. raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
  5055. end;
  5056. // set read callback
  5057. png_set_write_fn(png, stream, glBitmap_libPNG_write_func, nil);
  5058. // set compression
  5059. png_set_compression_level(png, 6);
  5060. if InternalFormat in [ifBGR8, ifBGRA8] then
  5061. png_set_bgr(png);
  5062. png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
  5063. png_write_info(png, png_info);
  5064. png_write_image(png, @png_rows[0]);
  5065. png_write_end(png, png_info);
  5066. png_destroy_write_struct(@png, @png_info);
  5067. finally
  5068. SetLength(png_rows, 0);
  5069. end;
  5070. finally
  5071. quit_libPNG;
  5072. end;
  5073. end;
  5074. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  5075. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5076. procedure TglBitmap.SavePNG(const aStream: TStream);
  5077. var
  5078. Png: TPNGObject;
  5079. pSource, pDest: pByte;
  5080. X, Y, PixSize: Integer;
  5081. ColorType: Cardinal;
  5082. Alpha: Boolean;
  5083. pTemp: pByte;
  5084. Temp: Byte;
  5085. begin
  5086. if not (ftPNG in FormatGetSupportedFiles (InternalFormat)) then
  5087. raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
  5088. case FInternalFormat of
  5089. ifAlpha, ifLuminance, ifDepth8: begin
  5090. ColorType := COLOR_GRAYSCALE;
  5091. PixSize := 1;
  5092. Alpha := false;
  5093. end;
  5094. ifLuminanceAlpha: begin
  5095. ColorType := COLOR_GRAYSCALEALPHA;
  5096. PixSize := 1;
  5097. Alpha := true;
  5098. end;
  5099. ifBGR8, ifRGB8: begin
  5100. ColorType := COLOR_RGB;
  5101. PixSize := 3;
  5102. Alpha := false;
  5103. end;
  5104. ifBGRA8, ifRGBA8: begin
  5105. ColorType := COLOR_RGBALPHA;
  5106. PixSize := 3;
  5107. Alpha := true
  5108. end;
  5109. else
  5110. raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
  5111. end;
  5112. Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
  5113. try
  5114. // Copy ImageData
  5115. pSource := Data;
  5116. for Y := 0 to Height -1 do begin
  5117. pDest := png.ScanLine[Y];
  5118. for X := 0 to Width -1 do begin
  5119. Move(pSource^, pDest^, PixSize);
  5120. Inc(pDest, PixSize);
  5121. Inc(pSource, PixSize);
  5122. if Alpha then begin
  5123. png.AlphaScanline[Y]^[X] := pSource^;
  5124. Inc(pSource);
  5125. end;
  5126. end;
  5127. // convert RGB line to BGR
  5128. if InternalFormat in [ifRGB8, ifRGBA8] then begin
  5129. pTemp := png.ScanLine[Y];
  5130. for X := 0 to Width -1 do begin
  5131. Temp := pByteArray(pTemp)^[0];
  5132. pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
  5133. pByteArray(pTemp)^[2] := Temp;
  5134. Inc(pTemp, 3);
  5135. end;
  5136. end;
  5137. end;
  5138. // Save to Stream
  5139. Png.CompressionLevel := 6;
  5140. Png.SaveToStream(Stream);
  5141. finally
  5142. FreeAndNil(Png);
  5143. end;
  5144. end;
  5145. {$IFEND}
  5146. {$ENDIF}
  5147. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5148. //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5149. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5150. {$IFDEF GLB_LIB_JPEG}
  5151. type
  5152. glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
  5153. glBitmap_libJPEG_source_mgr = record
  5154. pub: jpeg_source_mgr;
  5155. SrcStream: TStream;
  5156. SrcBuffer: array [1..4096] of byte;
  5157. end;
  5158. glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
  5159. glBitmap_libJPEG_dest_mgr = record
  5160. pub: jpeg_destination_mgr;
  5161. DestStream: TStream;
  5162. DestBuffer: array [1..4096] of byte;
  5163. end;
  5164. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5165. {
  5166. procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
  5167. var
  5168. Msg: String;
  5169. begin
  5170. SetLength(Msg, 256);
  5171. cinfo^.err^.format_message(cinfo, pChar(Msg));
  5172. Writeln('ERROR [' + IntToStr(cinfo^.err^.msg_code) + '] ' + Msg);
  5173. cinfo^.global_state := 0;
  5174. jpeg_abort(cinfo);
  5175. end;
  5176. }
  5177. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5178. {
  5179. procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
  5180. var
  5181. Msg: String;
  5182. begin
  5183. SetLength(Msg, 256);
  5184. cinfo^.err^.format_message(cinfo, pChar(Msg));
  5185. Writeln('OUTPUT [' + IntToStr(cinfo^.err^.msg_code) + '] ' + Msg);
  5186. cinfo^.global_state := 0;
  5187. end;
  5188. }
  5189. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5190. {
  5191. procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
  5192. begin
  5193. end;
  5194. }
  5195. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5196. function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
  5197. var
  5198. src: glBitmap_libJPEG_source_mgr_ptr;
  5199. bytes: integer;
  5200. begin
  5201. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  5202. bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
  5203. if (bytes <= 0) then begin
  5204. src^.SrcBuffer[1] := $FF;
  5205. src^.SrcBuffer[2] := JPEG_EOI;
  5206. bytes := 2;
  5207. end;
  5208. src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
  5209. src^.pub.bytes_in_buffer := bytes;
  5210. result := true;
  5211. end;
  5212. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5213. procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
  5214. var
  5215. src: glBitmap_libJPEG_source_mgr_ptr;
  5216. begin
  5217. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  5218. if num_bytes > 0 then begin
  5219. // wanted byte isn't in buffer so set stream position and read buffer
  5220. if num_bytes > src^.pub.bytes_in_buffer then begin
  5221. src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
  5222. src^.pub.fill_input_buffer(cinfo);
  5223. end else begin
  5224. // wanted byte is in buffer so only skip
  5225. inc(src^.pub.next_input_byte, num_bytes);
  5226. dec(src^.pub.bytes_in_buffer, num_bytes);
  5227. end;
  5228. end;
  5229. end;
  5230. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5231. {
  5232. procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
  5233. begin
  5234. end;
  5235. }
  5236. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5237. {
  5238. procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
  5239. begin
  5240. end;
  5241. }
  5242. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5243. function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
  5244. var
  5245. dest: glBitmap_libJPEG_dest_mgr_ptr;
  5246. begin
  5247. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  5248. if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
  5249. // write complete buffer
  5250. dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
  5251. // reset buffer
  5252. dest^.pub.next_output_byte := @dest^.DestBuffer[1];
  5253. dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
  5254. end;
  5255. result := true;
  5256. end;
  5257. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5258. procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
  5259. var
  5260. Idx: Integer;
  5261. dest: glBitmap_libJPEG_dest_mgr_ptr;
  5262. begin
  5263. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  5264. for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
  5265. // check for endblock
  5266. if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
  5267. // write endblock
  5268. dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
  5269. // leave
  5270. break;
  5271. end else
  5272. dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
  5273. end;
  5274. end;
  5275. {$ENDIF}
  5276. {$IFDEF GLB_SUPPORT_JPEG_READ}
  5277. {$IF DEFINED(GLB_SDL_IMAGE)}
  5278. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5279. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5280. var
  5281. Surface: PSDL_Surface;
  5282. RWops: PSDL_RWops;
  5283. begin
  5284. result := false;
  5285. RWops := glBitmapCreateRWops(Stream);
  5286. try
  5287. if IMG_isJPG(RWops) > 0 then begin
  5288. Surface := IMG_LoadJPG_RW(RWops);
  5289. try
  5290. AssignFromSurface(Surface);
  5291. result := true;
  5292. finally
  5293. SDL_FreeSurface(Surface);
  5294. end;
  5295. end;
  5296. finally
  5297. SDL_FreeRW(RWops);
  5298. end;
  5299. end;
  5300. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  5301. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5302. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5303. var
  5304. StreamPos: Int64;
  5305. Temp: array[0..1]of Byte;
  5306. jpeg: jpeg_decompress_struct;
  5307. jpeg_err: jpeg_error_mgr;
  5308. IntFormat: TglBitmapInternalFormat;
  5309. pImage: pByte;
  5310. TempHeight, TempWidth: Integer;
  5311. pTemp: pByte;
  5312. Row: Integer;
  5313. begin
  5314. result := false;
  5315. if not init_libJPEG then
  5316. raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
  5317. try
  5318. // reading first two bytes to test file and set cursor back to begin
  5319. StreamPos := Stream.Position;
  5320. Stream.Read(Temp[0], 2);
  5321. Stream.Position := StreamPos;
  5322. // if Bitmap then read file.
  5323. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  5324. FillChar(jpeg, SizeOf(jpeg_decompress_struct), $00);
  5325. FillChar(jpeg_err, SizeOf(jpeg_error_mgr), $00);
  5326. // error managment
  5327. jpeg.err := jpeg_std_error(@jpeg_err);
  5328. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  5329. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  5330. // decompression struct
  5331. jpeg_create_decompress(@jpeg);
  5332. // allocation space for streaming methods
  5333. jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
  5334. // seeting up custom functions
  5335. with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
  5336. pub.init_source := glBitmap_libJPEG_init_source;
  5337. pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
  5338. pub.skip_input_data := glBitmap_libJPEG_skip_input_data;
  5339. pub.resync_to_restart := jpeg_resync_to_restart; // use default method
  5340. pub.term_source := glBitmap_libJPEG_term_source;
  5341. pub.bytes_in_buffer := 0; // forces fill_input_buffer on first read
  5342. pub.next_input_byte := nil; // until buffer loaded
  5343. SrcStream := Stream;
  5344. end;
  5345. // set global decoding state
  5346. jpeg.global_state := DSTATE_START;
  5347. // read header of jpeg
  5348. jpeg_read_header(@jpeg, false);
  5349. // setting output parameter
  5350. case jpeg.jpeg_color_space of
  5351. JCS_GRAYSCALE:
  5352. begin
  5353. jpeg.out_color_space := JCS_GRAYSCALE;
  5354. IntFormat := ifLuminance;
  5355. end;
  5356. else
  5357. jpeg.out_color_space := JCS_RGB;
  5358. IntFormat := ifRGB8;
  5359. end;
  5360. // reading image
  5361. jpeg_start_decompress(@jpeg);
  5362. TempHeight := jpeg.output_height;
  5363. TempWidth := jpeg.output_width;
  5364. // creating new image
  5365. GetMem(pImage, FormatGetImageSize(glBitmapPosition(TempWidth, TempHeight), IntFormat));
  5366. try
  5367. pTemp := pImage;
  5368. for Row := 0 to TempHeight -1 do begin
  5369. jpeg_read_scanlines(@jpeg, @pTemp, 1);
  5370. Inc(pTemp, Trunc(FormatGetSize(IntFormat) * TempWidth));
  5371. end;
  5372. // finish decompression
  5373. jpeg_finish_decompress(@jpeg);
  5374. // destroy decompression
  5375. jpeg_destroy_decompress(@jpeg);
  5376. SetDataPointer(pImage, IntFormat, TempWidth, TempHeight);
  5377. result := true;
  5378. except
  5379. FreeMem(pImage);
  5380. raise;
  5381. end;
  5382. end;
  5383. finally
  5384. quit_libJPEG;
  5385. end;
  5386. end;
  5387. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  5388. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5389. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5390. var
  5391. bmp: TBitmap;
  5392. jpg: TJPEGImage;
  5393. StreamPos: Int64;
  5394. Temp: array[0..1]of Byte;
  5395. begin
  5396. result := false;
  5397. // reading first two bytes to test file and set cursor back to begin
  5398. StreamPos := Stream.Position;
  5399. Stream.Read(Temp[0], 2);
  5400. Stream.Position := StreamPos;
  5401. // if Bitmap then read file.
  5402. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  5403. bmp := TBitmap.Create;
  5404. try
  5405. jpg := TJPEGImage.Create;
  5406. try
  5407. jpg.LoadFromStream(Stream);
  5408. bmp.Assign(jpg);
  5409. result := AssignFromBitmap(bmp);
  5410. finally
  5411. jpg.Free;
  5412. end;
  5413. finally
  5414. bmp.Free;
  5415. end;
  5416. end;
  5417. end;
  5418. {$IFEND}
  5419. {$ENDIF}
  5420. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  5421. {$IF DEFEFINED(GLB_LIB_JPEG)}
  5422. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5423. procedure TglBitmap.SaveJPEG(Stream: TStream);
  5424. var
  5425. jpeg: jpeg_compress_struct;
  5426. jpeg_err: jpeg_error_mgr;
  5427. Row: Integer;
  5428. pTemp, pTemp2: pByte;
  5429. procedure CopyRow(pDest, pSource: pByte);
  5430. var
  5431. X: Integer;
  5432. begin
  5433. for X := 0 to Width - 1 do begin
  5434. pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
  5435. pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
  5436. pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
  5437. Inc(pDest, 3);
  5438. Inc(pSource, 3);
  5439. end;
  5440. end;
  5441. begin
  5442. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  5443. raise EglBitmapUnsupportedInternalFormat.Create('SaveJpg - ' + UNSUPPORTED_INTERNAL_FORMAT);
  5444. if not init_libJPEG then
  5445. raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
  5446. try
  5447. FillChar(jpeg, SizeOf(jpeg_compress_struct), $00);
  5448. FillChar(jpeg_err, SizeOf(jpeg_error_mgr), $00);
  5449. // error managment
  5450. jpeg.err := jpeg_std_error(@jpeg_err);
  5451. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  5452. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  5453. // compression struct
  5454. jpeg_create_compress(@jpeg);
  5455. // allocation space for streaming methods
  5456. jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
  5457. // seeting up custom functions
  5458. with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
  5459. pub.init_destination := glBitmap_libJPEG_init_destination;
  5460. pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
  5461. pub.term_destination := glBitmap_libJPEG_term_destination;
  5462. pub.next_output_byte := @DestBuffer[1];
  5463. pub.free_in_buffer := Length(DestBuffer);
  5464. DestStream := Stream;
  5465. end;
  5466. // very important state
  5467. jpeg.global_state := CSTATE_START;
  5468. jpeg.image_width := Width;
  5469. jpeg.image_height := Height;
  5470. case InternalFormat of
  5471. ifAlpha, ifLuminance, ifDepth8: begin
  5472. jpeg.input_components := 1;
  5473. jpeg.in_color_space := JCS_GRAYSCALE;
  5474. end;
  5475. ifRGB8, ifBGR8: begin
  5476. jpeg.input_components := 3;
  5477. jpeg.in_color_space := JCS_RGB;
  5478. end;
  5479. end;
  5480. jpeg_set_defaults(@jpeg);
  5481. jpeg_set_quality(@jpeg, 95, true);
  5482. jpeg_start_compress(@jpeg, true);
  5483. pTemp := Data;
  5484. if InternalFormat = ifBGR8 then
  5485. GetMem(pTemp2, fRowSize)
  5486. else
  5487. pTemp2 := pTemp;
  5488. try
  5489. for Row := 0 to jpeg.image_height -1 do begin
  5490. // prepare row
  5491. if InternalFormat = ifBGR8 then
  5492. CopyRow(pTemp2, pTemp)
  5493. else
  5494. pTemp2 := pTemp;
  5495. // write row
  5496. jpeg_write_scanlines(@jpeg, @pTemp2, 1);
  5497. inc(pTemp, fRowSize);
  5498. end;
  5499. finally
  5500. // free memory
  5501. if InternalFormat = ifBGR8 then
  5502. FreeMem(pTemp2);
  5503. end;
  5504. jpeg_finish_compress(@jpeg);
  5505. jpeg_destroy_compress(@jpeg);
  5506. finally
  5507. quit_libJPEG;
  5508. end;
  5509. end;
  5510. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  5511. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5512. procedure TglBitmap.SaveJPEG(Stream: TStream);
  5513. var
  5514. Bmp: TBitmap;
  5515. Jpg: TJPEGImage;
  5516. begin
  5517. if not (ftJPEG in FormatGetSupportedFiles (InternalFormat)) then
  5518. raise EglBitmapUnsupportedInternalFormat.Create('SaveJpg - ' + UNSUPPORTED_INTERNAL_FORMAT);
  5519. Bmp := TBitmap.Create;
  5520. try
  5521. Jpg := TJPEGImage.Create;
  5522. try
  5523. AssignToBitmap(Bmp);
  5524. if FInternalFormat in [ifAlpha, ifLuminance, ifDepth8] then begin
  5525. Jpg.Grayscale := true;
  5526. Jpg.PixelFormat := jf8Bit;
  5527. end;
  5528. Jpg.Assign(Bmp);
  5529. Jpg.SaveToStream(Stream);
  5530. finally
  5531. FreeAndNil(Jpg);
  5532. end;
  5533. finally
  5534. FreeAndNil(Bmp);
  5535. end;
  5536. end;
  5537. {$ENDIF}
  5538. {$ENDIF}
  5539. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5540. //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5541. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5542. const
  5543. BMP_MAGIC = $4D42;
  5544. BMP_COMP_RGB = 0;
  5545. BMP_COMP_RLE8 = 1;
  5546. BMP_COMP_RLE4 = 2;
  5547. BMP_COMP_BITFIELDS = 3;
  5548. type
  5549. TBMPHeader = packed record
  5550. bfType: Word;
  5551. bfSize: Cardinal;
  5552. bfReserved1: Word;
  5553. bfReserved2: Word;
  5554. bfOffBits: Cardinal;
  5555. end;
  5556. TBMPInfo = packed record
  5557. biSize: Cardinal;
  5558. biWidth: Longint;
  5559. biHeight: Longint;
  5560. biPlanes: Word;
  5561. biBitCount: Word;
  5562. biCompression: Cardinal;
  5563. biSizeImage: Cardinal;
  5564. biXPelsPerMeter: Longint;
  5565. biYPelsPerMeter: Longint;
  5566. biClrUsed: Cardinal;
  5567. biClrImportant: Cardinal;
  5568. end;
  5569. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5570. function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
  5571. //////////////////////////////////////////////////////////////////////////////////////////////////
  5572. function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapColorRec): TglBitmapFormat;
  5573. begin
  5574. result := tfEmpty;
  5575. aStream.Read(aInfo{%H-}, SizeOf(aInfo));
  5576. FillChar(aMask{%H-}, SizeOf(aMask), 0);
  5577. //Read Compression
  5578. case aInfo.biCompression of
  5579. BMP_COMP_RLE4,
  5580. BMP_COMP_RLE8: begin
  5581. raise EglBitmapException.Create('RLE compression is not supported');
  5582. end;
  5583. BMP_COMP_BITFIELDS: begin
  5584. if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
  5585. aStream.Read(aMask.r, SizeOf(aMask.r));
  5586. aStream.Read(aMask.g, SizeOf(aMask.g));
  5587. aStream.Read(aMask.b, SizeOf(aMask.b));
  5588. aStream.Read(aMask.a, SizeOf(aMask.a));
  5589. end else
  5590. raise EglBitmapException.Create('Bitfields are only supported for 16bit and 32bit formats');
  5591. end;
  5592. end;
  5593. //get suitable format
  5594. case aInfo.biBitCount of
  5595. 8: result := tfLuminance8;
  5596. 16: result := tfBGR5;
  5597. 24: result := tfBGR8;
  5598. 32: result := tfBGRA8;
  5599. end;
  5600. end;
  5601. function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
  5602. var
  5603. i, c: Integer;
  5604. ColorTable: TbmpColorTable;
  5605. begin
  5606. result := nil;
  5607. if (aInfo.biBitCount >= 16) then
  5608. exit;
  5609. aFormat := tfLuminance8;
  5610. c := aInfo.biClrUsed;
  5611. if (c = 0) then
  5612. c := 1 shl aInfo.biBitCount;
  5613. SetLength(ColorTable, c);
  5614. for i := 0 to c-1 do begin
  5615. aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
  5616. if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
  5617. aFormat := tfRGB8;
  5618. end;
  5619. result := TbmpColorTableFormat.Create;
  5620. result.PixelSize := aInfo.biBitCount / 8;
  5621. result.ColorTable := ColorTable;
  5622. result.Range := glBitmapColorRec($FF, $FF, $FF, $00);
  5623. end;
  5624. //////////////////////////////////////////////////////////////////////////////////////////////////
  5625. function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
  5626. const aInfo: TBMPInfo): TbmpBitfieldFormat;
  5627. var
  5628. TmpFormat: TglBitmapFormat;
  5629. FormatDesc: TFormatDescriptor;
  5630. begin
  5631. result := nil;
  5632. if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
  5633. for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  5634. FormatDesc := TFormatDescriptor.Get(TmpFormat);
  5635. if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
  5636. aFormat := FormatDesc.Format;
  5637. exit;
  5638. end;
  5639. end;
  5640. if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
  5641. aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
  5642. if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
  5643. aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
  5644. result := TbmpBitfieldFormat.Create;
  5645. result.PixelSize := aInfo.biBitCount / 8;
  5646. result.RedMask := aMask.r;
  5647. result.GreenMask := aMask.g;
  5648. result.BlueMask := aMask.b;
  5649. result.AlphaMask := aMask.a;
  5650. end;
  5651. end;
  5652. var
  5653. //simple types
  5654. StartPos: Int64;
  5655. ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
  5656. PaddingBuff: Cardinal;
  5657. LineBuf, ImageData, TmpData: PByte;
  5658. SourceMD, DestMD: Pointer;
  5659. BmpFormat: TglBitmapFormat;
  5660. //records
  5661. Mask: TglBitmapColorRec;
  5662. Header: TBMPHeader;
  5663. Info: TBMPInfo;
  5664. //classes
  5665. SpecialFormat: TFormatDescriptor;
  5666. FormatDesc: TFormatDescriptor;
  5667. //////////////////////////////////////////////////////////////////////////////////////////////////
  5668. procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
  5669. var
  5670. i: Integer;
  5671. Pixel: TglBitmapPixelData;
  5672. begin
  5673. aStream.Read(aLineBuf^, rbLineSize);
  5674. SpecialFormat.PreparePixel(Pixel);
  5675. for i := 0 to Info.biWidth-1 do begin
  5676. SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
  5677. glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
  5678. FormatDesc.Map(Pixel, aData, DestMD);
  5679. end;
  5680. end;
  5681. begin
  5682. result := false;
  5683. BmpFormat := tfEmpty;
  5684. SpecialFormat := nil;
  5685. LineBuf := nil;
  5686. SourceMD := nil;
  5687. DestMD := nil;
  5688. // Header
  5689. StartPos := aStream.Position;
  5690. aStream.Read(Header{%H-}, SizeOf(Header));
  5691. if Header.bfType = BMP_MAGIC then begin
  5692. try try
  5693. BmpFormat := ReadInfo(Info, Mask);
  5694. SpecialFormat := ReadColorTable(BmpFormat, Info);
  5695. if not Assigned(SpecialFormat) then
  5696. SpecialFormat := CheckBitfields(BmpFormat, Mask, Info);
  5697. aStream.Position := StartPos + Header.bfOffBits;
  5698. if (BmpFormat <> tfEmpty) then begin
  5699. FormatDesc := TFormatDescriptor.Get(BmpFormat);
  5700. rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
  5701. wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
  5702. Padding := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
  5703. //get Memory
  5704. DestMD := FormatDesc.CreateMappingData;
  5705. ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
  5706. GetMem(ImageData, ImageSize);
  5707. if Assigned(SpecialFormat) then begin
  5708. GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
  5709. SourceMD := SpecialFormat.CreateMappingData;
  5710. end;
  5711. //read Data
  5712. try try
  5713. FillChar(ImageData^, ImageSize, $FF);
  5714. TmpData := ImageData;
  5715. if (Info.biHeight > 0) then
  5716. Inc(TmpData, wbLineSize * (Info.biHeight-1));
  5717. for i := 0 to Abs(Info.biHeight)-1 do begin
  5718. if Assigned(SpecialFormat) then
  5719. SpecialFormatReadLine(TmpData, LineBuf) //if is special format read and convert data
  5720. else
  5721. aStream.Read(TmpData^, wbLineSize); //else only read data
  5722. if (Info.biHeight > 0) then
  5723. dec(TmpData, wbLineSize)
  5724. else
  5725. inc(TmpData, wbLineSize);
  5726. aStream.Read(PaddingBuff{%H-}, Padding);
  5727. end;
  5728. SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight));
  5729. result := true;
  5730. finally
  5731. if Assigned(LineBuf) then
  5732. FreeMem(LineBuf);
  5733. if Assigned(SourceMD) then
  5734. SpecialFormat.FreeMappingData(SourceMD);
  5735. FormatDesc.FreeMappingData(DestMD);
  5736. end;
  5737. except
  5738. FreeMem(ImageData);
  5739. raise;
  5740. end;
  5741. end else
  5742. raise EglBitmapException.Create('LoadBMP - No suitable format found');
  5743. except
  5744. aStream.Position := StartPos;
  5745. raise;
  5746. end;
  5747. finally
  5748. FreeAndNil(SpecialFormat);
  5749. end;
  5750. end
  5751. else aStream.Position := StartPos;
  5752. end;
  5753. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5754. procedure TglBitmap.SaveBMP(const aStream: TStream);
  5755. var
  5756. Header: TBMPHeader;
  5757. Info: TBMPInfo;
  5758. Converter: TbmpColorTableFormat;
  5759. FormatDesc: TFormatDescriptor;
  5760. SourceFD, DestFD: Pointer;
  5761. pData, srcData, dstData, ConvertBuffer: pByte;
  5762. Pixel: TglBitmapPixelData;
  5763. ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
  5764. RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
  5765. PaddingBuff: Cardinal;
  5766. function GetLineWidth : Integer;
  5767. begin
  5768. result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
  5769. end;
  5770. begin
  5771. if not (ftBMP in FormatGetSupportedFiles(Format)) then
  5772. raise EglBitmapUnsupportedFormatFormat.Create('SaveBMP - ' + UNSUPPORTED_FORMAT);
  5773. Converter := nil;
  5774. FormatDesc := TFormatDescriptor.Get(Format);
  5775. ImageSize := FormatDesc.GetSize(Dimension);
  5776. FillChar(Header{%H-}, SizeOf(Header), 0);
  5777. Header.bfType := BMP_MAGIC;
  5778. Header.bfSize := SizeOf(Header) + SizeOf(Info) + ImageSize;
  5779. Header.bfReserved1 := 0;
  5780. Header.bfReserved2 := 0;
  5781. Header.bfOffBits := SizeOf(Header) + SizeOf(Info);
  5782. FillChar(Info{%H-}, SizeOf(Info), 0);
  5783. Info.biSize := SizeOf(Info);
  5784. Info.biWidth := Width;
  5785. Info.biHeight := Height;
  5786. Info.biPlanes := 1;
  5787. Info.biCompression := BMP_COMP_RGB;
  5788. Info.biSizeImage := ImageSize;
  5789. try
  5790. case Format of
  5791. tfLuminance4: begin
  5792. Info.biBitCount := 4;
  5793. Header.bfSize := Header.bfSize + 16 * SizeOf(Cardinal);
  5794. Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
  5795. Converter := TbmpColorTableFormat.Create;
  5796. Converter.PixelSize := 0.5;
  5797. Converter.Format := Format;
  5798. Converter.Range := glBitmapColorRec($F, $F, $F, $0);
  5799. Converter.CreateColorTable;
  5800. end;
  5801. tfR3G3B2, tfLuminance8: begin
  5802. Info.biBitCount := 8;
  5803. Header.bfSize := Header.bfSize + 256 * SizeOf(Cardinal);
  5804. Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
  5805. Converter := TbmpColorTableFormat.Create;
  5806. Converter.PixelSize := 1;
  5807. Converter.Format := Format;
  5808. if (Format = tfR3G3B2) then begin
  5809. Converter.Range := glBitmapColorRec($7, $7, $3, $0);
  5810. Converter.Shift := glBitmapShiftRec(0, 3, 6, 0);
  5811. end else
  5812. Converter.Range := glBitmapColorRec($FF, $FF, $FF, $0);
  5813. Converter.CreateColorTable;
  5814. end;
  5815. tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
  5816. tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin
  5817. Info.biBitCount := 16;
  5818. Info.biCompression := BMP_COMP_BITFIELDS;
  5819. end;
  5820. tfBGR8, tfRGB8: begin
  5821. Info.biBitCount := 24;
  5822. end;
  5823. tfRGB10, tfRGB10A2, tfRGBA8,
  5824. tfBGR10, tfBGR10A2, tfBGRA8: begin
  5825. Info.biBitCount := 32;
  5826. Info.biCompression := BMP_COMP_BITFIELDS;
  5827. end;
  5828. else
  5829. raise EglBitmapUnsupportedFormatFormat.Create('SaveBMP - ' + UNSUPPORTED_FORMAT);
  5830. end;
  5831. Info.biXPelsPerMeter := 2835;
  5832. Info.biYPelsPerMeter := 2835;
  5833. // prepare bitmasks
  5834. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  5835. Header.bfSize := Header.bfSize + 4 * SizeOf(Cardinal);
  5836. Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
  5837. RedMask := FormatDesc.RedMask;
  5838. GreenMask := FormatDesc.GreenMask;
  5839. BlueMask := FormatDesc.BlueMask;
  5840. AlphaMask := FormatDesc.AlphaMask;
  5841. end;
  5842. // headers
  5843. aStream.Write(Header, SizeOf(Header));
  5844. aStream.Write(Info, SizeOf(Info));
  5845. // colortable
  5846. if Assigned(Converter) then
  5847. aStream.Write(Converter.ColorTable[0].b,
  5848. SizeOf(TbmpColorTableEnty) * Length(Converter.ColorTable));
  5849. // bitmasks
  5850. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  5851. aStream.Write(RedMask, SizeOf(Cardinal));
  5852. aStream.Write(GreenMask, SizeOf(Cardinal));
  5853. aStream.Write(BlueMask, SizeOf(Cardinal));
  5854. aStream.Write(AlphaMask, SizeOf(Cardinal));
  5855. end;
  5856. // image data
  5857. rbLineSize := Round(Info.biWidth * FormatDesc.PixelSize);
  5858. wbLineSize := Round(Info.biWidth * Info.biBitCount / 8);
  5859. Padding := GetLineWidth - wbLineSize;
  5860. PaddingBuff := 0;
  5861. pData := Data;
  5862. inc(pData, (Height-1) * rbLineSize);
  5863. // prepare row buffer. But only for RGB because RGBA supports color masks
  5864. // so it's possible to change color within the image.
  5865. if Assigned(Converter) then begin
  5866. FormatDesc.PreparePixel(Pixel);
  5867. GetMem(ConvertBuffer, wbLineSize);
  5868. SourceFD := FormatDesc.CreateMappingData;
  5869. DestFD := Converter.CreateMappingData;
  5870. end else
  5871. ConvertBuffer := nil;
  5872. try
  5873. for LineIdx := 0 to Height - 1 do begin
  5874. // preparing row
  5875. if Assigned(Converter) then begin
  5876. srcData := pData;
  5877. dstData := ConvertBuffer;
  5878. for PixelIdx := 0 to Info.biWidth-1 do begin
  5879. FormatDesc.Unmap(srcData, Pixel, SourceFD);
  5880. glBitmapConvertPixel(Pixel, FormatDesc, Converter);
  5881. Converter.Map(Pixel, dstData, DestFD);
  5882. end;
  5883. aStream.Write(ConvertBuffer^, wbLineSize);
  5884. end else begin
  5885. aStream.Write(pData^, rbLineSize);
  5886. end;
  5887. dec(pData, rbLineSize);
  5888. if (Padding > 0) then
  5889. aStream.Write(PaddingBuff, Padding);
  5890. end;
  5891. finally
  5892. // destroy row buffer
  5893. if Assigned(ConvertBuffer) then begin
  5894. FormatDesc.FreeMappingData(SourceFD);
  5895. Converter.FreeMappingData(DestFD);
  5896. FreeMem(ConvertBuffer);
  5897. end;
  5898. end;
  5899. finally
  5900. if Assigned(Converter) then
  5901. Converter.Free;
  5902. end;
  5903. end;
  5904. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5905. //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5906. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5907. type
  5908. TTGAHeader = packed record
  5909. ImageID: Byte;
  5910. ColorMapType: Byte;
  5911. ImageType: Byte;
  5912. //ColorMapSpec: Array[0..4] of Byte;
  5913. ColorMapStart: Word;
  5914. ColorMapLength: Word;
  5915. ColorMapEntrySize: Byte;
  5916. OrigX: Word;
  5917. OrigY: Word;
  5918. Width: Word;
  5919. Height: Word;
  5920. Bpp: Byte;
  5921. ImageDesc: Byte;
  5922. end;
  5923. const
  5924. TGA_UNCOMPRESSED_RGB = 2;
  5925. TGA_UNCOMPRESSED_GRAY = 3;
  5926. TGA_COMPRESSED_RGB = 10;
  5927. TGA_COMPRESSED_GRAY = 11;
  5928. TGA_NONE_COLOR_TABLE = 0;
  5929. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5930. function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
  5931. var
  5932. Header: TTGAHeader;
  5933. ImageData: PByte;
  5934. StartPosition: Int64;
  5935. PixelSize, LineSize: Integer;
  5936. tgaFormat: TglBitmapFormat;
  5937. FormatDesc: TFormatDescriptor;
  5938. Counter: packed record
  5939. X, Y: packed record
  5940. low, high, dir: Integer;
  5941. end;
  5942. end;
  5943. const
  5944. CACHE_SIZE = $4000;
  5945. ////////////////////////////////////////////////////////////////////////////////////////
  5946. procedure ReadUncompressed;
  5947. var
  5948. i, j: Integer;
  5949. buf, tmp1, tmp2: PByte;
  5950. begin
  5951. buf := nil;
  5952. if (Counter.X.dir < 0) then
  5953. buf := GetMem(LineSize);
  5954. try
  5955. while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
  5956. tmp1 := ImageData + (Counter.Y.low * LineSize); //pointer to LineStart
  5957. if (Counter.X.dir < 0) then begin //flip X
  5958. aStream.Read(buf^, LineSize);
  5959. tmp2 := buf + LineSize - PixelSize; //pointer to last pixel in line
  5960. for i := 0 to Header.Width-1 do begin //for all pixels in line
  5961. for j := 0 to PixelSize-1 do begin //for all bytes in pixel
  5962. tmp1^ := tmp2^;
  5963. inc(tmp1);
  5964. inc(tmp2);
  5965. end;
  5966. dec(tmp2, 2*PixelSize); //move 2 backwards, because j-loop moved 1 forward
  5967. end;
  5968. end else
  5969. aStream.Read(tmp1^, LineSize);
  5970. inc(Counter.Y.low, Counter.Y.dir); //move to next line index
  5971. end;
  5972. finally
  5973. if Assigned(buf) then
  5974. FreeMem(buf);
  5975. end;
  5976. end;
  5977. ////////////////////////////////////////////////////////////////////////////////////////
  5978. procedure ReadCompressed;
  5979. /////////////////////////////////////////////////////////////////
  5980. var
  5981. TmpData: PByte;
  5982. LinePixelsRead: Integer;
  5983. procedure CheckLine;
  5984. begin
  5985. if (LinePixelsRead >= Header.Width) then begin
  5986. LinePixelsRead := 0;
  5987. inc(Counter.Y.low, Counter.Y.dir); //next line index
  5988. TmpData := ImageData + Counter.Y.low * LineSize; //set line
  5989. if (Counter.X.dir < 0) then //if x flipped then
  5990. TmpData := TmpData + LineSize - PixelSize; //set last pixel
  5991. end;
  5992. end;
  5993. /////////////////////////////////////////////////////////////////
  5994. var
  5995. Cache: PByte;
  5996. CacheSize, CachePos: Integer;
  5997. procedure CachedRead(out Buffer; Count: Integer);
  5998. var
  5999. BytesRead: Integer;
  6000. begin
  6001. if (CachePos + Count > CacheSize) then begin
  6002. //if buffer overflow save non read bytes
  6003. BytesRead := 0;
  6004. if (CacheSize - CachePos > 0) then begin
  6005. BytesRead := CacheSize - CachePos;
  6006. Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
  6007. inc(CachePos, BytesRead);
  6008. end;
  6009. //load cache from file
  6010. CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
  6011. aStream.Read(Cache^, CacheSize);
  6012. CachePos := 0;
  6013. //read rest of requested bytes
  6014. if (Count - BytesRead > 0) then begin
  6015. Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
  6016. inc(CachePos, Count - BytesRead);
  6017. end;
  6018. end else begin
  6019. //if no buffer overflow just read the data
  6020. Move(PByteArray(Cache)^[CachePos], Buffer, Count);
  6021. inc(CachePos, Count);
  6022. end;
  6023. end;
  6024. procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
  6025. begin
  6026. case PixelSize of
  6027. 1: begin
  6028. aBuffer^ := aData^;
  6029. inc(aBuffer, Counter.X.dir);
  6030. end;
  6031. 2: begin
  6032. PWord(aBuffer)^ := PWord(aData)^;
  6033. inc(aBuffer, 2 * Counter.X.dir);
  6034. end;
  6035. 3: begin
  6036. PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
  6037. PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
  6038. PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
  6039. inc(aBuffer, 3 * Counter.X.dir);
  6040. end;
  6041. 4: begin
  6042. PCardinal(aBuffer)^ := PCardinal(aData)^;
  6043. inc(aBuffer, 4 * Counter.X.dir);
  6044. end;
  6045. end;
  6046. end;
  6047. var
  6048. TotalPixelsToRead, TotalPixelsRead: Integer;
  6049. Temp: Byte;
  6050. buf: array [0..3] of Byte; //1 pixel is max 32bit long
  6051. PixelRepeat: Boolean;
  6052. PixelsToRead, PixelCount: Integer;
  6053. begin
  6054. CacheSize := 0;
  6055. CachePos := 0;
  6056. TotalPixelsToRead := Header.Width * Header.Height;
  6057. TotalPixelsRead := 0;
  6058. LinePixelsRead := 0;
  6059. GetMem(Cache, CACHE_SIZE);
  6060. try
  6061. TmpData := ImageData + Counter.Y.low * LineSize; //set line
  6062. if (Counter.X.dir < 0) then //if x flipped then
  6063. TmpData := TmpData + LineSize - PixelSize; //set last pixel
  6064. repeat
  6065. //read CommandByte
  6066. CachedRead(Temp, 1);
  6067. PixelRepeat := (Temp and $80) > 0;
  6068. PixelsToRead := (Temp and $7F) + 1;
  6069. inc(TotalPixelsRead, PixelsToRead);
  6070. if PixelRepeat then
  6071. CachedRead(buf[0], PixelSize);
  6072. while (PixelsToRead > 0) do begin
  6073. CheckLine;
  6074. PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
  6075. while (PixelCount > 0) do begin
  6076. if not PixelRepeat then
  6077. CachedRead(buf[0], PixelSize);
  6078. PixelToBuffer(@buf[0], TmpData);
  6079. inc(LinePixelsRead);
  6080. dec(PixelsToRead);
  6081. dec(PixelCount);
  6082. end;
  6083. end;
  6084. until (TotalPixelsRead >= TotalPixelsToRead);
  6085. finally
  6086. FreeMem(Cache);
  6087. end;
  6088. end;
  6089. function IsGrayFormat: Boolean;
  6090. begin
  6091. result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
  6092. end;
  6093. begin
  6094. result := false;
  6095. // reading header to test file and set cursor back to begin
  6096. StartPosition := aStream.Position;
  6097. aStream.Read(Header{%H-}, SizeOf(Header));
  6098. // no colormapped files
  6099. if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
  6100. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
  6101. begin
  6102. try
  6103. if Header.ImageID <> 0 then // skip image ID
  6104. aStream.Position := aStream.Position + Header.ImageID;
  6105. case Header.Bpp of
  6106. 8: if IsGrayFormat then case (Header.ImageDesc and $F) of
  6107. 0: tgaFormat := tfLuminance8;
  6108. 8: tgaFormat := tfAlpha8;
  6109. end;
  6110. 16: if IsGrayFormat then case (Header.ImageDesc and $F) of
  6111. 0: tgaFormat := tfLuminance16;
  6112. 8: tgaFormat := tfLuminance8Alpha8;
  6113. end else case (Header.ImageDesc and $F) of
  6114. 0: tgaFormat := tfBGR5;
  6115. 1: tgaFormat := tfBGR5A1;
  6116. 4: tgaFormat := tfBGRA4;
  6117. end;
  6118. 24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  6119. 0: tgaFormat := tfBGR8;
  6120. end;
  6121. 32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  6122. 2: tgaFormat := tfBGR10A2;
  6123. 8: tgaFormat := tfBGRA8;
  6124. end;
  6125. end;
  6126. if (tgaFormat = tfEmpty) then
  6127. raise EglBitmapException.Create('LoadTga - unsupported format');
  6128. FormatDesc := TFormatDescriptor.Get(tgaFormat);
  6129. PixelSize := FormatDesc.GetSize(1, 1);
  6130. LineSize := FormatDesc.GetSize(Header.Width, 1);
  6131. GetMem(ImageData, LineSize * Header.Height);
  6132. try
  6133. //column direction
  6134. if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
  6135. Counter.X.low := Header.Height-1;;
  6136. Counter.X.high := 0;
  6137. Counter.X.dir := -1;
  6138. end else begin
  6139. Counter.X.low := 0;
  6140. Counter.X.high := Header.Height-1;
  6141. Counter.X.dir := 1;
  6142. end;
  6143. // Row direction
  6144. if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
  6145. Counter.Y.low := 0;
  6146. Counter.Y.high := Header.Height-1;
  6147. Counter.Y.dir := 1;
  6148. end else begin
  6149. Counter.Y.low := Header.Height-1;;
  6150. Counter.Y.high := 0;
  6151. Counter.Y.dir := -1;
  6152. end;
  6153. // Read Image
  6154. case Header.ImageType of
  6155. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
  6156. ReadUncompressed;
  6157. TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
  6158. ReadCompressed;
  6159. end;
  6160. SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height);
  6161. result := true;
  6162. except
  6163. FreeMem(ImageData);
  6164. raise;
  6165. end;
  6166. finally
  6167. aStream.Position := StartPosition;
  6168. end;
  6169. end
  6170. else aStream.Position := StartPosition;
  6171. end;
  6172. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6173. procedure TglBitmap.SaveTGA(const aStream: TStream);
  6174. var
  6175. Header: TTGAHeader;
  6176. LineSize, Size, x, y: Integer;
  6177. Pixel: TglBitmapPixelData;
  6178. LineBuf, SourceData, DestData: PByte;
  6179. SourceMD, DestMD: Pointer;
  6180. FormatDesc: TFormatDescriptor;
  6181. Converter: TFormatDescriptor;
  6182. begin
  6183. if not (ftTGA in FormatGetSupportedFiles(Format)) then
  6184. raise EglBitmapUnsupportedFormatFormat.Create('SaveTGA - ' + UNSUPPORTED_FORMAT);
  6185. //prepare header
  6186. FillChar(Header{%H-}, SizeOf(Header), 0);
  6187. //set ImageType
  6188. if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
  6189. tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
  6190. Header.ImageType := TGA_UNCOMPRESSED_GRAY
  6191. else
  6192. Header.ImageType := TGA_UNCOMPRESSED_RGB;
  6193. //set BitsPerPixel
  6194. if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
  6195. Header.Bpp := 8
  6196. else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
  6197. tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
  6198. Header.Bpp := 16
  6199. else if (Format in [tfBGR8, tfRGB8]) then
  6200. Header.Bpp := 24
  6201. else
  6202. Header.Bpp := 32;
  6203. //set AlphaBitCount
  6204. case Format of
  6205. tfRGB5A1, tfBGR5A1:
  6206. Header.ImageDesc := 1 and $F;
  6207. tfRGB10A2, tfBGR10A2:
  6208. Header.ImageDesc := 2 and $F;
  6209. tfRGBA4, tfBGRA4:
  6210. Header.ImageDesc := 4 and $F;
  6211. tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
  6212. Header.ImageDesc := 8 and $F;
  6213. end;
  6214. Header.Width := Width;
  6215. Header.Height := Height;
  6216. Header.ImageDesc := Header.ImageDesc or $20; //flip y
  6217. aStream.Write(Header, SizeOf(Header));
  6218. // convert RGB(A) to BGR(A)
  6219. Converter := nil;
  6220. FormatDesc := TFormatDescriptor.Get(Format);
  6221. Size := FormatDesc.GetSize(Dimension);
  6222. if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
  6223. if (FormatDesc.RGBInverted = tfEmpty) then
  6224. raise EglBitmapException.Create('inverted RGB format is empty');
  6225. Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
  6226. if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
  6227. (Converter.PixelSize <> FormatDesc.PixelSize) then
  6228. raise EglBitmapException.Create('invalid inverted RGB format');
  6229. end;
  6230. if Assigned(Converter) then begin
  6231. LineSize := FormatDesc.GetSize(Width, 1);
  6232. LineBuf := GetMem(LineSize);
  6233. SourceMD := FormatDesc.CreateMappingData;
  6234. DestMD := Converter.CreateMappingData;
  6235. try
  6236. SourceData := Data;
  6237. for y := 0 to Height-1 do begin
  6238. DestData := LineBuf;
  6239. for x := 0 to Width-1 do begin
  6240. FormatDesc.Unmap(SourceData, Pixel, SourceMD);
  6241. Converter.Map(Pixel, DestData, DestMD);
  6242. end;
  6243. aStream.Write(LineBuf^, LineSize);
  6244. end;
  6245. finally
  6246. FreeMem(LineBuf);
  6247. FormatDesc.FreeMappingData(SourceMD);
  6248. FormatDesc.FreeMappingData(DestMD);
  6249. end;
  6250. end else
  6251. aStream.Write(Data^, Size);
  6252. end;
  6253. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6254. //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6255. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6256. const
  6257. DDS_MAGIC: Cardinal = $20534444;
  6258. // DDS_header.dwFlags
  6259. DDSD_CAPS = $00000001;
  6260. DDSD_HEIGHT = $00000002;
  6261. DDSD_WIDTH = $00000004;
  6262. DDSD_PIXELFORMAT = $00001000;
  6263. // DDS_header.sPixelFormat.dwFlags
  6264. DDPF_ALPHAPIXELS = $00000001;
  6265. DDPF_ALPHA = $00000002;
  6266. DDPF_FOURCC = $00000004;
  6267. DDPF_RGB = $00000040;
  6268. DDPF_LUMINANCE = $00020000;
  6269. // DDS_header.sCaps.dwCaps1
  6270. DDSCAPS_TEXTURE = $00001000;
  6271. // DDS_header.sCaps.dwCaps2
  6272. DDSCAPS2_CUBEMAP = $00000200;
  6273. D3DFMT_DXT1 = $31545844;
  6274. D3DFMT_DXT3 = $33545844;
  6275. D3DFMT_DXT5 = $35545844;
  6276. type
  6277. TDDSPixelFormat = packed record
  6278. dwSize: Cardinal;
  6279. dwFlags: Cardinal;
  6280. dwFourCC: Cardinal;
  6281. dwRGBBitCount: Cardinal;
  6282. dwRBitMask: Cardinal;
  6283. dwGBitMask: Cardinal;
  6284. dwBBitMask: Cardinal;
  6285. dwABitMask: Cardinal;
  6286. end;
  6287. TDDSCaps = packed record
  6288. dwCaps1: Cardinal;
  6289. dwCaps2: Cardinal;
  6290. dwDDSX: Cardinal;
  6291. dwReserved: Cardinal;
  6292. end;
  6293. TDDSHeader = packed record
  6294. dwSize: Cardinal;
  6295. dwFlags: Cardinal;
  6296. dwHeight: Cardinal;
  6297. dwWidth: Cardinal;
  6298. dwPitchOrLinearSize: Cardinal;
  6299. dwDepth: Cardinal;
  6300. dwMipMapCount: Cardinal;
  6301. dwReserved: array[0..10] of Cardinal;
  6302. PixelFormat: TDDSPixelFormat;
  6303. Caps: TDDSCaps;
  6304. dwReserved2: Cardinal;
  6305. end;
  6306. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6307. function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
  6308. var
  6309. Header: TDDSHeader;
  6310. Converter: TbmpBitfieldFormat;
  6311. function GetDDSFormat: TglBitmapFormat;
  6312. var
  6313. fd: TFormatDescriptor;
  6314. i: Integer;
  6315. Range: TglBitmapColorRec;
  6316. match: Boolean;
  6317. begin
  6318. result := tfEmpty;
  6319. with Header.PixelFormat do begin
  6320. // Compresses
  6321. if ((dwFlags and DDPF_FOURCC) > 0) then begin
  6322. case Header.PixelFormat.dwFourCC of
  6323. D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
  6324. D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
  6325. D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
  6326. end;
  6327. end else if ((Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin
  6328. //find matching format
  6329. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  6330. fd := TFormatDescriptor.Get(result);
  6331. if fd.MaskMatch(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask) and
  6332. (8 * fd.PixelSize = dwRGBBitCount) then
  6333. exit;
  6334. end;
  6335. //find format with same Range
  6336. Range.r := dwRBitMask;
  6337. Range.g := dwGBitMask;
  6338. Range.b := dwBBitMask;
  6339. Range.a := dwABitMask;
  6340. for i := 0 to 3 do begin
  6341. while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do
  6342. Range.arr[i] := Range.arr[i] shr 1;
  6343. end;
  6344. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  6345. fd := TFormatDescriptor.Get(result);
  6346. match := true;
  6347. for i := 0 to 3 do
  6348. if (fd.Range.arr[i] <> Range.arr[i]) then begin
  6349. match := false;
  6350. break;
  6351. end;
  6352. if match then
  6353. break;
  6354. end;
  6355. //no format with same range found -> use default
  6356. if (result = tfEmpty) then begin
  6357. if (dwABitMask > 0) then
  6358. result := tfBGRA8
  6359. else
  6360. result := tfBGR8;
  6361. end;
  6362. Converter := TbmpBitfieldFormat.Create;
  6363. Converter.RedMask := dwRBitMask;
  6364. Converter.GreenMask := dwGBitMask;
  6365. Converter.BlueMask := dwBBitMask;
  6366. Converter.AlphaMask := dwABitMask;
  6367. Converter.PixelSize := dwRGBBitCount / 8;
  6368. end;
  6369. end;
  6370. end;
  6371. var
  6372. StreamPos: Int64;
  6373. x, y, LineSize, RowSize, Magic: Cardinal;
  6374. NewImage, TmpData, RowData, SrcData: PByte;
  6375. SourceMD, DestMD: Pointer;
  6376. Pixel: TglBitmapPixelData;
  6377. ddsFormat: TglBitmapFormat;
  6378. FormatDesc: TFormatDescriptor;
  6379. begin
  6380. result := false;
  6381. Converter := nil;
  6382. StreamPos := aStream.Position;
  6383. // Magic
  6384. aStream.Read(Magic{%H-}, sizeof(Magic));
  6385. if (Magic <> DDS_MAGIC) then begin
  6386. aStream.Position := StreamPos;
  6387. exit;
  6388. end;
  6389. //Header
  6390. aStream.Read(Header{%H-}, sizeof(Header));
  6391. if (Header.dwSize <> SizeOf(Header)) or
  6392. ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
  6393. (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
  6394. begin
  6395. aStream.Position := StreamPos;
  6396. exit;
  6397. end;
  6398. if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
  6399. raise EglBitmapException.Create('LoadDDS - CubeMaps are not supported');
  6400. ddsFormat := GetDDSFormat;
  6401. try
  6402. if (ddsFormat = tfEmpty) then
  6403. raise EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');
  6404. FormatDesc := TFormatDescriptor.Get(ddsFormat);
  6405. LineSize := Trunc(Header.dwWidth * FormatDesc.PixelSize);
  6406. GetMem(NewImage, Header.dwHeight * LineSize);
  6407. try
  6408. TmpData := NewImage;
  6409. //Converter needed
  6410. if Assigned(Converter) then begin
  6411. RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
  6412. GetMem(RowData, RowSize);
  6413. SourceMD := Converter.CreateMappingData;
  6414. DestMD := FormatDesc.CreateMappingData;
  6415. try
  6416. for y := 0 to Header.dwHeight-1 do begin
  6417. TmpData := NewImage + y * LineSize;
  6418. SrcData := RowData;
  6419. aStream.Read(SrcData^, RowSize);
  6420. for x := 0 to Header.dwWidth-1 do begin
  6421. Converter.Unmap(SrcData, Pixel, SourceMD);
  6422. glBitmapConvertPixel(Pixel, Converter, FormatDesc);
  6423. FormatDesc.Map(Pixel, TmpData, DestMD);
  6424. end;
  6425. end;
  6426. finally
  6427. Converter.FreeMappingData(SourceMD);
  6428. FormatDesc.FreeMappingData(DestMD);
  6429. FreeMem(RowData);
  6430. end;
  6431. end else
  6432. // Compressed
  6433. if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
  6434. RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
  6435. for Y := 0 to Header.dwHeight-1 do begin
  6436. aStream.Read(TmpData^, RowSize);
  6437. Inc(TmpData, LineSize);
  6438. end;
  6439. end else
  6440. // Uncompressed
  6441. if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
  6442. RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
  6443. for Y := 0 to Header.dwHeight-1 do begin
  6444. aStream.Read(TmpData^, RowSize);
  6445. Inc(TmpData, LineSize);
  6446. end;
  6447. end else
  6448. raise EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');
  6449. SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight);
  6450. result := true;
  6451. except
  6452. FreeMem(NewImage);
  6453. raise;
  6454. end;
  6455. finally
  6456. FreeAndNil(Converter);
  6457. end;
  6458. end;
  6459. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6460. procedure TglBitmap.SaveDDS(const aStream: TStream);
  6461. var
  6462. Header: TDDSHeader;
  6463. FormatDesc: TFormatDescriptor;
  6464. begin
  6465. if not (ftDDS in FormatGetSupportedFiles(Format)) then
  6466. raise EglBitmapUnsupportedFormatFormat.Create('SaveDDS - ' + UNSUPPORTED_FORMAT);
  6467. FormatDesc := TFormatDescriptor.Get(Format);
  6468. // Generell
  6469. FillChar(Header{%H-}, SizeOf(Header), 0);
  6470. Header.dwSize := SizeOf(Header);
  6471. Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
  6472. Header.dwWidth := Max(1, Width);
  6473. Header.dwHeight := Max(1, Height);
  6474. // Caps
  6475. Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
  6476. // Pixelformat
  6477. Header.PixelFormat.dwSize := sizeof(Header);
  6478. if (FormatDesc.IsCompressed) then begin
  6479. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
  6480. case Format of
  6481. tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
  6482. tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
  6483. tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
  6484. end;
  6485. end else if (Format in [tfAlpha8, tfAlpha16]) then begin
  6486. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHA;
  6487. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6488. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6489. end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
  6490. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
  6491. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6492. Header.PixelFormat.dwRBitMask := FormatDesc.RedMask;
  6493. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6494. end else begin
  6495. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
  6496. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6497. Header.PixelFormat.dwRBitMask := FormatDesc.RedMask;
  6498. Header.PixelFormat.dwGBitMask := FormatDesc.GreenMask;
  6499. Header.PixelFormat.dwBBitMask := FormatDesc.BlueMask;
  6500. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6501. end;
  6502. if (FormatDesc.HasAlpha) then
  6503. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
  6504. aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
  6505. aStream.Write(Header, SizeOf(Header));
  6506. aStream.Write(Data^, FormatDesc.GetSize(Dimension));
  6507. end;
  6508. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6509. //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6510. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6511. function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
  6512. begin
  6513. if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
  6514. result := fLines[aIndex]
  6515. else
  6516. result := nil;
  6517. end;
  6518. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6519. procedure TglBitmap2D.SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
  6520. const aWidth: Integer; const aHeight: Integer);
  6521. var
  6522. Idx, LineWidth: Integer;
  6523. begin
  6524. inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
  6525. if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
  6526. (* TODO PixelFuncs
  6527. fGetPixelFunc := GetPixel2DUnmap;
  6528. fSetPixelFunc := SetPixel2DUnmap;
  6529. *)
  6530. // Assigning Data
  6531. if Assigned(Data) then begin
  6532. SetLength(fLines, GetHeight);
  6533. LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
  6534. for Idx := 0 to GetHeight -1 do begin
  6535. fLines[Idx] := Data;
  6536. Inc(fLines[Idx], Idx * LineWidth);
  6537. end;
  6538. end
  6539. else SetLength(fLines, 0);
  6540. end else begin
  6541. SetLength(fLines, 0);
  6542. (*
  6543. fSetPixelFunc := nil;
  6544. case Format of
  6545. ifDXT1:
  6546. fGetPixelFunc := GetPixel2DDXT1;
  6547. ifDXT3:
  6548. fGetPixelFunc := GetPixel2DDXT3;
  6549. ifDXT5:
  6550. fGetPixelFunc := GetPixel2DDXT5;
  6551. else
  6552. fGetPixelFunc := nil;
  6553. end;
  6554. *)
  6555. end;
  6556. end;
  6557. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6558. procedure TglBitmap2D.UploadData(const aTarget: Cardinal; const aBuildWithGlu: Boolean);
  6559. var
  6560. FormatDesc: TFormatDescriptor;
  6561. begin
  6562. glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
  6563. FormatDesc := TFormatDescriptor.Get(Format);
  6564. if FormatDesc.IsCompressed then begin
  6565. glCompressedTexImage2D(Target, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
  6566. end else if aBuildWithGlu then begin
  6567. gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
  6568. FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  6569. end else begin
  6570. glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
  6571. FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  6572. end;
  6573. // Freigeben
  6574. if (FreeDataAfterGenTexture) then
  6575. FreeData;
  6576. end;
  6577. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6578. procedure TglBitmap2D.AfterConstruction;
  6579. begin
  6580. inherited;
  6581. Target := GL_TEXTURE_2D;
  6582. end;
  6583. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6584. procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  6585. var
  6586. Temp: pByte;
  6587. Size, w, h: Integer;
  6588. FormatDesc: TFormatDescriptor;
  6589. begin
  6590. FormatDesc := TFormatDescriptor.Get(Format);
  6591. if FormatDesc.IsCompressed then
  6592. raise EglBitmapUnsupportedFormatFormat.Create('TglBitmap2D.GrabScreen - ' + UNSUPPORTED_FORMAT);
  6593. w := aRight - aLeft;
  6594. h := aBottom - aTop;
  6595. Size := FormatDesc.GetSize(w, h);
  6596. GetMem(Temp, Size);
  6597. try
  6598. glPixelStorei(GL_PACK_ALIGNMENT, 1);
  6599. glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  6600. SetDataPointer(Temp, Format, w, h);
  6601. FlipVert;
  6602. except
  6603. FreeMem(Temp);
  6604. raise;
  6605. end;
  6606. end;
  6607. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6608. procedure TglBitmap2D.GetDataFromTexture;
  6609. var
  6610. Temp: PByte;
  6611. TempWidth, TempHeight: Integer;
  6612. TempIntFormat: Cardinal;
  6613. IntFormat, f: TglBitmapFormat;
  6614. FormatDesc: TFormatDescriptor;
  6615. begin
  6616. Bind;
  6617. // Request Data
  6618. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH, @TempWidth);
  6619. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT, @TempHeight);
  6620. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
  6621. IntFormat := tfEmpty;
  6622. for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
  6623. FormatDesc := TFormatDescriptor.Get(f);
  6624. if (FormatDesc.glInternalFormat = TempIntFormat) then begin
  6625. IntFormat := FormatDesc.Format;
  6626. break;
  6627. end;
  6628. end;
  6629. // Getting data from OpenGL
  6630. FormatDesc := TFormatDescriptor.Get(IntFormat);
  6631. GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
  6632. try
  6633. if FormatDesc.IsCompressed then
  6634. glGetCompressedTexImage(Target, 0, Temp)
  6635. else
  6636. glGetTexImage(Target, 0, FormatDesc.glInternalFormat, FormatDesc.glDataFormat, Temp);
  6637. SetDataPointer(Temp, IntFormat, TempWidth, TempHeight);
  6638. except
  6639. FreeMem(Temp);
  6640. raise;
  6641. end;
  6642. end;
  6643. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6644. procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
  6645. var
  6646. BuildWithGlu, PotTex, TexRec: Boolean;
  6647. TexSize: Integer;
  6648. begin
  6649. if Assigned(Data) then begin
  6650. // Check Texture Size
  6651. if (aTestTextureSize) then begin
  6652. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  6653. if ((Height > TexSize) or (Width > TexSize)) then
  6654. raise EglBitmapSizeToLargeException.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  6655. PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
  6656. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
  6657. if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  6658. raise EglBitmapNonPowerOfTwoException.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  6659. end;
  6660. CreateId;
  6661. SetupParameters(BuildWithGlu);
  6662. UploadData(Target, BuildWithGlu);
  6663. glAreTexturesResident(1, @fID, @fIsResident);
  6664. end;
  6665. end;
  6666. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6667. function TglBitmap2D.FlipHorz: Boolean;
  6668. var
  6669. Col, Row: Integer;
  6670. TempDestData, DestData, SourceData: PByte;
  6671. ImgSize: Integer;
  6672. begin
  6673. result := inherited FlipHorz;
  6674. if Assigned(Data) then begin
  6675. SourceData := Data;
  6676. ImgSize := Height * fRowSize;
  6677. GetMem(DestData, ImgSize);
  6678. try
  6679. TempDestData := DestData;
  6680. Dec(TempDestData, fRowSize + fPixelSize);
  6681. for Row := 0 to Height -1 do begin
  6682. Inc(TempDestData, fRowSize * 2);
  6683. for Col := 0 to Width -1 do begin
  6684. Move(SourceData^, TempDestData^, fPixelSize);
  6685. Inc(SourceData, fPixelSize);
  6686. Dec(TempDestData, fPixelSize);
  6687. end;
  6688. end;
  6689. SetDataPointer(DestData, Format);
  6690. result := true;
  6691. except
  6692. FreeMem(DestData);
  6693. raise;
  6694. end;
  6695. end;
  6696. end;
  6697. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6698. function TglBitmap2D.FlipVert: Boolean;
  6699. var
  6700. Row: Integer;
  6701. TempDestData, DestData, SourceData: PByte;
  6702. begin
  6703. result := inherited FlipVert;
  6704. if Assigned(Data) then begin
  6705. SourceData := Data;
  6706. GetMem(DestData, Height * fRowSize);
  6707. try
  6708. TempDestData := DestData;
  6709. Inc(TempDestData, Width * (Height -1) * fPixelSize);
  6710. for Row := 0 to Height -1 do begin
  6711. Move(SourceData^, TempDestData^, fRowSize);
  6712. Dec(TempDestData, fRowSize);
  6713. Inc(SourceData, fRowSize);
  6714. end;
  6715. SetDataPointer(DestData, Format);
  6716. result := true;
  6717. except
  6718. FreeMem(DestData);
  6719. raise;
  6720. end;
  6721. end;
  6722. end;
  6723. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6724. //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6725. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6726. type
  6727. TMatrixItem = record
  6728. X, Y: Integer;
  6729. W: Single;
  6730. end;
  6731. PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
  6732. TglBitmapToNormalMapRec = Record
  6733. Scale: Single;
  6734. Heights: array of Single;
  6735. MatrixU : array of TMatrixItem;
  6736. MatrixV : array of TMatrixItem;
  6737. end;
  6738. const
  6739. ONE_OVER_255 = 1 / 255;
  6740. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6741. procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
  6742. var
  6743. Val: Single;
  6744. begin
  6745. with FuncRec do begin
  6746. Val :=
  6747. Source.Data.r * LUMINANCE_WEIGHT_R +
  6748. Source.Data.g * LUMINANCE_WEIGHT_G +
  6749. Source.Data.b * LUMINANCE_WEIGHT_B;
  6750. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
  6751. end;
  6752. end;
  6753. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6754. procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  6755. begin
  6756. with FuncRec do
  6757. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
  6758. end;
  6759. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6760. procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
  6761. type
  6762. TVec = Array[0..2] of Single;
  6763. var
  6764. Idx: Integer;
  6765. du, dv: Double;
  6766. Len: Single;
  6767. Vec: TVec;
  6768. function GetHeight(X, Y: Integer): Single;
  6769. begin
  6770. with FuncRec do begin
  6771. X := Max(0, Min(Size.X -1, X));
  6772. Y := Max(0, Min(Size.Y -1, Y));
  6773. result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
  6774. end;
  6775. end;
  6776. begin
  6777. with FuncRec do begin
  6778. with PglBitmapToNormalMapRec(Args)^ do begin
  6779. du := 0;
  6780. for Idx := Low(MatrixU) to High(MatrixU) do
  6781. du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
  6782. dv := 0;
  6783. for Idx := Low(MatrixU) to High(MatrixU) do
  6784. dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
  6785. Vec[0] := -du * Scale;
  6786. Vec[1] := -dv * Scale;
  6787. Vec[2] := 1;
  6788. end;
  6789. // Normalize
  6790. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  6791. if Len <> 0 then begin
  6792. Vec[0] := Vec[0] * Len;
  6793. Vec[1] := Vec[1] * Len;
  6794. Vec[2] := Vec[2] * Len;
  6795. end;
  6796. // Farbe zuweisem
  6797. Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
  6798. Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
  6799. Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
  6800. end;
  6801. end;
  6802. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6803. procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
  6804. var
  6805. Rec: TglBitmapToNormalMapRec;
  6806. procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
  6807. begin
  6808. if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
  6809. Matrix[Index].X := X;
  6810. Matrix[Index].Y := Y;
  6811. Matrix[Index].W := W;
  6812. end;
  6813. end;
  6814. begin
  6815. (* TODO Compression
  6816. if not FormatIsUncompressed(InternalFormat) then
  6817. raise EglBitmapUnsupportedFormatFormat.Create('TglBitmap2D.ToNormalMap - ' + UNSUPPORTED_FORMAT);
  6818. *)
  6819. if aScale > 100 then
  6820. Rec.Scale := 100
  6821. else if aScale < -100 then
  6822. Rec.Scale := -100
  6823. else
  6824. Rec.Scale := aScale;
  6825. SetLength(Rec.Heights, Width * Height);
  6826. try
  6827. case aFunc of
  6828. nm4Samples: begin
  6829. SetLength(Rec.MatrixU, 2);
  6830. SetEntry(Rec.MatrixU, 0, -1, 0, -0.5);
  6831. SetEntry(Rec.MatrixU, 1, 1, 0, 0.5);
  6832. SetLength(Rec.MatrixV, 2);
  6833. SetEntry(Rec.MatrixV, 0, 0, 1, 0.5);
  6834. SetEntry(Rec.MatrixV, 1, 0, -1, -0.5);
  6835. end;
  6836. nmSobel: begin
  6837. SetLength(Rec.MatrixU, 6);
  6838. SetEntry(Rec.MatrixU, 0, -1, 1, -1.0);
  6839. SetEntry(Rec.MatrixU, 1, -1, 0, -2.0);
  6840. SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
  6841. SetEntry(Rec.MatrixU, 3, 1, 1, 1.0);
  6842. SetEntry(Rec.MatrixU, 4, 1, 0, 2.0);
  6843. SetEntry(Rec.MatrixU, 5, 1, -1, 1.0);
  6844. SetLength(Rec.MatrixV, 6);
  6845. SetEntry(Rec.MatrixV, 0, -1, 1, 1.0);
  6846. SetEntry(Rec.MatrixV, 1, 0, 1, 2.0);
  6847. SetEntry(Rec.MatrixV, 2, 1, 1, 1.0);
  6848. SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
  6849. SetEntry(Rec.MatrixV, 4, 0, -1, -2.0);
  6850. SetEntry(Rec.MatrixV, 5, 1, -1, -1.0);
  6851. end;
  6852. nm3x3: begin
  6853. SetLength(Rec.MatrixU, 6);
  6854. SetEntry(Rec.MatrixU, 0, -1, 1, -1/6);
  6855. SetEntry(Rec.MatrixU, 1, -1, 0, -1/6);
  6856. SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
  6857. SetEntry(Rec.MatrixU, 3, 1, 1, 1/6);
  6858. SetEntry(Rec.MatrixU, 4, 1, 0, 1/6);
  6859. SetEntry(Rec.MatrixU, 5, 1, -1, 1/6);
  6860. SetLength(Rec.MatrixV, 6);
  6861. SetEntry(Rec.MatrixV, 0, -1, 1, 1/6);
  6862. SetEntry(Rec.MatrixV, 1, 0, 1, 1/6);
  6863. SetEntry(Rec.MatrixV, 2, 1, 1, 1/6);
  6864. SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
  6865. SetEntry(Rec.MatrixV, 4, 0, -1, -1/6);
  6866. SetEntry(Rec.MatrixV, 5, 1, -1, -1/6);
  6867. end;
  6868. nm5x5: begin
  6869. SetLength(Rec.MatrixU, 20);
  6870. SetEntry(Rec.MatrixU, 0, -2, 2, -1 / 16);
  6871. SetEntry(Rec.MatrixU, 1, -1, 2, -1 / 10);
  6872. SetEntry(Rec.MatrixU, 2, 1, 2, 1 / 10);
  6873. SetEntry(Rec.MatrixU, 3, 2, 2, 1 / 16);
  6874. SetEntry(Rec.MatrixU, 4, -2, 1, -1 / 10);
  6875. SetEntry(Rec.MatrixU, 5, -1, 1, -1 / 8);
  6876. SetEntry(Rec.MatrixU, 6, 1, 1, 1 / 8);
  6877. SetEntry(Rec.MatrixU, 7, 2, 1, 1 / 10);
  6878. SetEntry(Rec.MatrixU, 8, -2, 0, -1 / 2.8);
  6879. SetEntry(Rec.MatrixU, 9, -1, 0, -0.5);
  6880. SetEntry(Rec.MatrixU, 10, 1, 0, 0.5);
  6881. SetEntry(Rec.MatrixU, 11, 2, 0, 1 / 2.8);
  6882. SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
  6883. SetEntry(Rec.MatrixU, 13, -1, -1, -1 / 8);
  6884. SetEntry(Rec.MatrixU, 14, 1, -1, 1 / 8);
  6885. SetEntry(Rec.MatrixU, 15, 2, -1, 1 / 10);
  6886. SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
  6887. SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
  6888. SetEntry(Rec.MatrixU, 18, 1, -2, 1 / 10);
  6889. SetEntry(Rec.MatrixU, 19, 2, -2, 1 / 16);
  6890. SetLength(Rec.MatrixV, 20);
  6891. SetEntry(Rec.MatrixV, 0, -2, 2, 1 / 16);
  6892. SetEntry(Rec.MatrixV, 1, -1, 2, 1 / 10);
  6893. SetEntry(Rec.MatrixV, 2, 0, 2, 0.25);
  6894. SetEntry(Rec.MatrixV, 3, 1, 2, 1 / 10);
  6895. SetEntry(Rec.MatrixV, 4, 2, 2, 1 / 16);
  6896. SetEntry(Rec.MatrixV, 5, -2, 1, 1 / 10);
  6897. SetEntry(Rec.MatrixV, 6, -1, 1, 1 / 8);
  6898. SetEntry(Rec.MatrixV, 7, 0, 1, 0.5);
  6899. SetEntry(Rec.MatrixV, 8, 1, 1, 1 / 8);
  6900. SetEntry(Rec.MatrixV, 9, 2, 1, 1 / 16);
  6901. SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
  6902. SetEntry(Rec.MatrixV, 11, -1, -1, -1 / 8);
  6903. SetEntry(Rec.MatrixV, 12, 0, -1, -0.5);
  6904. SetEntry(Rec.MatrixV, 13, 1, -1, -1 / 8);
  6905. SetEntry(Rec.MatrixV, 14, 2, -1, -1 / 10);
  6906. SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
  6907. SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
  6908. SetEntry(Rec.MatrixV, 17, 0, -2, -0.25);
  6909. SetEntry(Rec.MatrixV, 18, 1, -2, -1 / 10);
  6910. SetEntry(Rec.MatrixV, 19, 2, -2, -1 / 16);
  6911. end;
  6912. end;
  6913. // Daten Sammeln
  6914. if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
  6915. AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
  6916. else
  6917. AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
  6918. AddFunc(glBitmapToNormalMapFunc, false, @Rec);
  6919. finally
  6920. SetLength(Rec.Heights, 0);
  6921. end;
  6922. end;
  6923. (*
  6924. procedure TglBitmap1D.SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width, Height: Integer);
  6925. var
  6926. pTemp: pByte;
  6927. Size: Integer;
  6928. begin
  6929. if Height > 1 then begin
  6930. // extract first line of the data
  6931. Size := FormatGetImageSize(glBitmapPosition(Width), Format);
  6932. GetMem(pTemp, Size);
  6933. Move(Data^, pTemp^, Size);
  6934. FreeMem(Data);
  6935. end else
  6936. pTemp := Data;
  6937. // set data pointer
  6938. inherited SetDataPointer(pTemp, Format, Width);
  6939. if FormatIsUncompressed(Format) then begin
  6940. fUnmapFunc := FormatGetUnMapFunc(Format);
  6941. fGetPixelFunc := GetPixel1DUnmap;
  6942. end;
  6943. end;
  6944. procedure TglBitmap1D.GetPixel1DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
  6945. var
  6946. pTemp: pByte;
  6947. begin
  6948. pTemp := Data;
  6949. Inc(pTemp, Pos.X * fPixelSize);
  6950. fUnmapFunc(pTemp, Pixel);
  6951. end;
  6952. function TglBitmap1D.FlipHorz: Boolean;
  6953. var
  6954. Col: Integer;
  6955. pTempDest, pDest, pSource: pByte;
  6956. begin
  6957. result := inherited FlipHorz;
  6958. if Assigned(Data) and FormatIsUncompressed(InternalFormat) then begin
  6959. pSource := Data;
  6960. GetMem(pDest, fRowSize);
  6961. try
  6962. pTempDest := pDest;
  6963. Inc(pTempDest, fRowSize);
  6964. for Col := 0 to Width -1 do begin
  6965. Move(pSource^, pTempDest^, fPixelSize);
  6966. Inc(pSource, fPixelSize);
  6967. Dec(pTempDest, fPixelSize);
  6968. end;
  6969. SetDataPointer(pDest, InternalFormat);
  6970. result := true;
  6971. finally
  6972. FreeMem(pDest);
  6973. end;
  6974. end;
  6975. end;
  6976. procedure TglBitmap1D.UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
  6977. begin
  6978. // Upload data
  6979. if Self.InternalFormat in [ifDXT1, ifDXT3, ifDXT5] then
  6980. glCompressedTexImage1D(Target, 0, InternalFormat, Width, 0, Trunc(Width * FormatGetSize(Self.InternalFormat)), Data)
  6981. else
  6982. // Upload data
  6983. if BuildWithGlu then
  6984. gluBuild1DMipmaps(Target, InternalFormat, Width, Format, Typ, Data)
  6985. else
  6986. glTexImage1D(Target, 0, InternalFormat, Width, 0, Format, Typ, Data);
  6987. // Freigeben
  6988. if (FreeDataAfterGenTexture) then
  6989. FreeData;
  6990. end;
  6991. procedure TglBitmap1D.GenTexture(TestTextureSize: Boolean);
  6992. var
  6993. BuildWithGlu, TexRec: Boolean;
  6994. glFormat, glInternalFormat, glType: Cardinal;
  6995. TexSize: Integer;
  6996. begin
  6997. if Assigned(Data) then begin
  6998. // Check Texture Size
  6999. if (TestTextureSize) then begin
  7000. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  7001. if (Width > TexSize) then
  7002. raise EglBitmapSizeToLargeException.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  7003. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
  7004. (Target = GL_TEXTURE_RECTANGLE_ARB);
  7005. if not (IsPowerOfTwo (Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  7006. raise EglBitmapNonPowerOfTwoException.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7007. end;
  7008. CreateId;
  7009. SetupParameters(BuildWithGlu);
  7010. SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
  7011. UploadData(Target, glFormat, glInternalFormat, glType, BuildWithGlu);
  7012. // Infos sammeln
  7013. glAreTexturesResident(1, @fID, @fIsResident);
  7014. end;
  7015. end;
  7016. procedure TglBitmap1D.AfterConstruction;
  7017. begin
  7018. inherited;
  7019. Target := GL_TEXTURE_1D;
  7020. end;
  7021. { TglBitmapCubeMap }
  7022. procedure TglBitmapCubeMap.AfterConstruction;
  7023. begin
  7024. inherited;
  7025. if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
  7026. raise EglBitmapException.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
  7027. SetWrap; // set all to GL_CLAMP_TO_EDGE
  7028. Target := GL_TEXTURE_CUBE_MAP;
  7029. fGenMode := GL_REFLECTION_MAP;
  7030. end;
  7031. procedure TglBitmapCubeMap.Bind(EnableTexCoordsGen, EnableTextureUnit: Boolean);
  7032. begin
  7033. inherited Bind (EnableTextureUnit);
  7034. if EnableTexCoordsGen then begin
  7035. glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
  7036. glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
  7037. glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
  7038. glEnable(GL_TEXTURE_GEN_S);
  7039. glEnable(GL_TEXTURE_GEN_T);
  7040. glEnable(GL_TEXTURE_GEN_R);
  7041. end;
  7042. end;
  7043. procedure TglBitmapCubeMap.GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean);
  7044. var
  7045. glFormat, glInternalFormat, glType: Cardinal;
  7046. BuildWithGlu: Boolean;
  7047. TexSize: Integer;
  7048. begin
  7049. // Check Texture Size
  7050. if (TestTextureSize) then begin
  7051. glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
  7052. if ((Height > TexSize) or (Width > TexSize)) then
  7053. raise EglBitmapSizeToLargeException.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
  7054. if not ((IsPowerOfTwo (Height) and IsPowerOfTwo (Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
  7055. raise EglBitmapNonPowerOfTwoException.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
  7056. end;
  7057. // create Texture
  7058. if ID = 0 then begin
  7059. CreateID;
  7060. SetupParameters(BuildWithGlu);
  7061. end;
  7062. SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
  7063. UploadData (CubeTarget, glFormat, glInternalFormat, glType, BuildWithGlu);
  7064. end;
  7065. procedure TglBitmapCubeMap.GenTexture(TestTextureSize: Boolean);
  7066. begin
  7067. Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
  7068. end;
  7069. procedure TglBitmapCubeMap.Unbind(DisableTexCoordsGen,
  7070. DisableTextureUnit: Boolean);
  7071. begin
  7072. inherited Unbind (DisableTextureUnit);
  7073. if DisableTexCoordsGen then begin
  7074. glDisable(GL_TEXTURE_GEN_S);
  7075. glDisable(GL_TEXTURE_GEN_T);
  7076. glDisable(GL_TEXTURE_GEN_R);
  7077. end;
  7078. end;
  7079. { TglBitmapNormalMap }
  7080. type
  7081. TVec = Array[0..2] of Single;
  7082. TglBitmapNormalMapGetVectorFunc = procedure (var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  7083. PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
  7084. TglBitmapNormalMapRec = record
  7085. HalfSize : Integer;
  7086. Func: TglBitmapNormalMapGetVectorFunc;
  7087. end;
  7088. procedure glBitmapNormalMapPosX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  7089. begin
  7090. Vec[0] := HalfSize;
  7091. Vec[1] := - (Position.Y + 0.5 - HalfSize);
  7092. Vec[2] := - (Position.X + 0.5 - HalfSize);
  7093. end;
  7094. procedure glBitmapNormalMapNegX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  7095. begin
  7096. Vec[0] := - HalfSize;
  7097. Vec[1] := - (Position.Y + 0.5 - HalfSize);
  7098. Vec[2] := Position.X + 0.5 - HalfSize;
  7099. end;
  7100. procedure glBitmapNormalMapPosY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  7101. begin
  7102. Vec[0] := Position.X + 0.5 - HalfSize;
  7103. Vec[1] := HalfSize;
  7104. Vec[2] := Position.Y + 0.5 - HalfSize;
  7105. end;
  7106. procedure glBitmapNormalMapNegY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  7107. begin
  7108. Vec[0] := Position.X + 0.5 - HalfSize;
  7109. Vec[1] := - HalfSize;
  7110. Vec[2] := - (Position.Y + 0.5 - HalfSize);
  7111. end;
  7112. procedure glBitmapNormalMapPosZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  7113. begin
  7114. Vec[0] := Position.X + 0.5 - HalfSize;
  7115. Vec[1] := - (Position.Y + 0.5 - HalfSize);
  7116. Vec[2] := HalfSize;
  7117. end;
  7118. procedure glBitmapNormalMapNegZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  7119. begin
  7120. Vec[0] := - (Position.X + 0.5 - HalfSize);
  7121. Vec[1] := - (Position.Y + 0.5 - HalfSize);
  7122. Vec[2] := - HalfSize;
  7123. end;
  7124. procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
  7125. var
  7126. Vec : TVec;
  7127. Len: Single;
  7128. begin
  7129. with FuncRec do begin
  7130. with PglBitmapNormalMapRec (CustomData)^ do begin
  7131. Func(Vec, Position, HalfSize);
  7132. // Normalize
  7133. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  7134. if Len <> 0 then begin
  7135. Vec[0] := Vec[0] * Len;
  7136. Vec[1] := Vec[1] * Len;
  7137. Vec[2] := Vec[2] * Len;
  7138. end;
  7139. // Scale Vector and AddVectro
  7140. Vec[0] := Vec[0] * 0.5 + 0.5;
  7141. Vec[1] := Vec[1] * 0.5 + 0.5;
  7142. Vec[2] := Vec[2] * 0.5 + 0.5;
  7143. end;
  7144. // Set Color
  7145. Dest.Red := Round(Vec[0] * 255);
  7146. Dest.Green := Round(Vec[1] * 255);
  7147. Dest.Blue := Round(Vec[2] * 255);
  7148. end;
  7149. end;
  7150. procedure TglBitmapNormalMap.AfterConstruction;
  7151. begin
  7152. inherited;
  7153. fGenMode := GL_NORMAL_MAP;
  7154. end;
  7155. procedure TglBitmapNormalMap.GenerateNormalMap(Size: Integer;
  7156. TestTextureSize: Boolean);
  7157. var
  7158. Rec: TglBitmapNormalMapRec;
  7159. SizeRec: TglBitmapPixelPosition;
  7160. begin
  7161. Rec.HalfSize := Size div 2;
  7162. FreeDataAfterGenTexture := false;
  7163. SizeRec.Fields := [ffX, ffY];
  7164. SizeRec.X := Size;
  7165. SizeRec.Y := Size;
  7166. // Positive X
  7167. Rec.Func := glBitmapNormalMapPosX;
  7168. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  7169. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, TestTextureSize);
  7170. // Negative X
  7171. Rec.Func := glBitmapNormalMapNegX;
  7172. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  7173. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, TestTextureSize);
  7174. // Positive Y
  7175. Rec.Func := glBitmapNormalMapPosY;
  7176. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  7177. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, TestTextureSize);
  7178. // Negative Y
  7179. Rec.Func := glBitmapNormalMapNegY;
  7180. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  7181. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, TestTextureSize);
  7182. // Positive Z
  7183. Rec.Func := glBitmapNormalMapPosZ;
  7184. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  7185. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, TestTextureSize);
  7186. // Negative Z
  7187. Rec.Func := glBitmapNormalMapNegZ;
  7188. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  7189. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, TestTextureSize);
  7190. end;
  7191. *)
  7192. initialization
  7193. glBitmapSetDefaultFormat(tfEmpty);
  7194. glBitmapSetDefaultMipmap(mmMipmap);
  7195. glBitmapSetDefaultFilter(GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
  7196. glBitmapSetDefaultWrap (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
  7197. glBitmapSetDefaultFreeDataAfterGenTexture(true);
  7198. glBitmapSetDefaultDeleteTextureOnFree (true);
  7199. TFormatDescriptor.Init;
  7200. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  7201. OpenGLInitialized := false;
  7202. InitOpenGLCS := TCriticalSection.Create;
  7203. {$ENDIF}
  7204. finalization
  7205. TFormatDescriptor.Finalize;
  7206. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  7207. FreeAndNil(InitOpenGLCS);
  7208. {$ENDIF}
  7209. end.