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

8068 lines
266 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. // ###### Start of preferences ################################################
  220. {$DEFINE GLB_NO_NATIVE_GL}
  221. // To enable the dglOpenGL.pas Header
  222. // With native GL then bindings are staticlly declared to support other headers
  223. // or use the glBitmap inside of DLLs (minimize codesize).
  224. {.$DEFINE GLB_SDL}
  225. // To enable the support for SDL_surfaces
  226. {.$DEFINE GLB_DELPHI}
  227. // To enable the support for TBitmap from Delphi (not lazarus)
  228. // *** image libs ***
  229. {.$DEFINE GLB_SDL_IMAGE}
  230. // To enable the support of SDL_image to load files. (READ ONLY)
  231. // If you enable SDL_image all other libraries will be ignored!
  232. {.$DEFINE GLB_PNGIMAGE}
  233. // to enable png support with the unit pngimage. You can download it from http://pngdelphi.sourceforge.net/
  234. // if you enable pngimage the libPNG will be ignored
  235. {.$DEFINE GLB_LIB_PNG}
  236. // to use the libPNG http://www.libpng.org/
  237. // You will need an aditional header.
  238. // http://www.opengl24.de/index.php?cat=header&file=libpng
  239. {.$DEFINE GLB_DELPHI_JPEG}
  240. // if you enable delphi jpegs the libJPEG will be ignored
  241. {.$DEFINE GLB_LIB_JPEG}
  242. // to use the libJPEG http://www.ijg.org/
  243. // You will need an aditional header.
  244. // http://www.opengl24.de/index.php?cat=header&file=libjpeg
  245. // ###### End of preferences ##################################################
  246. // ###### PRIVATE. Do not change anything. ####################################
  247. // *** old defines for compatibility ***
  248. {$IFDEF NO_NATIVE_GL}
  249. {$DEFINE GLB_NO_NATIVE_GL}
  250. {$ENDIF}
  251. {$IFDEF pngimage}
  252. {$definde GLB_PNGIMAGE}
  253. {$ENDIF}
  254. // *** Delphi Versions ***
  255. {$IFDEF fpc}
  256. {$MODE Delphi}
  257. {$IFDEF CPUI386}
  258. {$DEFINE CPU386}
  259. {$ASMMODE INTEL}
  260. {$ENDIF}
  261. {$IFNDEF WINDOWS}
  262. {$linklib c}
  263. {$ENDIF}
  264. {$ENDIF}
  265. // *** checking define combinations ***
  266. {$IFDEF GLB_SDL_IMAGE}
  267. {$IFNDEF GLB_SDL}
  268. {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
  269. {$DEFINE GLB_SDL}
  270. {$ENDIF}
  271. {$IFDEF GLB_PNGIMAGE}
  272. {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
  273. {$undef GLB_PNGIMAGE}
  274. {$ENDIF}
  275. {$IFDEF GLB_DELPHI_JPEG}
  276. {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
  277. {$undef GLB_DELPHI_JPEG}
  278. {$ENDIF}
  279. {$IFDEF GLB_LIB_PNG}
  280. {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
  281. {$undef GLB_LIB_PNG}
  282. {$ENDIF}
  283. {$IFDEF GLB_LIB_JPEG}
  284. {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
  285. {$undef GLB_LIB_JPEG}
  286. {$ENDIF}
  287. {$DEFINE GLB_SUPPORT_PNG_READ}
  288. {$DEFINE GLB_SUPPORT_JPEG_READ}
  289. {$ENDIF}
  290. {$IFDEF GLB_PNGIMAGE}
  291. {$IFDEF GLB_LIB_PNG}
  292. {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
  293. {$undef GLB_LIB_PNG}
  294. {$ENDIF}
  295. {$DEFINE GLB_SUPPORT_PNG_READ}
  296. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  297. {$ENDIF}
  298. {$IFDEF GLB_LIB_PNG}
  299. {$DEFINE GLB_SUPPORT_PNG_READ}
  300. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  301. {$ENDIF}
  302. {$IFDEF GLB_DELPHI_JPEG}
  303. {$IFDEF GLB_LIB_JPEG}
  304. {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
  305. {$undef GLB_LIB_JPEG}
  306. {$ENDIF}
  307. {$DEFINE GLB_SUPPORT_JPEG_READ}
  308. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  309. {$ENDIF}
  310. {$IFDEF GLB_LIB_JPEG}
  311. {$DEFINE GLB_SUPPORT_JPEG_READ}
  312. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  313. {$ENDIF}
  314. // *** general options ***
  315. {$EXTENDEDSYNTAX ON}
  316. {$LONGSTRINGS ON}
  317. {$ALIGN ON}
  318. {$IFNDEF FPC}
  319. {$OPTIMIZATION ON}
  320. {$ENDIF}
  321. interface
  322. uses
  323. {$IFDEF GLB_NO_NATIVE_GL} dglOpenGL, {$ENDIF}
  324. {$IFDEF GLB_SDL} SDL, {$ENDIF}
  325. {$IFDEF GLB_DELPHI} Dialogs, Windows, Graphics, {$ENDIF}
  326. {$IFDEF GLB_SDL_IMAGE} SDL_image, {$ENDIF}
  327. {$IFDEF GLB_PNGIMAGE} pngimage, {$ENDIF}
  328. {$IFDEF GLB_LIB_PNG} libPNG, {$ENDIF}
  329. {$IFDEF GLB_DELPHI_JPEG} JPEG, {$ENDIF}
  330. {$IFDEF GLB_LIB_JPEG} libJPEG, {$ENDIF}
  331. Classes, SysUtils;
  332. {$IFNDEF GLB_DELPHI}
  333. type
  334. HGLRC = Cardinal;
  335. DWORD = Cardinal;
  336. PDWORD = ^DWORD;
  337. TRGBQuad = packed record
  338. rgbBlue: Byte;
  339. rgbGreen: Byte;
  340. rgbRed: Byte;
  341. rgbReserved: Byte;
  342. end;
  343. {$ENDIF}
  344. (* TODO dglOpenGL
  345. {$IFNDEF GLB_NO_NATIVE_GL}
  346. // Native OpenGL Implementation
  347. type
  348. PByteBool = ^ByteBool;
  349. {$IFDEF GLB_DELPHI}
  350. var
  351. gLastContext: HGLRC;
  352. {$ENDIF}
  353. const
  354. // Generell
  355. GL_VERSION = $1F02;
  356. GL_EXTENSIONS = $1F03;
  357. GL_TRUE = 1;
  358. GL_FALSE = 0;
  359. GL_TEXTURE_1D = $0DE0;
  360. GL_TEXTURE_2D = $0DE1;
  361. GL_MAX_TEXTURE_SIZE = $0D33;
  362. GL_PACK_ALIGNMENT = $0D05;
  363. GL_UNPACK_ALIGNMENT = $0CF5;
  364. // Textureformats
  365. GL_RGB = $1907;
  366. GL_RGB4 = $804F;
  367. GL_RGB8 = $8051;
  368. GL_RGBA = $1908;
  369. GL_RGBA4 = $8056;
  370. GL_RGBA8 = $8058;
  371. GL_BGR = $80E0;
  372. GL_BGRA = $80E1;
  373. GL_ALPHA4 = $803B;
  374. GL_ALPHA8 = $803C;
  375. GL_LUMINANCE4 = $803F;
  376. GL_LUMINANCE8 = $8040;
  377. GL_LUMINANCE4_ALPHA4 = $8043;
  378. GL_LUMINANCE8_ALPHA8 = $8045;
  379. GL_DEPTH_COMPONENT = $1902;
  380. GL_UNSIGNED_BYTE = $1401;
  381. GL_ALPHA = $1906;
  382. GL_LUMINANCE = $1909;
  383. GL_LUMINANCE_ALPHA = $190A;
  384. GL_TEXTURE_WIDTH = $1000;
  385. GL_TEXTURE_HEIGHT = $1001;
  386. GL_TEXTURE_INTERNAL_FORMAT = $1003;
  387. GL_TEXTURE_RED_SIZE = $805C;
  388. GL_TEXTURE_GREEN_SIZE = $805D;
  389. GL_TEXTURE_BLUE_SIZE = $805E;
  390. GL_TEXTURE_ALPHA_SIZE = $805F;
  391. GL_TEXTURE_LUMINANCE_SIZE = $8060;
  392. // Dataformats
  393. GL_UNSIGNED_SHORT_5_6_5 = $8363;
  394. GL_UNSIGNED_SHORT_5_6_5_REV = $8364;
  395. GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;
  396. GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;
  397. GL_UNSIGNED_INT_2_10_10_10_REV = $8368;
  398. // Filter
  399. GL_NEAREST = $2600;
  400. GL_LINEAR = $2601;
  401. GL_NEAREST_MIPMAP_NEAREST = $2700;
  402. GL_LINEAR_MIPMAP_NEAREST = $2701;
  403. GL_NEAREST_MIPMAP_LINEAR = $2702;
  404. GL_LINEAR_MIPMAP_LINEAR = $2703;
  405. GL_TEXTURE_MAG_FILTER = $2800;
  406. GL_TEXTURE_MIN_FILTER = $2801;
  407. // Wrapmodes
  408. GL_TEXTURE_WRAP_S = $2802;
  409. GL_TEXTURE_WRAP_T = $2803;
  410. GL_CLAMP = $2900;
  411. GL_REPEAT = $2901;
  412. GL_CLAMP_TO_EDGE = $812F;
  413. GL_CLAMP_TO_BORDER = $812D;
  414. GL_TEXTURE_WRAP_R = $8072;
  415. GL_MIRRORED_REPEAT = $8370;
  416. // Border Color
  417. GL_TEXTURE_BORDER_COLOR = $1004;
  418. // Texgen
  419. GL_NORMAL_MAP = $8511;
  420. GL_REFLECTION_MAP = $8512;
  421. GL_S = $2000;
  422. GL_T = $2001;
  423. GL_R = $2002;
  424. GL_TEXTURE_GEN_MODE = $2500;
  425. GL_TEXTURE_GEN_S = $0C60;
  426. GL_TEXTURE_GEN_T = $0C61;
  427. GL_TEXTURE_GEN_R = $0C62;
  428. // Cubemaps
  429. GL_MAX_CUBE_MAP_TEXTURE_SIZE = $851C;
  430. GL_TEXTURE_CUBE_MAP = $8513;
  431. GL_TEXTURE_BINDING_CUBE_MAP = $8514;
  432. GL_TEXTURE_CUBE_MAP_POSITIVE_X = $8515;
  433. GL_TEXTURE_CUBE_MAP_NEGATIVE_X = $8516;
  434. GL_TEXTURE_CUBE_MAP_POSITIVE_Y = $8517;
  435. GL_TEXTURE_CUBE_MAP_NEGATIVE_Y = $8518;
  436. GL_TEXTURE_CUBE_MAP_POSITIVE_Z = $8519;
  437. GL_TEXTURE_CUBE_MAP_NEGATIVE_Z = $851A;
  438. GL_TEXTURE_RECTANGLE_ARB = $84F5;
  439. // GL_SGIS_generate_mipmap
  440. GL_GENERATE_MIPMAP = $8191;
  441. // GL_EXT_texture_compression_s3tc
  442. GL_COMPRESSED_RGB_S3TC_DXT1_EXT = $83F0;
  443. GL_COMPRESSED_RGBA_S3TC_DXT1_EXT = $83F1;
  444. GL_COMPRESSED_RGBA_S3TC_DXT3_EXT = $83F2;
  445. GL_COMPRESSED_RGBA_S3TC_DXT5_EXT = $83F3;
  446. // GL_EXT_texture_filter_anisotropic
  447. GL_TEXTURE_MAX_ANISOTROPY_EXT = $84FE;
  448. GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;
  449. // GL_ARB_texture_compression
  450. GL_COMPRESSED_RGB = $84ED;
  451. GL_COMPRESSED_RGBA = $84EE;
  452. GL_COMPRESSED_ALPHA = $84E9;
  453. GL_COMPRESSED_LUMINANCE = $84EA;
  454. GL_COMPRESSED_LUMINANCE_ALPHA = $84EB;
  455. // Extensions
  456. var
  457. GL_VERSION_1_2,
  458. GL_VERSION_1_3,
  459. GL_VERSION_1_4,
  460. GL_VERSION_2_0,
  461. GL_ARB_texture_border_clamp,
  462. GL_ARB_texture_cube_map,
  463. GL_ARB_texture_compression,
  464. GL_ARB_texture_non_power_of_two,
  465. GL_ARB_texture_rectangle,
  466. GL_ARB_texture_mirrored_repeat,
  467. GL_EXT_bgra,
  468. GL_EXT_texture_edge_clamp,
  469. GL_EXT_texture_cube_map,
  470. GL_EXT_texture_compression_s3tc,
  471. GL_EXT_texture_filter_anisotropic,
  472. GL_EXT_texture_rectangle,
  473. GL_NV_texture_rectangle,
  474. GL_IBM_texture_mirrored_repeat,
  475. GL_SGIS_generate_mipmap: Boolean;
  476. const
  477. {$IFDEF LINUX}
  478. libglu = 'libGLU.so.1';
  479. libopengl = 'libGL.so.1';
  480. {$else}
  481. libglu = 'glu32.dll';
  482. libopengl = 'opengl32.dll';
  483. {$ENDIF}
  484. {$IFDEF LINUX}
  485. function glXGetProcAddress(ProcName: PAnsiChar): Pointer; cdecl; external libopengl;
  486. {$else}
  487. function wglGetProcAddress(ProcName: PAnsiChar): Pointer; stdcall; external libopengl;
  488. {$ENDIF}
  489. function glGetString(name: Cardinal): PAnsiChar; {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
  490. procedure glEnable(cap: Cardinal); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
  491. procedure glDisable(cap: Cardinal); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
  492. procedure glGetIntegerv(pname: Cardinal; params: PInteger); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
  493. procedure glTexImage1D(target: Cardinal; level, internalformat, width, border: Integer; format, atype: Cardinal; const pixels: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
  494. procedure glTexImage2D(target: Cardinal; level, internalformat, width, height, border: Integer; format, atype: Cardinal; const pixels: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
  495. procedure glGenTextures(n: Integer; Textures: PCardinal); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
  496. procedure glBindTexture(target: Cardinal; Texture: Cardinal); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
  497. procedure glDeleteTextures(n: Integer; const textures: PCardinal); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
  498. procedure glReadPixels(x, y: Integer; width, height: Integer; format, atype: Cardinal; pixels: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
  499. procedure glPixelStorei(pname: Cardinal; param: Integer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
  500. procedure glGetTexImage(target: Cardinal; level: Integer; format: Cardinal; _type: Cardinal; pixels: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
  501. function glAreTexturesResident(n: Integer; const Textures: PCardinal; residences: PByteBool): ByteBool; {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
  502. procedure glTexParameteri(target: Cardinal; pname: Cardinal; param: Integer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
  503. procedure glTexParameterfv(target: Cardinal; pname: Cardinal; const params: PSingle); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
  504. procedure glGetTexLevelParameteriv(target: Cardinal; level: Integer; pname: Cardinal; params: PInteger); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
  505. procedure glTexGeni(coord, pname: Cardinal; param: Integer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
  506. function gluBuild1DMipmaps(Target: Cardinal; Components, Width: Integer; Format, atype: Cardinal; Data: Pointer): Integer; {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libglu;
  507. function gluBuild2DMipmaps(Target: Cardinal; Components, Width, Height: Integer; Format, aType: Cardinal; Data: Pointer): Integer; {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libglu;
  508. var
  509. glCompressedTexImage2D : procedure(target: Cardinal; level: Integer; internalformat: Cardinal; width, height: Integer; border: Integer; imageSize: Integer; const data: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF}
  510. glCompressedTexImage1D : procedure(target: Cardinal; level: Integer; internalformat: Cardinal; width: Integer; border: Integer; imageSize: Integer; const data: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF}
  511. glGetCompressedTexImage : procedure(target: Cardinal; level: Integer; img: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF}
  512. {$ENDIF}
  513. *)
  514. type
  515. ////////////////////////////////////////////////////////////////////////////////////////////////////
  516. EglBitmapException = class(Exception);
  517. EglBitmapSizeToLargeException = class(EglBitmapException);
  518. EglBitmapNonPowerOfTwoException = class(EglBitmapException);
  519. EglBitmapUnsupportedFormatFormat = class(EglBitmapException);
  520. ////////////////////////////////////////////////////////////////////////////////////////////////////
  521. TglBitmapFormat = (
  522. tfEmpty = 0,
  523. tfAlpha4,
  524. tfAlpha8,
  525. tfAlpha12,
  526. tfAlpha16,
  527. tfLuminance4,
  528. tfLuminance8,
  529. tfLuminance12,
  530. tfLuminance16,
  531. tfLuminance4Alpha4,
  532. tfLuminance6Alpha2,
  533. tfLuminance8Alpha8,
  534. tfLuminance12Alpha4,
  535. tfLuminance12Alpha12,
  536. tfLuminance16Alpha16,
  537. tfR3G3B2,
  538. tfRGB4,
  539. tfR5G6B5,
  540. tfRGB5,
  541. tfRGB8,
  542. tfRGB10,
  543. tfRGB12,
  544. tfRGB16,
  545. tfRGBA2,
  546. tfRGBA4,
  547. tfRGB5A1,
  548. tfRGBA8,
  549. tfRGB10A2,
  550. tfRGBA12,
  551. tfRGBA16,
  552. tfBGR4,
  553. tfB5G6R5,
  554. tfBGR5,
  555. tfBGR8,
  556. tfBGR10,
  557. tfBGR12,
  558. tfBGR16,
  559. tfBGRA2,
  560. tfBGRA4,
  561. tfBGR5A1,
  562. tfBGRA8,
  563. tfBGR10A2,
  564. tfBGRA12,
  565. tfBGRA16,
  566. tfDepth16,
  567. tfDepth24,
  568. tfDepth32,
  569. tfS3tcDtx1RGBA,
  570. tfS3tcDtx3RGBA,
  571. tfS3tcDtx5RGBA
  572. );
  573. TglBitmapFileType = (
  574. {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG, {$ENDIF}
  575. {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
  576. ftDDS,
  577. ftTGA,
  578. ftBMP);
  579. TglBitmapFileTypes = set of TglBitmapFileType;
  580. TglBitmapMipMap = (
  581. mmNone,
  582. mmMipmap,
  583. mmMipmapGlu);
  584. TglBitmapNormalMapFunc = (
  585. nm4Samples,
  586. nmSobel,
  587. nm3x3,
  588. nm5x5);
  589. ////////////////////////////////////////////////////////////////////////////////////////////////////
  590. TglBitmapColorRec = packed record
  591. case Integer of
  592. 0: (r, g, b, a: Cardinal);
  593. 1: (arr: array[0..3] of Cardinal);
  594. end;
  595. TglBitmapPixelData = packed record
  596. Data, Range: TglBitmapColorRec;
  597. Format: TglBitmapFormat;
  598. end;
  599. PglBitmapPixelData = ^TglBitmapPixelData;
  600. ////////////////////////////////////////////////////////////////////////////////////////////////////
  601. TglBitmapPixelPositionFields = set of (ffX, ffY);
  602. TglBitmapPixelPosition = record
  603. Fields : TglBitmapPixelPositionFields;
  604. X : Word;
  605. Y : Word;
  606. end;
  607. ////////////////////////////////////////////////////////////////////////////////////////////////////
  608. TglBitmap = class;
  609. TglBitmapFunctionRec = record
  610. Sender: TglBitmap;
  611. Size: TglBitmapPixelPosition;
  612. Position: TglBitmapPixelPosition;
  613. Source: TglBitmapPixelData;
  614. Dest: TglBitmapPixelData;
  615. Args: PtrInt;
  616. end;
  617. TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
  618. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  619. TglBitmap = class
  620. protected
  621. fID: GLuint;
  622. fTarget: GLuint;
  623. fAnisotropic: Integer;
  624. fDeleteTextureOnFree: Boolean;
  625. fFreeDataAfterGenTexture: Boolean;
  626. fData: PByte;
  627. fIsResident: Boolean;
  628. fBorderColor: array[0..3] of Single;
  629. fDimension: TglBitmapPixelPosition;
  630. fMipMap: TglBitmapMipMap;
  631. fFormat: TglBitmapFormat;
  632. // Mapping
  633. fPixelSize: Integer;
  634. fRowSize: Integer;
  635. // Filtering
  636. fFilterMin: Cardinal;
  637. fFilterMag: Cardinal;
  638. // TexturWarp
  639. fWrapS: Cardinal;
  640. fWrapT: Cardinal;
  641. fWrapR: Cardinal;
  642. // CustomData
  643. fFilename: String;
  644. fCustomName: String;
  645. fCustomNameW: WideString;
  646. fCustomData: Pointer;
  647. //Getter
  648. function GetWidth: Integer; virtual;
  649. function GetHeight: Integer; virtual;
  650. function GetFileWidth: Integer; virtual;
  651. function GetFileHeight: Integer; virtual;
  652. //Setter
  653. procedure SetCustomData(const aValue: Pointer);
  654. procedure SetCustomName(const aValue: String);
  655. procedure SetCustomNameW(const aValue: WideString);
  656. procedure SetDeleteTextureOnFree(const aValue: Boolean);
  657. procedure SetFormat(const aValue: TglBitmapFormat);
  658. procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
  659. procedure SetID(const aValue: Cardinal);
  660. procedure SetMipMap(const aValue: TglBitmapMipMap);
  661. procedure SetTarget(const aValue: Cardinal);
  662. procedure SetAnisotropic(const aValue: Integer);
  663. procedure CreateID;
  664. procedure SetupParameters(var aBuildWithGlu: Boolean);
  665. procedure SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
  666. const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;
  667. procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
  668. function FlipHorz: Boolean; virtual;
  669. function FlipVert: Boolean; virtual;
  670. property Width: Integer read GetWidth;
  671. property Height: Integer read GetHeight;
  672. property FileWidth: Integer read GetFileWidth;
  673. property FileHeight: Integer read GetFileHeight;
  674. public
  675. //Properties
  676. property ID: Cardinal read fID write SetID;
  677. property Target: Cardinal read fTarget write SetTarget;
  678. property Format: TglBitmapFormat read fFormat write SetFormat;
  679. property MipMap: TglBitmapMipMap read fMipMap write SetMipMap;
  680. property Anisotropic: Integer read fAnisotropic write SetAnisotropic;
  681. property Filename: String read fFilename;
  682. property CustomName: String read fCustomName write SetCustomName;
  683. property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
  684. property CustomData: Pointer read fCustomData write SetCustomData;
  685. property DeleteTextureOnFree: Boolean read fDeleteTextureOnFree write SetDeleteTextureOnFree;
  686. property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
  687. property Dimension: TglBitmapPixelPosition read fDimension;
  688. property Data: PByte read fData;
  689. property IsResident: Boolean read fIsResident;
  690. procedure AfterConstruction; override;
  691. procedure BeforeDestruction; override;
  692. //Load
  693. procedure LoadFromFile(const aFilename: String);
  694. procedure LoadFromStream(const aStream: TStream); virtual;
  695. procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  696. const aFormat: TglBitmapFormat; const aArgs: PtrInt = 0);
  697. {$IFDEF GLB_DELPHI}
  698. procedure LoadFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil);
  699. procedure LoadFromResourceID(const sInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  700. {$ENDIF}
  701. //Save
  702. procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  703. procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
  704. //Convert
  705. function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: PtrInt = 0): Boolean; overload;
  706. function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  707. const aFormat: TglBitmapFormat; const aArgs: PtrInt = 0): Boolean; overload;
  708. public
  709. //Alpha & Co
  710. {$IFDEF GLB_SDL}
  711. function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  712. function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  713. function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  714. function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
  715. const aArgs: PtrInt = 0): Boolean;
  716. {$ENDIF}
  717. {$IFDEF GLB_DELPHI}
  718. function AssignToBitmap(const aBitmap: TBitmap): Boolean;
  719. function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  720. function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  721. function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
  722. const aArgs: PtrInt = 0): Boolean;
  723. function AddAlphaFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil;
  724. const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;
  725. function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  726. const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;
  727. {$ENDIF}
  728. function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: PtrInt = 0): Boolean; virtual;
  729. function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;
  730. function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;
  731. function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;
  732. function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
  733. function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
  734. function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
  735. function AddAlphaFromValue(const aAlpha: Byte): Boolean;
  736. function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  737. function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  738. function RemoveAlpha: Boolean; virtual;
  739. public
  740. //Common
  741. function Clone: TglBitmap;
  742. function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
  743. procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
  744. procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  745. procedure FreeData;
  746. //ColorFill
  747. procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
  748. procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
  749. procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
  750. //TexParameters
  751. procedure SetFilter(const aMin, aMag: Cardinal);
  752. procedure SetWrap(
  753. const S: Cardinal = GL_CLAMP_TO_EDGE;
  754. const T: Cardinal = GL_CLAMP_TO_EDGE;
  755. const R: Cardinal = GL_CLAMP_TO_EDGE);
  756. procedure GetPixel(const aPos: TglBitmapPixelPosition; var aPixel: TglBitmapPixelData); virtual;
  757. procedure SetPixel(const aPos: TglBitmapPixelPosition; const aPixel: TglBitmapPixelData); virtual;
  758. procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
  759. procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
  760. //Constructors
  761. constructor Create; overload;
  762. constructor Create(const aFileName: String); overload;
  763. constructor Create(const aStream: TStream); overload;
  764. constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat); overload;
  765. constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: PtrInt = 0); overload;
  766. {$IFDEF GLB_DELPHI}
  767. constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
  768. constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
  769. {$ENDIF}
  770. private
  771. {$IFDEF GLB_SUPPORT_PNG_READ}
  772. function LoadPNG(const aStream: TStream): Boolean; virtual;
  773. procedure SavePNG(const aStream: TStream); virtual;
  774. {$ENDIF}
  775. {$IFDEF GLB_SUPPORT_JPEG_READ}
  776. function LoadJPEG(const aStream: TStream): Boolean; virtual;
  777. procedure SaveJPEG(const aStream: TStream); virtual;
  778. {$ENDIF}
  779. function LoadBMP(const aStream: TStream): Boolean; virtual;
  780. procedure SaveBMP(const aStream: TStream); virtual;
  781. function LoadTGA(const aStream: TStream): Boolean; virtual;
  782. procedure SaveTGA(const aStream: TStream); virtual;
  783. function LoadDDS(const aStream: TStream): Boolean; virtual;
  784. procedure SaveDDS(const aStream: TStream); virtual;
  785. end;
  786. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  787. TglBitmap2D = class(TglBitmap)
  788. protected
  789. // Bildeinstellungen
  790. fLines: array of PByte;
  791. (* TODO
  792. procedure GetDXTColorBlock(pData: pByte; relX, relY: Integer; var Pixel: TglBitmapPixelData);
  793. procedure GetPixel2DDXT1(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
  794. procedure GetPixel2DDXT3(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
  795. procedure GetPixel2DDXT5(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
  796. procedure GetPixel2DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
  797. procedure SetPixel2DUnmap(const Pos: TglBitmapPixelPosition; const Pixel: TglBitmapPixelData);
  798. *)
  799. function GetScanline(const aIndex: Integer): Pointer;
  800. procedure SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
  801. const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
  802. procedure UploadData(const aTarget: Cardinal; const aBuildWithGlu: Boolean);
  803. public
  804. property Width;
  805. property Height;
  806. property Scanline[const aIndex: Integer]: Pointer read GetScanline;
  807. procedure AfterConstruction; override;
  808. procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  809. procedure GetDataFromTexture;
  810. procedure GenTexture(const aTestTextureSize: Boolean = true); override;
  811. function FlipHorz: Boolean; override;
  812. function FlipVert: Boolean; override;
  813. procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
  814. const aScale: Single = 2; const aUseAlpha: Boolean = false);
  815. end;
  816. (* TODO
  817. TglBitmapCubeMap = class(TglBitmap2D)
  818. protected
  819. fGenMode: Integer;
  820. // Hide GenTexture
  821. procedure GenTexture(TestTextureSize: Boolean = true); reintroduce;
  822. public
  823. procedure AfterConstruction; override;
  824. procedure GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean = true);
  825. procedure Unbind(DisableTexCoordsGen: Boolean = true; DisableTextureUnit: Boolean = true); reintroduce; virtual;
  826. procedure Bind(EnableTexCoordsGen: Boolean = true; EnableTextureUnit: Boolean = true); reintroduce; virtual;
  827. end;
  828. TglBitmapNormalMap = class(TglBitmapCubeMap)
  829. public
  830. procedure AfterConstruction; override;
  831. procedure GenerateNormalMap(Size: Integer = 32; TestTextureSize: Boolean = true);
  832. end;
  833. TglBitmap1D = class(TglBitmap)
  834. protected
  835. procedure GetPixel1DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
  836. procedure SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width: Integer = -1; Height: Integer = -1); override;
  837. procedure UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
  838. public
  839. // propertys
  840. property Width;
  841. procedure AfterConstruction; override;
  842. // Other
  843. function FlipHorz: Boolean; override;
  844. // Generation
  845. procedure GenTexture(TestTextureSize: Boolean = true); override;
  846. end;
  847. *)
  848. const
  849. NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
  850. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  851. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  852. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  853. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  854. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  855. procedure glBitmapSetDefaultWrap(
  856. const S: Cardinal = GL_CLAMP_TO_EDGE;
  857. const T: Cardinal = GL_CLAMP_TO_EDGE;
  858. const R: Cardinal = GL_CLAMP_TO_EDGE);
  859. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  860. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  861. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  862. function glBitmapGetDefaultFormat: TglBitmapFormat;
  863. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  864. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  865. function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
  866. function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
  867. function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
  868. var
  869. glBitmapDefaultDeleteTextureOnFree: Boolean;
  870. glBitmapDefaultFreeDataAfterGenTextures: Boolean;
  871. glBitmapDefaultFormat: TglBitmapFormat;
  872. glBitmapDefaultMipmap: TglBitmapMipMap;
  873. glBitmapDefaultFilterMin: Cardinal;
  874. glBitmapDefaultFilterMag: Cardinal;
  875. glBitmapDefaultWrapS: Cardinal;
  876. glBitmapDefaultWrapT: Cardinal;
  877. glBitmapDefaultWrapR: Cardinal;
  878. {$IFDEF GLB_DELPHI}
  879. function CreateGrayPalette: HPALETTE;
  880. {$ENDIF}
  881. implementation
  882. (* TODO
  883. function FormatIsCompressed(Format: TglBitmapInternalFormat): boolean;
  884. function FormatIsUncompressed(Format: TglBitmapInternalFormat): boolean;
  885. function LoadTexture(Filename: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal = 0{$ENDIF}): Boolean;
  886. function LoadCubeMap(PositiveX, NegativeX, PositiveY, NegativeY, PositiveZ, NegativeZ: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal = 0{$ENDIF}): Boolean;
  887. function LoadNormalMap(Size: Integer; var Texture: Cardinal): Boolean;
  888. *)
  889. uses
  890. Math, syncobjs;
  891. type
  892. ////////////////////////////////////////////////////////////////////////////////////////////////////
  893. TShiftRec = packed record
  894. case Integer of
  895. 0: (r, g, b, a: Byte);
  896. 1: (arr: array[0..3] of Byte);
  897. end;
  898. TFormatDescriptor = class(TObject)
  899. private
  900. function GetRedMask: UInt64;
  901. function GetGreenMask: UInt64;
  902. function GetBlueMask: UInt64;
  903. function GetAlphaMask: UInt64;
  904. protected
  905. fFormat: TglBitmapFormat;
  906. fWithAlpha: TglBitmapFormat;
  907. fWithoutAlpha: TglBitmapFormat;
  908. fRGBInverted: TglBitmapFormat;
  909. fUncompressed: TglBitmapFormat;
  910. fPixelSize: Single;
  911. fIsCompressed: Boolean;
  912. fRange: TglBitmapColorRec;
  913. fShift: TShiftRec;
  914. fglFormat: Cardinal;
  915. fglInternalFormat: Cardinal;
  916. fglDataFormat: Cardinal;
  917. function GetComponents: Integer; virtual;
  918. public
  919. property Format: TglBitmapFormat read fFormat;
  920. property WithAlpha: TglBitmapFormat read fWithAlpha;
  921. property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;
  922. property RGBInverted: TglBitmapFormat read fRGBInverted;
  923. property Components: Integer read GetComponents;
  924. property PixelSize: Single read fPixelSize;
  925. property IsCompressed: Boolean read fIsCompressed;
  926. property glFormat: Cardinal read fglFormat;
  927. property glInternalFormat: Cardinal read fglInternalFormat;
  928. property glDataFormat: Cardinal read fglDataFormat;
  929. property Range: TglBitmapColorRec read fRange;
  930. property Shift: TShiftRec read fShift;
  931. property RedMask: UInt64 read GetRedMask;
  932. property GreenMask: UInt64 read GetGreenMask;
  933. property BlueMask: UInt64 read GetBlueMask;
  934. property AlphaMask: UInt64 read GetAlphaMask;
  935. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
  936. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
  937. function GetSize(const aSize: TglBitmapPixelPosition): Integer; virtual; overload;
  938. function GetSize(const aWidth, aHeight: Integer): Integer; virtual; overload;
  939. function CreateMappingData: Pointer; virtual;
  940. procedure FreeMappingData(var aMappingData: Pointer); virtual;
  941. function IsEmpty: Boolean; virtual;
  942. function HasAlpha: Boolean; virtual;
  943. function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: UInt64): Boolean; virtual;
  944. procedure PreparePixel(var aPixel: TglBitmapPixelData); virtual;
  945. constructor Create; virtual;
  946. public
  947. class procedure Init;
  948. class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  949. class function GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  950. class procedure Clear;
  951. class procedure Finalize;
  952. end;
  953. TFormatDescriptorClass = class of TFormatDescriptor;
  954. TfdEmpty = class(TFormatDescriptor);
  955. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  956. TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte
  957. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  958. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  959. constructor Create; override;
  960. end;
  961. TfdLuminance_UB1 = class(TFormatDescriptor) //1* unsigned byte
  962. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  963. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  964. constructor Create; override;
  965. end;
  966. TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte
  967. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  968. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  969. constructor Create; override;
  970. end;
  971. TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte
  972. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  973. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  974. constructor Create; override;
  975. end;
  976. TfdRGB_UB3 = class(TFormatDescriptor) //3* unsigned byte
  977. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  978. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  979. constructor Create; override;
  980. end;
  981. TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
  982. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  983. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  984. constructor Create; override;
  985. end;
  986. TfdRGBA_UB4 = class(TfdRGB_UB3) //4* unsigned byte
  987. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  988. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  989. constructor Create; override;
  990. end;
  991. TfdBGRA_UB4 = class(TfdBGR_UB3) //4* unsigned byte (inverse)
  992. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  993. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  994. constructor Create; override;
  995. end;
  996. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  997. TfdAlpha_US1 = class(TFormatDescriptor) //1* unsigned short
  998. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  999. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1000. constructor Create; override;
  1001. end;
  1002. TfdLuminance_US1 = class(TFormatDescriptor) //1* unsigned short
  1003. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1004. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1005. constructor Create; override;
  1006. end;
  1007. TfdUniversal_US1 = class(TFormatDescriptor) //1* unsigned short
  1008. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1009. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1010. constructor Create; override;
  1011. end;
  1012. TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short
  1013. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1014. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1015. constructor Create; override;
  1016. end;
  1017. TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short
  1018. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1019. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1020. constructor Create; override;
  1021. end;
  1022. TfdRGB_US3 = class(TFormatDescriptor) //3* unsigned short
  1023. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1024. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1025. constructor Create; override;
  1026. end;
  1027. TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)
  1028. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1029. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1030. constructor Create; override;
  1031. end;
  1032. TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
  1033. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1034. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1035. constructor Create; override;
  1036. end;
  1037. TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
  1038. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1039. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1040. constructor Create; override;
  1041. end;
  1042. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1043. TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int
  1044. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1045. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1046. constructor Create; override;
  1047. end;
  1048. TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int
  1049. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1050. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1051. constructor Create; override;
  1052. end;
  1053. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1054. TfdAlpha4 = class(TfdAlpha_UB1)
  1055. constructor Create; override;
  1056. end;
  1057. TfdAlpha8 = class(TfdAlpha_UB1)
  1058. constructor Create; override;
  1059. end;
  1060. TfdAlpha12 = class(TfdAlpha_US1)
  1061. constructor Create; override;
  1062. end;
  1063. TfdAlpha16 = class(TfdAlpha_US1)
  1064. constructor Create; override;
  1065. end;
  1066. TfdLuminance4 = class(TfdLuminance_UB1)
  1067. constructor Create; override;
  1068. end;
  1069. TfdLuminance8 = class(TfdLuminance_UB1)
  1070. constructor Create; override;
  1071. end;
  1072. TfdLuminance12 = class(TfdLuminance_US1)
  1073. constructor Create; override;
  1074. end;
  1075. TfdLuminance16 = class(TfdLuminance_US1)
  1076. constructor Create; override;
  1077. end;
  1078. TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
  1079. constructor Create; override;
  1080. end;
  1081. TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
  1082. constructor Create; override;
  1083. end;
  1084. TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
  1085. constructor Create; override;
  1086. end;
  1087. TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
  1088. constructor Create; override;
  1089. end;
  1090. TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)
  1091. constructor Create; override;
  1092. end;
  1093. TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
  1094. constructor Create; override;
  1095. end;
  1096. TfdR3G3B2 = class(TfdUniversal_UB1)
  1097. constructor Create; override;
  1098. end;
  1099. TfdRGB4 = class(TfdUniversal_US1)
  1100. constructor Create; override;
  1101. end;
  1102. TfdR5G6B5 = class(TfdUniversal_US1)
  1103. constructor Create; override;
  1104. end;
  1105. TfdRGB5 = class(TfdUniversal_US1)
  1106. constructor Create; override;
  1107. end;
  1108. TfdRGB8 = class(TfdRGB_UB3)
  1109. constructor Create; override;
  1110. end;
  1111. TfdRGB10 = class(TfdUniversal_UI1)
  1112. constructor Create; override;
  1113. end;
  1114. TfdRGB12 = class(TfdRGB_US3)
  1115. constructor Create; override;
  1116. end;
  1117. TfdRGB16 = class(TfdRGB_US3)
  1118. constructor Create; override;
  1119. end;
  1120. TfdRGBA2 = class(TfdRGBA_UB4)
  1121. constructor Create; override;
  1122. end;
  1123. TfdRGBA4 = class(TfdUniversal_US1)
  1124. constructor Create; override;
  1125. end;
  1126. TfdRGB5A1 = class(TfdUniversal_US1)
  1127. constructor Create; override;
  1128. end;
  1129. TfdRGBA8 = class(TfdRGBA_UB4)
  1130. constructor Create; override;
  1131. end;
  1132. TfdRGB10A2 = class(TfdUniversal_UI1)
  1133. constructor Create; override;
  1134. end;
  1135. TfdRGBA12 = class(TfdRGBA_US4)
  1136. constructor Create; override;
  1137. end;
  1138. TfdRGBA16 = class(TfdRGBA_US4)
  1139. constructor Create; override;
  1140. end;
  1141. TfdBGR4 = class(TfdUniversal_US1)
  1142. constructor Create; override;
  1143. end;
  1144. TfdB5G6R5 = class(TfdUniversal_US1)
  1145. constructor Create; override;
  1146. end;
  1147. TfdBGR5 = class(TfdUniversal_US1)
  1148. constructor Create; override;
  1149. end;
  1150. TfdBGR8 = class(TfdBGR_UB3)
  1151. constructor Create; override;
  1152. end;
  1153. TfdBGR10 = class(TfdUniversal_UI1)
  1154. constructor Create; override;
  1155. end;
  1156. TfdBGR12 = class(TfdBGR_US3)
  1157. constructor Create; override;
  1158. end;
  1159. TfdBGR16 = class(TfdBGR_US3)
  1160. constructor Create; override;
  1161. end;
  1162. TfdBGRA2 = class(TfdBGRA_UB4)
  1163. constructor Create; override;
  1164. end;
  1165. TfdBGRA4 = class(TfdUniversal_US1)
  1166. constructor Create; override;
  1167. end;
  1168. TfdBGR5A1 = class(TfdUniversal_US1)
  1169. constructor Create; override;
  1170. end;
  1171. TfdBGRA8 = class(TfdBGRA_UB4)
  1172. constructor Create; override;
  1173. end;
  1174. TfdBGR10A2 = class(TfdUniversal_UI1)
  1175. constructor Create; override;
  1176. end;
  1177. TfdBGRA12 = class(TfdBGRA_US4)
  1178. constructor Create; override;
  1179. end;
  1180. TfdBGRA16 = class(TfdBGRA_US4)
  1181. constructor Create; override;
  1182. end;
  1183. TfdDepth16 = class(TfdDepth_US1)
  1184. constructor Create; override;
  1185. end;
  1186. TfdDepth24 = class(TfdDepth_UI1)
  1187. constructor Create; override;
  1188. end;
  1189. TfdDepth32 = class(TfdDepth_UI1)
  1190. constructor Create; override;
  1191. end;
  1192. TfdS3tcDtx1RGBA = class(TFormatDescriptor)
  1193. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1194. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1195. constructor Create; override;
  1196. end;
  1197. TfdS3tcDtx3RGBA = class(TFormatDescriptor)
  1198. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1199. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1200. constructor Create; override;
  1201. end;
  1202. TfdS3tcDtx5RGBA = class(TFormatDescriptor)
  1203. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1204. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1205. constructor Create; override;
  1206. end;
  1207. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1208. TbmpBitfieldFormat = class(TFormatDescriptor)
  1209. private
  1210. procedure SetRedMask (const aValue: UInt64);
  1211. procedure SetGreenMask(const aValue: UInt64);
  1212. procedure SetBlueMask (const aValue: UInt64);
  1213. procedure SetAlphaMask(const aValue: UInt64);
  1214. procedure Update(aMask: UInt64; out aRange: Cardinal; out aShift: Byte);
  1215. public
  1216. property RedMask: UInt64 read GetRedMask write SetRedMask;
  1217. property GreenMask: UInt64 read GetGreenMask write SetGreenMask;
  1218. property BlueMask: UInt64 read GetBlueMask write SetBlueMask;
  1219. property AlphaMask: UInt64 read GetAlphaMask write SetAlphaMask;
  1220. property PixelSize: Single read fPixelSize write fPixelSize;
  1221. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1222. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1223. end;
  1224. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1225. TbmpColorTableEnty = packed record
  1226. b, g, r, a: Byte;
  1227. end;
  1228. TbmpColorTable = array of TbmpColorTableEnty;
  1229. TbmpColorTableFormat = class(TFormatDescriptor)
  1230. private
  1231. fColorTable: TbmpColorTable;
  1232. public
  1233. property PixelSize: Single read fPixelSize write fPixelSize;
  1234. property ColorTable: TbmpColorTable read fColorTable write fColorTable;
  1235. property Range: TglBitmapColorRec read fRange write fRange;
  1236. property Shift: TShiftRec read fShift write fShift;
  1237. property Format: TglBitmapFormat read fFormat write fFormat;
  1238. procedure CreateColorTable;
  1239. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1240. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1241. destructor Destroy; override;
  1242. end;
  1243. const
  1244. LUMINANCE_WEIGHT_R = 0.30;
  1245. LUMINANCE_WEIGHT_G = 0.59;
  1246. LUMINANCE_WEIGHT_B = 0.11;
  1247. ALPHA_WEIGHT_R = 0.30;
  1248. ALPHA_WEIGHT_G = 0.59;
  1249. ALPHA_WEIGHT_B = 0.11;
  1250. DEPTH_WEIGHT_R = 0.333333333;
  1251. DEPTH_WEIGHT_G = 0.333333333;
  1252. DEPTH_WEIGHT_B = 0.333333333;
  1253. UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
  1254. FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
  1255. TfdEmpty,
  1256. TfdAlpha4,
  1257. TfdAlpha8,
  1258. TfdAlpha12,
  1259. TfdAlpha16,
  1260. TfdLuminance4,
  1261. TfdLuminance8,
  1262. TfdLuminance12,
  1263. TfdLuminance16,
  1264. TfdLuminance4Alpha4,
  1265. TfdLuminance6Alpha2,
  1266. TfdLuminance8Alpha8,
  1267. TfdLuminance12Alpha4,
  1268. TfdLuminance12Alpha12,
  1269. TfdLuminance16Alpha16,
  1270. TfdR3G3B2,
  1271. TfdRGB4,
  1272. TfdR5G6B5,
  1273. TfdRGB5,
  1274. TfdRGB8,
  1275. TfdRGB10,
  1276. TfdRGB12,
  1277. TfdRGB16,
  1278. TfdRGBA2,
  1279. TfdRGBA4,
  1280. TfdRGB5A1,
  1281. TfdRGBA8,
  1282. TfdRGB10A2,
  1283. TfdRGBA12,
  1284. TfdRGBA16,
  1285. TfdBGR4,
  1286. TfdB5G6R5,
  1287. TfdBGR5,
  1288. TfdBGR8,
  1289. TfdBGR10,
  1290. TfdBGR12,
  1291. TfdBGR16,
  1292. TfdBGRA2,
  1293. TfdBGRA4,
  1294. TfdBGR5A1,
  1295. TfdBGRA8,
  1296. TfdBGR10A2,
  1297. TfdBGRA12,
  1298. TfdBGRA16,
  1299. TfdDepth16,
  1300. TfdDepth24,
  1301. TfdDepth32,
  1302. TfdS3tcDtx1RGBA,
  1303. TfdS3tcDtx3RGBA,
  1304. TfdS3tcDtx5RGBA
  1305. );
  1306. var
  1307. FormatDescriptorCS: TCriticalSection;
  1308. FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
  1309. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1310. function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
  1311. begin
  1312. result.Fields := [];
  1313. if X >= 0 then
  1314. result.Fields := result.Fields + [ffX];
  1315. if Y >= 0 then
  1316. result.Fields := result.Fields + [ffY];
  1317. result.X := Max(0, X);
  1318. result.Y := Max(0, Y);
  1319. end;
  1320. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1321. function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
  1322. begin
  1323. result.r := r;
  1324. result.g := g;
  1325. result.b := b;
  1326. result.a := a;
  1327. end;
  1328. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1329. function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
  1330. var
  1331. i: Integer;
  1332. begin
  1333. result := false;
  1334. for i := 0 to high(r1.arr) do
  1335. if (r1.arr[i] <> r2.arr[i]) then
  1336. exit;
  1337. result := true;
  1338. end;
  1339. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1340. function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
  1341. begin
  1342. result.r := r;
  1343. result.g := g;
  1344. result.b := b;
  1345. result.a := a;
  1346. end;
  1347. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1348. function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
  1349. begin
  1350. result := [ftDDS];
  1351. if (aFormat in [
  1352. //4 bbp
  1353. tfLuminance4,
  1354. //8bpp
  1355. tfR3G3B2, tfLuminance8,
  1356. //16bpp
  1357. tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
  1358. tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,
  1359. //24bpp
  1360. tfBGR8, tfRGB8,
  1361. //32bpp
  1362. tfRGB10, tfRGB10A2, tfRGBA8,
  1363. tfBGR10, tfBGR10A2, tfBGRA8]) then
  1364. result := result + [ftBMP];
  1365. if (aFormat in [
  1366. //8 bpp
  1367. tfLuminance8, tfAlpha8,
  1368. //16 bpp
  1369. tfLuminance16, tfLuminance8Alpha8,
  1370. tfRGB5, tfRGB5A1, tfRGBA4,
  1371. tfBGR5, tfBGR5A1, tfBGRA4,
  1372. //24 bpp
  1373. tfRGB8, tfBGR8,
  1374. //32 bpp
  1375. tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
  1376. result := result + [ftTGA];
  1377. //TODO Supported File Formats!
  1378. (*
  1379. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  1380. if aFormat in [
  1381. tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
  1382. tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
  1383. tfuminance4Alpha4, tfLuminance6Alpha2, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16,
  1384. tfR3G3B2, tfRGB4, tfRGB5, tfRGB8, tfRGB10, tfRGB12, tfRGB16,
  1385. tfRGBA2, tfRGBA4, tfRGB5A1, tfRGBA8, tfRGB10A2, tfRGBA12, tfRGBA16,
  1386. tfDepth16, tfDepth24, tfDepth32]
  1387. then
  1388. result := result + [ftPNG];
  1389. {$ENDIF}
  1390. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  1391. if Format in [
  1392. tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
  1393. tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
  1394. tfR3G3B2, tfRGB4, tfRGB5, tfRGB8, tfRGB10, tfRGB12, tfRGB16,
  1395. tfDepth16, tfDepth24, tfDepth32]
  1396. then
  1397. result := result + [ftJPEG];
  1398. {$ENDIF}
  1399. if aFormat in [
  1400. tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
  1401. tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
  1402. tfuminance4Alpha4, tfLuminance6Alpha2, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16,
  1403. tfR3G3B2, tfRGB4, tfRGB5, tfRGB8, tfRGB10, tfRGB12, tfRGB16,
  1404. tfRGBA2, tfRGBA4, tfRGB5A1, tfRGBA8, tfRGB10A2, tfRGBA12, tfRGBA16,
  1405. tfDepth16, tfDepth24, tfDepth32]
  1406. then
  1407. result := result + [ftDDS, ftTGA, ftBMP];
  1408. *)
  1409. end;
  1410. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1411. function IsPowerOfTwo(aNumber: Integer): Boolean;
  1412. begin
  1413. while (aNumber and 1) = 0 do
  1414. aNumber := aNumber shr 1;
  1415. result := aNumber = 1;
  1416. end;
  1417. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1418. function GetTopMostBit(aBitSet: UInt64): Integer;
  1419. begin
  1420. result := 0;
  1421. while aBitSet > 0 do begin
  1422. inc(result);
  1423. aBitSet := aBitSet shr 1;
  1424. end;
  1425. end;
  1426. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1427. function CountSetBits(aBitSet: UInt64): Integer;
  1428. begin
  1429. result := 0;
  1430. while aBitSet > 0 do begin
  1431. if (aBitSet and 1) = 1 then
  1432. inc(result);
  1433. aBitSet := aBitSet shr 1;
  1434. end;
  1435. end;
  1436. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1437. function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1438. begin
  1439. result := Trunc(
  1440. LUMINANCE_WEIGHT_R * aPixel.Data.r +
  1441. LUMINANCE_WEIGHT_G * aPixel.Data.g +
  1442. LUMINANCE_WEIGHT_B * aPixel.Data.b);
  1443. end;
  1444. function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1445. begin
  1446. result := Trunc(
  1447. DEPTH_WEIGHT_R * aPixel.Data.r +
  1448. DEPTH_WEIGHT_G * aPixel.Data.g +
  1449. DEPTH_WEIGHT_B * aPixel.Data.b);
  1450. end;
  1451. //TODO check _ARB functions and constants
  1452. (* GLB_NO_NATIVE_GL
  1453. {$IFNDEF GLB_NO_NATIVE_GL}
  1454. procedure ReadOpenGLExtensions;
  1455. var
  1456. {$IFDEF GLB_DELPHI}
  1457. Context: HGLRC;
  1458. {$ENDIF}
  1459. Buffer: AnsiString;
  1460. MajorVersion, MinorVersion: Integer;
  1461. procedure TrimVersionString(Buffer: AnsiString; var Major, Minor: Integer);
  1462. var
  1463. Separator: Integer;
  1464. begin
  1465. Minor := 0;
  1466. Major := 0;
  1467. Separator := Pos(AnsiString('.'), Buffer);
  1468. if (Separator > 1) and (Separator < Length(Buffer)) and
  1469. (Buffer[Separator - 1] in ['0'..'9']) and
  1470. (Buffer[Separator + 1] in ['0'..'9']) then begin
  1471. Dec(Separator);
  1472. while (Separator > 0) and (Buffer[Separator] in ['0'..'9']) do
  1473. Dec(Separator);
  1474. Delete(Buffer, 1, Separator);
  1475. Separator := Pos(AnsiString('.'), Buffer) + 1;
  1476. while (Separator <= Length(Buffer)) and (AnsiChar(Buffer[Separator]) in ['0'..'9']) do
  1477. Inc(Separator);
  1478. Delete(Buffer, Separator, 255);
  1479. Separator := Pos(AnsiString('.'), Buffer);
  1480. Major := StrToInt(Copy(String(Buffer), 1, Separator - 1));
  1481. Minor := StrToInt(Copy(String(Buffer), Separator + 1, 1));
  1482. end;
  1483. end;
  1484. function CheckExtension(const Extension: AnsiString): Boolean;
  1485. var
  1486. ExtPos: Integer;
  1487. begin
  1488. ExtPos := Pos(Extension, Buffer);
  1489. result := ExtPos > 0;
  1490. if result then
  1491. result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
  1492. end;
  1493. function glLoad (aFunc: pAnsiChar): pointer;
  1494. begin
  1495. {$IFDEF LINUX}
  1496. result := glXGetProcAddress(aFunc);
  1497. {$else}
  1498. result := wglGetProcAddress(aFunc);
  1499. {$ENDIF}
  1500. end;
  1501. begin
  1502. {$IFDEF GLB_DELPHI}
  1503. Context := wglGetCurrentContext;
  1504. if Context <> gLastContext then begin
  1505. gLastContext := Context;
  1506. {$ENDIF}
  1507. // Version
  1508. Buffer := glGetString(GL_VERSION);
  1509. TrimVersionString(Buffer, MajorVersion, MinorVersion);
  1510. GL_VERSION_1_2 := false;
  1511. GL_VERSION_1_3 := false;
  1512. GL_VERSION_1_4 := false;
  1513. GL_VERSION_2_0 := false;
  1514. if MajorVersion = 1 then begin
  1515. if MinorVersion >= 1 then begin
  1516. if MinorVersion >= 2 then
  1517. GL_VERSION_1_2 := true;
  1518. if MinorVersion >= 3 then
  1519. GL_VERSION_1_3 := true;
  1520. if MinorVersion >= 4 then
  1521. GL_VERSION_1_4 := true;
  1522. end;
  1523. end;
  1524. if MajorVersion >= 2 then begin
  1525. GL_VERSION_1_2 := true;
  1526. GL_VERSION_1_3 := true;
  1527. GL_VERSION_1_4 := true;
  1528. GL_VERSION_2_0 := true;
  1529. end;
  1530. // Extensions
  1531. Buffer := glGetString(GL_EXTENSIONS);
  1532. GL_ARB_texture_border_clamp := CheckExtension('GL_ARB_texture_border_clamp');
  1533. GL_ARB_texture_cube_map := CheckExtension('GL_ARB_texture_cube_map');
  1534. GL_ARB_texture_compression := CheckExtension('GL_ARB_texture_compression');
  1535. GL_ARB_texture_non_power_of_two := CheckExtension('GL_ARB_texture_non_power_of_two');
  1536. GL_ARB_texture_rectangle := CheckExtension('GL_ARB_texture_rectangle');
  1537. GL_ARB_texture_mirrored_repeat := CheckExtension('GL_ARB_texture_mirrored_repeat');
  1538. GL_EXT_bgra := CheckExtension('GL_EXT_bgra');
  1539. GL_EXT_texture_edge_clamp := CheckExtension('GL_EXT_texture_edge_clamp');
  1540. GL_EXT_texture_cube_map := CheckExtension('GL_EXT_texture_cube_map');
  1541. GL_EXT_texture_compression_s3tc := CheckExtension('GL_EXT_texture_compression_s3tc');
  1542. GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
  1543. GL_EXT_texture_rectangle := CheckExtension('GL_EXT_texture_rectangle');
  1544. GL_NV_texture_rectangle := CheckExtension('GL_NV_texture_rectangle');
  1545. GL_IBM_texture_mirrored_repeat := CheckExtension('GL_IBM_texture_mirrored_repeat');
  1546. GL_SGIS_generate_mipmap := CheckExtension('GL_SGIS_generate_mipmap');
  1547. // Funtions
  1548. if GL_VERSION_1_3 then begin
  1549. // Loading Core
  1550. glCompressedTexImage1D := glLoad('glCompressedTexImage1D');
  1551. glCompressedTexImage2D := glLoad('glCompressedTexImage2D');
  1552. glGetCompressedTexImage := glLoad('glGetCompressedTexImage');
  1553. end else
  1554. begin
  1555. // Try loading Extension
  1556. glCompressedTexImage1D := glLoad('glCompressedTexImage1DARB');
  1557. glCompressedTexImage2D := glLoad('glCompressedTexImage2DARB');
  1558. glGetCompressedTexImage := glLoad('glGetCompressedTexImageARB');
  1559. end;
  1560. {$IFDEF GLB_DELPHI}
  1561. end;
  1562. {$ENDIF}
  1563. end;
  1564. {$ENDIF}
  1565. *)
  1566. (* TODO GLB_DELPHI
  1567. {$IFDEF GLB_DELPHI}
  1568. function CreateGrayPalette: HPALETTE;
  1569. var
  1570. Idx: Integer;
  1571. Pal: PLogPalette;
  1572. begin
  1573. GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
  1574. Pal.palVersion := $300;
  1575. Pal.palNumEntries := 256;
  1576. {$IFOPT R+}
  1577. {$DEFINE GLB_TEMPRANGECHECK}
  1578. {$R-}
  1579. {$ENDIF}
  1580. for Idx := 0 to 256 - 1 do begin
  1581. Pal.palPalEntry[Idx].peRed := Idx;
  1582. Pal.palPalEntry[Idx].peGreen := Idx;
  1583. Pal.palPalEntry[Idx].peBlue := Idx;
  1584. Pal.palPalEntry[Idx].peFlags := 0;
  1585. end;
  1586. {$IFDEF GLB_TEMPRANGECHECK}
  1587. {$UNDEF GLB_TEMPRANGECHECK}
  1588. {$R+}
  1589. {$ENDIF}
  1590. result := CreatePalette(Pal^);
  1591. FreeMem(Pal);
  1592. end;
  1593. {$ENDIF}
  1594. *)
  1595. (* TODO GLB_SDL_IMAGE
  1596. {$IFDEF GLB_SDL_IMAGE}
  1597. function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
  1598. begin
  1599. result := TStream(context^.unknown.data1).Seek(offset, whence);
  1600. end;
  1601. function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
  1602. begin
  1603. result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
  1604. end;
  1605. function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
  1606. begin
  1607. result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
  1608. end;
  1609. function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
  1610. begin
  1611. result := 0;
  1612. end;
  1613. function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
  1614. begin
  1615. result := SDL_AllocRW;
  1616. if result = nil then
  1617. raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
  1618. result^.seek := glBitmapRWseek;
  1619. result^.read := glBitmapRWread;
  1620. result^.write := glBitmapRWwrite;
  1621. result^.close := glBitmapRWclose;
  1622. result^.unknown.data1 := Stream;
  1623. end;
  1624. {$ENDIF}
  1625. *)
  1626. (* TODO LoadFuncs
  1627. function LoadTexture(Filename: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal{$ENDIF}): Boolean;
  1628. var
  1629. glBitmap: TglBitmap2D;
  1630. begin
  1631. result := false;
  1632. Texture := 0;
  1633. {$IFDEF GLB_DELPHI}
  1634. if Instance = 0 then
  1635. Instance := HInstance;
  1636. if (LoadFromRes) then
  1637. glBitmap := TglBitmap2D.CreateFromResourceName(Instance, FileName)
  1638. else
  1639. {$ENDIF}
  1640. glBitmap := TglBitmap2D.Create(FileName);
  1641. try
  1642. glBitmap.DeleteTextureOnFree := false;
  1643. glBitmap.FreeDataAfterGenTexture := false;
  1644. glBitmap.GenTexture(true);
  1645. if (glBitmap.ID > 0) then begin
  1646. Texture := glBitmap.ID;
  1647. result := true;
  1648. end;
  1649. finally
  1650. glBitmap.Free;
  1651. end;
  1652. end;
  1653. function LoadCubeMap(PositiveX, NegativeX, PositiveY, NegativeY, PositiveZ, NegativeZ: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal{$ENDIF}): Boolean;
  1654. var
  1655. CM: TglBitmapCubeMap;
  1656. begin
  1657. Texture := 0;
  1658. {$IFDEF GLB_DELPHI}
  1659. if Instance = 0 then
  1660. Instance := HInstance;
  1661. {$ENDIF}
  1662. CM := TglBitmapCubeMap.Create;
  1663. try
  1664. CM.DeleteTextureOnFree := false;
  1665. // Maps
  1666. {$IFDEF GLB_DELPHI}
  1667. if (LoadFromRes) then
  1668. CM.LoadFromResource(Instance, PositiveX)
  1669. else
  1670. {$ENDIF}
  1671. CM.LoadFromFile(PositiveX);
  1672. CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X);
  1673. {$IFDEF GLB_DELPHI}
  1674. if (LoadFromRes) then
  1675. CM.LoadFromResource(Instance, NegativeX)
  1676. else
  1677. {$ENDIF}
  1678. CM.LoadFromFile(NegativeX);
  1679. CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X);
  1680. {$IFDEF GLB_DELPHI}
  1681. if (LoadFromRes) then
  1682. CM.LoadFromResource(Instance, PositiveY)
  1683. else
  1684. {$ENDIF}
  1685. CM.LoadFromFile(PositiveY);
  1686. CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y);
  1687. {$IFDEF GLB_DELPHI}
  1688. if (LoadFromRes) then
  1689. CM.LoadFromResource(Instance, NegativeY)
  1690. else
  1691. {$ENDIF}
  1692. CM.LoadFromFile(NegativeY);
  1693. CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y);
  1694. {$IFDEF GLB_DELPHI}
  1695. if (LoadFromRes) then
  1696. CM.LoadFromResource(Instance, PositiveZ)
  1697. else
  1698. {$ENDIF}
  1699. CM.LoadFromFile(PositiveZ);
  1700. CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z);
  1701. {$IFDEF GLB_DELPHI}
  1702. if (LoadFromRes) then
  1703. CM.LoadFromResource(Instance, NegativeZ)
  1704. else
  1705. {$ENDIF}
  1706. CM.LoadFromFile(NegativeZ);
  1707. CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z);
  1708. Texture := CM.ID;
  1709. result := true;
  1710. finally
  1711. CM.Free;
  1712. end;
  1713. end;
  1714. function LoadNormalMap(Size: Integer; var Texture: Cardinal): Boolean;
  1715. var
  1716. NM: TglBitmapNormalMap;
  1717. begin
  1718. Texture := 0;
  1719. NM := TglBitmapNormalMap.Create;
  1720. try
  1721. NM.DeleteTextureOnFree := false;
  1722. NM.GenerateNormalMap(Size);
  1723. Texture := NM.ID;
  1724. result := true;
  1725. finally
  1726. NM.Free;
  1727. end;
  1728. end;
  1729. *)
  1730. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1731. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1732. begin
  1733. glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
  1734. end;
  1735. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1736. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1737. begin
  1738. glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
  1739. end;
  1740. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1741. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1742. begin
  1743. glBitmapDefaultMipmap := aValue;
  1744. end;
  1745. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1746. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1747. begin
  1748. glBitmapDefaultFormat := aFormat;
  1749. end;
  1750. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1751. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1752. begin
  1753. glBitmapDefaultFilterMin := aMin;
  1754. glBitmapDefaultFilterMag := aMag;
  1755. end;
  1756. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1757. procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
  1758. begin
  1759. glBitmapDefaultWrapS := S;
  1760. glBitmapDefaultWrapT := T;
  1761. glBitmapDefaultWrapR := R;
  1762. end;
  1763. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1764. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1765. begin
  1766. result := glBitmapDefaultDeleteTextureOnFree;
  1767. end;
  1768. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1769. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1770. begin
  1771. result := glBitmapDefaultFreeDataAfterGenTextures;
  1772. end;
  1773. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1774. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1775. begin
  1776. result := glBitmapDefaultMipmap;
  1777. end;
  1778. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1779. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1780. begin
  1781. result := glBitmapDefaultFormat;
  1782. end;
  1783. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1784. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  1785. begin
  1786. aMin := glBitmapDefaultFilterMin;
  1787. aMag := glBitmapDefaultFilterMag;
  1788. end;
  1789. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1790. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  1791. begin
  1792. S := glBitmapDefaultWrapS;
  1793. T := glBitmapDefaultWrapT;
  1794. R := glBitmapDefaultWrapR;
  1795. end;
  1796. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1797. //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1798. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1799. function TFormatDescriptor.GetRedMask: UInt64;
  1800. begin
  1801. result := fRange.r shl fShift.r;
  1802. end;
  1803. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1804. function TFormatDescriptor.GetGreenMask: UInt64;
  1805. begin
  1806. result := fRange.g shl fShift.g;
  1807. end;
  1808. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1809. function TFormatDescriptor.GetBlueMask: UInt64;
  1810. begin
  1811. result := fRange.b shl fShift.b;
  1812. end;
  1813. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1814. function TFormatDescriptor.GetAlphaMask: UInt64;
  1815. begin
  1816. result := fRange.a shl fShift.a;
  1817. end;
  1818. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1819. function TFormatDescriptor.GetComponents: Integer;
  1820. var
  1821. i: Integer;
  1822. begin
  1823. result := 0;
  1824. for i := 0 to 3 do
  1825. if (fRange.arr[i] > 0) then
  1826. inc(result);
  1827. end;
  1828. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1829. function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
  1830. var
  1831. w, h: Integer;
  1832. begin
  1833. if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
  1834. w := Max(1, aSize.X);
  1835. h := Max(1, aSize.Y);
  1836. result := GetSize(w, h);
  1837. end else
  1838. result := 0;
  1839. end;
  1840. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1841. function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
  1842. begin
  1843. result := 0;
  1844. if (aWidth <= 0) or (aHeight <= 0) then
  1845. exit;
  1846. result := Ceil(aWidth * aHeight * fPixelSize);
  1847. end;
  1848. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1849. function TFormatDescriptor.CreateMappingData: Pointer;
  1850. begin
  1851. result := nil;
  1852. end;
  1853. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1854. procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
  1855. begin
  1856. //DUMMY
  1857. end;
  1858. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1859. function TFormatDescriptor.IsEmpty: Boolean;
  1860. begin
  1861. result := (fFormat = tfEmpty);
  1862. end;
  1863. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1864. function TFormatDescriptor.HasAlpha: Boolean;
  1865. begin
  1866. result := (fRange.a > 0);
  1867. end;
  1868. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1869. function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: UInt64): Boolean;
  1870. begin
  1871. result := false;
  1872. if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
  1873. raise EglBitmapException.Create('FormatCheckFormat - All Masks are 0');
  1874. if (aRedMask <> RedMask) then
  1875. exit;
  1876. if (aGreenMask <> GreenMask) then
  1877. exit;
  1878. if (aBlueMask <> BlueMask) then
  1879. exit;
  1880. if (aAlphaMask <> AlphaMask) then
  1881. exit;
  1882. result := true;
  1883. end;
  1884. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1885. procedure TFormatDescriptor.PreparePixel(var aPixel: TglBitmapPixelData);
  1886. begin
  1887. FillChar(aPixel, SizeOf(aPixel), 0);
  1888. aPixel.Data := fRange;
  1889. aPixel.Range := fRange;
  1890. aPixel.Format := fFormat;
  1891. end;
  1892. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1893. constructor TFormatDescriptor.Create;
  1894. begin
  1895. inherited Create;
  1896. fFormat := tfEmpty;
  1897. fWithAlpha := tfEmpty;
  1898. fWithoutAlpha := tfEmpty;
  1899. fRGBInverted := tfEmpty;
  1900. fUncompressed := tfEmpty;
  1901. fPixelSize := 0.0;
  1902. fIsCompressed := false;
  1903. fglFormat := 0;
  1904. fglInternalFormat := 0;
  1905. fglDataFormat := 0;
  1906. FillChar(fRange, 0, SizeOf(fRange));
  1907. FillChar(fShift, 0, SizeOf(fShift));
  1908. end;
  1909. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1910. //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1911. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1912. procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1913. begin
  1914. aData^ := aPixel.Data.a;
  1915. inc(aData);
  1916. end;
  1917. procedure TfdAlpha_UB1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1918. begin
  1919. aPixel.Data.r := 0;
  1920. aPixel.Data.g := 0;
  1921. aPixel.Data.b := 0;
  1922. aPixel.Data.a := aData^;
  1923. inc(aData^);
  1924. end;
  1925. constructor TfdAlpha_UB1.Create;
  1926. begin
  1927. inherited Create;
  1928. fPixelSize := 1.0;
  1929. fRange.a := $FF;
  1930. fglFormat := GL_ALPHA;
  1931. fglDataFormat := GL_UNSIGNED_BYTE;
  1932. end;
  1933. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1934. //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1935. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1936. procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1937. begin
  1938. aData^ := LuminanceWeight(aPixel);
  1939. inc(aData);
  1940. end;
  1941. procedure TfdLuminance_UB1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1942. begin
  1943. aPixel.Data.r := aData^;
  1944. aPixel.Data.g := aData^;
  1945. aPixel.Data.b := aData^;
  1946. aPixel.Data.a := 0;
  1947. inc(aData);
  1948. end;
  1949. constructor TfdLuminance_UB1.Create;
  1950. begin
  1951. inherited Create;
  1952. fPixelSize := 1.0;
  1953. fRange.r := $FF;
  1954. fRange.g := $FF;
  1955. fRange.b := $FF;
  1956. fglFormat := GL_LUMINANCE;
  1957. fglDataFormat := GL_UNSIGNED_BYTE;
  1958. end;
  1959. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1960. //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1961. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1962. procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1963. var
  1964. i: Integer;
  1965. begin
  1966. aData^ := 0;
  1967. for i := 0 to 3 do
  1968. if (fRange.arr[i] > 0) then
  1969. aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  1970. inc(aData);
  1971. end;
  1972. procedure TfdUniversal_UB1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1973. var
  1974. i: Integer;
  1975. begin
  1976. for i := 0 to 3 do
  1977. aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
  1978. inc(aData);
  1979. end;
  1980. constructor TfdUniversal_UB1.Create;
  1981. begin
  1982. inherited Create;
  1983. fPixelSize := 1.0;
  1984. end;
  1985. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1986. //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1987. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1988. procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1989. begin
  1990. inherited Map(aPixel, aData, aMapData);
  1991. aData^ := aPixel.Data.a;
  1992. inc(aData);
  1993. end;
  1994. procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1995. begin
  1996. inherited Unmap(aData, aPixel, aMapData);
  1997. aPixel.Data.a := aData^;
  1998. inc(aData);
  1999. end;
  2000. constructor TfdLuminanceAlpha_UB2.Create;
  2001. begin
  2002. inherited Create;
  2003. fPixelSize := 2.0;
  2004. fRange.a := $FF;
  2005. fShift.a := 8;
  2006. fglFormat := GL_LUMINANCE_ALPHA;
  2007. fglDataFormat := GL_UNSIGNED_BYTE;
  2008. end;
  2009. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2010. //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2011. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2012. procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2013. begin
  2014. aData^ := aPixel.Data.r;
  2015. inc(aData);
  2016. aData^ := aPixel.Data.g;
  2017. inc(aData);
  2018. aData^ := aPixel.Data.b;
  2019. inc(aData);
  2020. end;
  2021. procedure TfdRGB_UB3.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2022. begin
  2023. aPixel.Data.r := aData^;
  2024. inc(aData);
  2025. aPixel.Data.g := aData^;
  2026. inc(aData);
  2027. aPixel.Data.b := aData^;
  2028. inc(aData);
  2029. aPixel.Data.a := 0;
  2030. end;
  2031. constructor TfdRGB_UB3.Create;
  2032. begin
  2033. inherited Create;
  2034. fPixelSize := 3.0;
  2035. fRange.r := $FF;
  2036. fRange.g := $FF;
  2037. fRange.b := $FF;
  2038. fShift.r := 0;
  2039. fShift.g := 8;
  2040. fShift.b := 16;
  2041. fglFormat := GL_RGB;
  2042. fglDataFormat := GL_UNSIGNED_BYTE;
  2043. end;
  2044. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2045. //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2046. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2047. procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2048. begin
  2049. aData^ := aPixel.Data.b;
  2050. inc(aData);
  2051. aData^ := aPixel.Data.g;
  2052. inc(aData);
  2053. aData^ := aPixel.Data.r;
  2054. inc(aData);
  2055. end;
  2056. procedure TfdBGR_UB3.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2057. begin
  2058. aPixel.Data.b := aData^;
  2059. inc(aData);
  2060. aPixel.Data.g := aData^;
  2061. inc(aData);
  2062. aPixel.Data.r := aData^;
  2063. inc(aData);
  2064. aPixel.Data.a := 0;
  2065. end;
  2066. constructor TfdBGR_UB3.Create;
  2067. begin
  2068. fPixelSize := 3.0;
  2069. fRange.r := $FF;
  2070. fRange.g := $FF;
  2071. fRange.b := $FF;
  2072. fShift.r := 16;
  2073. fShift.g := 8;
  2074. fShift.b := 0;
  2075. fglFormat := GL_BGR;
  2076. fglDataFormat := GL_UNSIGNED_BYTE;
  2077. end;
  2078. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2079. //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2080. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2081. procedure TfdRGBA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2082. begin
  2083. inherited Map(aPixel, aData, aMapData);
  2084. aData^ := aPixel.Data.a;
  2085. inc(aData);
  2086. end;
  2087. procedure TfdRGBA_UB4.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2088. begin
  2089. inherited Unmap(aData, aPixel, aMapData);
  2090. aPixel.Data.a := aData^;
  2091. inc(aData);
  2092. end;
  2093. constructor TfdRGBA_UB4.Create;
  2094. begin
  2095. inherited Create;
  2096. fPixelSize := 4.0;
  2097. fRange.a := $FF;
  2098. fShift.a := 24;
  2099. fglFormat := GL_RGBA;
  2100. fglDataFormat := GL_UNSIGNED_BYTE;
  2101. end;
  2102. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2103. //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2104. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2105. procedure TfdBGRA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2106. begin
  2107. inherited Map(aPixel, aData, aMapData);
  2108. aData^ := aPixel.Data.a;
  2109. inc(aData);
  2110. end;
  2111. procedure TfdBGRA_UB4.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2112. begin
  2113. inherited Unmap(aData, aPixel, aMapData);
  2114. aPixel.Data.a := aData^;
  2115. inc(aData);
  2116. end;
  2117. constructor TfdBGRA_UB4.Create;
  2118. begin
  2119. inherited Create;
  2120. fPixelSize := 4.0;
  2121. fRange.a := $FF;
  2122. fShift.a := 24;
  2123. fglFormat := GL_BGRA;
  2124. fglDataFormat := GL_UNSIGNED_BYTE;
  2125. end;
  2126. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2127. //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2128. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2129. procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2130. begin
  2131. PWord(aData)^ := aPixel.Data.a;
  2132. inc(aData, 2);
  2133. end;
  2134. procedure TfdAlpha_US1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2135. begin
  2136. aPixel.Data.r := 0;
  2137. aPixel.Data.g := 0;
  2138. aPixel.Data.b := 0;
  2139. aPixel.Data.a := PWord(aData)^;
  2140. inc(aData, 2);
  2141. end;
  2142. constructor TfdAlpha_US1.Create;
  2143. begin
  2144. inherited Create;
  2145. fPixelSize := 2.0;
  2146. fRange.a := $FFFF;
  2147. fglFormat := GL_ALPHA;
  2148. fglDataFormat := GL_UNSIGNED_SHORT;
  2149. end;
  2150. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2151. //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2152. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2153. procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2154. begin
  2155. PWord(aData)^ := LuminanceWeight(aPixel);
  2156. inc(aData, 2);
  2157. end;
  2158. procedure TfdLuminance_US1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2159. begin
  2160. aPixel.Data.r := PWord(aData)^;
  2161. aPixel.Data.g := PWord(aData)^;
  2162. aPixel.Data.b := PWord(aData)^;
  2163. aPixel.Data.a := 0;
  2164. inc(aData, 2);
  2165. end;
  2166. constructor TfdLuminance_US1.Create;
  2167. begin
  2168. inherited Create;
  2169. fPixelSize := 2.0;
  2170. fRange.r := $FFFF;
  2171. fRange.g := $FFFF;
  2172. fRange.b := $FFFF;
  2173. fglFormat := GL_LUMINANCE;
  2174. fglDataFormat := GL_UNSIGNED_SHORT;
  2175. end;
  2176. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2177. //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2178. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2179. procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2180. var
  2181. i: Integer;
  2182. begin
  2183. PWord(aData)^ := 0;
  2184. for i := 0 to 3 do
  2185. if (fRange.arr[i] > 0) then
  2186. PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2187. inc(aData, 2);
  2188. end;
  2189. procedure TfdUniversal_US1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2190. var
  2191. i: Integer;
  2192. begin
  2193. for i := 0 to 3 do
  2194. aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
  2195. inc(aData, 2);
  2196. end;
  2197. constructor TfdUniversal_US1.Create;
  2198. begin
  2199. inherited Create;
  2200. fPixelSize := 2.0;
  2201. end;
  2202. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2203. //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2204. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2205. procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2206. begin
  2207. PWord(aData)^ := DepthWeight(aPixel);
  2208. inc(aData, 2);
  2209. end;
  2210. procedure TfdDepth_US1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2211. begin
  2212. aPixel.Data.r := PWord(aData)^;
  2213. aPixel.Data.g := PWord(aData)^;
  2214. aPixel.Data.b := PWord(aData)^;
  2215. aPixel.Data.a := 0;
  2216. inc(aData, 2);
  2217. end;
  2218. constructor TfdDepth_US1.Create;
  2219. begin
  2220. inherited Create;
  2221. fPixelSize := 2.0;
  2222. fRange.r := $FFFF;
  2223. fRange.g := $FFFF;
  2224. fRange.b := $FFFF;
  2225. fglFormat := GL_DEPTH_COMPONENT;
  2226. fglDataFormat := GL_UNSIGNED_SHORT;
  2227. end;
  2228. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2229. //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2230. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2231. procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2232. begin
  2233. inherited Map(aPixel, aData, aMapData);
  2234. PWord(aData)^ := aPixel.Data.a;
  2235. inc(aData, 2);
  2236. end;
  2237. procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2238. begin
  2239. inherited Unmap(aData, aPixel, aMapData);
  2240. aPixel.Data.a := PWord(aData)^;
  2241. inc(aData, 2);
  2242. end;
  2243. constructor TfdLuminanceAlpha_US2.Create;
  2244. begin
  2245. inherited Create;
  2246. fPixelSize := 4.0;
  2247. fRange.a := $FFFF;
  2248. fShift.a := 16;
  2249. fglFormat := GL_LUMINANCE_ALPHA;
  2250. fglDataFormat := GL_UNSIGNED_SHORT;
  2251. end;
  2252. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2253. //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2254. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2255. procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2256. begin
  2257. PWord(aData)^ := aPixel.Data.r;
  2258. inc(aData, 2);
  2259. PWord(aData)^ := aPixel.Data.g;
  2260. inc(aData, 2);
  2261. PWord(aData)^ := aPixel.Data.b;
  2262. inc(aData, 2);
  2263. end;
  2264. procedure TfdRGB_US3.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2265. begin
  2266. aPixel.Data.r := PWord(aData)^;
  2267. inc(aData, 2);
  2268. aPixel.Data.g := PWord(aData)^;
  2269. inc(aData, 2);
  2270. aPixel.Data.b := PWord(aData)^;
  2271. inc(aData, 2);
  2272. aPixel.Data.a := 0;
  2273. end;
  2274. constructor TfdRGB_US3.Create;
  2275. begin
  2276. inherited Create;
  2277. fPixelSize := 6.0;
  2278. fRange.r := $FFFF;
  2279. fRange.g := $FFFF;
  2280. fRange.b := $FFFF;
  2281. fShift.r := 0;
  2282. fShift.g := 16;
  2283. fShift.b := 32;
  2284. fglFormat := GL_RGB;
  2285. fglDataFormat := GL_UNSIGNED_SHORT;
  2286. end;
  2287. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2288. //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2289. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2290. procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2291. begin
  2292. PWord(aData)^ := aPixel.Data.b;
  2293. inc(aData, 2);
  2294. PWord(aData)^ := aPixel.Data.g;
  2295. inc(aData, 2);
  2296. PWord(aData)^ := aPixel.Data.r;
  2297. inc(aData, 2);
  2298. end;
  2299. procedure TfdBGR_US3.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2300. begin
  2301. aPixel.Data.b := PWord(aData)^;
  2302. inc(aData, 2);
  2303. aPixel.Data.g := PWord(aData)^;
  2304. inc(aData, 2);
  2305. aPixel.Data.r := PWord(aData)^;
  2306. inc(aData, 2);
  2307. aPixel.Data.a := 0;
  2308. end;
  2309. constructor TfdBGR_US3.Create;
  2310. begin
  2311. inherited Create;
  2312. fPixelSize := 6.0;
  2313. fRange.r := $FFFF;
  2314. fRange.g := $FFFF;
  2315. fRange.b := $FFFF;
  2316. fShift.r := 32;
  2317. fShift.g := 16;
  2318. fShift.b := 0;
  2319. fglFormat := GL_BGR;
  2320. fglDataFormat := GL_UNSIGNED_SHORT;
  2321. end;
  2322. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2323. //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2324. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2325. procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2326. begin
  2327. inherited Map(aPixel, aData, aMapData);
  2328. PWord(aData)^ := aPixel.Data.a;
  2329. inc(aData, 2);
  2330. end;
  2331. procedure TfdRGBA_US4.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2332. begin
  2333. inherited Unmap(aData, aPixel, aMapData);
  2334. aPixel.Data.a := PWord(aData)^;
  2335. inc(aData, 2);
  2336. end;
  2337. constructor TfdRGBA_US4.Create;
  2338. begin
  2339. inherited Create;
  2340. fPixelSize := 8.0;
  2341. fRange.a := $FFFF;
  2342. fShift.a := 48;
  2343. fglFormat := GL_RGBA;
  2344. fglDataFormat := GL_UNSIGNED_SHORT;
  2345. end;
  2346. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2347. //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2348. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2349. procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2350. begin
  2351. inherited Map(aPixel, aData, aMapData);
  2352. PWord(aData)^ := aPixel.Data.a;
  2353. inc(aData, 2);
  2354. end;
  2355. procedure TfdBGRA_US4.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2356. begin
  2357. inherited Unmap(aData, aPixel, aMapData);
  2358. aPixel.Data.a := PWord(aData)^;
  2359. inc(aData, 2);
  2360. end;
  2361. constructor TfdBGRA_US4.Create;
  2362. begin
  2363. inherited Create;
  2364. fPixelSize := 8.0;
  2365. fRange.a := $FFFF;
  2366. fShift.a := 48;
  2367. fglFormat := GL_BGRA;
  2368. fglDataFormat := GL_UNSIGNED_SHORT;
  2369. end;
  2370. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2371. //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2372. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2373. procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2374. var
  2375. i: Integer;
  2376. begin
  2377. PCardinal(aData)^ := 0;
  2378. for i := 0 to 3 do
  2379. if (fRange.arr[i] > 0) then
  2380. PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2381. inc(aData, 4);
  2382. end;
  2383. procedure TfdUniversal_UI1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2384. var
  2385. i: Integer;
  2386. begin
  2387. for i := 0 to 3 do
  2388. aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
  2389. inc(aData, 2);
  2390. end;
  2391. constructor TfdUniversal_UI1.Create;
  2392. begin
  2393. inherited Create;
  2394. fPixelSize := 4.0;
  2395. end;
  2396. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2397. //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2398. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2399. procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2400. begin
  2401. PCardinal(aData)^ := DepthWeight(aPixel);
  2402. inc(aData, 4);
  2403. end;
  2404. procedure TfdDepth_UI1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2405. begin
  2406. aPixel.Data.r := PCardinal(aData)^;
  2407. aPixel.Data.g := PCardinal(aData)^;
  2408. aPixel.Data.b := PCardinal(aData)^;
  2409. aPixel.Data.a := 0;
  2410. inc(aData, 4);
  2411. end;
  2412. constructor TfdDepth_UI1.Create;
  2413. begin
  2414. inherited Create;
  2415. fPixelSize := 4.0;
  2416. fRange.r := $FFFFFFFF;
  2417. fRange.g := $FFFFFFFF;
  2418. fRange.b := $FFFFFFFF;
  2419. fglFormat := GL_DEPTH_COMPONENT;
  2420. fglDataFormat := GL_UNSIGNED_INT;
  2421. end;
  2422. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2423. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2424. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2425. constructor TfdAlpha4.Create;
  2426. begin
  2427. inherited Create;
  2428. fFormat := tfAlpha4;
  2429. fWithAlpha := tfAlpha4;
  2430. fglInternalFormat := GL_ALPHA4;
  2431. end;
  2432. constructor TfdAlpha8.Create;
  2433. begin
  2434. inherited Create;
  2435. fFormat := tfAlpha8;
  2436. fWithAlpha := tfAlpha8;
  2437. fglInternalFormat := GL_ALPHA8;
  2438. end;
  2439. constructor TfdAlpha12.Create;
  2440. begin
  2441. inherited Create;
  2442. fFormat := tfAlpha12;
  2443. fWithAlpha := tfAlpha12;
  2444. fglInternalFormat := GL_ALPHA12;
  2445. end;
  2446. constructor TfdAlpha16.Create;
  2447. begin
  2448. inherited Create;
  2449. fFormat := tfAlpha16;
  2450. fWithAlpha := tfAlpha16;
  2451. fglInternalFormat := GL_ALPHA16;
  2452. end;
  2453. constructor TfdLuminance4.Create;
  2454. begin
  2455. inherited Create;
  2456. fFormat := tfLuminance4;
  2457. fWithAlpha := tfLuminance4Alpha4;
  2458. fWithoutAlpha := tfLuminance4;
  2459. fglInternalFormat := GL_LUMINANCE4;
  2460. end;
  2461. constructor TfdLuminance8.Create;
  2462. begin
  2463. inherited Create;
  2464. fFormat := tfLuminance8;
  2465. fWithAlpha := tfLuminance8Alpha8;
  2466. fWithoutAlpha := tfLuminance8;
  2467. fglInternalFormat := GL_LUMINANCE8;
  2468. end;
  2469. constructor TfdLuminance12.Create;
  2470. begin
  2471. inherited Create;
  2472. fFormat := tfLuminance12;
  2473. fWithAlpha := tfLuminance12Alpha12;
  2474. fWithoutAlpha := tfLuminance12;
  2475. fglInternalFormat := GL_LUMINANCE12;
  2476. end;
  2477. constructor TfdLuminance16.Create;
  2478. begin
  2479. inherited Create;
  2480. fFormat := tfLuminance16;
  2481. fWithAlpha := tfLuminance16Alpha16;
  2482. fWithoutAlpha := tfLuminance16;
  2483. fglInternalFormat := GL_LUMINANCE16;
  2484. end;
  2485. constructor TfdLuminance4Alpha4.Create;
  2486. begin
  2487. inherited Create;
  2488. fFormat := tfLuminance4Alpha4;
  2489. fWithAlpha := tfLuminance4Alpha4;
  2490. fWithoutAlpha := tfLuminance4;
  2491. fglInternalFormat := GL_LUMINANCE4_ALPHA4;
  2492. end;
  2493. constructor TfdLuminance6Alpha2.Create;
  2494. begin
  2495. inherited Create;
  2496. fFormat := tfLuminance6Alpha2;
  2497. fWithAlpha := tfLuminance6Alpha2;
  2498. fWithoutAlpha := tfLuminance8;
  2499. fglInternalFormat := GL_LUMINANCE6_ALPHA2;
  2500. end;
  2501. constructor TfdLuminance8Alpha8.Create;
  2502. begin
  2503. inherited Create;
  2504. fFormat := tfLuminance8Alpha8;
  2505. fWithAlpha := tfLuminance8Alpha8;
  2506. fWithoutAlpha := tfLuminance8;
  2507. fglInternalFormat := GL_LUMINANCE8_ALPHA8;
  2508. end;
  2509. constructor TfdLuminance12Alpha4.Create;
  2510. begin
  2511. inherited Create;
  2512. fFormat := tfLuminance12Alpha4;
  2513. fWithAlpha := tfLuminance12Alpha4;
  2514. fWithoutAlpha := tfLuminance12;
  2515. fglInternalFormat := GL_LUMINANCE12_ALPHA4;
  2516. end;
  2517. constructor TfdLuminance12Alpha12.Create;
  2518. begin
  2519. inherited Create;
  2520. fFormat := tfLuminance12Alpha12;
  2521. fWithAlpha := tfLuminance12Alpha12;
  2522. fWithoutAlpha := tfLuminance12;
  2523. fglInternalFormat := GL_LUMINANCE12_ALPHA12;
  2524. end;
  2525. constructor TfdLuminance16Alpha16.Create;
  2526. begin
  2527. inherited Create;
  2528. fFormat := tfLuminance16Alpha16;
  2529. fWithAlpha := tfLuminance16Alpha16;
  2530. fWithoutAlpha := tfLuminance16;
  2531. fglInternalFormat := GL_LUMINANCE16_ALPHA16;
  2532. end;
  2533. constructor TfdR3G3B2.Create;
  2534. begin
  2535. inherited Create;
  2536. fFormat := tfR3G3B2;
  2537. fWithAlpha := tfRGBA2;
  2538. fWithoutAlpha := tfR3G3B2;
  2539. fRange.r := $7;
  2540. fRange.g := $7;
  2541. fRange.b := $3;
  2542. fShift.r := 0;
  2543. fShift.g := 3;
  2544. fShift.b := 6;
  2545. fglFormat := GL_RGB;
  2546. fglInternalFormat := GL_R3_G3_B2;
  2547. fglDataFormat := GL_UNSIGNED_BYTE_2_3_3_REV;
  2548. end;
  2549. constructor TfdRGB4.Create;
  2550. begin
  2551. inherited Create;
  2552. fFormat := tfRGB4;
  2553. fWithAlpha := tfRGBA4;
  2554. fWithoutAlpha := tfRGB4;
  2555. fRGBInverted := tfBGR4;
  2556. fRange.r := $F;
  2557. fRange.g := $F;
  2558. fRange.b := $F;
  2559. fShift.r := 0;
  2560. fShift.g := 4;
  2561. fShift.b := 8;
  2562. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2563. fglInternalFormat := GL_RGB4;
  2564. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2565. end;
  2566. constructor TfdR5G6B5.Create;
  2567. begin
  2568. inherited Create;
  2569. fFormat := tfR5G6B5;
  2570. fWithAlpha := tfRGBA4;
  2571. fWithoutAlpha := tfR5G6B5;
  2572. fRGBInverted := tfB5G6R5;
  2573. fRange.r := $1F;
  2574. fRange.g := $3F;
  2575. fRange.b := $1F;
  2576. fShift.r := 0;
  2577. fShift.g := 5;
  2578. fShift.b := 11;
  2579. fglFormat := GL_RGB;
  2580. fglInternalFormat := GL_RGB565;
  2581. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5_REV;
  2582. end;
  2583. constructor TfdRGB5.Create;
  2584. begin
  2585. inherited Create;
  2586. fFormat := tfRGB5;
  2587. fWithAlpha := tfRGB5A1;
  2588. fWithoutAlpha := tfRGB5;
  2589. fRGBInverted := tfBGR5;
  2590. fRange.r := $1F;
  2591. fRange.g := $1F;
  2592. fRange.b := $1F;
  2593. fShift.r := 0;
  2594. fShift.g := 5;
  2595. fShift.b := 10;
  2596. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2597. fglInternalFormat := GL_RGB5;
  2598. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2599. end;
  2600. constructor TfdRGB8.Create;
  2601. begin
  2602. inherited Create;
  2603. fFormat := tfRGB8;
  2604. fWithAlpha := tfRGBA8;
  2605. fWithoutAlpha := tfRGB8;
  2606. fRGBInverted := tfBGR8;
  2607. fglInternalFormat := GL_RGB8;
  2608. end;
  2609. constructor TfdRGB10.Create;
  2610. begin
  2611. inherited Create;
  2612. fFormat := tfRGB10;
  2613. fWithAlpha := tfRGB10A2;
  2614. fWithoutAlpha := tfRGB10;
  2615. fRGBInverted := tfBGR10;
  2616. fRange.r := $3FF;
  2617. fRange.g := $3FF;
  2618. fRange.b := $3FF;
  2619. fShift.r := 0;
  2620. fShift.g := 10;
  2621. fShift.b := 20;
  2622. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2623. fglInternalFormat := GL_RGB10;
  2624. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2625. end;
  2626. constructor TfdRGB12.Create;
  2627. begin
  2628. inherited Create;
  2629. fFormat := tfRGB12;
  2630. fWithAlpha := tfRGBA12;
  2631. fWithoutAlpha := tfRGB12;
  2632. fRGBInverted := tfBGR12;
  2633. fglInternalFormat := GL_RGB12;
  2634. end;
  2635. constructor TfdRGB16.Create;
  2636. begin
  2637. inherited Create;
  2638. fFormat := tfRGB16;
  2639. fWithAlpha := tfRGBA16;
  2640. fWithoutAlpha := tfRGB16;
  2641. fRGBInverted := tfBGR16;
  2642. fglInternalFormat := GL_RGB16;
  2643. end;
  2644. constructor TfdRGBA2.Create;
  2645. begin
  2646. inherited Create;
  2647. fFormat := tfRGBA2;
  2648. fWithAlpha := tfRGBA2;
  2649. fWithoutAlpha := tfR3G3B2;
  2650. fRGBInverted := tfBGRA2;
  2651. fglInternalFormat := GL_RGBA2;
  2652. end;
  2653. constructor TfdRGBA4.Create;
  2654. begin
  2655. inherited Create;
  2656. fFormat := tfRGBA4;
  2657. fWithAlpha := tfRGBA4;
  2658. fWithoutAlpha := tfRGB4;
  2659. fRGBInverted := tfBGRA4;
  2660. fRange.r := $F;
  2661. fRange.g := $F;
  2662. fRange.b := $F;
  2663. fRange.a := $F;
  2664. fShift.r := 0;
  2665. fShift.g := 4;
  2666. fShift.b := 8;
  2667. fShift.a := 12;
  2668. fglFormat := GL_RGBA;
  2669. fglInternalFormat := GL_RGBA4;
  2670. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2671. end;
  2672. constructor TfdRGB5A1.Create;
  2673. begin
  2674. inherited Create;
  2675. fFormat := tfRGB5A1;
  2676. fWithAlpha := tfRGB5A1;
  2677. fWithoutAlpha := tfRGB5;
  2678. fRGBInverted := tfBGR5A1;
  2679. fRange.r := $1F;
  2680. fRange.g := $1F;
  2681. fRange.b := $1F;
  2682. fRange.a := $01;
  2683. fShift.r := 0;
  2684. fShift.g := 5;
  2685. fShift.b := 10;
  2686. fShift.a := 15;
  2687. fglFormat := GL_RGBA;
  2688. fglInternalFormat := GL_RGB5_A1;
  2689. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2690. end;
  2691. constructor TfdRGBA8.Create;
  2692. begin
  2693. inherited Create;
  2694. fFormat := tfRGBA8;
  2695. fWithAlpha := tfRGBA8;
  2696. fWithoutAlpha := tfRGB8;
  2697. fRGBInverted := tfBGRA8;
  2698. fglInternalFormat := GL_RGBA8;
  2699. end;
  2700. constructor TfdRGB10A2.Create;
  2701. begin
  2702. inherited Create;
  2703. fFormat := tfRGB10A2;
  2704. fWithAlpha := tfRGB10A2;
  2705. fWithoutAlpha := tfRGB10;
  2706. fRGBInverted := tfBGR10A2;
  2707. fRange.r := $3FF;
  2708. fRange.g := $3FF;
  2709. fRange.b := $3FF;
  2710. fRange.a := $003;
  2711. fShift.r := 0;
  2712. fShift.g := 10;
  2713. fShift.b := 20;
  2714. fShift.a := 30;
  2715. fglFormat := GL_RGBA;
  2716. fglInternalFormat := GL_RGB10_A2;
  2717. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2718. end;
  2719. constructor TfdRGBA12.Create;
  2720. begin
  2721. inherited Create;
  2722. fFormat := tfRGBA12;
  2723. fWithAlpha := tfRGBA12;
  2724. fWithoutAlpha := tfRGB12;
  2725. fRGBInverted := tfBGRA12;
  2726. fglInternalFormat := GL_RGBA12;
  2727. end;
  2728. constructor TfdRGBA16.Create;
  2729. begin
  2730. inherited Create;
  2731. fFormat := tfRGBA16;
  2732. fWithAlpha := tfRGBA16;
  2733. fWithoutAlpha := tfRGB16;
  2734. fRGBInverted := tfBGRA16;
  2735. fglInternalFormat := GL_RGBA16;
  2736. end;
  2737. constructor TfdBGR4.Create;
  2738. begin
  2739. inherited Create;
  2740. fPixelSize := 2.0;
  2741. fFormat := tfBGR4;
  2742. fWithAlpha := tfBGRA4;
  2743. fWithoutAlpha := tfBGR4;
  2744. fRGBInverted := tfRGB4;
  2745. fRange.r := $F;
  2746. fRange.g := $F;
  2747. fRange.b := $F;
  2748. fRange.a := $0;
  2749. fShift.r := 8;
  2750. fShift.g := 4;
  2751. fShift.b := 0;
  2752. fShift.a := 0;
  2753. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2754. fglInternalFormat := GL_RGB4;
  2755. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2756. end;
  2757. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2758. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2759. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2760. constructor TfdB5G6R5.Create;
  2761. begin
  2762. inherited Create;
  2763. fFormat := tfB5G6R5;
  2764. fWithAlpha := tfBGRA4;
  2765. fWithoutAlpha := tfB5G6R5;
  2766. fRGBInverted := tfR5G6B5;
  2767. fRange.r := $1F;
  2768. fRange.g := $3F;
  2769. fRange.b := $1F;
  2770. fShift.r := 11;
  2771. fShift.g := 5;
  2772. fShift.b := 0;
  2773. fglFormat := GL_RGB; //B5G6R5 is only possible as R5G6B5 -> use reverted dataformat
  2774. fglInternalFormat := GL_RGB8;
  2775. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5;
  2776. end;
  2777. constructor TfdBGR5.Create;
  2778. begin
  2779. inherited Create;
  2780. fPixelSize := 2.0;
  2781. fFormat := tfBGR5;
  2782. fWithAlpha := tfBGR5A1;
  2783. fWithoutAlpha := tfBGR5;
  2784. fRGBInverted := tfRGB5;
  2785. fRange.r := $1F;
  2786. fRange.g := $1F;
  2787. fRange.b := $1F;
  2788. fRange.a := $00;
  2789. fShift.r := 10;
  2790. fShift.g := 5;
  2791. fShift.b := 0;
  2792. fShift.a := 0;
  2793. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2794. fglInternalFormat := GL_RGB5;
  2795. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2796. end;
  2797. constructor TfdBGR8.Create;
  2798. begin
  2799. inherited Create;
  2800. fFormat := tfBGR8;
  2801. fWithAlpha := tfBGRA8;
  2802. fWithoutAlpha := tfBGR8;
  2803. fRGBInverted := tfRGB8;
  2804. fglInternalFormat := GL_RGB8;
  2805. end;
  2806. constructor TfdBGR10.Create;
  2807. begin
  2808. inherited Create;
  2809. fFormat := tfBGR10;
  2810. fWithAlpha := tfBGR10A2;
  2811. fWithoutAlpha := tfBGR10;
  2812. fRGBInverted := tfRGB10;
  2813. fRange.r := $3FF;
  2814. fRange.g := $3FF;
  2815. fRange.b := $3FF;
  2816. fRange.a := $000;
  2817. fShift.r := 20;
  2818. fShift.g := 10;
  2819. fShift.b := 0;
  2820. fShift.a := 0;
  2821. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2822. fglInternalFormat := GL_RGB10;
  2823. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2824. end;
  2825. constructor TfdBGR12.Create;
  2826. begin
  2827. inherited Create;
  2828. fFormat := tfBGR12;
  2829. fWithAlpha := tfBGRA12;
  2830. fWithoutAlpha := tfBGR12;
  2831. fRGBInverted := tfRGB12;
  2832. fglInternalFormat := GL_RGB12;
  2833. end;
  2834. constructor TfdBGR16.Create;
  2835. begin
  2836. inherited Create;
  2837. fFormat := tfBGR16;
  2838. fWithAlpha := tfBGRA16;
  2839. fWithoutAlpha := tfBGR16;
  2840. fRGBInverted := tfRGB16;
  2841. fglInternalFormat := GL_RGB16;
  2842. end;
  2843. constructor TfdBGRA2.Create;
  2844. begin
  2845. inherited Create;
  2846. fFormat := tfBGRA2;
  2847. fWithAlpha := tfBGRA4;
  2848. fWithoutAlpha := tfBGR4;
  2849. fRGBInverted := tfRGBA2;
  2850. fglInternalFormat := GL_RGBA2;
  2851. end;
  2852. constructor TfdBGRA4.Create;
  2853. begin
  2854. inherited Create;
  2855. fFormat := tfBGRA4;
  2856. fWithAlpha := tfBGRA4;
  2857. fWithoutAlpha := tfBGR4;
  2858. fRGBInverted := tfRGBA4;
  2859. fRange.r := $F;
  2860. fRange.g := $F;
  2861. fRange.b := $F;
  2862. fRange.a := $F;
  2863. fShift.r := 8;
  2864. fShift.g := 4;
  2865. fShift.b := 0;
  2866. fShift.a := 12;
  2867. fglFormat := GL_BGRA;
  2868. fglInternalFormat := GL_RGBA4;
  2869. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2870. end;
  2871. constructor TfdBGR5A1.Create;
  2872. begin
  2873. inherited Create;
  2874. fFormat := tfBGR5A1;
  2875. fWithAlpha := tfBGR5A1;
  2876. fWithoutAlpha := tfBGR5;
  2877. fRGBInverted := tfRGB5A1;
  2878. fRange.r := $1F;
  2879. fRange.g := $1F;
  2880. fRange.b := $1F;
  2881. fRange.a := $01;
  2882. fShift.r := 10;
  2883. fShift.g := 5;
  2884. fShift.b := 0;
  2885. fShift.a := 15;
  2886. fglFormat := GL_BGRA;
  2887. fglInternalFormat := GL_RGB5_A1;
  2888. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2889. end;
  2890. constructor TfdBGRA8.Create;
  2891. begin
  2892. inherited Create;
  2893. fFormat := tfBGRA8;
  2894. fWithAlpha := tfBGRA8;
  2895. fWithoutAlpha := tfBGR8;
  2896. fRGBInverted := tfRGBA8;
  2897. fglInternalFormat := GL_RGBA8;
  2898. end;
  2899. constructor TfdBGR10A2.Create;
  2900. begin
  2901. inherited Create;
  2902. fFormat := tfBGR10A2;
  2903. fWithAlpha := tfBGR10A2;
  2904. fWithoutAlpha := tfBGR10;
  2905. fRGBInverted := tfRGB10A2;
  2906. fRange.r := $3FF;
  2907. fRange.g := $3FF;
  2908. fRange.b := $3FF;
  2909. fRange.a := $003;
  2910. fShift.r := 20;
  2911. fShift.g := 10;
  2912. fShift.b := 0;
  2913. fShift.a := 30;
  2914. fglFormat := GL_BGRA;
  2915. fglInternalFormat := GL_RGB10_A2;
  2916. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2917. end;
  2918. constructor TfdBGRA12.Create;
  2919. begin
  2920. inherited Create;
  2921. fFormat := tfBGRA12;
  2922. fWithAlpha := tfBGRA12;
  2923. fWithoutAlpha := tfBGR12;
  2924. fRGBInverted := tfRGBA12;
  2925. fglInternalFormat := GL_RGBA12;
  2926. end;
  2927. constructor TfdBGRA16.Create;
  2928. begin
  2929. inherited Create;
  2930. fFormat := tfBGRA16;
  2931. fWithAlpha := tfBGRA16;
  2932. fWithoutAlpha := tfBGR16;
  2933. fRGBInverted := tfRGBA16;
  2934. fglInternalFormat := GL_RGBA16;
  2935. end;
  2936. constructor TfdDepth16.Create;
  2937. begin
  2938. inherited Create;
  2939. fFormat := tfDepth16;
  2940. fWithAlpha := tfEmpty;
  2941. fWithoutAlpha := tfDepth16;
  2942. fglInternalFormat := GL_DEPTH_COMPONENT16;
  2943. end;
  2944. constructor TfdDepth24.Create;
  2945. begin
  2946. inherited Create;
  2947. fFormat := tfDepth24;
  2948. fWithAlpha := tfEmpty;
  2949. fWithoutAlpha := tfDepth24;
  2950. fglInternalFormat := GL_DEPTH_COMPONENT24;
  2951. end;
  2952. constructor TfdDepth32.Create;
  2953. begin
  2954. inherited Create;
  2955. fFormat := tfDepth32;
  2956. fWithAlpha := tfEmpty;
  2957. fWithoutAlpha := tfDepth32;
  2958. fglInternalFormat := GL_DEPTH_COMPONENT32;
  2959. end;
  2960. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2961. //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2962. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2963. procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2964. begin
  2965. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  2966. end;
  2967. procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2968. begin
  2969. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  2970. end;
  2971. constructor TfdS3tcDtx1RGBA.Create;
  2972. begin
  2973. inherited Create;
  2974. fFormat := tfS3tcDtx1RGBA;
  2975. fWithAlpha := tfS3tcDtx1RGBA;
  2976. fUncompressed := tfRGB5A1;
  2977. fPixelSize := 0.5;
  2978. fIsCompressed := true;
  2979. fglFormat := GL_COMPRESSED_RGBA;
  2980. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
  2981. fglDataFormat := GL_UNSIGNED_BYTE;
  2982. end;
  2983. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2984. //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2985. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2986. procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2987. begin
  2988. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  2989. end;
  2990. procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2991. begin
  2992. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  2993. end;
  2994. constructor TfdS3tcDtx3RGBA.Create;
  2995. begin
  2996. inherited Create;
  2997. fFormat := tfS3tcDtx3RGBA;
  2998. fWithAlpha := tfS3tcDtx3RGBA;
  2999. fUncompressed := tfRGBA8;
  3000. fPixelSize := 1.0;
  3001. fIsCompressed := true;
  3002. fglFormat := GL_COMPRESSED_RGBA;
  3003. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
  3004. fglDataFormat := GL_UNSIGNED_BYTE;
  3005. end;
  3006. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3007. //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3008. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3009. procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3010. begin
  3011. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  3012. end;
  3013. procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3014. begin
  3015. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  3016. end;
  3017. constructor TfdS3tcDtx5RGBA.Create;
  3018. begin
  3019. inherited Create;
  3020. fFormat := tfS3tcDtx3RGBA;
  3021. fWithAlpha := tfS3tcDtx3RGBA;
  3022. fUncompressed := tfRGBA8;
  3023. fPixelSize := 1.0;
  3024. fIsCompressed := true;
  3025. fglFormat := GL_COMPRESSED_RGBA;
  3026. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
  3027. fglDataFormat := GL_UNSIGNED_BYTE;
  3028. end;
  3029. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3030. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3031. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3032. class procedure TFormatDescriptor.Init;
  3033. begin
  3034. if not Assigned(FormatDescriptorCS) then
  3035. FormatDescriptorCS := TCriticalSection.Create;
  3036. end;
  3037. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3038. class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3039. begin
  3040. FormatDescriptorCS.Enter;
  3041. try
  3042. result := FormatDescriptors[aFormat];
  3043. if not Assigned(result) then begin
  3044. result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
  3045. FormatDescriptors[aFormat] := result;
  3046. end;
  3047. finally
  3048. FormatDescriptorCS.Leave;
  3049. end;
  3050. end;
  3051. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3052. class function TFormatDescriptor.GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3053. begin
  3054. result := Get(Get(aFormat).WithAlpha);
  3055. end;
  3056. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3057. class procedure TFormatDescriptor.Clear;
  3058. var
  3059. f: TglBitmapFormat;
  3060. begin
  3061. FormatDescriptorCS.Enter;
  3062. try
  3063. for f := low(FormatDescriptors) to high(FormatDescriptors) do
  3064. FreeAndNil(FormatDescriptors[f]);
  3065. finally
  3066. FormatDescriptorCS.Leave;
  3067. end;
  3068. end;
  3069. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3070. class procedure TFormatDescriptor.Finalize;
  3071. begin
  3072. Clear;
  3073. FreeAndNil(FormatDescriptorCS);
  3074. end;
  3075. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3076. //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3077. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3078. procedure TbmpBitfieldFormat.SetRedMask(const aValue: UInt64);
  3079. begin
  3080. Update(aValue, fRange.r, fShift.r);
  3081. end;
  3082. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3083. procedure TbmpBitfieldFormat.SetGreenMask(const aValue: UInt64);
  3084. begin
  3085. Update(aValue, fRange.g, fShift.g);
  3086. end;
  3087. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3088. procedure TbmpBitfieldFormat.SetBlueMask(const aValue: UInt64);
  3089. begin
  3090. Update(aValue, fRange.b, fShift.b);
  3091. end;
  3092. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3093. procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: UInt64);
  3094. begin
  3095. Update(aValue, fRange.a, fShift.a);
  3096. end;
  3097. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3098. procedure TbmpBitfieldFormat.Update(aMask: UInt64; out aRange: Cardinal; out
  3099. aShift: Byte);
  3100. begin
  3101. aShift := 0;
  3102. aRange := 0;
  3103. if (aMask = 0) then
  3104. exit;
  3105. while (aMask > 0) and ((aMask and 1) = 0) do begin
  3106. inc(aShift);
  3107. aMask := aMask shr 1;
  3108. end;
  3109. aRange := 1;
  3110. while (aMask > 0) do begin
  3111. aRange := aRange shl 1;
  3112. aMask := aMask shr 1;
  3113. end;
  3114. dec(aRange);
  3115. fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
  3116. end;
  3117. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3118. procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3119. var
  3120. data: UInt64;
  3121. s: Integer;
  3122. type
  3123. PUInt64 = ^UInt64;
  3124. begin
  3125. data :=
  3126. ((aPixel.Data.r and fRange.r) shl fShift.r) or
  3127. ((aPixel.Data.g and fRange.g) shl fShift.g) or
  3128. ((aPixel.Data.b and fRange.b) shl fShift.b) or
  3129. ((aPixel.Data.a and fRange.a) shl fShift.a);
  3130. s := Round(fPixelSize);
  3131. case s of
  3132. 1: aData^ := data;
  3133. 2: PWord(aData)^ := data;
  3134. 4: PCardinal(aData)^ := data;
  3135. 8: PUInt64(aData)^ := data;
  3136. else
  3137. raise EglBitmapException.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
  3138. end;
  3139. inc(aData, s);
  3140. end;
  3141. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3142. procedure TbmpBitfieldFormat.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3143. var
  3144. data: UInt64;
  3145. s, i: Integer;
  3146. type
  3147. PUInt64 = ^UInt64;
  3148. begin
  3149. s := Round(fPixelSize);
  3150. case s of
  3151. 1: data := aData^;
  3152. 2: data := PWord(aData)^;
  3153. 4: data := PCardinal(aData)^;
  3154. 8: data := PUInt64(aData)^;
  3155. else
  3156. raise EglBitmapException.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
  3157. end;
  3158. for i := 0 to 3 do
  3159. aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
  3160. inc(aData, s);
  3161. end;
  3162. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3163. //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3164. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3165. procedure TbmpColorTableFormat.CreateColorTable;
  3166. var
  3167. bits: Byte;
  3168. len: Integer;
  3169. i: Integer;
  3170. begin
  3171. if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
  3172. raise EglBitmapException.Create(UNSUPPORTED_FORMAT);
  3173. if (Format = tfLuminance4) then
  3174. SetLength(fColorTable, 16)
  3175. else
  3176. SetLength(fColorTable, 256);
  3177. case Format of
  3178. tfLuminance4: begin
  3179. for i := 0 to High(fColorTable) do begin
  3180. fColorTable[i].r := 16 * i;
  3181. fColorTable[i].g := 16 * i;
  3182. fColorTable[i].b := 16 * i;
  3183. fColorTable[i].a := 0;
  3184. end;
  3185. end;
  3186. tfLuminance8: begin
  3187. for i := 0 to High(fColorTable) do begin
  3188. fColorTable[i].r := i;
  3189. fColorTable[i].g := i;
  3190. fColorTable[i].b := i;
  3191. fColorTable[i].a := 0;
  3192. end;
  3193. end;
  3194. tfR3G3B2: begin
  3195. for i := 0 to High(fColorTable) do begin
  3196. fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
  3197. fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
  3198. fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
  3199. fColorTable[i].a := 0;
  3200. end;
  3201. end;
  3202. end;
  3203. end;
  3204. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3205. procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3206. var
  3207. d: Byte;
  3208. begin
  3209. if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
  3210. raise EglBitmapException.Create(UNSUPPORTED_FORMAT);
  3211. case Format of
  3212. tfLuminance4: begin
  3213. if (aMapData = nil) then
  3214. aData^ := 0;
  3215. d := LuminanceWeight(aPixel) and Range.r;
  3216. aData^ := aData^ or (d shl (4 - PtrInt(aMapData)));
  3217. inc(aMapData, 4);
  3218. if (PtrInt(aMapData) >= 8) then begin
  3219. inc(aData);
  3220. aMapData := nil;
  3221. end;
  3222. end;
  3223. tfLuminance8: begin
  3224. aData^ := LuminanceWeight(aPixel) and Range.r;
  3225. inc(aData);
  3226. end;
  3227. tfR3G3B2: begin
  3228. aData^ := Round(
  3229. ((aPixel.Data.r and Range.r) shl Shift.r) or
  3230. ((aPixel.Data.g and Range.g) shl Shift.g) or
  3231. ((aPixel.Data.b and Range.b) shl Shift.b));
  3232. inc(aData);
  3233. end;
  3234. end;
  3235. end;
  3236. procedure TbmpColorTableFormat.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3237. type
  3238. PUInt64 = ^UInt64;
  3239. var
  3240. idx: UInt64;
  3241. s: Integer;
  3242. bits: Byte;
  3243. f: Single;
  3244. begin
  3245. s := Trunc(fPixelSize);
  3246. f := fPixelSize - s;
  3247. bits := Round(8 * f);
  3248. case s of
  3249. 0: idx := (aData^ shr (8 - bits - PtrInt(aMapData))) and ((1 shl bits) - 1);
  3250. 1: idx := aData^;
  3251. 2: idx := PWord(aData)^;
  3252. 4: idx := PCardinal(aData)^;
  3253. 8: idx := PUInt64(aData)^;
  3254. else
  3255. raise EglBitmapException.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
  3256. end;
  3257. if (idx >= Length(fColorTable)) then
  3258. raise EglBitmapException.CreateFmt('invalid color index: %d', [idx]);
  3259. with fColorTable[idx] do begin
  3260. aPixel.Data.r := r;
  3261. aPixel.Data.g := g;
  3262. aPixel.Data.b := b;
  3263. aPixel.Data.a := a;
  3264. end;
  3265. inc(aMapData, bits);
  3266. if (PtrInt(aMapData) >= 8) then begin
  3267. inc(aData, 1);
  3268. dec(aMapData, 8);
  3269. end;
  3270. inc(aData, s);
  3271. end;
  3272. destructor TbmpColorTableFormat.Destroy;
  3273. begin
  3274. SetLength(fColorTable, 0);
  3275. inherited Destroy;
  3276. end;
  3277. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3278. //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3279. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3280. procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
  3281. begin
  3282. with aFuncRec do begin
  3283. if (Source.Range.r > 0) then
  3284. Dest.Data.r := Source.Data.r;
  3285. if (Source.Range.g > 0) then
  3286. Dest.Data.g := Source.Data.g;
  3287. if (Source.Range.b > 0) then
  3288. Dest.Data.b := Source.Data.b;
  3289. if (Source.Range.a > 0) then
  3290. Dest.Data.a := Source.Data.a;
  3291. end;
  3292. end;
  3293. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3294. procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3295. var
  3296. i: Integer;
  3297. begin
  3298. with aFuncRec do begin
  3299. for i := 0 to 3 do
  3300. if (Source.Range.arr[i] > 0) then
  3301. Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
  3302. end;
  3303. end;
  3304. type
  3305. TShiftData = packed record
  3306. case Integer of
  3307. 0: (r, g, b, a: SmallInt);
  3308. 1: (arr: array[0..3] of SmallInt);
  3309. end;
  3310. PShiftData = ^TShiftData;
  3311. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3312. procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3313. var
  3314. i: Integer;
  3315. begin
  3316. with aFuncRec do
  3317. for i := 0 to 3 do
  3318. if (Source.Range.arr[i] > 0) then
  3319. Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
  3320. end;
  3321. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3322. procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
  3323. begin
  3324. with aFuncRec do begin
  3325. Dest.Data.r := Source.Data.r;
  3326. Dest.Data.g := Source.Data.g;
  3327. Dest.Data.b := Source.Data.b;
  3328. Dest.Data.a := Source.Data.a;
  3329. if (Args and $1 > 0) then begin
  3330. Dest.Data.r := Dest.Data.r xor Dest.Range.r;
  3331. Dest.Data.g := Dest.Data.g xor Dest.Range.g;
  3332. Dest.Data.b := Dest.Data.b xor Dest.Range.b;
  3333. end;
  3334. if (Args and $2 > 0) then begin
  3335. Dest.Data.a := Dest.Data.a xor Dest.Range.a;
  3336. end;
  3337. end;
  3338. end;
  3339. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3340. procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
  3341. var
  3342. i: Integer;
  3343. begin
  3344. with aFuncRec do begin
  3345. for i := 0 to 3 do
  3346. Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
  3347. end;
  3348. end;
  3349. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3350. procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3351. var
  3352. Temp: Single;
  3353. begin
  3354. with FuncRec do begin
  3355. if (FuncRec.Args = 0) then begin //source has no alpha
  3356. Temp :=
  3357. Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
  3358. Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
  3359. Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
  3360. Dest.Data.a := Round(Dest.Range.a * Temp);
  3361. end else
  3362. Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
  3363. end;
  3364. end;
  3365. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3366. procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3367. type
  3368. PglBitmapPixelData = ^TglBitmapPixelData;
  3369. begin
  3370. with FuncRec do begin
  3371. Dest.Data.r := Source.Data.r;
  3372. Dest.Data.g := Source.Data.g;
  3373. Dest.Data.b := Source.Data.b;
  3374. with PglBitmapPixelData(Args)^ do
  3375. if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
  3376. (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
  3377. (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
  3378. Dest.Data.a := 0
  3379. else
  3380. Dest.Data.a := Dest.Range.a;
  3381. end;
  3382. end;
  3383. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3384. procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3385. type
  3386. PglBitmapPixelData = ^TglBitmapPixelData;
  3387. begin
  3388. with FuncRec do begin
  3389. Dest.Data.r := Source.Data.r;
  3390. Dest.Data.g := Source.Data.g;
  3391. Dest.Data.b := Source.Data.b;
  3392. Dest.Data.a := PCardinal(Args)^;
  3393. end;
  3394. end;
  3395. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3396. procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
  3397. type
  3398. PRGBPix = ^TRGBPix;
  3399. TRGBPix = array [0..2] of byte;
  3400. var
  3401. Temp: Byte;
  3402. begin
  3403. while aWidth > 0 do begin
  3404. Temp := PRGBPix(aData)^[0];
  3405. PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
  3406. PRGBPix(aData)^[2] := Temp;
  3407. if aHasAlpha then
  3408. Inc(aData, 4)
  3409. else
  3410. Inc(aData, 3);
  3411. dec(aWidth);
  3412. end;
  3413. end;
  3414. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3415. //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3416. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3417. function TglBitmap.GetWidth: Integer;
  3418. begin
  3419. if (ffX in fDimension.Fields) then
  3420. result := fDimension.X
  3421. else
  3422. result := -1;
  3423. end;
  3424. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3425. function TglBitmap.GetHeight: Integer;
  3426. begin
  3427. if (ffY in fDimension.Fields) then
  3428. result := fDimension.Y
  3429. else
  3430. result := -1;
  3431. end;
  3432. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3433. function TglBitmap.GetFileWidth: Integer;
  3434. begin
  3435. result := Max(1, Width);
  3436. end;
  3437. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3438. function TglBitmap.GetFileHeight: Integer;
  3439. begin
  3440. result := Max(1, Height);
  3441. end;
  3442. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3443. procedure TglBitmap.SetCustomData(const aValue: Pointer);
  3444. begin
  3445. if fCustomData = aValue then
  3446. exit;
  3447. fCustomData := aValue;
  3448. end;
  3449. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3450. procedure TglBitmap.SetCustomName(const aValue: String);
  3451. begin
  3452. if fCustomName = aValue then
  3453. exit;
  3454. fCustomName := aValue;
  3455. end;
  3456. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3457. procedure TglBitmap.SetCustomNameW(const aValue: WideString);
  3458. begin
  3459. if fCustomNameW = aValue then
  3460. exit;
  3461. fCustomNameW := aValue;
  3462. end;
  3463. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3464. procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
  3465. begin
  3466. if fDeleteTextureOnFree = aValue then
  3467. exit;
  3468. fDeleteTextureOnFree := aValue;
  3469. end;
  3470. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3471. procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
  3472. begin
  3473. if fFormat = aValue then
  3474. exit;
  3475. if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
  3476. raise EglBitmapUnsupportedFormatFormat.Create('SetInternalFormat - ' + UNSUPPORTED_FORMAT);
  3477. SetDataPointer(Data, aValue, Width, Height);
  3478. end;
  3479. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3480. procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
  3481. begin
  3482. if fFreeDataAfterGenTexture = aValue then
  3483. exit;
  3484. fFreeDataAfterGenTexture := aValue;
  3485. end;
  3486. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3487. procedure TglBitmap.SetID(const aValue: Cardinal);
  3488. begin
  3489. if fID = aValue then
  3490. exit;
  3491. fID := aValue;
  3492. end;
  3493. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3494. procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
  3495. begin
  3496. if fMipMap = aValue then
  3497. exit;
  3498. fMipMap := aValue;
  3499. end;
  3500. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3501. procedure TglBitmap.SetTarget(const aValue: Cardinal);
  3502. begin
  3503. if fTarget = aValue then
  3504. exit;
  3505. fTarget := aValue;
  3506. end;
  3507. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3508. procedure TglBitmap.SetAnisotropic(const aValue: Integer);
  3509. var
  3510. MaxAnisotropic: Integer;
  3511. begin
  3512. fAnisotropic := aValue;
  3513. if (ID > 0) then begin
  3514. if GL_EXT_texture_filter_anisotropic then begin
  3515. if fAnisotropic > 0 then begin
  3516. Bind(false);
  3517. glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
  3518. if aValue > MaxAnisotropic then
  3519. fAnisotropic := MaxAnisotropic;
  3520. glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
  3521. end;
  3522. end else begin
  3523. fAnisotropic := 0;
  3524. end;
  3525. end;
  3526. end;
  3527. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3528. procedure TglBitmap.CreateID;
  3529. begin
  3530. if (ID <> 0) then
  3531. glDeleteTextures(1, @fID);
  3532. glGenTextures(1, @fID);
  3533. Bind(false);
  3534. end;
  3535. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3536. procedure TglBitmap.SetupParameters(var aBuildWithGlu: Boolean);
  3537. begin
  3538. // Set Up Parameters
  3539. SetWrap(fWrapS, fWrapT, fWrapR);
  3540. SetFilter(fFilterMin, fFilterMag);
  3541. SetAnisotropic(fAnisotropic);
  3542. SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
  3543. // Mip Maps Generation Mode
  3544. aBuildWithGlu := false;
  3545. if (MipMap = mmMipmap) then begin
  3546. if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
  3547. glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
  3548. else
  3549. aBuildWithGlu := true;
  3550. end else if (MipMap = mmMipmapGlu) then
  3551. aBuildWithGlu := true;
  3552. end;
  3553. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3554. procedure TglBitmap.SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
  3555. const aWidth: Integer; const aHeight: Integer);
  3556. var
  3557. s: Single;
  3558. begin
  3559. if (Data <> aData) then begin
  3560. if (Assigned(Data)) then
  3561. FreeMem(Data);
  3562. fData := aData;
  3563. end;
  3564. FillChar(fDimension, SizeOf(fDimension), 0);
  3565. if not Assigned(fData) then begin
  3566. fFormat := tfEmpty;
  3567. fPixelSize := 0;
  3568. fRowSize := 0;
  3569. end else begin
  3570. if aWidth <> -1 then begin
  3571. fDimension.Fields := fDimension.Fields + [ffX];
  3572. fDimension.X := aWidth;
  3573. end;
  3574. if aHeight <> -1 then begin
  3575. fDimension.Fields := fDimension.Fields + [ffY];
  3576. fDimension.Y := aHeight;
  3577. end;
  3578. s := TFormatDescriptor.Get(aFormat).PixelSize;
  3579. fFormat := aFormat;
  3580. fPixelSize := Ceil(s);
  3581. fRowSize := Ceil(s * aWidth);
  3582. end;
  3583. end;
  3584. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3585. function TglBitmap.FlipHorz: Boolean;
  3586. begin
  3587. result := false;
  3588. end;
  3589. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3590. function TglBitmap.FlipVert: Boolean;
  3591. begin
  3592. result := false;
  3593. end;
  3594. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3595. //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3596. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3597. procedure TglBitmap.AfterConstruction;
  3598. begin
  3599. inherited AfterConstruction;
  3600. fID := 0;
  3601. fTarget := 0;
  3602. fIsResident := false;
  3603. fFormat := glBitmapGetDefaultFormat;
  3604. fMipMap := glBitmapDefaultMipmap;
  3605. fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
  3606. fDeleteTextureOnFree := glBitmapGetDefaultDeleteTextureOnFree;
  3607. glBitmapGetDefaultFilter (fFilterMin, fFilterMag);
  3608. glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
  3609. end;
  3610. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3611. procedure TglBitmap.BeforeDestruction;
  3612. begin
  3613. SetDataPointer(nil, tfEmpty);
  3614. if (fID > 0) and fDeleteTextureOnFree then
  3615. glDeleteTextures(1, @fID);
  3616. inherited BeforeDestruction;
  3617. end;
  3618. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3619. procedure TglBitmap.LoadFromFile(const aFilename: String);
  3620. var
  3621. fs: TFileStream;
  3622. begin
  3623. if not FileExists(aFilename) then
  3624. raise EglBitmapException.Create('file does not exist: ' + aFilename);
  3625. fFilename := aFilename;
  3626. fs := TFileStream.Create(fFilename, fmOpenRead);
  3627. try
  3628. fs.Position := 0;
  3629. LoadFromStream(fs);
  3630. finally
  3631. fs.Free;
  3632. end;
  3633. end;
  3634. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3635. procedure TglBitmap.LoadFromStream(const aStream: TStream);
  3636. begin
  3637. {$IFDEF GLB_SUPPORT_PNG_READ}
  3638. if not LoadPNG(aStream) then
  3639. {$ENDIF}
  3640. {$IFDEF GLB_SUPPORT_JPEG_READ}
  3641. if not LoadJPEG(aStream) then
  3642. {$ENDIF}
  3643. if not LoadDDS(aStream) then
  3644. if not LoadTGA(aStream) then
  3645. if not LoadBMP(aStream) then
  3646. raise EglBitmapException.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
  3647. end;
  3648. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3649. procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  3650. const aFormat: TglBitmapFormat; const aArgs: PtrInt);
  3651. var
  3652. tmpData: PByte;
  3653. size: Integer;
  3654. begin
  3655. size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  3656. GetMem(tmpData, size);
  3657. try
  3658. FillChar(tmpData^, size, #$FF);
  3659. SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y);
  3660. except
  3661. FreeMem(tmpData);
  3662. raise;
  3663. end;
  3664. AddFunc(Self, aFunc, false, Format, aArgs);
  3665. end;
  3666. {$IFDEF GLB_DELPHI}
  3667. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3668. procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil);
  3669. var
  3670. rs: TResourceStream;
  3671. TempPos: Integer;
  3672. ResTypeStr: String;
  3673. TempResType: PChar;
  3674. begin
  3675. if not Assigned(ResType) then begin
  3676. TempPos := Pos('.', Resource);
  3677. ResTypeStr := UpperCase(Copy(Resource, TempPos + 1, Length(Resource) - TempPos));
  3678. Resource := UpperCase(Copy(Resource, 0, TempPos -1));
  3679. TempResType := PChar(ResTypeStr);
  3680. end else
  3681. TempResType := ResType
  3682. rs := TResourceStream.Create(Instance, Resource, TempResType);
  3683. try
  3684. LoadFromStream(rs);
  3685. finally
  3686. rs.Free;
  3687. end;
  3688. end;
  3689. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3690. procedure TglBitmap.LoadFromResourceID(const sInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  3691. var
  3692. rs: TResourceStream;
  3693. begin
  3694. rs := TResourceStream.CreateFromID(Instance, ResourceID, ResType);
  3695. try
  3696. LoadFromStream(rs);
  3697. finally
  3698. rs.Free;
  3699. end;
  3700. end;
  3701. {$ENDIF}
  3702. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3703. procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  3704. var
  3705. fs: TFileStream;
  3706. begin
  3707. fs := TFileStream.Create(aFileName, fmCreate);
  3708. try
  3709. fs.Position := 0;
  3710. SaveToStream(fs, aFileType);
  3711. finally
  3712. fs.Free;
  3713. end;
  3714. end;
  3715. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3716. procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
  3717. begin
  3718. case aFileType of
  3719. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  3720. ftPNG: SavePng(aStream);
  3721. {$ENDIF}
  3722. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  3723. ftJPEG: SaveJPEG(aStream);
  3724. {$ENDIF}
  3725. ftDDS: SaveDDS(aStream);
  3726. ftTGA: SaveTGA(aStream);
  3727. ftBMP: SaveBMP(aStream);
  3728. end;
  3729. end;
  3730. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3731. function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: PtrInt): Boolean;
  3732. begin
  3733. result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
  3734. end;
  3735. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3736. function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  3737. const aFormat: TglBitmapFormat; const aArgs: PtrInt): Boolean;
  3738. var
  3739. DestData, TmpData, SourceData: pByte;
  3740. TempHeight, TempWidth: Integer;
  3741. SourceFD, DestFD: TFormatDescriptor;
  3742. SourceMD, DestMD: Pointer;
  3743. FuncRec: TglBitmapFunctionRec;
  3744. begin
  3745. Assert(Assigned(Data));
  3746. Assert(Assigned(aSource));
  3747. Assert(Assigned(aSource.Data));
  3748. result := false;
  3749. if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
  3750. SourceFD := TFormatDescriptor.Get(aSource.Format);
  3751. DestFD := TFormatDescriptor.Get(aFormat);
  3752. // inkompatible Formats so CreateTemp
  3753. if (SourceFD.PixelSize <> DestFD.PixelSize) then
  3754. aCreateTemp := true;
  3755. // Values
  3756. TempHeight := Max(1, aSource.Height);
  3757. TempWidth := Max(1, aSource.Width);
  3758. FuncRec.Sender := Self;
  3759. FuncRec.Args := aArgs;
  3760. TmpData := nil;
  3761. if aCreateTemp then begin
  3762. GetMem(TmpData, TFormatDescriptor.Get(aFormat).GetSize(TempWidth, TempHeight));
  3763. DestData := TmpData;
  3764. end else
  3765. DestData := Data;
  3766. try
  3767. SourceFD.PreparePixel(FuncRec.Source);
  3768. DestFD.PreparePixel (FuncRec.Dest);
  3769. SourceMD := SourceFD.CreateMappingData;
  3770. DestMD := DestFD.CreateMappingData;
  3771. FuncRec.Size := aSource.Dimension;
  3772. FuncRec.Position.Fields := FuncRec.Size.Fields;
  3773. try
  3774. SourceData := aSource.Data;
  3775. FuncRec.Position.Y := 0;
  3776. while FuncRec.Position.Y < TempHeight do begin
  3777. FuncRec.Position.X := 0;
  3778. while FuncRec.Position.X < TempWidth do begin
  3779. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  3780. aFunc(FuncRec);
  3781. DestFD.Map(FuncRec.Dest, DestData, DestMD);
  3782. inc(FuncRec.Position.X);
  3783. end;
  3784. inc(FuncRec.Position.Y);
  3785. end;
  3786. // Updating Image or InternalFormat
  3787. if aCreateTemp then
  3788. SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height)
  3789. else if (aFormat <> fFormat) then
  3790. Format := aFormat;
  3791. result := true;
  3792. finally
  3793. SourceFD.FreeMappingData(SourceMD);
  3794. DestFD.FreeMappingData(DestMD);
  3795. end;
  3796. except
  3797. if aCreateTemp then
  3798. FreeMem(TmpData);
  3799. raise;
  3800. end;
  3801. end;
  3802. end;
  3803. {$IFDEF GLB_SDL}
  3804. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3805. function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  3806. var
  3807. Row, RowSize: Integer;
  3808. SourceData, TmpData: PByte;
  3809. TempDepth: Integer;
  3810. Pix: TglBitmapPixelData;
  3811. FormatDesc: TglBitmapFormatDescriptor;
  3812. function GetRowPointer(Row: Integer): pByte;
  3813. begin
  3814. result := Surface.pixels;
  3815. Inc(result, Row * RowSize);
  3816. end;
  3817. begin
  3818. result := false;
  3819. (* TODO
  3820. if not FormatIsUncompressed(InternalFormat) then
  3821. raise EglBitmapUnsupportedInternalFormat.Create('AssignToSurface - ' + UNSUPPORTED_INTERNAL_FORMAT);
  3822. *)
  3823. FormatDesc := FORMAT_DESCRIPTORS[Format];
  3824. if Assigned(Data) then begin
  3825. case Trunc(FormatDesc.GetSize) of
  3826. 1: TempDepth := 8;
  3827. 2: TempDepth := 16;
  3828. 3: TempDepth := 24;
  3829. 4: TempDepth := 32;
  3830. else
  3831. raise EglBitmapException.Create('AssignToSurface - ' + UNSUPPORTED_INTERNAL_FORMAT);
  3832. end;
  3833. FormatDesc.PreparePixel(Pix);
  3834. with Pix.PixelDesc do
  3835. Surface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
  3836. RedRange shl RedShift, GreenRange shl GreenShift, BlueRange shl BlueShift, AlphaRange shl AlphaShift);
  3837. SourceData := Data;
  3838. RowSize := Ceil(FileWidth * FormatDesc.GetSize);
  3839. for Row := 0 to FileHeight -1 do begin
  3840. TmpData := GetRowPointer(Row);
  3841. if Assigned(TmpData) then begin
  3842. Move(SourceData^, TmpData^, RowSize);
  3843. inc(SourceData, RowSize);
  3844. end;
  3845. end;
  3846. result := true;
  3847. end;
  3848. end;
  3849. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3850. function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  3851. var
  3852. pSource, pData, pTempData: PByte;
  3853. Row, RowSize, TempWidth, TempHeight: Integer;
  3854. IntFormat, f: TglBitmapInternalFormat;
  3855. FormatDesc: TglBitmapFormatDescriptor;
  3856. function GetRowPointer(Row: Integer): pByte;
  3857. begin
  3858. result := Surface^.pixels;
  3859. Inc(result, Row * RowSize);
  3860. end;
  3861. begin
  3862. result := false;
  3863. if (Assigned(Surface)) then begin
  3864. with Surface^.format^ do begin
  3865. IntFormat := tfEmpty;
  3866. for f := Low(f) to High(f) do begin
  3867. if FORMAT_DESCRIPTORS[f].MaskMatch(RMask, GMask, BMask, AMask) then begin
  3868. IntFormat := f;
  3869. break;
  3870. end;
  3871. end;
  3872. if (IntFormat = tfEmpty) then
  3873. raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
  3874. end;
  3875. FormatDesc := FORMAT_DESCRIPTORS[IntFormat];
  3876. TempWidth := Surface^.w;
  3877. TempHeight := Surface^.h;
  3878. RowSize := Trunc(TempWidth * FormatDesc.GetSize);
  3879. GetMem(pData, TempHeight * RowSize);
  3880. try
  3881. pTempData := pData;
  3882. for Row := 0 to TempHeight -1 do begin
  3883. pSource := GetRowPointer(Row);
  3884. if (Assigned(pSource)) then begin
  3885. Move(pSource^, pTempData^, RowSize);
  3886. Inc(pTempData, RowSize);
  3887. end;
  3888. end;
  3889. SetDataPointer(pData, IntFormat, TempWidth, TempHeight);
  3890. result := true;
  3891. except
  3892. FreeMem(pData);
  3893. raise;
  3894. end;
  3895. end;
  3896. end;
  3897. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3898. function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  3899. var
  3900. Row, Col, AlphaInterleave: Integer;
  3901. pSource, pDest: PByte;
  3902. function GetRowPointer(Row: Integer): pByte;
  3903. begin
  3904. result := aSurface.pixels;
  3905. Inc(result, Row * Width);
  3906. end;
  3907. begin
  3908. result := false;
  3909. if Assigned(Data) then begin
  3910. if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
  3911. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
  3912. AlphaInterleave := 0;
  3913. case Format of
  3914. ifLuminance8Alpha8:
  3915. AlphaInterleave := 1;
  3916. ifBGRA8, ifRGBA8:
  3917. AlphaInterleave := 3;
  3918. end;
  3919. pSource := Data;
  3920. for Row := 0 to Height -1 do begin
  3921. pDest := GetRowPointer(Row);
  3922. if Assigned(pDest) then begin
  3923. for Col := 0 to Width -1 do begin
  3924. Inc(pSource, AlphaInterleave);
  3925. pDest^ := pSource^;
  3926. Inc(pDest);
  3927. Inc(pSource);
  3928. end;
  3929. end;
  3930. end;
  3931. result := true;
  3932. end;
  3933. end;
  3934. end;
  3935. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3936. function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
  3937. var
  3938. bmp: TglBitmap2D;
  3939. begin
  3940. bmp := TglBitmap2D.Create;
  3941. try
  3942. bmp.AssignFromSurface(Surface);
  3943. result := AddAlphaFromGlBitmap(bmp, Func, CustomData);
  3944. finally
  3945. bmp.Free;
  3946. end;
  3947. end;
  3948. {$ENDIF}
  3949. {$IFDEF GLB_DELPHI}
  3950. //TODO rework & test
  3951. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3952. function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
  3953. var
  3954. Row: Integer;
  3955. pSource, pData: PByte;
  3956. begin
  3957. result := false;
  3958. if Assigned(Data) then begin
  3959. if Assigned(aBitmap) then begin
  3960. aBitmap.Width := Width;
  3961. aBitmap.Height := Height;
  3962. case Format of
  3963. tfAlpha8, ifLuminance, ifDepth8:
  3964. begin
  3965. Bitmap.PixelFormat := pf8bit;
  3966. Bitmap.Palette := CreateGrayPalette;
  3967. end;
  3968. ifRGB5A1:
  3969. Bitmap.PixelFormat := pf15bit;
  3970. ifR5G6B5:
  3971. Bitmap.PixelFormat := pf16bit;
  3972. ifRGB8, ifBGR8:
  3973. Bitmap.PixelFormat := pf24bit;
  3974. ifRGBA8, ifBGRA8:
  3975. Bitmap.PixelFormat := pf32bit;
  3976. else
  3977. raise EglBitmapException.Create('AssignToBitmap - Invalid Pixelformat.');
  3978. end;
  3979. pSource := Data;
  3980. for Row := 0 to FileHeight -1 do begin
  3981. pData := Bitmap.Scanline[Row];
  3982. Move(pSource^, pData^, fRowSize);
  3983. Inc(pSource, fRowSize);
  3984. // swap RGB(A) to BGR(A)
  3985. if InternalFormat in [ifRGB8, ifRGBA8] then
  3986. SwapRGB(pData, FileWidth, InternalFormat = ifRGBA8);
  3987. end;
  3988. result := true;
  3989. end;
  3990. end;
  3991. end;
  3992. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3993. function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  3994. var
  3995. pSource, pData, pTempData: PByte;
  3996. Row, RowSize, TempWidth, TempHeight: Integer;
  3997. IntFormat: TglBitmapInternalFormat;
  3998. begin
  3999. result := false;
  4000. if (Assigned(Bitmap)) then begin
  4001. case Bitmap.PixelFormat of
  4002. pf8bit:
  4003. IntFormat := ifLuminance;
  4004. pf15bit:
  4005. IntFormat := ifRGB5A1;
  4006. pf16bit:
  4007. IntFormat := ifR5G6B5;
  4008. pf24bit:
  4009. IntFormat := ifBGR8;
  4010. pf32bit:
  4011. IntFormat := ifBGRA8;
  4012. else
  4013. raise EglBitmapException.Create('AssignFromBitmap - Invalid Pixelformat.');
  4014. end;
  4015. TempWidth := Bitmap.Width;
  4016. TempHeight := Bitmap.Height;
  4017. RowSize := Trunc(TempWidth * FormatGetSize(IntFormat));
  4018. GetMem(pData, TempHeight * RowSize);
  4019. try
  4020. pTempData := pData;
  4021. for Row := 0 to TempHeight -1 do begin
  4022. pSource := Bitmap.Scanline[Row];
  4023. if (Assigned(pSource)) then begin
  4024. Move(pSource^, pTempData^, RowSize);
  4025. Inc(pTempData, RowSize);
  4026. end;
  4027. end;
  4028. SetDataPointer(pData, IntFormat, TempWidth, TempHeight);
  4029. result := true;
  4030. except
  4031. FreeMem(pData);
  4032. raise;
  4033. end;
  4034. end;
  4035. end;
  4036. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4037. function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  4038. var
  4039. Row, Col, AlphaInterleave: Integer;
  4040. pSource, pDest: PByte;
  4041. begin
  4042. result := false;
  4043. if Assigned(Data) then begin
  4044. if InternalFormat in [ifAlpha, ifLuminanceAlpha, ifRGBA8, ifBGRA8] then begin
  4045. if Assigned(Bitmap) then begin
  4046. Bitmap.PixelFormat := pf8bit;
  4047. Bitmap.Palette := CreateGrayPalette;
  4048. Bitmap.Width := Width;
  4049. Bitmap.Height := Height;
  4050. case InternalFormat of
  4051. ifLuminanceAlpha:
  4052. AlphaInterleave := 1;
  4053. ifRGBA8, ifBGRA8:
  4054. AlphaInterleave := 3;
  4055. else
  4056. AlphaInterleave := 0;
  4057. end;
  4058. // Copy Data
  4059. pSource := Data;
  4060. for Row := 0 to Height -1 do begin
  4061. pDest := Bitmap.Scanline[Row];
  4062. if Assigned(pDest) then begin
  4063. for Col := 0 to Width -1 do begin
  4064. Inc(pSource, AlphaInterleave);
  4065. pDest^ := pSource^;
  4066. Inc(pDest);
  4067. Inc(pSource);
  4068. end;
  4069. end;
  4070. end;
  4071. result := true;
  4072. end;
  4073. end;
  4074. end;
  4075. end;
  4076. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4077. function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
  4078. var
  4079. tex: TglBitmap2D;
  4080. begin
  4081. tex := TglBitmap2D.Create;
  4082. try
  4083. tex.AssignFromBitmap(Bitmap);
  4084. result := AddAlphaFromglBitmap(tex, Func, CustomData);
  4085. finally
  4086. tex.Free;
  4087. end;
  4088. end;
  4089. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4090. function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar;
  4091. const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
  4092. var
  4093. RS: TResourceStream;
  4094. TempPos: Integer;
  4095. ResTypeStr: String;
  4096. TempResType: PChar;
  4097. begin
  4098. if Assigned(ResType) then
  4099. TempResType := ResType
  4100. else
  4101. begin
  4102. TempPos := Pos('.', Resource);
  4103. ResTypeStr := UpperCase(Copy(Resource, TempPos + 1, Length(Resource) - TempPos));
  4104. Resource := UpperCase(Copy(Resource, 0, TempPos -1));
  4105. TempResType := PChar(ResTypeStr);
  4106. end;
  4107. RS := TResourceStream.Create(Instance, Resource, TempResType);
  4108. try
  4109. result := AddAlphaFromStream(RS, Func, CustomData);
  4110. finally
  4111. RS.Free;
  4112. end;
  4113. end;
  4114. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4115. function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  4116. const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
  4117. var
  4118. RS: TResourceStream;
  4119. begin
  4120. RS := TResourceStream.CreateFromID(Instance, ResourceID, ResType);
  4121. try
  4122. result := AddAlphaFromStream(RS, Func, CustomData);
  4123. finally
  4124. RS.Free;
  4125. end;
  4126. end;
  4127. {$ENDIF}
  4128. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4129. function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
  4130. begin
  4131. (* TODO
  4132. if not FormatIsUncompressed(InternalFormat) then
  4133. raise EglBitmapUnsupportedFormatFormat.Create('AddAlphaFromFunc - ' + UNSUPPORTED_FORMAT);
  4134. *)
  4135. result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
  4136. end;
  4137. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4138. function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
  4139. var
  4140. FS: TFileStream;
  4141. begin
  4142. FS := TFileStream.Create(FileName, fmOpenRead);
  4143. try
  4144. result := AddAlphaFromStream(FS, aFunc, aArgs);
  4145. finally
  4146. FS.Free;
  4147. end;
  4148. end;
  4149. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4150. function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
  4151. var
  4152. tex: TglBitmap2D;
  4153. begin
  4154. tex := TglBitmap2D.Create(aStream);
  4155. try
  4156. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4157. finally
  4158. tex.Free;
  4159. end;
  4160. end;
  4161. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4162. function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
  4163. var
  4164. DestData, DestData2, SourceData: pByte;
  4165. TempHeight, TempWidth: Integer;
  4166. SourceFD, DestFD: TFormatDescriptor;
  4167. SourceMD, DestMD, DestMD2: Pointer;
  4168. FuncRec: TglBitmapFunctionRec;
  4169. begin
  4170. result := false;
  4171. Assert(Assigned(Data));
  4172. Assert(Assigned(aBitmap));
  4173. Assert(Assigned(aBitmap.Data));
  4174. if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
  4175. result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
  4176. if not Assigned(aFunc) then
  4177. aFunc := glBitmapAlphaFunc;
  4178. SourceFD := TFormatDescriptor.Get(aBitmap.Format);
  4179. DestFD := TFormatDescriptor.Get(Format);
  4180. // Values
  4181. TempHeight := aBitmap.FileHeight;
  4182. TempWidth := aBitmap.FileWidth;
  4183. FuncRec.Sender := Self;
  4184. FuncRec.Args := aArgs;
  4185. FuncRec.Size := Dimension;
  4186. FuncRec.Position.Fields := FuncRec.Size.Fields;
  4187. FuncRec.Args := PtrInt(SourceFD.HasAlpha) and 1;
  4188. DestData := Data;
  4189. DestData2 := Data;
  4190. SourceData := aBitmap.Data;
  4191. // Mapping
  4192. SourceFD.PreparePixel(FuncRec.Source);
  4193. DestFD.PreparePixel (FuncRec.Dest);
  4194. SourceMD := SourceFD.CreateMappingData;
  4195. DestMD := DestFD.CreateMappingData;
  4196. DestMD2 := DestFD.CreateMappingData;
  4197. try
  4198. FuncRec.Position.Y := 0;
  4199. while FuncRec.Position.Y < TempHeight do begin
  4200. FuncRec.Position.X := 0;
  4201. while FuncRec.Position.X < TempWidth do begin
  4202. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  4203. DestFD.Unmap (DestData, FuncRec.Dest, DestMD);
  4204. aFunc(FuncRec);
  4205. DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
  4206. inc(FuncRec.Position.X);
  4207. end;
  4208. inc(FuncRec.Position.Y);
  4209. end;
  4210. finally
  4211. SourceFD.FreeMappingData(SourceMD);
  4212. DestFD.FreeMappingData(DestMD);
  4213. DestFD.FreeMappingData(DestMD2);
  4214. end;
  4215. end;
  4216. end;
  4217. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4218. function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
  4219. begin
  4220. result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
  4221. end;
  4222. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4223. function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
  4224. var
  4225. PixelData: TglBitmapPixelData;
  4226. begin
  4227. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4228. result := AddAlphaFromColorKeyFloat(
  4229. aRed / PixelData.Range.r,
  4230. aGreen / PixelData.Range.g,
  4231. aBlue / PixelData.Range.b,
  4232. aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
  4233. end;
  4234. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4235. function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
  4236. var
  4237. values: array[0..2] of Single;
  4238. tmp: Cardinal;
  4239. i: Integer;
  4240. PixelData: TglBitmapPixelData;
  4241. begin
  4242. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4243. with PixelData do begin
  4244. values[0] := aRed;
  4245. values[1] := aGreen;
  4246. values[2] := aBlue;
  4247. for i := 0 to 2 do begin
  4248. tmp := Trunc(Range.arr[i] * aDeviation);
  4249. Data.arr[i] := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
  4250. Range.arr[i] := Max(0, Trunc(Range.arr[i] * values[i] - tmp));
  4251. end;
  4252. Data.a := 0;
  4253. Range.a := 0;
  4254. end;
  4255. result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, PtrInt(@PixelData));
  4256. end;
  4257. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4258. function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
  4259. begin
  4260. result := AddAlphaFromValueFloat(aAlpha / $FF);
  4261. end;
  4262. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4263. function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  4264. var
  4265. PixelData: TglBitmapPixelData;
  4266. begin
  4267. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4268. result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
  4269. end;
  4270. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4271. function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  4272. var
  4273. PixelData: TglBitmapPixelData;
  4274. begin
  4275. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4276. with PixelData do
  4277. Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
  4278. result := AddAlphaFromFunc(glBitmapValueAlphaFunc, PtrInt(@PixelData.Data.a));
  4279. end;
  4280. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4281. function TglBitmap.RemoveAlpha: Boolean;
  4282. var
  4283. FormatDesc: TFormatDescriptor;
  4284. begin
  4285. result := false;
  4286. FormatDesc := TFormatDescriptor.Get(Format);
  4287. if Assigned(Data) then begin
  4288. if not ({FormatDesc.IsUncompressed or }FormatDesc.HasAlpha) then
  4289. raise EglBitmapUnsupportedFormatFormat.Create('RemoveAlpha - ' + UNSUPPORTED_FORMAT);
  4290. result := ConvertTo(FormatDesc.WithoutAlpha);
  4291. end;
  4292. end;
  4293. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4294. function TglBitmap.Clone: TglBitmap;
  4295. var
  4296. Temp: TglBitmap;
  4297. TempPtr: PByte;
  4298. Size: Integer;
  4299. begin
  4300. result := nil;
  4301. Temp := (ClassType.Create as TglBitmap);
  4302. try
  4303. // copy texture data if assigned
  4304. if Assigned(Data) then begin
  4305. Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
  4306. GetMem(TempPtr, Size);
  4307. try
  4308. Move(Data^, TempPtr^, Size);
  4309. Temp.SetDataPointer(TempPtr, Format, Width, Height);
  4310. except
  4311. FreeMem(TempPtr);
  4312. raise;
  4313. end;
  4314. end else
  4315. Temp.SetDataPointer(nil, Format, Width, Height);
  4316. // copy properties
  4317. Temp.fID := ID;
  4318. Temp.fTarget := Target;
  4319. Temp.fFormat := Format;
  4320. Temp.fMipMap := MipMap;
  4321. Temp.fAnisotropic := Anisotropic;
  4322. Temp.fBorderColor := fBorderColor;
  4323. Temp.fDeleteTextureOnFree := DeleteTextureOnFree;
  4324. Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
  4325. Temp.fFilterMin := fFilterMin;
  4326. Temp.fFilterMag := fFilterMag;
  4327. Temp.fWrapS := fWrapS;
  4328. Temp.fWrapT := fWrapT;
  4329. Temp.fWrapR := fWrapR;
  4330. Temp.fFilename := fFilename;
  4331. Temp.fCustomName := fCustomName;
  4332. Temp.fCustomNameW := fCustomNameW;
  4333. Temp.fCustomData := fCustomData;
  4334. result := Temp;
  4335. except
  4336. FreeAndNil(Temp);
  4337. raise;
  4338. end;
  4339. end;
  4340. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4341. function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
  4342. var
  4343. SourceFD, DestFD: TFormatDescriptor;
  4344. SourcePD, DestPD: TglBitmapPixelData;
  4345. ShiftData: TShiftData;
  4346. function CanCopyDirect: Boolean;
  4347. begin
  4348. result :=
  4349. ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  4350. ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  4351. ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  4352. ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  4353. end;
  4354. function CanShift: Boolean;
  4355. begin
  4356. result :=
  4357. ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  4358. ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  4359. ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  4360. ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  4361. end;
  4362. function GetShift(aSource, aDest: Cardinal) : ShortInt;
  4363. begin
  4364. result := 0;
  4365. while (aSource > aDest) and (aSource > 0) do begin
  4366. inc(result);
  4367. aSource := aSource shr 1;
  4368. end;
  4369. end;
  4370. begin
  4371. if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
  4372. SourceFD := TFormatDescriptor.Get(Format);
  4373. DestFD := TFormatDescriptor.Get(aFormat);
  4374. SourceFD.PreparePixel(SourcePD);
  4375. DestFD.PreparePixel (DestPD);
  4376. if CanCopyDirect then
  4377. result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
  4378. else if CanShift then begin
  4379. ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
  4380. ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
  4381. ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
  4382. ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
  4383. result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, PtrInt(@ShiftData));
  4384. end else
  4385. result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
  4386. end else
  4387. result := true;
  4388. end;
  4389. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4390. procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
  4391. begin
  4392. if aUseRGB or aUseAlpha then
  4393. AddFunc(glBitmapInvertFunc, false, ((PtrInt(aUseAlpha) and 1) shl 1) or (PtrInt(aUseRGB) and 1));
  4394. end;
  4395. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4396. procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  4397. begin
  4398. fBorderColor[0] := aRed;
  4399. fBorderColor[1] := aGreen;
  4400. fBorderColor[2] := aBlue;
  4401. fBorderColor[3] := aAlpha;
  4402. if (ID > 0) then begin
  4403. Bind(false);
  4404. glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
  4405. end;
  4406. end;
  4407. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4408. procedure TglBitmap.FreeData;
  4409. begin
  4410. SetDataPointer(nil, tfEmpty);
  4411. end;
  4412. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4413. procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
  4414. const aAlpha: Byte);
  4415. begin
  4416. FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
  4417. end;
  4418. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4419. procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
  4420. var
  4421. PixelData: TglBitmapPixelData;
  4422. begin
  4423. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4424. FillWithColorFloat(
  4425. aRed / PixelData.Range.r,
  4426. aGreen / PixelData.Range.g,
  4427. aBlue / PixelData.Range.b,
  4428. aAlpha / PixelData.Range.a);
  4429. end;
  4430. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4431. procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
  4432. var
  4433. PixelData: TglBitmapPixelData;
  4434. begin
  4435. TFormatDescriptor.Get(Format).PreparePixel(PixelData);
  4436. with PixelData do begin
  4437. Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
  4438. Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
  4439. Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
  4440. Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
  4441. end;
  4442. AddFunc(glBitmapFillWithColorFunc, false, PtrInt(@PixelData));
  4443. end;
  4444. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4445. procedure TglBitmap.SetFilter(const aMin, aMag: Cardinal);
  4446. begin
  4447. //check MIN filter
  4448. case aMin of
  4449. GL_NEAREST:
  4450. fFilterMin := GL_NEAREST;
  4451. GL_LINEAR:
  4452. fFilterMin := GL_LINEAR;
  4453. GL_NEAREST_MIPMAP_NEAREST:
  4454. fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
  4455. GL_LINEAR_MIPMAP_NEAREST:
  4456. fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
  4457. GL_NEAREST_MIPMAP_LINEAR:
  4458. fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
  4459. GL_LINEAR_MIPMAP_LINEAR:
  4460. fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
  4461. else
  4462. raise EglBitmapException.Create('SetFilter - Unknow MIN filter.');
  4463. end;
  4464. //check MAG filter
  4465. case aMag of
  4466. GL_NEAREST:
  4467. fFilterMag := GL_NEAREST;
  4468. GL_LINEAR:
  4469. fFilterMag := GL_LINEAR;
  4470. else
  4471. raise EglBitmapException.Create('SetFilter - Unknow MAG filter.');
  4472. end;
  4473. //apply filter
  4474. if (ID > 0) then begin
  4475. Bind(false);
  4476. glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
  4477. if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
  4478. case fFilterMin of
  4479. GL_NEAREST, GL_LINEAR:
  4480. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  4481. GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
  4482. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
  4483. GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
  4484. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
  4485. end;
  4486. end else
  4487. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  4488. end;
  4489. end;
  4490. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4491. procedure TglBitmap.SetWrap(const S: Cardinal; const T: Cardinal; const R: Cardinal);
  4492. procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
  4493. begin
  4494. case aValue of
  4495. GL_CLAMP:
  4496. aTarget := GL_CLAMP;
  4497. GL_REPEAT:
  4498. aTarget := GL_REPEAT;
  4499. GL_CLAMP_TO_EDGE: begin
  4500. if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
  4501. aTarget := GL_CLAMP_TO_EDGE
  4502. else
  4503. aTarget := GL_CLAMP;
  4504. end;
  4505. GL_CLAMP_TO_BORDER: begin
  4506. if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
  4507. aTarget := GL_CLAMP_TO_BORDER
  4508. else
  4509. aTarget := GL_CLAMP;
  4510. end;
  4511. GL_MIRRORED_REPEAT: begin
  4512. if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
  4513. aTarget := GL_MIRRORED_REPEAT
  4514. else
  4515. raise EglBitmapException.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
  4516. end;
  4517. else
  4518. raise EglBitmapException.Create('SetWrap - Unknow Texturewrap (S).');
  4519. end;
  4520. end;
  4521. begin
  4522. CheckAndSetWrap(S, fWrapS);
  4523. CheckAndSetWrap(T, fWrapT);
  4524. CheckAndSetWrap(R, fWrapR);
  4525. if (ID > 0) then begin
  4526. Bind(false);
  4527. glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
  4528. glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
  4529. glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
  4530. end;
  4531. end;
  4532. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4533. procedure TglBitmap.GetPixel(const aPos: TglBitmapPixelPosition; var aPixel: TglBitmapPixelData);
  4534. begin
  4535. { TODO delete?
  4536. if Assigned (fGetPixelFunc) then
  4537. fGetPixelFunc(aPos, aPixel);
  4538. }
  4539. end;
  4540. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4541. procedure TglBitmap.SetPixel(const aPos: TglBitmapPixelPosition; const aPixel: TglBitmapPixelData);
  4542. begin
  4543. {TODO delete?
  4544. if Assigned (fSetPixelFunc) then
  4545. fSetPixelFuc(aPos, aPixel);
  4546. }
  4547. end;
  4548. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4549. procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
  4550. begin
  4551. if aEnableTextureUnit then
  4552. glEnable(Target);
  4553. if (ID > 0) then
  4554. glBindTexture(Target, ID);
  4555. end;
  4556. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4557. procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
  4558. begin
  4559. if aDisableTextureUnit then
  4560. glDisable(Target);
  4561. glBindTexture(Target, 0);
  4562. end;
  4563. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4564. constructor TglBitmap.Create;
  4565. begin
  4566. {$IFNDEF GLB_NO_NATIVE_GL}
  4567. ReadOpenGLExtensions;
  4568. {$ENDIF}
  4569. if (ClassType = TglBitmap) then
  4570. raise EglBitmapException.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
  4571. inherited Create;
  4572. end;
  4573. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4574. constructor TglBitmap.Create(const aFileName: String);
  4575. begin
  4576. Create;
  4577. LoadFromFile(FileName);
  4578. end;
  4579. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4580. constructor TglBitmap.Create(const aStream: TStream);
  4581. begin
  4582. Create;
  4583. LoadFromStream(aStream);
  4584. end;
  4585. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4586. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat);
  4587. var
  4588. Image: PByte;
  4589. ImageSize: Integer;
  4590. begin
  4591. Create;
  4592. TFormatDescriptor.Get(aFormat).GetSize(aSize);
  4593. GetMem(Image, ImageSize);
  4594. try
  4595. FillChar(Image^, ImageSize, #$FF);
  4596. SetDataPointer(Image, aFormat, aSize.X, aSize.Y);
  4597. except
  4598. FreeMem(Image);
  4599. raise;
  4600. end;
  4601. end;
  4602. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4603. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat;
  4604. const aFunc: TglBitmapFunction; const aArgs: PtrInt);
  4605. begin
  4606. Create;
  4607. LoadFromFunc(aSize, aFunc, aFormat, aArgs);
  4608. end;
  4609. {$IFDEF GLB_DELPHI}
  4610. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4611. constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
  4612. begin
  4613. Create;
  4614. LoadFromResource(aInstance, aResource, aResType);
  4615. end;
  4616. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4617. constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  4618. begin
  4619. Create;
  4620. LoadFromResourceID(aInstance, aResourceID, aResType);
  4621. end;
  4622. {$ENDIF}
  4623. {$IFDEF GLB_SUPPORT_PNG_READ}
  4624. {$IF DEFINED(GLB_SDL_IMAGE)}
  4625. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4626. //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4627. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4628. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  4629. var
  4630. Surface: PSDL_Surface;
  4631. RWops: PSDL_RWops;
  4632. begin
  4633. result := false;
  4634. RWops := glBitmapCreateRWops(aStream);
  4635. try
  4636. if IMG_isPNG(RWops) > 0 then begin
  4637. Surface := IMG_LoadPNG_RW(RWops);
  4638. try
  4639. AssignFromSurface(Surface);
  4640. Rresult := true;
  4641. finally
  4642. SDL_FreeSurface(Surface);
  4643. end;
  4644. end;
  4645. finally
  4646. SDL_FreeRW(RWops);
  4647. end;
  4648. end;
  4649. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  4650. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4651. procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  4652. begin
  4653. TStream(png_get_io_ptr(png)).Read(buffer^, size);
  4654. end;
  4655. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4656. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  4657. var
  4658. StreamPos: Int64;
  4659. signature: array [0..7] of byte;
  4660. png: png_structp;
  4661. png_info: png_infop;
  4662. TempHeight, TempWidth: Integer;
  4663. Format: TglBitmapInternalFormat;
  4664. png_data: pByte;
  4665. png_rows: array of pByte;
  4666. Row, LineSize: Integer;
  4667. begin
  4668. result := false;
  4669. if not init_libPNG then
  4670. raise Exception.Create('LoadPNG - unable to initialize libPNG.');
  4671. try
  4672. // signature
  4673. StreamPos := Stream.Position;
  4674. Stream.Read(signature, 8);
  4675. Stream.Position := StreamPos;
  4676. if png_check_sig(@signature, 8) <> 0 then begin
  4677. // png read struct
  4678. png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  4679. if png = nil then
  4680. raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
  4681. // png info
  4682. png_info := png_create_info_struct(png);
  4683. if png_info = nil then begin
  4684. png_destroy_read_struct(@png, nil, nil);
  4685. raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
  4686. end;
  4687. // set read callback
  4688. png_set_read_fn(png, stream, glBitmap_libPNG_read_func);
  4689. // read informations
  4690. png_read_info(png, png_info);
  4691. // size
  4692. TempHeight := png_get_image_height(png, png_info);
  4693. TempWidth := png_get_image_width(png, png_info);
  4694. // format
  4695. case png_get_color_type(png, png_info) of
  4696. PNG_COLOR_TYPE_GRAY:
  4697. Format := tfLuminance8;
  4698. PNG_COLOR_TYPE_GRAY_ALPHA:
  4699. Format := tfLuminance8Alpha8;
  4700. PNG_COLOR_TYPE_RGB:
  4701. Format := tfRGB8;
  4702. PNG_COLOR_TYPE_RGB_ALPHA:
  4703. Format := tfRGBA8;
  4704. else
  4705. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  4706. end;
  4707. // cut upper 8 bit from 16 bit formats
  4708. if png_get_bit_depth(png, png_info) > 8 then
  4709. png_set_strip_16(png);
  4710. // expand bitdepth smaller than 8
  4711. if png_get_bit_depth(png, png_info) < 8 then
  4712. png_set_expand(png);
  4713. // allocating mem for scanlines
  4714. LineSize := png_get_rowbytes(png, png_info);
  4715. GetMem(png_data, TempHeight * LineSize);
  4716. try
  4717. SetLength(png_rows, TempHeight);
  4718. for Row := Low(png_rows) to High(png_rows) do begin
  4719. png_rows[Row] := png_data;
  4720. Inc(png_rows[Row], Row * LineSize);
  4721. end;
  4722. // read complete image into scanlines
  4723. png_read_image(png, @png_rows[0]);
  4724. // read end
  4725. png_read_end(png, png_info);
  4726. // destroy read struct
  4727. png_destroy_read_struct(@png, @png_info, nil);
  4728. SetLength(png_rows, 0);
  4729. // set new data
  4730. SetDataPointer(png_data, Format, TempWidth, TempHeight);
  4731. result := true;
  4732. except
  4733. FreeMem(png_data);
  4734. raise;
  4735. end;
  4736. end;
  4737. finally
  4738. quit_libPNG;
  4739. end;
  4740. end;
  4741. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  4742. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4743. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  4744. var
  4745. StreamPos: Int64;
  4746. Png: TPNGObject;
  4747. Header: Array[0..7] of Byte;
  4748. Row, Col, PixSize, LineSize: Integer;
  4749. NewImage, pSource, pDest, pAlpha: pByte;
  4750. Format: TglBitmapInternalFormat;
  4751. const
  4752. PngHeader: Array[0..7] of Byte = (#137, #80, #78, #71, #13, #10, #26, #10);
  4753. begin
  4754. result := false;
  4755. StreamPos := Stream.Position;
  4756. Stream.Read(Header[0], SizeOf(Header));
  4757. Stream.Position := StreamPos;
  4758. {Test if the header matches}
  4759. if Header = PngHeader then begin
  4760. Png := TPNGObject.Create;
  4761. try
  4762. Png.LoadFromStream(Stream);
  4763. case Png.Header.ColorType of
  4764. COLOR_GRAYSCALE:
  4765. Format := ifLuminance;
  4766. COLOR_GRAYSCALEALPHA:
  4767. Format := ifLuminanceAlpha;
  4768. COLOR_RGB:
  4769. Format := ifBGR8;
  4770. COLOR_RGBALPHA:
  4771. Format := ifBGRA8;
  4772. else
  4773. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  4774. end;
  4775. PixSize := Trunc(FormatGetSize(Format));
  4776. LineSize := Integer(Png.Header.Width) * PixSize;
  4777. GetMem(NewImage, LineSize * Integer(Png.Header.Height));
  4778. try
  4779. pDest := NewImage;
  4780. case Png.Header.ColorType of
  4781. COLOR_RGB, COLOR_GRAYSCALE:
  4782. begin
  4783. for Row := 0 to Png.Height -1 do begin
  4784. Move (Png.Scanline[Row]^, pDest^, LineSize);
  4785. Inc(pDest, LineSize);
  4786. end;
  4787. end;
  4788. COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
  4789. begin
  4790. PixSize := PixSize -1;
  4791. for Row := 0 to Png.Height -1 do begin
  4792. pSource := Png.Scanline[Row];
  4793. pAlpha := pByte(Png.AlphaScanline[Row]);
  4794. for Col := 0 to Png.Width -1 do begin
  4795. Move (pSource^, pDest^, PixSize);
  4796. Inc(pSource, PixSize);
  4797. Inc(pDest, PixSize);
  4798. pDest^ := pAlpha^;
  4799. inc(pAlpha);
  4800. Inc(pDest);
  4801. end;
  4802. end;
  4803. end;
  4804. else
  4805. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  4806. end;
  4807. SetDataPointer(NewImage, Format, Png.Header.Width, Png.Header.Height);
  4808. result := true;
  4809. except
  4810. FreeMem(NewImage);
  4811. raise;
  4812. end;
  4813. finally
  4814. Png.Free;
  4815. end;
  4816. end;
  4817. end;
  4818. {$IFEND}
  4819. {$ENDIF}
  4820. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  4821. {$IFDEF GLB_LIB_PNG}
  4822. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4823. procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  4824. begin
  4825. TStream(png_get_io_ptr(png)).Write(buffer^, size);
  4826. end;
  4827. {$ENDIF}
  4828. {$IF DEFINED(GLB_LIB_PNG)}
  4829. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4830. procedure TglBitmap.SavePNG(const aStream: TStream);
  4831. var
  4832. png: png_structp;
  4833. png_info: png_infop;
  4834. png_rows: array of pByte;
  4835. LineSize: Integer;
  4836. ColorType: Integer;
  4837. Row: Integer;
  4838. begin
  4839. if not (ftPNG in FormatGetSupportedFiles (InternalFormat)) then
  4840. raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
  4841. if not init_libPNG then
  4842. raise Exception.Create('SavePNG - unable to initialize libPNG.');
  4843. try
  4844. case FInternalFormat of
  4845. ifAlpha, ifLuminance, ifDepth8:
  4846. ColorType := PNG_COLOR_TYPE_GRAY;
  4847. ifLuminanceAlpha:
  4848. ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
  4849. ifBGR8, ifRGB8:
  4850. ColorType := PNG_COLOR_TYPE_RGB;
  4851. ifBGRA8, ifRGBA8:
  4852. ColorType := PNG_COLOR_TYPE_RGBA;
  4853. else
  4854. raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
  4855. end;
  4856. LineSize := Trunc(FormatGetSize(FInternalFormat) * Width);
  4857. // creating array for scanline
  4858. SetLength(png_rows, Height);
  4859. try
  4860. for Row := 0 to Height - 1 do begin
  4861. png_rows[Row] := Data;
  4862. Inc(png_rows[Row], Row * LineSize)
  4863. end;
  4864. // write struct
  4865. png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  4866. if png = nil then
  4867. raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
  4868. // create png info
  4869. png_info := png_create_info_struct(png);
  4870. if png_info = nil then begin
  4871. png_destroy_write_struct(@png, nil);
  4872. raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
  4873. end;
  4874. // set read callback
  4875. png_set_write_fn(png, stream, glBitmap_libPNG_write_func, nil);
  4876. // set compression
  4877. png_set_compression_level(png, 6);
  4878. if InternalFormat in [ifBGR8, ifBGRA8] then
  4879. png_set_bgr(png);
  4880. png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
  4881. png_write_info(png, png_info);
  4882. png_write_image(png, @png_rows[0]);
  4883. png_write_end(png, png_info);
  4884. png_destroy_write_struct(@png, @png_info);
  4885. finally
  4886. SetLength(png_rows, 0);
  4887. end;
  4888. finally
  4889. quit_libPNG;
  4890. end;
  4891. end;
  4892. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  4893. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4894. procedure TglBitmap.SavePNG(const aStream: TStream);
  4895. var
  4896. Png: TPNGObject;
  4897. pSource, pDest: pByte;
  4898. X, Y, PixSize: Integer;
  4899. ColorType: Cardinal;
  4900. Alpha: Boolean;
  4901. pTemp: pByte;
  4902. Temp: Byte;
  4903. begin
  4904. if not (ftPNG in FormatGetSupportedFiles (InternalFormat)) then
  4905. raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
  4906. case FInternalFormat of
  4907. ifAlpha, ifLuminance, ifDepth8: begin
  4908. ColorType := COLOR_GRAYSCALE;
  4909. PixSize := 1;
  4910. Alpha := false;
  4911. end;
  4912. ifLuminanceAlpha: begin
  4913. ColorType := COLOR_GRAYSCALEALPHA;
  4914. PixSize := 1;
  4915. Alpha := true;
  4916. end;
  4917. ifBGR8, ifRGB8: begin
  4918. ColorType := COLOR_RGB;
  4919. PixSize := 3;
  4920. Alpha := false;
  4921. end;
  4922. ifBGRA8, ifRGBA8: begin
  4923. ColorType := COLOR_RGBALPHA;
  4924. PixSize := 3;
  4925. Alpha := true
  4926. end;
  4927. else
  4928. raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
  4929. end;
  4930. Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
  4931. try
  4932. // Copy ImageData
  4933. pSource := Data;
  4934. for Y := 0 to Height -1 do begin
  4935. pDest := png.ScanLine[Y];
  4936. for X := 0 to Width -1 do begin
  4937. Move(pSource^, pDest^, PixSize);
  4938. Inc(pDest, PixSize);
  4939. Inc(pSource, PixSize);
  4940. if Alpha then begin
  4941. png.AlphaScanline[Y]^[X] := pSource^;
  4942. Inc(pSource);
  4943. end;
  4944. end;
  4945. // convert RGB line to BGR
  4946. if InternalFormat in [ifRGB8, ifRGBA8] then begin
  4947. pTemp := png.ScanLine[Y];
  4948. for X := 0 to Width -1 do begin
  4949. Temp := pByteArray(pTemp)^[0];
  4950. pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
  4951. pByteArray(pTemp)^[2] := Temp;
  4952. Inc(pTemp, 3);
  4953. end;
  4954. end;
  4955. end;
  4956. // Save to Stream
  4957. Png.CompressionLevel := 6;
  4958. Png.SaveToStream(Stream);
  4959. finally
  4960. FreeAndNil(Png);
  4961. end;
  4962. end;
  4963. {$IFEND}
  4964. {$ENDIF}
  4965. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4966. //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4967. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4968. {$IFDEF GLB_LIB_JPEG}
  4969. type
  4970. glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
  4971. glBitmap_libJPEG_source_mgr = record
  4972. pub: jpeg_source_mgr;
  4973. SrcStream: TStream;
  4974. SrcBuffer: array [1..4096] of byte;
  4975. end;
  4976. glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
  4977. glBitmap_libJPEG_dest_mgr = record
  4978. pub: jpeg_destination_mgr;
  4979. DestStream: TStream;
  4980. DestBuffer: array [1..4096] of byte;
  4981. end;
  4982. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4983. {
  4984. procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
  4985. var
  4986. Msg: String;
  4987. begin
  4988. SetLength(Msg, 256);
  4989. cinfo^.err^.format_message(cinfo, pChar(Msg));
  4990. Writeln('ERROR [' + IntToStr(cinfo^.err^.msg_code) + '] ' + Msg);
  4991. cinfo^.global_state := 0;
  4992. jpeg_abort(cinfo);
  4993. end;
  4994. }
  4995. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4996. {
  4997. procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
  4998. var
  4999. Msg: String;
  5000. begin
  5001. SetLength(Msg, 256);
  5002. cinfo^.err^.format_message(cinfo, pChar(Msg));
  5003. Writeln('OUTPUT [' + IntToStr(cinfo^.err^.msg_code) + '] ' + Msg);
  5004. cinfo^.global_state := 0;
  5005. end;
  5006. }
  5007. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5008. {
  5009. procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
  5010. begin
  5011. end;
  5012. }
  5013. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5014. function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
  5015. var
  5016. src: glBitmap_libJPEG_source_mgr_ptr;
  5017. bytes: integer;
  5018. begin
  5019. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  5020. bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
  5021. if (bytes <= 0) then begin
  5022. src^.SrcBuffer[1] := $FF;
  5023. src^.SrcBuffer[2] := JPEG_EOI;
  5024. bytes := 2;
  5025. end;
  5026. src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
  5027. src^.pub.bytes_in_buffer := bytes;
  5028. result := true;
  5029. end;
  5030. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5031. procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
  5032. var
  5033. src: glBitmap_libJPEG_source_mgr_ptr;
  5034. begin
  5035. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  5036. if num_bytes > 0 then begin
  5037. // wanted byte isn't in buffer so set stream position and read buffer
  5038. if num_bytes > src^.pub.bytes_in_buffer then begin
  5039. src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
  5040. src^.pub.fill_input_buffer(cinfo);
  5041. end else begin
  5042. // wanted byte is in buffer so only skip
  5043. inc(src^.pub.next_input_byte, num_bytes);
  5044. dec(src^.pub.bytes_in_buffer, num_bytes);
  5045. end;
  5046. end;
  5047. end;
  5048. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5049. {
  5050. procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
  5051. begin
  5052. end;
  5053. }
  5054. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5055. {
  5056. procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
  5057. begin
  5058. end;
  5059. }
  5060. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5061. function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
  5062. var
  5063. dest: glBitmap_libJPEG_dest_mgr_ptr;
  5064. begin
  5065. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  5066. if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
  5067. // write complete buffer
  5068. dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
  5069. // reset buffer
  5070. dest^.pub.next_output_byte := @dest^.DestBuffer[1];
  5071. dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
  5072. end;
  5073. result := true;
  5074. end;
  5075. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5076. procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
  5077. var
  5078. Idx: Integer;
  5079. dest: glBitmap_libJPEG_dest_mgr_ptr;
  5080. begin
  5081. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  5082. for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
  5083. // check for endblock
  5084. if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
  5085. // write endblock
  5086. dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
  5087. // leave
  5088. break;
  5089. end else
  5090. dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
  5091. end;
  5092. end;
  5093. {$ENDIF}
  5094. {$IFDEF GLB_SUPPORT_JPEG_READ}
  5095. {$IF DEFINED(GLB_SDL_IMAGE)}
  5096. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5097. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5098. var
  5099. Surface: PSDL_Surface;
  5100. RWops: PSDL_RWops;
  5101. begin
  5102. result := false;
  5103. RWops := glBitmapCreateRWops(Stream);
  5104. try
  5105. if IMG_isJPG(RWops) > 0 then begin
  5106. Surface := IMG_LoadJPG_RW(RWops);
  5107. try
  5108. AssignFromSurface(Surface);
  5109. result := true;
  5110. finally
  5111. SDL_FreeSurface(Surface);
  5112. end;
  5113. end;
  5114. finally
  5115. SDL_FreeRW(RWops);
  5116. end;
  5117. end;
  5118. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  5119. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5120. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5121. var
  5122. StreamPos: Int64;
  5123. Temp: array[0..1]of Byte;
  5124. jpeg: jpeg_decompress_struct;
  5125. jpeg_err: jpeg_error_mgr;
  5126. IntFormat: TglBitmapInternalFormat;
  5127. pImage: pByte;
  5128. TempHeight, TempWidth: Integer;
  5129. pTemp: pByte;
  5130. Row: Integer;
  5131. begin
  5132. result := false;
  5133. if not init_libJPEG then
  5134. raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
  5135. try
  5136. // reading first two bytes to test file and set cursor back to begin
  5137. StreamPos := Stream.Position;
  5138. Stream.Read(Temp[0], 2);
  5139. Stream.Position := StreamPos;
  5140. // if Bitmap then read file.
  5141. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  5142. FillChar(jpeg, SizeOf(jpeg_decompress_struct), $00);
  5143. FillChar(jpeg_err, SizeOf(jpeg_error_mgr), $00);
  5144. // error managment
  5145. jpeg.err := jpeg_std_error(@jpeg_err);
  5146. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  5147. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  5148. // decompression struct
  5149. jpeg_create_decompress(@jpeg);
  5150. // allocation space for streaming methods
  5151. jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
  5152. // seeting up custom functions
  5153. with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
  5154. pub.init_source := glBitmap_libJPEG_init_source;
  5155. pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
  5156. pub.skip_input_data := glBitmap_libJPEG_skip_input_data;
  5157. pub.resync_to_restart := jpeg_resync_to_restart; // use default method
  5158. pub.term_source := glBitmap_libJPEG_term_source;
  5159. pub.bytes_in_buffer := 0; // forces fill_input_buffer on first read
  5160. pub.next_input_byte := nil; // until buffer loaded
  5161. SrcStream := Stream;
  5162. end;
  5163. // set global decoding state
  5164. jpeg.global_state := DSTATE_START;
  5165. // read header of jpeg
  5166. jpeg_read_header(@jpeg, false);
  5167. // setting output parameter
  5168. case jpeg.jpeg_color_space of
  5169. JCS_GRAYSCALE:
  5170. begin
  5171. jpeg.out_color_space := JCS_GRAYSCALE;
  5172. IntFormat := ifLuminance;
  5173. end;
  5174. else
  5175. jpeg.out_color_space := JCS_RGB;
  5176. IntFormat := ifRGB8;
  5177. end;
  5178. // reading image
  5179. jpeg_start_decompress(@jpeg);
  5180. TempHeight := jpeg.output_height;
  5181. TempWidth := jpeg.output_width;
  5182. // creating new image
  5183. GetMem(pImage, FormatGetImageSize(glBitmapPosition(TempWidth, TempHeight), IntFormat));
  5184. try
  5185. pTemp := pImage;
  5186. for Row := 0 to TempHeight -1 do begin
  5187. jpeg_read_scanlines(@jpeg, @pTemp, 1);
  5188. Inc(pTemp, Trunc(FormatGetSize(IntFormat) * TempWidth));
  5189. end;
  5190. // finish decompression
  5191. jpeg_finish_decompress(@jpeg);
  5192. // destroy decompression
  5193. jpeg_destroy_decompress(@jpeg);
  5194. SetDataPointer(pImage, IntFormat, TempWidth, TempHeight);
  5195. result := true;
  5196. except
  5197. FreeMem(pImage);
  5198. raise;
  5199. end;
  5200. end;
  5201. finally
  5202. quit_libJPEG;
  5203. end;
  5204. end;
  5205. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  5206. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5207. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5208. var
  5209. bmp: TBitmap;
  5210. jpg: TJPEGImage;
  5211. StreamPos: Int64;
  5212. Temp: array[0..1]of Byte;
  5213. begin
  5214. result := false;
  5215. // reading first two bytes to test file and set cursor back to begin
  5216. StreamPos := Stream.Position;
  5217. Stream.Read(Temp[0], 2);
  5218. Stream.Position := StreamPos;
  5219. // if Bitmap then read file.
  5220. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  5221. bmp := TBitmap.Create;
  5222. try
  5223. jpg := TJPEGImage.Create;
  5224. try
  5225. jpg.LoadFromStream(Stream);
  5226. bmp.Assign(jpg);
  5227. result := AssignFromBitmap(bmp);
  5228. finally
  5229. jpg.Free;
  5230. end;
  5231. finally
  5232. bmp.Free;
  5233. end;
  5234. end;
  5235. end;
  5236. {$IFEND}
  5237. {$ENDIF}
  5238. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  5239. {$IF DEFEFINED(GLB_LIB_JPEG)}
  5240. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5241. procedure TglBitmap.SaveJPEG(Stream: TStream);
  5242. var
  5243. jpeg: jpeg_compress_struct;
  5244. jpeg_err: jpeg_error_mgr;
  5245. Row: Integer;
  5246. pTemp, pTemp2: pByte;
  5247. procedure CopyRow(pDest, pSource: pByte);
  5248. var
  5249. X: Integer;
  5250. begin
  5251. for X := 0 to Width - 1 do begin
  5252. pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
  5253. pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
  5254. pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
  5255. Inc(pDest, 3);
  5256. Inc(pSource, 3);
  5257. end;
  5258. end;
  5259. begin
  5260. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  5261. raise EglBitmapUnsupportedInternalFormat.Create('SaveJpg - ' + UNSUPPORTED_INTERNAL_FORMAT);
  5262. if not init_libJPEG then
  5263. raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
  5264. try
  5265. FillChar(jpeg, SizeOf(jpeg_compress_struct), $00);
  5266. FillChar(jpeg_err, SizeOf(jpeg_error_mgr), $00);
  5267. // error managment
  5268. jpeg.err := jpeg_std_error(@jpeg_err);
  5269. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  5270. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  5271. // compression struct
  5272. jpeg_create_compress(@jpeg);
  5273. // allocation space for streaming methods
  5274. jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
  5275. // seeting up custom functions
  5276. with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
  5277. pub.init_destination := glBitmap_libJPEG_init_destination;
  5278. pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
  5279. pub.term_destination := glBitmap_libJPEG_term_destination;
  5280. pub.next_output_byte := @DestBuffer[1];
  5281. pub.free_in_buffer := Length(DestBuffer);
  5282. DestStream := Stream;
  5283. end;
  5284. // very important state
  5285. jpeg.global_state := CSTATE_START;
  5286. jpeg.image_width := Width;
  5287. jpeg.image_height := Height;
  5288. case InternalFormat of
  5289. ifAlpha, ifLuminance, ifDepth8: begin
  5290. jpeg.input_components := 1;
  5291. jpeg.in_color_space := JCS_GRAYSCALE;
  5292. end;
  5293. ifRGB8, ifBGR8: begin
  5294. jpeg.input_components := 3;
  5295. jpeg.in_color_space := JCS_RGB;
  5296. end;
  5297. end;
  5298. jpeg_set_defaults(@jpeg);
  5299. jpeg_set_quality(@jpeg, 95, true);
  5300. jpeg_start_compress(@jpeg, true);
  5301. pTemp := Data;
  5302. if InternalFormat = ifBGR8 then
  5303. GetMem(pTemp2, fRowSize)
  5304. else
  5305. pTemp2 := pTemp;
  5306. try
  5307. for Row := 0 to jpeg.image_height -1 do begin
  5308. // prepare row
  5309. if InternalFormat = ifBGR8 then
  5310. CopyRow(pTemp2, pTemp)
  5311. else
  5312. pTemp2 := pTemp;
  5313. // write row
  5314. jpeg_write_scanlines(@jpeg, @pTemp2, 1);
  5315. inc(pTemp, fRowSize);
  5316. end;
  5317. finally
  5318. // free memory
  5319. if InternalFormat = ifBGR8 then
  5320. FreeMem(pTemp2);
  5321. end;
  5322. jpeg_finish_compress(@jpeg);
  5323. jpeg_destroy_compress(@jpeg);
  5324. finally
  5325. quit_libJPEG;
  5326. end;
  5327. end;
  5328. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  5329. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5330. procedure TglBitmap.SaveJPEG(Stream: TStream);
  5331. var
  5332. Bmp: TBitmap;
  5333. Jpg: TJPEGImage;
  5334. begin
  5335. if not (ftJPEG in FormatGetSupportedFiles (InternalFormat)) then
  5336. raise EglBitmapUnsupportedInternalFormat.Create('SaveJpg - ' + UNSUPPORTED_INTERNAL_FORMAT);
  5337. Bmp := TBitmap.Create;
  5338. try
  5339. Jpg := TJPEGImage.Create;
  5340. try
  5341. AssignToBitmap(Bmp);
  5342. if FInternalFormat in [ifAlpha, ifLuminance, ifDepth8] then begin
  5343. Jpg.Grayscale := true;
  5344. Jpg.PixelFormat := jf8Bit;
  5345. end;
  5346. Jpg.Assign(Bmp);
  5347. Jpg.SaveToStream(Stream);
  5348. finally
  5349. FreeAndNil(Jpg);
  5350. end;
  5351. finally
  5352. FreeAndNil(Bmp);
  5353. end;
  5354. end;
  5355. {$ENDIF}
  5356. {$ENDIF}
  5357. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5358. //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5359. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5360. const
  5361. BMP_MAGIC = $4D42;
  5362. BMP_COMP_RGB = 0;
  5363. BMP_COMP_RLE8 = 1;
  5364. BMP_COMP_RLE4 = 2;
  5365. BMP_COMP_BITFIELDS = 3;
  5366. type
  5367. TBMPHeader = packed record
  5368. bfType: Word;
  5369. bfSize: Cardinal;
  5370. bfReserved1: Word;
  5371. bfReserved2: Word;
  5372. bfOffBits: Cardinal;
  5373. end;
  5374. TBMPInfo = packed record
  5375. biSize: Cardinal;
  5376. biWidth: Longint;
  5377. biHeight: Longint;
  5378. biPlanes: Word;
  5379. biBitCount: Word;
  5380. biCompression: Cardinal;
  5381. biSizeImage: Cardinal;
  5382. biXPelsPerMeter: Longint;
  5383. biYPelsPerMeter: Longint;
  5384. biClrUsed: Cardinal;
  5385. biClrImportant: Cardinal;
  5386. end;
  5387. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5388. function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
  5389. //////////////////////////////////////////////////////////////////////////////////////////////////
  5390. function ReadInfo(var aInfo: TBMPInfo; var aMask: TglBitmapColorRec): TglBitmapFormat;
  5391. begin
  5392. result := tfEmpty;
  5393. aStream.Read(aInfo, SizeOf(aInfo));
  5394. FillChar(aMask, SizeOf(aMask), 0);
  5395. //Read Compression
  5396. case aInfo.biCompression of
  5397. BMP_COMP_RLE4,
  5398. BMP_COMP_RLE8: begin
  5399. raise EglBitmapException.Create('RLE compression is not supported');
  5400. end;
  5401. BMP_COMP_BITFIELDS: begin
  5402. if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
  5403. aStream.Read(aMask.r, SizeOf(aMask.r));
  5404. aStream.Read(aMask.g, SizeOf(aMask.g));
  5405. aStream.Read(aMask.b, SizeOf(aMask.b));
  5406. aStream.Read(aMask.a, SizeOf(aMask.a));
  5407. end else
  5408. raise EglBitmapException.Create('Bitfields are only supported for 16bit and 32bit formats');
  5409. end;
  5410. end;
  5411. //get suitable format
  5412. case aInfo.biBitCount of
  5413. 8: result := tfLuminance8;
  5414. 16: result := tfBGR5;
  5415. 24: result := tfBGR8;
  5416. 32: result := tfBGRA8;
  5417. end;
  5418. end;
  5419. function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
  5420. var
  5421. i, c: Integer;
  5422. ColorTable: TbmpColorTable;
  5423. begin
  5424. result := nil;
  5425. if (aInfo.biBitCount >= 16) then
  5426. exit;
  5427. aFormat := tfLuminance8;
  5428. c := aInfo.biClrUsed;
  5429. if (c = 0) then
  5430. c := 1 shl aInfo.biBitCount;
  5431. SetLength(ColorTable, c);
  5432. for i := 0 to c-1 do begin
  5433. aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
  5434. if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
  5435. aFormat := tfRGB8;
  5436. end;
  5437. result := TbmpColorTableFormat.Create;
  5438. result.PixelSize := aInfo.biBitCount / 8;
  5439. result.ColorTable := ColorTable;
  5440. result.Range := glBitmapColorRec($FF, $FF, $FF, $00);
  5441. end;
  5442. //////////////////////////////////////////////////////////////////////////////////////////////////
  5443. function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
  5444. const aInfo: TBMPInfo): TbmpBitfieldFormat;
  5445. var
  5446. TmpFormat: TglBitmapFormat;
  5447. FormatDesc: TFormatDescriptor;
  5448. begin
  5449. result := nil;
  5450. if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
  5451. for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  5452. FormatDesc := TFormatDescriptor.Get(TmpFormat);
  5453. if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
  5454. aFormat := FormatDesc.Format;
  5455. exit;
  5456. end;
  5457. end;
  5458. if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
  5459. aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
  5460. if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
  5461. aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
  5462. result := TbmpBitfieldFormat.Create;
  5463. result.PixelSize := aInfo.biBitCount / 8;
  5464. result.RedMask := aMask.r;
  5465. result.GreenMask := aMask.g;
  5466. result.BlueMask := aMask.b;
  5467. result.AlphaMask := aMask.a;
  5468. end;
  5469. end;
  5470. var
  5471. //simple types
  5472. StartPos: Int64;
  5473. ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
  5474. PaddingBuff: Cardinal;
  5475. LineBuf, ImageData, TmpData: PByte;
  5476. SourceMD, DestMD: Pointer;
  5477. BmpFormat: TglBitmapFormat;
  5478. ColorTable: TbmpColorTable;
  5479. //records
  5480. Mask: TglBitmapColorRec;
  5481. Header: TBMPHeader;
  5482. Info: TBMPInfo;
  5483. //classes
  5484. SpecialFormat: TFormatDescriptor;
  5485. FormatDesc: TFormatDescriptor;
  5486. //////////////////////////////////////////////////////////////////////////////////////////////////
  5487. procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
  5488. var
  5489. i, j: Integer;
  5490. Pixel: TglBitmapPixelData;
  5491. begin
  5492. aStream.Read(aLineBuf^, rbLineSize);
  5493. SpecialFormat.PreparePixel(Pixel);
  5494. for i := 0 to Info.biWidth-1 do begin
  5495. SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
  5496. with FormatDesc do begin
  5497. //TODO: use convert function
  5498. for j := 0 to 3 do
  5499. if (SpecialFormat.Range.arr[j] <> Range.arr[j]) then begin
  5500. if (SpecialFormat.Range.arr[j] > 0) then
  5501. Pixel.Data.arr[j] := Round(Pixel.Data.arr[j] / SpecialFormat.Range.arr[j] * Range.arr[j])
  5502. else
  5503. Pixel.Data.arr[j] := 0;
  5504. end;
  5505. end;
  5506. FormatDesc.Map(Pixel, aData, DestMD);
  5507. end;
  5508. end;
  5509. begin
  5510. result := false;
  5511. BmpFormat := tfEmpty;
  5512. SpecialFormat := nil;
  5513. LineBuf := nil;
  5514. SourceMD := nil;
  5515. DestMD := nil;
  5516. // Header
  5517. StartPos := aStream.Position;
  5518. aStream.Read(Header, SizeOf(Header));
  5519. if Header.bfType = BMP_MAGIC then begin
  5520. try try
  5521. BmpFormat := ReadInfo(Info, Mask);
  5522. SpecialFormat := ReadColorTable(BmpFormat, Info);
  5523. if not Assigned(SpecialFormat) then
  5524. SpecialFormat := CheckBitfields(BmpFormat, Mask, Info);
  5525. aStream.Position := StartPos + Header.bfOffBits;
  5526. if (BmpFormat <> tfEmpty) then begin
  5527. FormatDesc := TFormatDescriptor.Get(BmpFormat);
  5528. rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
  5529. wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
  5530. Padding := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
  5531. //get Memory
  5532. DestMD := FormatDesc.CreateMappingData;
  5533. ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
  5534. GetMem(ImageData, ImageSize);
  5535. if Assigned(SpecialFormat) then begin
  5536. GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
  5537. SourceMD := SpecialFormat.CreateMappingData;
  5538. end;
  5539. //read Data
  5540. try try
  5541. FillChar(ImageData^, ImageSize, $FF);
  5542. TmpData := ImageData;
  5543. if (Info.biHeight > 0) then
  5544. Inc(TmpData, wbLineSize * (Info.biHeight-1));
  5545. for i := 0 to Abs(Info.biHeight)-1 do begin
  5546. if Assigned(SpecialFormat) then
  5547. SpecialFormatReadLine(TmpData, LineBuf) //if is special format read and convert data
  5548. else
  5549. aStream.Read(TmpData^, wbLineSize); //else only read data
  5550. if (Info.biHeight > 0) then
  5551. dec(TmpData, wbLineSize)
  5552. else
  5553. inc(TmpData, wbLineSize);
  5554. aStream.Read(PaddingBuff, Padding);
  5555. end;
  5556. SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight));
  5557. result := true;
  5558. finally
  5559. if Assigned(LineBuf) then
  5560. FreeMem(LineBuf);
  5561. if Assigned(SourceMD) then
  5562. SpecialFormat.FreeMappingData(SourceMD);
  5563. FormatDesc.FreeMappingData(DestMD);
  5564. end;
  5565. except
  5566. FreeMem(ImageData);
  5567. raise;
  5568. end;
  5569. end else
  5570. raise EglBitmapException.Create('LoadBMP - No suitable format found');
  5571. except
  5572. aStream.Position := StartPos;
  5573. raise;
  5574. end;
  5575. finally
  5576. FreeAndNil(SpecialFormat);
  5577. end;
  5578. end
  5579. else aStream.Position := StartPos;
  5580. end;
  5581. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5582. procedure TglBitmap.SaveBMP(const aStream: TStream);
  5583. var
  5584. Header: TBMPHeader;
  5585. Info: TBMPInfo;
  5586. Converter: TbmpColorTableFormat;
  5587. FormatDesc: TFormatDescriptor;
  5588. SourceFD, DestFD: Pointer;
  5589. pData, srcData, dstData, ConvertBuffer: pByte;
  5590. Pixel: TglBitmapPixelData;
  5591. PixelFormat: TglBitmapPixelData;
  5592. ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx, i: Integer;
  5593. RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
  5594. PaddingBuff: Cardinal;
  5595. function GetLineWidth : Integer;
  5596. begin
  5597. result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
  5598. end;
  5599. begin
  5600. if not (ftBMP in FormatGetSupportedFiles(Format)) then
  5601. raise EglBitmapUnsupportedFormatFormat.Create('SaveBMP - ' + UNSUPPORTED_FORMAT);
  5602. Converter := nil;
  5603. FormatDesc := TFormatDescriptor.Get(Format);
  5604. ImageSize := FormatDesc.GetSize(Dimension);
  5605. FillChar(Header, SizeOf(Header), 0);
  5606. Header.bfType := BMP_MAGIC;
  5607. Header.bfSize := SizeOf(Header) + SizeOf(Info) + ImageSize;
  5608. Header.bfReserved1 := 0;
  5609. Header.bfReserved2 := 0;
  5610. Header.bfOffBits := SizeOf(Header) + SizeOf(Info);
  5611. FillChar(Info, SizeOf(Info), 0);
  5612. Info.biSize := SizeOf(Info);
  5613. Info.biWidth := Width;
  5614. Info.biHeight := Height;
  5615. Info.biPlanes := 1;
  5616. Info.biCompression := BMP_COMP_RGB;
  5617. Info.biSizeImage := ImageSize;
  5618. try
  5619. case Format of
  5620. tfLuminance4: begin
  5621. Info.biBitCount := 4;
  5622. Header.bfSize := Header.bfSize + 16 * SizeOf(Cardinal);
  5623. Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
  5624. Converter := TbmpColorTableFormat.Create;
  5625. Converter.PixelSize := 0.5;
  5626. Converter.Format := Format;
  5627. Converter.Range := glBitmapColorRec($F, $F, $F, $0);
  5628. Converter.CreateColorTable;
  5629. end;
  5630. tfR3G3B2, tfLuminance8: begin
  5631. Info.biBitCount := 8;
  5632. Header.bfSize := Header.bfSize + 256 * SizeOf(Cardinal);
  5633. Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
  5634. Converter := TbmpColorTableFormat.Create;
  5635. Converter.PixelSize := 1;
  5636. Converter.Format := Format;
  5637. if (Format = tfR3G3B2) then begin
  5638. Converter.Range := glBitmapColorRec($7, $7, $3, $0);
  5639. Converter.Shift := glBitmapShiftRec(0, 3, 6, 0);
  5640. end else
  5641. Converter.Range := glBitmapColorRec($FF, $FF, $FF, $0);
  5642. Converter.CreateColorTable;
  5643. end;
  5644. tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
  5645. tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin
  5646. Info.biBitCount := 16;
  5647. Info.biCompression := BMP_COMP_BITFIELDS;
  5648. end;
  5649. tfBGR8, tfRGB8: begin
  5650. Info.biBitCount := 24;
  5651. end;
  5652. tfRGB10, tfRGB10A2, tfRGBA8,
  5653. tfBGR10, tfBGR10A2, tfBGRA8: begin
  5654. Info.biBitCount := 32;
  5655. Info.biCompression := BMP_COMP_BITFIELDS;
  5656. end;
  5657. else
  5658. raise EglBitmapUnsupportedFormatFormat.Create('SaveBMP - ' + UNSUPPORTED_FORMAT);
  5659. end;
  5660. Info.biXPelsPerMeter := 2835;
  5661. Info.biYPelsPerMeter := 2835;
  5662. // prepare bitmasks
  5663. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  5664. Header.bfSize := Header.bfSize + 4 * SizeOf(Cardinal);
  5665. Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
  5666. RedMask := FormatDesc.RedMask;
  5667. GreenMask := FormatDesc.GreenMask;
  5668. BlueMask := FormatDesc.BlueMask;
  5669. AlphaMask := FormatDesc.AlphaMask;
  5670. end;
  5671. // headers
  5672. aStream.Write(Header, SizeOf(Header));
  5673. aStream.Write(Info, SizeOf(Info));
  5674. // colortable
  5675. if Assigned(Converter) then
  5676. aStream.Write(Converter.ColorTable[0].b,
  5677. SizeOf(TbmpColorTableEnty) * Length(Converter.ColorTable));
  5678. // bitmasks
  5679. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  5680. aStream.Write(RedMask, SizeOf(Cardinal));
  5681. aStream.Write(GreenMask, SizeOf(Cardinal));
  5682. aStream.Write(BlueMask, SizeOf(Cardinal));
  5683. aStream.Write(AlphaMask, SizeOf(Cardinal));
  5684. end;
  5685. // image data
  5686. rbLineSize := Round(Info.biWidth * FormatDesc.PixelSize);
  5687. wbLineSize := Round(Info.biWidth * Info.biBitCount / 8);
  5688. Padding := GetLineWidth - wbLineSize;
  5689. PaddingBuff := 0;
  5690. pData := Data;
  5691. inc(pData, (Height-1) * rbLineSize);
  5692. // prepare row buffer. But only for RGB because RGBA supports color masks
  5693. // so it's possible to change color within the image.
  5694. if Assigned(Converter) then begin
  5695. FormatDesc.PreparePixel(Pixel);
  5696. GetMem(ConvertBuffer, wbLineSize);
  5697. SourceFD := FormatDesc.CreateMappingData;
  5698. DestFD := Converter.CreateMappingData;
  5699. end else
  5700. ConvertBuffer := nil;
  5701. try
  5702. for LineIdx := 0 to Height - 1 do begin
  5703. // preparing row
  5704. if Assigned(Converter) then begin
  5705. srcData := pData;
  5706. dstData := ConvertBuffer;
  5707. for PixelIdx := 0 to Info.biWidth-1 do begin
  5708. FormatDesc.Unmap(srcData, Pixel, SourceFD);
  5709. with FormatDesc do begin
  5710. //TODO use convert function
  5711. for i := 0 to 3 do
  5712. if (Converter.Range.arr[i] <> Range.arr[i]) then begin
  5713. if (Range.arr[i] > 0) then
  5714. Pixel.Data.arr[i] := Round(Pixel.Data.arr[i] / Range.arr[i] * Converter.Range.arr[i])
  5715. else
  5716. Pixel.Data.arr[i] := 0;
  5717. end;
  5718. end;
  5719. Converter.Map(Pixel, dstData, DestFD);
  5720. end;
  5721. aStream.Write(ConvertBuffer^, wbLineSize);
  5722. end else begin
  5723. aStream.Write(pData^, rbLineSize);
  5724. end;
  5725. dec(pData, rbLineSize);
  5726. if (Padding > 0) then
  5727. aStream.Write(PaddingBuff, Padding);
  5728. end;
  5729. finally
  5730. // destroy row buffer
  5731. if Assigned(ConvertBuffer) then begin
  5732. FormatDesc.FreeMappingData(SourceFD);
  5733. Converter.FreeMappingData(DestFD);
  5734. FreeMem(ConvertBuffer);
  5735. end;
  5736. end;
  5737. finally
  5738. if Assigned(Converter) then
  5739. Converter.Free;
  5740. end;
  5741. end;
  5742. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5743. //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5744. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5745. type
  5746. TTGAHeader = packed record
  5747. ImageID: Byte;
  5748. ColorMapType: Byte;
  5749. ImageType: Byte;
  5750. //ColorMapSpec: Array[0..4] of Byte;
  5751. ColorMapStart: Word;
  5752. ColorMapLength: Word;
  5753. ColorMapEntrySize: Byte;
  5754. OrigX: Word;
  5755. OrigY: Word;
  5756. Width: Word;
  5757. Height: Word;
  5758. Bpp: Byte;
  5759. ImageDesc: Byte;
  5760. end;
  5761. const
  5762. TGA_UNCOMPRESSED_COLOR_TABLE = 1;
  5763. TGA_UNCOMPRESSED_RGB = 2;
  5764. TGA_UNCOMPRESSED_GRAY = 3;
  5765. TGA_COMPRESSED_COLOR_TABLE = 9;
  5766. TGA_COMPRESSED_RGB = 10;
  5767. TGA_COMPRESSED_GRAY = 11;
  5768. TGA_NONE_COLOR_TABLE = 0;
  5769. TGA_COLOR_TABLE = 1;
  5770. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5771. function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
  5772. var
  5773. Header: TTGAHeader;
  5774. ImageData: PByte;
  5775. StartPosition: Int64;
  5776. PixelSize, LineSize: Integer;
  5777. tgaFormat: TglBitmapFormat;
  5778. FormatDesc: TFormatDescriptor;
  5779. Counter: packed record
  5780. X, Y: packed record
  5781. low, high, dir: Integer;
  5782. end;
  5783. end;
  5784. const
  5785. CACHE_SIZE = $4000;
  5786. ////////////////////////////////////////////////////////////////////////////////////////
  5787. procedure ReadUncompressed;
  5788. var
  5789. i, j: Integer;
  5790. buf, tmp1, tmp2: PByte;
  5791. begin
  5792. buf := nil;
  5793. if (Counter.X.dir < 0) then
  5794. buf := GetMem(LineSize);
  5795. try
  5796. while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
  5797. tmp1 := ImageData + (Counter.Y.low * LineSize); //pointer to LineStart
  5798. if (Counter.X.dir < 0) then begin //flip X
  5799. aStream.Read(buf^, LineSize);
  5800. tmp2 := buf + LineSize - PixelSize; //pointer to last pixel in line
  5801. for i := 0 to Header.Width-1 do begin //for all pixels in line
  5802. for j := 0 to PixelSize-1 do begin //for all bytes in pixel
  5803. tmp1^ := tmp2^;
  5804. inc(tmp1);
  5805. inc(tmp2);
  5806. end;
  5807. dec(tmp2, 2*PixelSize); //move 2 backwards, because j-loop moved 1 forward
  5808. end;
  5809. end else
  5810. aStream.Read(tmp1^, LineSize);
  5811. inc(Counter.Y.low, Counter.Y.dir); //move to next line index
  5812. end;
  5813. finally
  5814. if Assigned(buf) then
  5815. FreeMem(buf);
  5816. end;
  5817. end;
  5818. ////////////////////////////////////////////////////////////////////////////////////////
  5819. procedure ReadCompressed;
  5820. /////////////////////////////////////////////////////////////////
  5821. var
  5822. TmpData: PByte;
  5823. LinePixelsRead: Integer;
  5824. procedure CheckLine;
  5825. begin
  5826. if (LinePixelsRead >= Header.Width) then begin
  5827. LinePixelsRead := 0;
  5828. inc(Counter.Y.low, Counter.Y.dir); //next line index
  5829. TmpData := ImageData + Counter.Y.low * LineSize; //set line
  5830. if (Counter.X.dir < 0) then //if x flipped then
  5831. TmpData := TmpData + LineSize - PixelSize; //set last pixel
  5832. end;
  5833. end;
  5834. /////////////////////////////////////////////////////////////////
  5835. var
  5836. Cache: PByte;
  5837. CacheSize, CachePos: Integer;
  5838. procedure CachedRead(out Buffer; Count: Integer);
  5839. var
  5840. BytesRead: Integer;
  5841. begin
  5842. if (CachePos + Count > CacheSize) then begin
  5843. //if buffer overflow save non read bytes
  5844. BytesRead := 0;
  5845. if (CacheSize - CachePos > 0) then begin
  5846. BytesRead := CacheSize - CachePos;
  5847. Move(PByteArray(Cache)^[CachePos], Buffer, BytesRead);
  5848. inc(CachePos, BytesRead);
  5849. end;
  5850. //load cache from file
  5851. CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
  5852. aStream.Read(Cache^, CacheSize);
  5853. CachePos := 0;
  5854. //read rest of requested bytes
  5855. if (Count - BytesRead > 0) then begin
  5856. Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
  5857. inc(CachePos, Count - BytesRead);
  5858. end;
  5859. end else begin
  5860. //if no buffer overflow just read the data
  5861. Move(PByteArray(Cache)^[CachePos], Buffer, Count);
  5862. inc(CachePos, Count);
  5863. end;
  5864. end;
  5865. procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
  5866. begin
  5867. case PixelSize of
  5868. 1: begin
  5869. aBuffer^ := aData^;
  5870. inc(aBuffer, Counter.X.dir);
  5871. end;
  5872. 2: begin
  5873. PWord(aBuffer)^ := PWord(aData)^;
  5874. inc(aBuffer, 2 * Counter.X.dir);
  5875. end;
  5876. 3: begin
  5877. PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
  5878. PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
  5879. PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
  5880. inc(aBuffer, 3 * Counter.X.dir);
  5881. end;
  5882. 4: begin
  5883. PCardinal(aBuffer)^ := PCardinal(aData)^;
  5884. inc(aBuffer, 4 * Counter.X.dir);
  5885. end;
  5886. end;
  5887. end;
  5888. var
  5889. TotalPixelsToRead, TotalPixelsRead: Integer;
  5890. Temp: Byte;
  5891. buf: array [0..3] of Byte; //1 pixel is max 32bit long
  5892. PixelRepeat: Boolean;
  5893. PixelsToRead, PixelCount: Integer;
  5894. begin
  5895. CacheSize := 0;
  5896. CachePos := 0;
  5897. TotalPixelsToRead := Header.Width * Header.Height;
  5898. TotalPixelsRead := 0;
  5899. LinePixelsRead := 0;
  5900. GetMem(Cache, CACHE_SIZE);
  5901. try
  5902. TmpData := ImageData + Counter.Y.low * LineSize; //set line
  5903. if (Counter.X.dir < 0) then //if x flipped then
  5904. TmpData := TmpData + LineSize - PixelSize; //set last pixel
  5905. repeat
  5906. //read CommandByte
  5907. CachedRead(Temp, 1);
  5908. PixelRepeat := (Temp and $80) > 0;
  5909. PixelsToRead := (Temp and $7F) + 1;
  5910. inc(TotalPixelsRead, PixelsToRead);
  5911. if PixelRepeat then
  5912. CachedRead(buf[0], PixelSize);
  5913. while (PixelsToRead > 0) do begin
  5914. CheckLine;
  5915. PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
  5916. while (PixelCount > 0) do begin
  5917. if not PixelRepeat then
  5918. CachedRead(buf[0], PixelSize);
  5919. PixelToBuffer(@buf[0], TmpData);
  5920. inc(LinePixelsRead);
  5921. dec(PixelsToRead);
  5922. dec(PixelCount);
  5923. end;
  5924. end;
  5925. until (TotalPixelsRead >= TotalPixelsToRead);
  5926. finally
  5927. FreeMem(Cache);
  5928. end;
  5929. end;
  5930. function IsGrayFormat: Boolean;
  5931. begin
  5932. result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
  5933. end;
  5934. begin
  5935. result := false;
  5936. // reading header to test file and set cursor back to begin
  5937. StartPosition := aStream.Position;
  5938. aStream.Read(Header, SizeOf(Header));
  5939. // no colormapped files
  5940. if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
  5941. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
  5942. begin
  5943. try
  5944. if Header.ImageID <> 0 then // skip image ID
  5945. aStream.Position := aStream.Position + Header.ImageID;
  5946. case Header.Bpp of
  5947. 8: if IsGrayFormat then case (Header.ImageDesc and $F) of
  5948. 0: tgaFormat := tfLuminance8;
  5949. 8: tgaFormat := tfAlpha8;
  5950. end;
  5951. 16: if IsGrayFormat then case (Header.ImageDesc and $F) of
  5952. 0: tgaFormat := tfLuminance16;
  5953. 8: tgaFormat := tfLuminance8Alpha8;
  5954. end else case (Header.ImageDesc and $F) of
  5955. 0: tgaFormat := tfBGR5;
  5956. 1: tgaFormat := tfBGR5A1;
  5957. 4: tgaFormat := tfBGRA4;
  5958. end;
  5959. 24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  5960. 0: tgaFormat := tfBGR8;
  5961. end;
  5962. 32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  5963. 2: tgaFormat := tfBGR10A2;
  5964. 8: tgaFormat := tfBGRA8;
  5965. end;
  5966. end;
  5967. if (tgaFormat = tfEmpty) then
  5968. raise EglBitmapException.Create('LoadTga - unsupported format');
  5969. FormatDesc := TFormatDescriptor.Get(tgaFormat);
  5970. PixelSize := FormatDesc.GetSize(1, 1);
  5971. LineSize := FormatDesc.GetSize(Header.Width, 1);
  5972. GetMem(ImageData, LineSize * Header.Height);
  5973. try
  5974. //column direction
  5975. if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
  5976. Counter.X.low := Header.Height-1;;
  5977. Counter.X.high := 0;
  5978. Counter.X.dir := -1;
  5979. end else begin
  5980. Counter.X.low := 0;
  5981. Counter.X.high := Header.Height-1;
  5982. Counter.X.dir := 1;
  5983. end;
  5984. // Row direction
  5985. if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
  5986. Counter.Y.low := 0;
  5987. Counter.Y.high := Header.Height-1;
  5988. Counter.Y.dir := 1;
  5989. end else begin
  5990. Counter.Y.low := Header.Height-1;;
  5991. Counter.Y.high := 0;
  5992. Counter.Y.dir := -1;
  5993. end;
  5994. // Read Image
  5995. case Header.ImageType of
  5996. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
  5997. ReadUncompressed;
  5998. TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
  5999. ReadCompressed;
  6000. end;
  6001. SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height);
  6002. result := true;
  6003. except
  6004. FreeMem(ImageData);
  6005. raise;
  6006. end;
  6007. finally
  6008. aStream.Position := StartPosition;
  6009. end;
  6010. end
  6011. else aStream.Position := StartPosition;
  6012. end;
  6013. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6014. procedure TglBitmap.SaveTGA(const aStream: TStream);
  6015. var
  6016. Header: TTGAHeader;
  6017. LineSize, Size, x, y: Integer;
  6018. Pixel: TglBitmapPixelData;
  6019. LineBuf, SourceData, DestData: PByte;
  6020. SourceMD, DestMD: Pointer;
  6021. FormatDesc: TFormatDescriptor;
  6022. Converter: TFormatDescriptor;
  6023. begin
  6024. if not (ftTGA in FormatGetSupportedFiles(Format)) then
  6025. raise EglBitmapUnsupportedFormatFormat.Create('SaveTGA - ' + UNSUPPORTED_FORMAT);
  6026. //prepare header
  6027. FillChar(Header, SizeOf(Header), 0);
  6028. //set ImageType
  6029. if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
  6030. tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
  6031. Header.ImageType := TGA_UNCOMPRESSED_GRAY
  6032. else
  6033. Header.ImageType := TGA_UNCOMPRESSED_RGB;
  6034. //set BitsPerPixel
  6035. if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
  6036. Header.Bpp := 8
  6037. else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
  6038. tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
  6039. Header.Bpp := 16
  6040. else if (Format in [tfBGR8, tfRGB8]) then
  6041. Header.Bpp := 24
  6042. else
  6043. Header.Bpp := 32;
  6044. //set AlphaBitCount
  6045. case Format of
  6046. tfRGB5A1, tfBGR5A1:
  6047. Header.ImageDesc := 1 and $F;
  6048. tfRGB10A2, tfBGR10A2:
  6049. Header.ImageDesc := 2 and $F;
  6050. tfRGBA4, tfBGRA4:
  6051. Header.ImageDesc := 4 and $F;
  6052. tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
  6053. Header.ImageDesc := 8 and $F;
  6054. end;
  6055. Header.Width := Width;
  6056. Header.Height := Height;
  6057. Header.ImageDesc := Header.ImageDesc or $20; //flip y
  6058. aStream.Write(Header, SizeOf(Header));
  6059. // convert RGB(A) to BGR(A)
  6060. Converter := nil;
  6061. FormatDesc := TFormatDescriptor.Get(Format);
  6062. Size := FormatDesc.GetSize(Dimension);
  6063. if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
  6064. if (FormatDesc.RGBInverted = tfEmpty) then
  6065. raise EglBitmapException.Create('inverted RGB format is empty');
  6066. Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
  6067. if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
  6068. (Converter.PixelSize <> FormatDesc.PixelSize) then
  6069. raise EglBitmapException.Create('invalid inverted RGB format');
  6070. end;
  6071. if Assigned(Converter) then begin
  6072. LineSize := FormatDesc.GetSize(Width, 1);
  6073. LineBuf := GetMem(LineSize);
  6074. SourceMD := FormatDesc.CreateMappingData;
  6075. DestMD := Converter.CreateMappingData;
  6076. try
  6077. SourceData := Data;
  6078. for y := 0 to Height-1 do begin
  6079. DestData := LineBuf;
  6080. for x := 0 to Width-1 do begin
  6081. FormatDesc.Unmap(SourceData, Pixel, SourceMD);
  6082. Converter.Map(Pixel, DestData, DestMD);
  6083. end;
  6084. aStream.Write(LineBuf^, LineSize);
  6085. end;
  6086. finally
  6087. FreeMem(LineBuf);
  6088. FormatDesc.FreeMappingData(SourceMD);
  6089. FormatDesc.FreeMappingData(DestMD);
  6090. end;
  6091. end else
  6092. aStream.Write(Data^, Size);
  6093. end;
  6094. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6095. //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6096. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6097. const
  6098. DDS_MAGIC = $20534444;
  6099. // DDS_header.dwFlags
  6100. DDSD_CAPS = $00000001;
  6101. DDSD_HEIGHT = $00000002;
  6102. DDSD_WIDTH = $00000004;
  6103. DDSD_PITCH = $00000008;
  6104. DDSD_PIXELFORMAT = $00001000;
  6105. DDSD_MIPMAPCOUNT = $00020000;
  6106. DDSD_LINEARSIZE = $00080000;
  6107. DDSD_DEPTH = $00800000;
  6108. // DDS_header.sPixelFormat.dwFlags
  6109. DDPF_ALPHAPIXELS = $00000001;
  6110. DDPF_FOURCC = $00000004;
  6111. DDPF_INDEXED = $00000020;
  6112. DDPF_RGB = $00000040;
  6113. DDPF_LUMINANCE = $00020000;
  6114. // DDS_header.sCaps.dwCaps1
  6115. DDSCAPS_COMPLEX = $00000008;
  6116. DDSCAPS_TEXTURE = $00001000;
  6117. DDSCAPS_MIPMAP = $00400000;
  6118. // DDS_header.sCaps.dwCaps2
  6119. DDSCAPS2_CUBEMAP = $00000200;
  6120. DDSCAPS2_CUBEMAP_POSITIVEX = $00000400;
  6121. DDSCAPS2_CUBEMAP_NEGATIVEX = $00000800;
  6122. DDSCAPS2_CUBEMAP_POSITIVEY = $00001000;
  6123. DDSCAPS2_CUBEMAP_NEGATIVEY = $00002000;
  6124. DDSCAPS2_CUBEMAP_POSITIVEZ = $00004000;
  6125. DDSCAPS2_CUBEMAP_NEGATIVEZ = $00008000;
  6126. DDSCAPS2_VOLUME = $00200000;
  6127. D3DFMT_DXT1 = $31545844;
  6128. D3DFMT_DXT3 = $33545844;
  6129. D3DFMT_DXT5 = $35545844;
  6130. type
  6131. TDDSPixelFormat = packed record
  6132. dwSize: Cardinal;
  6133. dwFlags: Cardinal;
  6134. dwFourCC: Cardinal;
  6135. dwRGBBitCount: Cardinal;
  6136. dwRBitMask: Cardinal;
  6137. dwGBitMask: Cardinal;
  6138. dwBBitMask: Cardinal;
  6139. dwABitMask: Cardinal;
  6140. end;
  6141. TDDSCaps = packed record
  6142. dwCaps1: Cardinal;
  6143. dwCaps2: Cardinal;
  6144. dwDDSX: Cardinal;
  6145. dwReserved: Cardinal;
  6146. end;
  6147. TDDSHeader = packed record
  6148. dwMagic: Cardinal;
  6149. dwSize: Cardinal;
  6150. dwFlags: Cardinal;
  6151. dwHeight: Cardinal;
  6152. dwWidth: Cardinal;
  6153. dwPitchOrLinearSize: Cardinal;
  6154. dwDepth: Cardinal;
  6155. dwMipMapCount: Cardinal;
  6156. dwReserved: array[0..10] of Cardinal;
  6157. PixelFormat: TDDSPixelFormat;
  6158. Caps: TDDSCaps;
  6159. dwReserved2: Cardinal;
  6160. end;
  6161. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6162. function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
  6163. var
  6164. Header: TDDSHeader;
  6165. function GetDDSFormat: TglBitmapFormat;
  6166. begin
  6167. result := tfEmpty;
  6168. with Header.PixelFormat do begin
  6169. // Compresses
  6170. if ((dwFlags and DDPF_FOURCC) > 0) then begin
  6171. case Header.PixelFormat.dwFourCC of
  6172. D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
  6173. D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
  6174. D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
  6175. end;
  6176. end else
  6177. // RGB
  6178. if (dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
  6179. case dwRGBBitCount of
  6180. 8: begin
  6181. if ((dwFlags and DDPF_ALPHAPIXELS) > 0) then
  6182. result := tfAlpha8
  6183. else if ((dwFlags and DDPF_LUMINANCE) > 0) then
  6184. result := tfLuminance8;
  6185. end;
  6186. 16: begin
  6187. if ((dwFlags and DDPF_ALPHAPIXELS) > 0) then begin
  6188. case CountSetBits(dwRBitMask) of
  6189. 5: result := tfRGB5A1;
  6190. 4: result := tfRGBA4;
  6191. else
  6192. result := tfLuminance8Alpha8;
  6193. end;
  6194. end else if (CountSetBits(dwGBitMask) = 6) then
  6195. result := tfR5G6B5
  6196. else
  6197. result := tfRGB5;
  6198. end;
  6199. 24: begin
  6200. result := tfRGB8;
  6201. end;
  6202. 32: begin
  6203. if CountSetBits(dwRBitMask) = 10 then
  6204. result := tfRGB10A2
  6205. else
  6206. result := tfRGBA8;
  6207. end;
  6208. end;
  6209. if (dwRBitMask <> 0) and (dwBBitMask <> 0) and (dwRBitMask > dwBBitMask) then
  6210. result := TFormatDescriptor.Get(result).RGBInverted;
  6211. end;
  6212. end;
  6213. end;
  6214. var
  6215. StreamPos: Int64;
  6216. Y, LineSize: Cardinal;
  6217. RowSize: Cardinal;
  6218. NewImage, TmpData: PByte;
  6219. ddsFormat: TglBitmapFormat;
  6220. FormatDesc: TFormatDescriptor;
  6221. begin
  6222. result := false;
  6223. // Header
  6224. StreamPos := aStream.Position;
  6225. aStream.Read(Header, sizeof(Header));
  6226. if (Header.dwMagic <> DDS_MAGIC) or (Header.dwSize <> 124) or
  6227. ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
  6228. (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
  6229. begin
  6230. aStream.Position := StreamPos;
  6231. exit;
  6232. end;
  6233. if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
  6234. raise EglBitmapException.Create('LoadDDS - CubeMaps are not supported');
  6235. ddsFormat := GetDDSFormat;
  6236. if (ddsFormat = tfEmpty) then
  6237. raise EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');
  6238. FormatDesc := TFormatDescriptor.Get(ddsFormat);
  6239. LineSize := Trunc(Header.dwWidth * FormatDesc.PixelSize);
  6240. GetMem(NewImage, Header.dwHeight * LineSize);
  6241. try
  6242. TmpData := NewImage;
  6243. // Compressed
  6244. if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
  6245. RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
  6246. for Y := 0 to Header.dwHeight-1 do begin
  6247. aStream.Read(TmpData^, RowSize);
  6248. Inc(TmpData, LineSize);
  6249. end;
  6250. end else
  6251. // Uncompressed
  6252. if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
  6253. RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
  6254. for Y := 0 to Header.dwHeight-1 do begin
  6255. aStream.Read(TmpData^, RowSize);
  6256. Inc(TmpData, LineSize);
  6257. end;
  6258. end else
  6259. raise EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');
  6260. SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight);
  6261. result := true;
  6262. except
  6263. FreeMem(NewImage);
  6264. raise;
  6265. end;
  6266. end;
  6267. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6268. procedure TglBitmap.SaveDDS(const aStream: TStream);
  6269. var
  6270. Header: TDDSHeader;
  6271. Pix: TglBitmapPixelData;
  6272. FormatDesc: TFormatDescriptor;
  6273. begin
  6274. //if not FormatIsUncompressed(InternalFormat) then
  6275. // raise EglBitmapUnsupportedFormatFormat.Create('SaveDDS - ' + UNSUPPORTED_FORMAT);
  6276. (* TODO if Format = tfAlpha8 then
  6277. FORMAT_DESCRIPTORS[tfLuminance8].PreparePixel(Pix);
  6278. else *)
  6279. TFormatDescriptor.Get(Format).PreparePixel(Pix);
  6280. // Generell
  6281. FillChar(Header, SizeOf(Header), 0);
  6282. Header.dwMagic := DDS_MAGIC;
  6283. Header.dwSize := 124;
  6284. Header.dwFlags := DDSD_PITCH or DDSD_CAPS or DDSD_PIXELFORMAT;
  6285. if Width > 0 then begin
  6286. Header.dwWidth := Width;
  6287. Header.dwFlags := Header.dwFlags or DDSD_WIDTH;
  6288. end;
  6289. if Height > 0 then begin
  6290. Header.dwHeight := Height;
  6291. Header.dwFlags := Header.dwFlags or DDSD_HEIGHT;
  6292. end;
  6293. Header.dwPitchOrLinearSize := fRowSize;
  6294. Header.dwMipMapCount := 1;
  6295. // Caps
  6296. Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
  6297. // Pixelformat
  6298. Header.PixelFormat.dwSize := Sizeof(Header.PixelFormat);
  6299. Header.PixelFormat.dwFlags := DDPF_RGB;
  6300. (* TODO tfAlpha8
  6301. if FORMAT_DESCRIPTORS[Format].HasAlpha and (Format <> tfAlpha8) then
  6302. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
  6303. *)
  6304. FormatDesc := TFormatDescriptor.Get(Format);
  6305. Header.PixelFormat.dwRGBBitCount := Trunc(FormatDesc.PixelSize * 8);
  6306. Header.PixelFormat.dwRBitMask := FormatDesc.RedMask;
  6307. Header.PixelFormat.dwGBitMask := FormatDesc.GreenMask;
  6308. Header.PixelFormat.dwBBitMask := FormatDesc.BlueMask;
  6309. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6310. aStream.Write(Header, SizeOf(Header));
  6311. aStream.Write(Data^, FormatDesc.GetSize(Dimension));
  6312. end;
  6313. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6314. //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6315. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6316. function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
  6317. begin
  6318. if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
  6319. result := fLines[aIndex]
  6320. else
  6321. result := nil;
  6322. end;
  6323. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6324. procedure TglBitmap2D.SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
  6325. const aWidth: Integer; const aHeight: Integer);
  6326. var
  6327. Idx, LineWidth: Integer;
  6328. begin
  6329. inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
  6330. if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
  6331. (* TODO PixelFuncs
  6332. fGetPixelFunc := GetPixel2DUnmap;
  6333. fSetPixelFunc := SetPixel2DUnmap;
  6334. *)
  6335. // Assigning Data
  6336. if Assigned(Data) then begin
  6337. SetLength(fLines, GetHeight);
  6338. LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
  6339. for Idx := 0 to GetHeight -1 do begin
  6340. fLines[Idx] := Data;
  6341. Inc(fLines[Idx], Idx * LineWidth);
  6342. end;
  6343. end
  6344. else SetLength(fLines, 0);
  6345. end else begin
  6346. SetLength(fLines, 0);
  6347. (*
  6348. fSetPixelFunc := nil;
  6349. case Format of
  6350. ifDXT1:
  6351. fGetPixelFunc := GetPixel2DDXT1;
  6352. ifDXT3:
  6353. fGetPixelFunc := GetPixel2DDXT3;
  6354. ifDXT5:
  6355. fGetPixelFunc := GetPixel2DDXT5;
  6356. else
  6357. fGetPixelFunc := nil;
  6358. end;
  6359. *)
  6360. end;
  6361. end;
  6362. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6363. procedure TglBitmap2D.UploadData(const aTarget: Cardinal; const aBuildWithGlu: Boolean);
  6364. var
  6365. FormatDesc: TFormatDescriptor;
  6366. begin
  6367. glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
  6368. FormatDesc := TFormatDescriptor.Get(Format);
  6369. if FormatDesc.IsCompressed then begin
  6370. glCompressedTexImage2D(Target, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
  6371. end else if aBuildWithGlu then begin
  6372. gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
  6373. FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  6374. end else begin
  6375. glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
  6376. FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  6377. end;
  6378. // Freigeben
  6379. if (FreeDataAfterGenTexture) then
  6380. FreeData;
  6381. end;
  6382. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6383. procedure TglBitmap2D.AfterConstruction;
  6384. begin
  6385. inherited;
  6386. Target := GL_TEXTURE_2D;
  6387. end;
  6388. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6389. procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  6390. var
  6391. Temp: pByte;
  6392. Size, w, h: Integer;
  6393. FormatDesc: TFormatDescriptor;
  6394. begin
  6395. FormatDesc := TFormatDescriptor.Get(Format);
  6396. if FormatDesc.IsCompressed then
  6397. raise EglBitmapUnsupportedFormatFormat.Create('TglBitmap2D.GrabScreen - ' + UNSUPPORTED_FORMAT);
  6398. w := aRight - aLeft;
  6399. h := aBottom - aTop;
  6400. Size := FormatDesc.GetSize(w, h);
  6401. GetMem(Temp, Size);
  6402. try
  6403. glPixelStorei(GL_PACK_ALIGNMENT, 1);
  6404. glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  6405. SetDataPointer(Temp, Format, w, h);
  6406. FlipVert;
  6407. except
  6408. FreeMem(Temp);
  6409. raise;
  6410. end;
  6411. end;
  6412. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6413. procedure TglBitmap2D.GetDataFromTexture;
  6414. var
  6415. Temp: PByte;
  6416. TempWidth, TempHeight: Integer;
  6417. TempType, TempIntFormat: Cardinal;
  6418. IntFormat, f: TglBitmapFormat;
  6419. FormatDesc: TFormatDescriptor;
  6420. begin
  6421. Bind;
  6422. // Request Data
  6423. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH, @TempWidth);
  6424. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT, @TempHeight);
  6425. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
  6426. IntFormat := tfEmpty;
  6427. for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do
  6428. if (TFormatDescriptor.Get(f).glInternalFormat = TempIntFormat) then begin
  6429. IntFormat := FormatDesc.Format;
  6430. break;
  6431. end;
  6432. // Getting data from OpenGL
  6433. FormatDesc := TFormatDescriptor.Get(IntFormat);
  6434. GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
  6435. try
  6436. if FormatDesc.IsCompressed then
  6437. glGetCompressedTexImage(Target, 0, Temp)
  6438. else
  6439. glGetTexImage(Target, 0, FormatDesc.glInternalFormat, FormatDesc.glDataFormat, Temp);
  6440. SetDataPointer(Temp, IntFormat, TempWidth, TempHeight);
  6441. except
  6442. FreeMem(Temp);
  6443. raise;
  6444. end;
  6445. end;
  6446. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6447. procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
  6448. var
  6449. BuildWithGlu, PotTex, TexRec: Boolean;
  6450. TexSize: Integer;
  6451. begin
  6452. if Assigned(Data) then begin
  6453. // Check Texture Size
  6454. if (aTestTextureSize) then begin
  6455. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  6456. if ((Height > TexSize) or (Width > TexSize)) then
  6457. raise EglBitmapSizeToLargeException.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  6458. PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
  6459. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE_ARB);
  6460. if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  6461. raise EglBitmapNonPowerOfTwoException.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  6462. end;
  6463. CreateId;
  6464. SetupParameters(BuildWithGlu);
  6465. UploadData(Target, BuildWithGlu);
  6466. glAreTexturesResident(1, @fID, @fIsResident);
  6467. end;
  6468. end;
  6469. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6470. function TglBitmap2D.FlipHorz: Boolean;
  6471. var
  6472. Col, Row: Integer;
  6473. TempDestData, DestData, SourceData: PByte;
  6474. ImgSize: Integer;
  6475. begin
  6476. result := inherited FlipHorz;
  6477. if Assigned(Data) then begin
  6478. SourceData := Data;
  6479. ImgSize := Height * fRowSize;
  6480. GetMem(DestData, ImgSize);
  6481. try
  6482. TempDestData := DestData;
  6483. Dec(TempDestData, fRowSize + fPixelSize);
  6484. for Row := 0 to Height -1 do begin
  6485. Inc(TempDestData, fRowSize * 2);
  6486. for Col := 0 to Width -1 do begin
  6487. Move(SourceData^, TempDestData^, fPixelSize);
  6488. Inc(SourceData, fPixelSize);
  6489. Dec(TempDestData, fPixelSize);
  6490. end;
  6491. end;
  6492. SetDataPointer(DestData, Format);
  6493. result := true;
  6494. except
  6495. FreeMem(DestData);
  6496. raise;
  6497. end;
  6498. end;
  6499. end;
  6500. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6501. function TglBitmap2D.FlipVert: Boolean;
  6502. var
  6503. Row: Integer;
  6504. TempDestData, DestData, SourceData: PByte;
  6505. begin
  6506. result := inherited FlipVert;
  6507. if Assigned(Data) then begin
  6508. SourceData := Data;
  6509. GetMem(DestData, Height * fRowSize);
  6510. try
  6511. TempDestData := DestData;
  6512. Inc(TempDestData, Width * (Height -1) * fPixelSize);
  6513. for Row := 0 to Height -1 do begin
  6514. Move(SourceData^, TempDestData^, fRowSize);
  6515. Dec(TempDestData, fRowSize);
  6516. Inc(SourceData, fRowSize);
  6517. end;
  6518. SetDataPointer(DestData, Format);
  6519. result := true;
  6520. except
  6521. FreeMem(DestData);
  6522. raise;
  6523. end;
  6524. end;
  6525. end;
  6526. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6527. //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6528. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6529. type
  6530. TMatrixItem = record
  6531. X, Y: Integer;
  6532. W: Single;
  6533. end;
  6534. PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
  6535. TglBitmapToNormalMapRec = Record
  6536. Scale: Single;
  6537. Heights: array of Single;
  6538. MatrixU : array of TMatrixItem;
  6539. MatrixV : array of TMatrixItem;
  6540. end;
  6541. const
  6542. ONE_OVER_255 = 1 / 255;
  6543. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6544. procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
  6545. var
  6546. Val: Single;
  6547. begin
  6548. with FuncRec do begin
  6549. Val :=
  6550. Source.Data.r * LUMINANCE_WEIGHT_R +
  6551. Source.Data.g * LUMINANCE_WEIGHT_G +
  6552. Source.Data.b * LUMINANCE_WEIGHT_B;
  6553. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
  6554. end;
  6555. end;
  6556. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6557. procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  6558. begin
  6559. with FuncRec do
  6560. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
  6561. end;
  6562. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6563. procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
  6564. type
  6565. TVec = Array[0..2] of Single;
  6566. var
  6567. Idx: Integer;
  6568. du, dv: Double;
  6569. Len: Single;
  6570. Vec: TVec;
  6571. function GetHeight(X, Y: Integer): Single;
  6572. begin
  6573. with FuncRec do begin
  6574. X := Max(0, Min(Size.X -1, X));
  6575. Y := Max(0, Min(Size.Y -1, Y));
  6576. result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
  6577. end;
  6578. end;
  6579. begin
  6580. with FuncRec do begin
  6581. with PglBitmapToNormalMapRec(Args)^ do begin
  6582. du := 0;
  6583. for Idx := Low(MatrixU) to High(MatrixU) do
  6584. du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
  6585. dv := 0;
  6586. for Idx := Low(MatrixU) to High(MatrixU) do
  6587. dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
  6588. Vec[0] := -du * Scale;
  6589. Vec[1] := -dv * Scale;
  6590. Vec[2] := 1;
  6591. end;
  6592. // Normalize
  6593. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  6594. if Len <> 0 then begin
  6595. Vec[0] := Vec[0] * Len;
  6596. Vec[1] := Vec[1] * Len;
  6597. Vec[2] := Vec[2] * Len;
  6598. end;
  6599. // Farbe zuweisem
  6600. Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
  6601. Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
  6602. Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
  6603. end;
  6604. end;
  6605. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6606. procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
  6607. var
  6608. Rec: TglBitmapToNormalMapRec;
  6609. procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
  6610. begin
  6611. if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
  6612. Matrix[Index].X := X;
  6613. Matrix[Index].Y := Y;
  6614. Matrix[Index].W := W;
  6615. end;
  6616. end;
  6617. begin
  6618. (* TODO Compression
  6619. if not FormatIsUncompressed(InternalFormat) then
  6620. raise EglBitmapUnsupportedFormatFormat.Create('TglBitmap2D.ToNormalMap - ' + UNSUPPORTED_FORMAT);
  6621. *)
  6622. if aScale > 100 then
  6623. Rec.Scale := 100
  6624. else if aScale < -100 then
  6625. Rec.Scale := -100
  6626. else
  6627. Rec.Scale := aScale;
  6628. SetLength(Rec.Heights, Width * Height);
  6629. try
  6630. case aFunc of
  6631. nm4Samples: begin
  6632. SetLength(Rec.MatrixU, 2);
  6633. SetEntry(Rec.MatrixU, 0, -1, 0, -0.5);
  6634. SetEntry(Rec.MatrixU, 1, 1, 0, 0.5);
  6635. SetLength(Rec.MatrixV, 2);
  6636. SetEntry(Rec.MatrixV, 0, 0, 1, 0.5);
  6637. SetEntry(Rec.MatrixV, 1, 0, -1, -0.5);
  6638. end;
  6639. nmSobel: begin
  6640. SetLength(Rec.MatrixU, 6);
  6641. SetEntry(Rec.MatrixU, 0, -1, 1, -1.0);
  6642. SetEntry(Rec.MatrixU, 1, -1, 0, -2.0);
  6643. SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
  6644. SetEntry(Rec.MatrixU, 3, 1, 1, 1.0);
  6645. SetEntry(Rec.MatrixU, 4, 1, 0, 2.0);
  6646. SetEntry(Rec.MatrixU, 5, 1, -1, 1.0);
  6647. SetLength(Rec.MatrixV, 6);
  6648. SetEntry(Rec.MatrixV, 0, -1, 1, 1.0);
  6649. SetEntry(Rec.MatrixV, 1, 0, 1, 2.0);
  6650. SetEntry(Rec.MatrixV, 2, 1, 1, 1.0);
  6651. SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
  6652. SetEntry(Rec.MatrixV, 4, 0, -1, -2.0);
  6653. SetEntry(Rec.MatrixV, 5, 1, -1, -1.0);
  6654. end;
  6655. nm3x3: begin
  6656. SetLength(Rec.MatrixU, 6);
  6657. SetEntry(Rec.MatrixU, 0, -1, 1, -1/6);
  6658. SetEntry(Rec.MatrixU, 1, -1, 0, -1/6);
  6659. SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
  6660. SetEntry(Rec.MatrixU, 3, 1, 1, 1/6);
  6661. SetEntry(Rec.MatrixU, 4, 1, 0, 1/6);
  6662. SetEntry(Rec.MatrixU, 5, 1, -1, 1/6);
  6663. SetLength(Rec.MatrixV, 6);
  6664. SetEntry(Rec.MatrixV, 0, -1, 1, 1/6);
  6665. SetEntry(Rec.MatrixV, 1, 0, 1, 1/6);
  6666. SetEntry(Rec.MatrixV, 2, 1, 1, 1/6);
  6667. SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
  6668. SetEntry(Rec.MatrixV, 4, 0, -1, -1/6);
  6669. SetEntry(Rec.MatrixV, 5, 1, -1, -1/6);
  6670. end;
  6671. nm5x5: begin
  6672. SetLength(Rec.MatrixU, 20);
  6673. SetEntry(Rec.MatrixU, 0, -2, 2, -1 / 16);
  6674. SetEntry(Rec.MatrixU, 1, -1, 2, -1 / 10);
  6675. SetEntry(Rec.MatrixU, 2, 1, 2, 1 / 10);
  6676. SetEntry(Rec.MatrixU, 3, 2, 2, 1 / 16);
  6677. SetEntry(Rec.MatrixU, 4, -2, 1, -1 / 10);
  6678. SetEntry(Rec.MatrixU, 5, -1, 1, -1 / 8);
  6679. SetEntry(Rec.MatrixU, 6, 1, 1, 1 / 8);
  6680. SetEntry(Rec.MatrixU, 7, 2, 1, 1 / 10);
  6681. SetEntry(Rec.MatrixU, 8, -2, 0, -1 / 2.8);
  6682. SetEntry(Rec.MatrixU, 9, -1, 0, -0.5);
  6683. SetEntry(Rec.MatrixU, 10, 1, 0, 0.5);
  6684. SetEntry(Rec.MatrixU, 11, 2, 0, 1 / 2.8);
  6685. SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
  6686. SetEntry(Rec.MatrixU, 13, -1, -1, -1 / 8);
  6687. SetEntry(Rec.MatrixU, 14, 1, -1, 1 / 8);
  6688. SetEntry(Rec.MatrixU, 15, 2, -1, 1 / 10);
  6689. SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
  6690. SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
  6691. SetEntry(Rec.MatrixU, 18, 1, -2, 1 / 10);
  6692. SetEntry(Rec.MatrixU, 19, 2, -2, 1 / 16);
  6693. SetLength(Rec.MatrixV, 20);
  6694. SetEntry(Rec.MatrixV, 0, -2, 2, 1 / 16);
  6695. SetEntry(Rec.MatrixV, 1, -1, 2, 1 / 10);
  6696. SetEntry(Rec.MatrixV, 2, 0, 2, 0.25);
  6697. SetEntry(Rec.MatrixV, 3, 1, 2, 1 / 10);
  6698. SetEntry(Rec.MatrixV, 4, 2, 2, 1 / 16);
  6699. SetEntry(Rec.MatrixV, 5, -2, 1, 1 / 10);
  6700. SetEntry(Rec.MatrixV, 6, -1, 1, 1 / 8);
  6701. SetEntry(Rec.MatrixV, 7, 0, 1, 0.5);
  6702. SetEntry(Rec.MatrixV, 8, 1, 1, 1 / 8);
  6703. SetEntry(Rec.MatrixV, 9, 2, 1, 1 / 16);
  6704. SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
  6705. SetEntry(Rec.MatrixV, 11, -1, -1, -1 / 8);
  6706. SetEntry(Rec.MatrixV, 12, 0, -1, -0.5);
  6707. SetEntry(Rec.MatrixV, 13, 1, -1, -1 / 8);
  6708. SetEntry(Rec.MatrixV, 14, 2, -1, -1 / 10);
  6709. SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
  6710. SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
  6711. SetEntry(Rec.MatrixV, 17, 0, -2, -0.25);
  6712. SetEntry(Rec.MatrixV, 18, 1, -2, -1 / 10);
  6713. SetEntry(Rec.MatrixV, 19, 2, -2, -1 / 16);
  6714. end;
  6715. end;
  6716. // Daten Sammeln
  6717. if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
  6718. AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, PtrInt(@Rec))
  6719. else
  6720. AddFunc(glBitmapToNormalMapPrepareFunc, false, PtrInt(@Rec));
  6721. AddFunc(glBitmapToNormalMapFunc, false, PtrInt(@Rec));
  6722. finally
  6723. SetLength(Rec.Heights, 0);
  6724. end;
  6725. end;
  6726. (*
  6727. procedure TglBitmap1D.SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width, Height: Integer);
  6728. var
  6729. pTemp: pByte;
  6730. Size: Integer;
  6731. begin
  6732. if Height > 1 then begin
  6733. // extract first line of the data
  6734. Size := FormatGetImageSize(glBitmapPosition(Width), Format);
  6735. GetMem(pTemp, Size);
  6736. Move(Data^, pTemp^, Size);
  6737. FreeMem(Data);
  6738. end else
  6739. pTemp := Data;
  6740. // set data pointer
  6741. inherited SetDataPointer(pTemp, Format, Width);
  6742. if FormatIsUncompressed(Format) then begin
  6743. fUnmapFunc := FormatGetUnMapFunc(Format);
  6744. fGetPixelFunc := GetPixel1DUnmap;
  6745. end;
  6746. end;
  6747. procedure TglBitmap1D.GetPixel1DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
  6748. var
  6749. pTemp: pByte;
  6750. begin
  6751. pTemp := Data;
  6752. Inc(pTemp, Pos.X * fPixelSize);
  6753. fUnmapFunc(pTemp, Pixel);
  6754. end;
  6755. function TglBitmap1D.FlipHorz: Boolean;
  6756. var
  6757. Col: Integer;
  6758. pTempDest, pDest, pSource: pByte;
  6759. begin
  6760. result := inherited FlipHorz;
  6761. if Assigned(Data) and FormatIsUncompressed(InternalFormat) then begin
  6762. pSource := Data;
  6763. GetMem(pDest, fRowSize);
  6764. try
  6765. pTempDest := pDest;
  6766. Inc(pTempDest, fRowSize);
  6767. for Col := 0 to Width -1 do begin
  6768. Move(pSource^, pTempDest^, fPixelSize);
  6769. Inc(pSource, fPixelSize);
  6770. Dec(pTempDest, fPixelSize);
  6771. end;
  6772. SetDataPointer(pDest, InternalFormat);
  6773. result := true;
  6774. finally
  6775. FreeMem(pDest);
  6776. end;
  6777. end;
  6778. end;
  6779. procedure TglBitmap1D.UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
  6780. begin
  6781. // Upload data
  6782. if Self.InternalFormat in [ifDXT1, ifDXT3, ifDXT5] then
  6783. glCompressedTexImage1D(Target, 0, InternalFormat, Width, 0, Trunc(Width * FormatGetSize(Self.InternalFormat)), Data)
  6784. else
  6785. // Upload data
  6786. if BuildWithGlu then
  6787. gluBuild1DMipmaps(Target, InternalFormat, Width, Format, Typ, Data)
  6788. else
  6789. glTexImage1D(Target, 0, InternalFormat, Width, 0, Format, Typ, Data);
  6790. // Freigeben
  6791. if (FreeDataAfterGenTexture) then
  6792. FreeData;
  6793. end;
  6794. procedure TglBitmap1D.GenTexture(TestTextureSize: Boolean);
  6795. var
  6796. BuildWithGlu, TexRec: Boolean;
  6797. glFormat, glInternalFormat, glType: Cardinal;
  6798. TexSize: Integer;
  6799. begin
  6800. if Assigned(Data) then begin
  6801. // Check Texture Size
  6802. if (TestTextureSize) then begin
  6803. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  6804. if (Width > TexSize) then
  6805. raise EglBitmapSizeToLargeException.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  6806. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
  6807. (Target = GL_TEXTURE_RECTANGLE_ARB);
  6808. if not (IsPowerOfTwo (Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  6809. raise EglBitmapNonPowerOfTwoException.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  6810. end;
  6811. CreateId;
  6812. SetupParameters(BuildWithGlu);
  6813. SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
  6814. UploadData(Target, glFormat, glInternalFormat, glType, BuildWithGlu);
  6815. // Infos sammeln
  6816. glAreTexturesResident(1, @fID, @fIsResident);
  6817. end;
  6818. end;
  6819. procedure TglBitmap1D.AfterConstruction;
  6820. begin
  6821. inherited;
  6822. Target := GL_TEXTURE_1D;
  6823. end;
  6824. { TglBitmapCubeMap }
  6825. procedure TglBitmapCubeMap.AfterConstruction;
  6826. begin
  6827. inherited;
  6828. if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
  6829. raise EglBitmapException.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
  6830. SetWrap; // set all to GL_CLAMP_TO_EDGE
  6831. Target := GL_TEXTURE_CUBE_MAP;
  6832. fGenMode := GL_REFLECTION_MAP;
  6833. end;
  6834. procedure TglBitmapCubeMap.Bind(EnableTexCoordsGen, EnableTextureUnit: Boolean);
  6835. begin
  6836. inherited Bind (EnableTextureUnit);
  6837. if EnableTexCoordsGen then begin
  6838. glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
  6839. glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
  6840. glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
  6841. glEnable(GL_TEXTURE_GEN_S);
  6842. glEnable(GL_TEXTURE_GEN_T);
  6843. glEnable(GL_TEXTURE_GEN_R);
  6844. end;
  6845. end;
  6846. procedure TglBitmapCubeMap.GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean);
  6847. var
  6848. glFormat, glInternalFormat, glType: Cardinal;
  6849. BuildWithGlu: Boolean;
  6850. TexSize: Integer;
  6851. begin
  6852. // Check Texture Size
  6853. if (TestTextureSize) then begin
  6854. glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
  6855. if ((Height > TexSize) or (Width > TexSize)) then
  6856. raise EglBitmapSizeToLargeException.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
  6857. if not ((IsPowerOfTwo (Height) and IsPowerOfTwo (Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
  6858. raise EglBitmapNonPowerOfTwoException.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
  6859. end;
  6860. // create Texture
  6861. if ID = 0 then begin
  6862. CreateID;
  6863. SetupParameters(BuildWithGlu);
  6864. end;
  6865. SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
  6866. UploadData (CubeTarget, glFormat, glInternalFormat, glType, BuildWithGlu);
  6867. end;
  6868. procedure TglBitmapCubeMap.GenTexture(TestTextureSize: Boolean);
  6869. begin
  6870. Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
  6871. end;
  6872. procedure TglBitmapCubeMap.Unbind(DisableTexCoordsGen,
  6873. DisableTextureUnit: Boolean);
  6874. begin
  6875. inherited Unbind (DisableTextureUnit);
  6876. if DisableTexCoordsGen then begin
  6877. glDisable(GL_TEXTURE_GEN_S);
  6878. glDisable(GL_TEXTURE_GEN_T);
  6879. glDisable(GL_TEXTURE_GEN_R);
  6880. end;
  6881. end;
  6882. { TglBitmapNormalMap }
  6883. type
  6884. TVec = Array[0..2] of Single;
  6885. TglBitmapNormalMapGetVectorFunc = procedure (var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  6886. PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
  6887. TglBitmapNormalMapRec = record
  6888. HalfSize : Integer;
  6889. Func: TglBitmapNormalMapGetVectorFunc;
  6890. end;
  6891. procedure glBitmapNormalMapPosX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  6892. begin
  6893. Vec[0] := HalfSize;
  6894. Vec[1] := - (Position.Y + 0.5 - HalfSize);
  6895. Vec[2] := - (Position.X + 0.5 - HalfSize);
  6896. end;
  6897. procedure glBitmapNormalMapNegX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  6898. begin
  6899. Vec[0] := - HalfSize;
  6900. Vec[1] := - (Position.Y + 0.5 - HalfSize);
  6901. Vec[2] := Position.X + 0.5 - HalfSize;
  6902. end;
  6903. procedure glBitmapNormalMapPosY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  6904. begin
  6905. Vec[0] := Position.X + 0.5 - HalfSize;
  6906. Vec[1] := HalfSize;
  6907. Vec[2] := Position.Y + 0.5 - HalfSize;
  6908. end;
  6909. procedure glBitmapNormalMapNegY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  6910. begin
  6911. Vec[0] := Position.X + 0.5 - HalfSize;
  6912. Vec[1] := - HalfSize;
  6913. Vec[2] := - (Position.Y + 0.5 - HalfSize);
  6914. end;
  6915. procedure glBitmapNormalMapPosZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  6916. begin
  6917. Vec[0] := Position.X + 0.5 - HalfSize;
  6918. Vec[1] := - (Position.Y + 0.5 - HalfSize);
  6919. Vec[2] := HalfSize;
  6920. end;
  6921. procedure glBitmapNormalMapNegZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  6922. begin
  6923. Vec[0] := - (Position.X + 0.5 - HalfSize);
  6924. Vec[1] := - (Position.Y + 0.5 - HalfSize);
  6925. Vec[2] := - HalfSize;
  6926. end;
  6927. procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
  6928. var
  6929. Vec : TVec;
  6930. Len: Single;
  6931. begin
  6932. with FuncRec do begin
  6933. with PglBitmapNormalMapRec (CustomData)^ do begin
  6934. Func(Vec, Position, HalfSize);
  6935. // Normalize
  6936. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  6937. if Len <> 0 then begin
  6938. Vec[0] := Vec[0] * Len;
  6939. Vec[1] := Vec[1] * Len;
  6940. Vec[2] := Vec[2] * Len;
  6941. end;
  6942. // Scale Vector and AddVectro
  6943. Vec[0] := Vec[0] * 0.5 + 0.5;
  6944. Vec[1] := Vec[1] * 0.5 + 0.5;
  6945. Vec[2] := Vec[2] * 0.5 + 0.5;
  6946. end;
  6947. // Set Color
  6948. Dest.Red := Round(Vec[0] * 255);
  6949. Dest.Green := Round(Vec[1] * 255);
  6950. Dest.Blue := Round(Vec[2] * 255);
  6951. end;
  6952. end;
  6953. procedure TglBitmapNormalMap.AfterConstruction;
  6954. begin
  6955. inherited;
  6956. fGenMode := GL_NORMAL_MAP;
  6957. end;
  6958. procedure TglBitmapNormalMap.GenerateNormalMap(Size: Integer;
  6959. TestTextureSize: Boolean);
  6960. var
  6961. Rec: TglBitmapNormalMapRec;
  6962. SizeRec: TglBitmapPixelPosition;
  6963. begin
  6964. Rec.HalfSize := Size div 2;
  6965. FreeDataAfterGenTexture := false;
  6966. SizeRec.Fields := [ffX, ffY];
  6967. SizeRec.X := Size;
  6968. SizeRec.Y := Size;
  6969. // Positive X
  6970. Rec.Func := glBitmapNormalMapPosX;
  6971. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  6972. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, TestTextureSize);
  6973. // Negative X
  6974. Rec.Func := glBitmapNormalMapNegX;
  6975. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  6976. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, TestTextureSize);
  6977. // Positive Y
  6978. Rec.Func := glBitmapNormalMapPosY;
  6979. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  6980. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, TestTextureSize);
  6981. // Negative Y
  6982. Rec.Func := glBitmapNormalMapNegY;
  6983. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  6984. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, TestTextureSize);
  6985. // Positive Z
  6986. Rec.Func := glBitmapNormalMapPosZ;
  6987. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  6988. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, TestTextureSize);
  6989. // Negative Z
  6990. Rec.Func := glBitmapNormalMapNegZ;
  6991. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  6992. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, TestTextureSize);
  6993. end;
  6994. *)
  6995. initialization
  6996. glBitmapSetDefaultFormat(tfEmpty);
  6997. glBitmapSetDefaultMipmap(mmMipmap);
  6998. glBitmapSetDefaultFilter(GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
  6999. glBitmapSetDefaultWrap (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
  7000. glBitmapSetDefaultFreeDataAfterGenTexture(true);
  7001. glBitmapSetDefaultDeleteTextureOnFree (true);
  7002. TFormatDescriptor.Init;
  7003. finalization
  7004. TFormatDescriptor.Finalize;
  7005. end.