25개 이상의 토픽을 선택하실 수 없습니다. Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

8140 lines
269 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, //must be smallest value!
  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. if (aFormat in [
  1351. //4 bbp
  1352. tfLuminance4,
  1353. //8bpp
  1354. tfR3G3B2, tfLuminance8,
  1355. //16bpp
  1356. tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
  1357. tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,
  1358. //24bpp
  1359. tfBGR8, tfRGB8,
  1360. //32bpp
  1361. tfRGB10, tfRGB10A2, tfRGBA8,
  1362. tfBGR10, tfBGR10A2, tfBGRA8]) then
  1363. result := result + [ftBMP];
  1364. if (aFormat in [
  1365. //8 bpp
  1366. tfLuminance8, tfAlpha8,
  1367. //16 bpp
  1368. tfLuminance16, tfLuminance8Alpha8,
  1369. tfRGB5, tfRGB5A1, tfRGBA4,
  1370. tfBGR5, tfBGR5A1, tfBGRA4,
  1371. //24 bpp
  1372. tfRGB8, tfBGR8,
  1373. //32 bpp
  1374. tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
  1375. result := result + [ftTGA];
  1376. if (aFormat in [
  1377. //8 bpp
  1378. tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,
  1379. tfR3G3B2, tfRGBA2, tfBGRA2,
  1380. //16 bpp
  1381. tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,
  1382. tfRGB4, tfR5G6B5, tfRGB5, tfRGBA4, tfRGB5A1,
  1383. tfBGR4, tfB5G6R5, tfBGR5, tfBGRA4, tfBGR5A1,
  1384. //24 bpp
  1385. tfRGB8, tfBGR8,
  1386. //32 bbp
  1387. tfLuminance16Alpha16,
  1388. tfRGBA8, tfRGB10A2,
  1389. tfBGRA8, tfBGR10A2,
  1390. //compressed
  1391. tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then
  1392. result := result + [ftDDS];
  1393. (* TODO
  1394. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  1395. if aFormat in [
  1396. tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
  1397. tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
  1398. tfuminance4Alpha4, tfLuminance6Alpha2, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16,
  1399. tfR3G3B2, tfRGB4, tfRGB5, tfRGB8, tfRGB10, tfRGB12, tfRGB16,
  1400. tfRGBA2, tfRGBA4, tfRGB5A1, tfRGBA8, tfRGB10A2, tfRGBA12, tfRGBA16,
  1401. tfDepth16, tfDepth24, tfDepth32]
  1402. then
  1403. result := result + [ftPNG];
  1404. {$ENDIF}
  1405. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  1406. if Format in [
  1407. tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
  1408. tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
  1409. tfR3G3B2, tfRGB4, tfRGB5, tfRGB8, tfRGB10, tfRGB12, tfRGB16,
  1410. tfDepth16, tfDepth24, tfDepth32]
  1411. then
  1412. result := result + [ftJPEG];
  1413. {$ENDIF}
  1414. if aFormat in [
  1415. tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
  1416. tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
  1417. tfuminance4Alpha4, tfLuminance6Alpha2, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16,
  1418. tfR3G3B2, tfRGB4, tfRGB5, tfRGB8, tfRGB10, tfRGB12, tfRGB16,
  1419. tfRGBA2, tfRGBA4, tfRGB5A1, tfRGBA8, tfRGB10A2, tfRGBA12, tfRGBA16,
  1420. tfDepth16, tfDepth24, tfDepth32]
  1421. then
  1422. result := result + [ftDDS, ftTGA, ftBMP];
  1423. *)
  1424. end;
  1425. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1426. function IsPowerOfTwo(aNumber: Integer): Boolean;
  1427. begin
  1428. while (aNumber and 1) = 0 do
  1429. aNumber := aNumber shr 1;
  1430. result := aNumber = 1;
  1431. end;
  1432. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1433. function GetTopMostBit(aBitSet: UInt64): Integer;
  1434. begin
  1435. result := 0;
  1436. while aBitSet > 0 do begin
  1437. inc(result);
  1438. aBitSet := aBitSet shr 1;
  1439. end;
  1440. end;
  1441. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1442. function CountSetBits(aBitSet: UInt64): Integer;
  1443. begin
  1444. result := 0;
  1445. while aBitSet > 0 do begin
  1446. if (aBitSet and 1) = 1 then
  1447. inc(result);
  1448. aBitSet := aBitSet shr 1;
  1449. end;
  1450. end;
  1451. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1452. function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1453. begin
  1454. result := Trunc(
  1455. LUMINANCE_WEIGHT_R * aPixel.Data.r +
  1456. LUMINANCE_WEIGHT_G * aPixel.Data.g +
  1457. LUMINANCE_WEIGHT_B * aPixel.Data.b);
  1458. end;
  1459. function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1460. begin
  1461. result := Trunc(
  1462. DEPTH_WEIGHT_R * aPixel.Data.r +
  1463. DEPTH_WEIGHT_G * aPixel.Data.g +
  1464. DEPTH_WEIGHT_B * aPixel.Data.b);
  1465. end;
  1466. //TODO check _ARB functions and constants
  1467. (* GLB_NO_NATIVE_GL
  1468. {$IFNDEF GLB_NO_NATIVE_GL}
  1469. procedure ReadOpenGLExtensions;
  1470. var
  1471. {$IFDEF GLB_DELPHI}
  1472. Context: HGLRC;
  1473. {$ENDIF}
  1474. Buffer: AnsiString;
  1475. MajorVersion, MinorVersion: Integer;
  1476. procedure TrimVersionString(Buffer: AnsiString; var Major, Minor: Integer);
  1477. var
  1478. Separator: Integer;
  1479. begin
  1480. Minor := 0;
  1481. Major := 0;
  1482. Separator := Pos(AnsiString('.'), Buffer);
  1483. if (Separator > 1) and (Separator < Length(Buffer)) and
  1484. (Buffer[Separator - 1] in ['0'..'9']) and
  1485. (Buffer[Separator + 1] in ['0'..'9']) then begin
  1486. Dec(Separator);
  1487. while (Separator > 0) and (Buffer[Separator] in ['0'..'9']) do
  1488. Dec(Separator);
  1489. Delete(Buffer, 1, Separator);
  1490. Separator := Pos(AnsiString('.'), Buffer) + 1;
  1491. while (Separator <= Length(Buffer)) and (AnsiChar(Buffer[Separator]) in ['0'..'9']) do
  1492. Inc(Separator);
  1493. Delete(Buffer, Separator, 255);
  1494. Separator := Pos(AnsiString('.'), Buffer);
  1495. Major := StrToInt(Copy(String(Buffer), 1, Separator - 1));
  1496. Minor := StrToInt(Copy(String(Buffer), Separator + 1, 1));
  1497. end;
  1498. end;
  1499. function CheckExtension(const Extension: AnsiString): Boolean;
  1500. var
  1501. ExtPos: Integer;
  1502. begin
  1503. ExtPos := Pos(Extension, Buffer);
  1504. result := ExtPos > 0;
  1505. if result then
  1506. result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
  1507. end;
  1508. function glLoad (aFunc: pAnsiChar): pointer;
  1509. begin
  1510. {$IFDEF LINUX}
  1511. result := glXGetProcAddress(aFunc);
  1512. {$else}
  1513. result := wglGetProcAddress(aFunc);
  1514. {$ENDIF}
  1515. end;
  1516. begin
  1517. {$IFDEF GLB_DELPHI}
  1518. Context := wglGetCurrentContext;
  1519. if Context <> gLastContext then begin
  1520. gLastContext := Context;
  1521. {$ENDIF}
  1522. // Version
  1523. Buffer := glGetString(GL_VERSION);
  1524. TrimVersionString(Buffer, MajorVersion, MinorVersion);
  1525. GL_VERSION_1_2 := false;
  1526. GL_VERSION_1_3 := false;
  1527. GL_VERSION_1_4 := false;
  1528. GL_VERSION_2_0 := false;
  1529. if MajorVersion = 1 then begin
  1530. if MinorVersion >= 1 then begin
  1531. if MinorVersion >= 2 then
  1532. GL_VERSION_1_2 := true;
  1533. if MinorVersion >= 3 then
  1534. GL_VERSION_1_3 := true;
  1535. if MinorVersion >= 4 then
  1536. GL_VERSION_1_4 := true;
  1537. end;
  1538. end;
  1539. if MajorVersion >= 2 then begin
  1540. GL_VERSION_1_2 := true;
  1541. GL_VERSION_1_3 := true;
  1542. GL_VERSION_1_4 := true;
  1543. GL_VERSION_2_0 := true;
  1544. end;
  1545. // Extensions
  1546. Buffer := glGetString(GL_EXTENSIONS);
  1547. GL_ARB_texture_border_clamp := CheckExtension('GL_ARB_texture_border_clamp');
  1548. GL_ARB_texture_cube_map := CheckExtension('GL_ARB_texture_cube_map');
  1549. GL_ARB_texture_compression := CheckExtension('GL_ARB_texture_compression');
  1550. GL_ARB_texture_non_power_of_two := CheckExtension('GL_ARB_texture_non_power_of_two');
  1551. GL_ARB_texture_rectangle := CheckExtension('GL_ARB_texture_rectangle');
  1552. GL_ARB_texture_mirrored_repeat := CheckExtension('GL_ARB_texture_mirrored_repeat');
  1553. GL_EXT_bgra := CheckExtension('GL_EXT_bgra');
  1554. GL_EXT_texture_edge_clamp := CheckExtension('GL_EXT_texture_edge_clamp');
  1555. GL_EXT_texture_cube_map := CheckExtension('GL_EXT_texture_cube_map');
  1556. GL_EXT_texture_compression_s3tc := CheckExtension('GL_EXT_texture_compression_s3tc');
  1557. GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
  1558. GL_EXT_texture_rectangle := CheckExtension('GL_EXT_texture_rectangle');
  1559. GL_NV_texture_rectangle := CheckExtension('GL_NV_texture_rectangle');
  1560. GL_IBM_texture_mirrored_repeat := CheckExtension('GL_IBM_texture_mirrored_repeat');
  1561. GL_SGIS_generate_mipmap := CheckExtension('GL_SGIS_generate_mipmap');
  1562. // Funtions
  1563. if GL_VERSION_1_3 then begin
  1564. // Loading Core
  1565. glCompressedTexImage1D := glLoad('glCompressedTexImage1D');
  1566. glCompressedTexImage2D := glLoad('glCompressedTexImage2D');
  1567. glGetCompressedTexImage := glLoad('glGetCompressedTexImage');
  1568. end else
  1569. begin
  1570. // Try loading Extension
  1571. glCompressedTexImage1D := glLoad('glCompressedTexImage1DARB');
  1572. glCompressedTexImage2D := glLoad('glCompressedTexImage2DARB');
  1573. glGetCompressedTexImage := glLoad('glGetCompressedTexImageARB');
  1574. end;
  1575. {$IFDEF GLB_DELPHI}
  1576. end;
  1577. {$ENDIF}
  1578. end;
  1579. {$ENDIF}
  1580. *)
  1581. (* TODO GLB_DELPHI
  1582. {$IFDEF GLB_DELPHI}
  1583. function CreateGrayPalette: HPALETTE;
  1584. var
  1585. Idx: Integer;
  1586. Pal: PLogPalette;
  1587. begin
  1588. GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
  1589. Pal.palVersion := $300;
  1590. Pal.palNumEntries := 256;
  1591. {$IFOPT R+}
  1592. {$DEFINE GLB_TEMPRANGECHECK}
  1593. {$R-}
  1594. {$ENDIF}
  1595. for Idx := 0 to 256 - 1 do begin
  1596. Pal.palPalEntry[Idx].peRed := Idx;
  1597. Pal.palPalEntry[Idx].peGreen := Idx;
  1598. Pal.palPalEntry[Idx].peBlue := Idx;
  1599. Pal.palPalEntry[Idx].peFlags := 0;
  1600. end;
  1601. {$IFDEF GLB_TEMPRANGECHECK}
  1602. {$UNDEF GLB_TEMPRANGECHECK}
  1603. {$R+}
  1604. {$ENDIF}
  1605. result := CreatePalette(Pal^);
  1606. FreeMem(Pal);
  1607. end;
  1608. {$ENDIF}
  1609. *)
  1610. (* TODO GLB_SDL_IMAGE
  1611. {$IFDEF GLB_SDL_IMAGE}
  1612. function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
  1613. begin
  1614. result := TStream(context^.unknown.data1).Seek(offset, whence);
  1615. end;
  1616. function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
  1617. begin
  1618. result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
  1619. end;
  1620. function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
  1621. begin
  1622. result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
  1623. end;
  1624. function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
  1625. begin
  1626. result := 0;
  1627. end;
  1628. function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
  1629. begin
  1630. result := SDL_AllocRW;
  1631. if result = nil then
  1632. raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
  1633. result^.seek := glBitmapRWseek;
  1634. result^.read := glBitmapRWread;
  1635. result^.write := glBitmapRWwrite;
  1636. result^.close := glBitmapRWclose;
  1637. result^.unknown.data1 := Stream;
  1638. end;
  1639. {$ENDIF}
  1640. *)
  1641. (* TODO LoadFuncs
  1642. function LoadTexture(Filename: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal{$ENDIF}): Boolean;
  1643. var
  1644. glBitmap: TglBitmap2D;
  1645. begin
  1646. result := false;
  1647. Texture := 0;
  1648. {$IFDEF GLB_DELPHI}
  1649. if Instance = 0 then
  1650. Instance := HInstance;
  1651. if (LoadFromRes) then
  1652. glBitmap := TglBitmap2D.CreateFromResourceName(Instance, FileName)
  1653. else
  1654. {$ENDIF}
  1655. glBitmap := TglBitmap2D.Create(FileName);
  1656. try
  1657. glBitmap.DeleteTextureOnFree := false;
  1658. glBitmap.FreeDataAfterGenTexture := false;
  1659. glBitmap.GenTexture(true);
  1660. if (glBitmap.ID > 0) then begin
  1661. Texture := glBitmap.ID;
  1662. result := true;
  1663. end;
  1664. finally
  1665. glBitmap.Free;
  1666. end;
  1667. end;
  1668. function LoadCubeMap(PositiveX, NegativeX, PositiveY, NegativeY, PositiveZ, NegativeZ: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal{$ENDIF}): Boolean;
  1669. var
  1670. CM: TglBitmapCubeMap;
  1671. begin
  1672. Texture := 0;
  1673. {$IFDEF GLB_DELPHI}
  1674. if Instance = 0 then
  1675. Instance := HInstance;
  1676. {$ENDIF}
  1677. CM := TglBitmapCubeMap.Create;
  1678. try
  1679. CM.DeleteTextureOnFree := false;
  1680. // Maps
  1681. {$IFDEF GLB_DELPHI}
  1682. if (LoadFromRes) then
  1683. CM.LoadFromResource(Instance, PositiveX)
  1684. else
  1685. {$ENDIF}
  1686. CM.LoadFromFile(PositiveX);
  1687. CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X);
  1688. {$IFDEF GLB_DELPHI}
  1689. if (LoadFromRes) then
  1690. CM.LoadFromResource(Instance, NegativeX)
  1691. else
  1692. {$ENDIF}
  1693. CM.LoadFromFile(NegativeX);
  1694. CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X);
  1695. {$IFDEF GLB_DELPHI}
  1696. if (LoadFromRes) then
  1697. CM.LoadFromResource(Instance, PositiveY)
  1698. else
  1699. {$ENDIF}
  1700. CM.LoadFromFile(PositiveY);
  1701. CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y);
  1702. {$IFDEF GLB_DELPHI}
  1703. if (LoadFromRes) then
  1704. CM.LoadFromResource(Instance, NegativeY)
  1705. else
  1706. {$ENDIF}
  1707. CM.LoadFromFile(NegativeY);
  1708. CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y);
  1709. {$IFDEF GLB_DELPHI}
  1710. if (LoadFromRes) then
  1711. CM.LoadFromResource(Instance, PositiveZ)
  1712. else
  1713. {$ENDIF}
  1714. CM.LoadFromFile(PositiveZ);
  1715. CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z);
  1716. {$IFDEF GLB_DELPHI}
  1717. if (LoadFromRes) then
  1718. CM.LoadFromResource(Instance, NegativeZ)
  1719. else
  1720. {$ENDIF}
  1721. CM.LoadFromFile(NegativeZ);
  1722. CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z);
  1723. Texture := CM.ID;
  1724. result := true;
  1725. finally
  1726. CM.Free;
  1727. end;
  1728. end;
  1729. function LoadNormalMap(Size: Integer; var Texture: Cardinal): Boolean;
  1730. var
  1731. NM: TglBitmapNormalMap;
  1732. begin
  1733. Texture := 0;
  1734. NM := TglBitmapNormalMap.Create;
  1735. try
  1736. NM.DeleteTextureOnFree := false;
  1737. NM.GenerateNormalMap(Size);
  1738. Texture := NM.ID;
  1739. result := true;
  1740. finally
  1741. NM.Free;
  1742. end;
  1743. end;
  1744. *)
  1745. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1746. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1747. begin
  1748. glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
  1749. end;
  1750. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1751. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1752. begin
  1753. glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
  1754. end;
  1755. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1756. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1757. begin
  1758. glBitmapDefaultMipmap := aValue;
  1759. end;
  1760. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1761. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1762. begin
  1763. glBitmapDefaultFormat := aFormat;
  1764. end;
  1765. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1766. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1767. begin
  1768. glBitmapDefaultFilterMin := aMin;
  1769. glBitmapDefaultFilterMag := aMag;
  1770. end;
  1771. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1772. procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
  1773. begin
  1774. glBitmapDefaultWrapS := S;
  1775. glBitmapDefaultWrapT := T;
  1776. glBitmapDefaultWrapR := R;
  1777. end;
  1778. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1779. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1780. begin
  1781. result := glBitmapDefaultDeleteTextureOnFree;
  1782. end;
  1783. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1784. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1785. begin
  1786. result := glBitmapDefaultFreeDataAfterGenTextures;
  1787. end;
  1788. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1789. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1790. begin
  1791. result := glBitmapDefaultMipmap;
  1792. end;
  1793. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1794. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1795. begin
  1796. result := glBitmapDefaultFormat;
  1797. end;
  1798. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1799. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  1800. begin
  1801. aMin := glBitmapDefaultFilterMin;
  1802. aMag := glBitmapDefaultFilterMag;
  1803. end;
  1804. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1805. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  1806. begin
  1807. S := glBitmapDefaultWrapS;
  1808. T := glBitmapDefaultWrapT;
  1809. R := glBitmapDefaultWrapR;
  1810. end;
  1811. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1812. //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1813. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1814. function TFormatDescriptor.GetRedMask: UInt64;
  1815. begin
  1816. result := fRange.r shl fShift.r;
  1817. end;
  1818. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1819. function TFormatDescriptor.GetGreenMask: UInt64;
  1820. begin
  1821. result := fRange.g shl fShift.g;
  1822. end;
  1823. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1824. function TFormatDescriptor.GetBlueMask: UInt64;
  1825. begin
  1826. result := fRange.b shl fShift.b;
  1827. end;
  1828. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1829. function TFormatDescriptor.GetAlphaMask: UInt64;
  1830. begin
  1831. result := fRange.a shl fShift.a;
  1832. end;
  1833. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1834. function TFormatDescriptor.GetComponents: Integer;
  1835. var
  1836. i: Integer;
  1837. begin
  1838. result := 0;
  1839. for i := 0 to 3 do
  1840. if (fRange.arr[i] > 0) then
  1841. inc(result);
  1842. end;
  1843. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1844. function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
  1845. var
  1846. w, h: Integer;
  1847. begin
  1848. if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
  1849. w := Max(1, aSize.X);
  1850. h := Max(1, aSize.Y);
  1851. result := GetSize(w, h);
  1852. end else
  1853. result := 0;
  1854. end;
  1855. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1856. function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
  1857. begin
  1858. result := 0;
  1859. if (aWidth <= 0) or (aHeight <= 0) then
  1860. exit;
  1861. result := Ceil(aWidth * aHeight * fPixelSize);
  1862. end;
  1863. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1864. function TFormatDescriptor.CreateMappingData: Pointer;
  1865. begin
  1866. result := nil;
  1867. end;
  1868. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1869. procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
  1870. begin
  1871. //DUMMY
  1872. end;
  1873. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1874. function TFormatDescriptor.IsEmpty: Boolean;
  1875. begin
  1876. result := (fFormat = tfEmpty);
  1877. end;
  1878. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1879. function TFormatDescriptor.HasAlpha: Boolean;
  1880. begin
  1881. result := (fRange.a > 0);
  1882. end;
  1883. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1884. function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: UInt64): Boolean;
  1885. begin
  1886. result := false;
  1887. if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
  1888. raise EglBitmapException.Create('FormatCheckFormat - All Masks are 0');
  1889. if (aRedMask <> RedMask) then
  1890. exit;
  1891. if (aGreenMask <> GreenMask) then
  1892. exit;
  1893. if (aBlueMask <> BlueMask) then
  1894. exit;
  1895. if (aAlphaMask <> AlphaMask) then
  1896. exit;
  1897. result := true;
  1898. end;
  1899. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1900. procedure TFormatDescriptor.PreparePixel(var aPixel: TglBitmapPixelData);
  1901. begin
  1902. FillChar(aPixel, SizeOf(aPixel), 0);
  1903. aPixel.Data := fRange;
  1904. aPixel.Range := fRange;
  1905. aPixel.Format := fFormat;
  1906. end;
  1907. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1908. constructor TFormatDescriptor.Create;
  1909. begin
  1910. inherited Create;
  1911. fFormat := tfEmpty;
  1912. fWithAlpha := tfEmpty;
  1913. fWithoutAlpha := tfEmpty;
  1914. fRGBInverted := tfEmpty;
  1915. fUncompressed := tfEmpty;
  1916. fPixelSize := 0.0;
  1917. fIsCompressed := false;
  1918. fglFormat := 0;
  1919. fglInternalFormat := 0;
  1920. fglDataFormat := 0;
  1921. FillChar(fRange, 0, SizeOf(fRange));
  1922. FillChar(fShift, 0, SizeOf(fShift));
  1923. end;
  1924. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1925. //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1926. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1927. procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1928. begin
  1929. aData^ := aPixel.Data.a;
  1930. inc(aData);
  1931. end;
  1932. procedure TfdAlpha_UB1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1933. begin
  1934. aPixel.Data.r := 0;
  1935. aPixel.Data.g := 0;
  1936. aPixel.Data.b := 0;
  1937. aPixel.Data.a := aData^;
  1938. inc(aData^);
  1939. end;
  1940. constructor TfdAlpha_UB1.Create;
  1941. begin
  1942. inherited Create;
  1943. fPixelSize := 1.0;
  1944. fRange.a := $FF;
  1945. fglFormat := GL_ALPHA;
  1946. fglDataFormat := GL_UNSIGNED_BYTE;
  1947. end;
  1948. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1949. //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1950. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1951. procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1952. begin
  1953. aData^ := LuminanceWeight(aPixel);
  1954. inc(aData);
  1955. end;
  1956. procedure TfdLuminance_UB1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1957. begin
  1958. aPixel.Data.r := aData^;
  1959. aPixel.Data.g := aData^;
  1960. aPixel.Data.b := aData^;
  1961. aPixel.Data.a := 0;
  1962. inc(aData);
  1963. end;
  1964. constructor TfdLuminance_UB1.Create;
  1965. begin
  1966. inherited Create;
  1967. fPixelSize := 1.0;
  1968. fRange.r := $FF;
  1969. fRange.g := $FF;
  1970. fRange.b := $FF;
  1971. fglFormat := GL_LUMINANCE;
  1972. fglDataFormat := GL_UNSIGNED_BYTE;
  1973. end;
  1974. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1975. //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1976. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1977. procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1978. var
  1979. i: Integer;
  1980. begin
  1981. aData^ := 0;
  1982. for i := 0 to 3 do
  1983. if (fRange.arr[i] > 0) then
  1984. aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  1985. inc(aData);
  1986. end;
  1987. procedure TfdUniversal_UB1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1988. var
  1989. i: Integer;
  1990. begin
  1991. for i := 0 to 3 do
  1992. aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
  1993. inc(aData);
  1994. end;
  1995. constructor TfdUniversal_UB1.Create;
  1996. begin
  1997. inherited Create;
  1998. fPixelSize := 1.0;
  1999. end;
  2000. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2001. //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2002. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2003. procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2004. begin
  2005. inherited Map(aPixel, aData, aMapData);
  2006. aData^ := aPixel.Data.a;
  2007. inc(aData);
  2008. end;
  2009. procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2010. begin
  2011. inherited Unmap(aData, aPixel, aMapData);
  2012. aPixel.Data.a := aData^;
  2013. inc(aData);
  2014. end;
  2015. constructor TfdLuminanceAlpha_UB2.Create;
  2016. begin
  2017. inherited Create;
  2018. fPixelSize := 2.0;
  2019. fRange.a := $FF;
  2020. fShift.a := 8;
  2021. fglFormat := GL_LUMINANCE_ALPHA;
  2022. fglDataFormat := GL_UNSIGNED_BYTE;
  2023. end;
  2024. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2025. //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2026. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2027. procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2028. begin
  2029. aData^ := aPixel.Data.r;
  2030. inc(aData);
  2031. aData^ := aPixel.Data.g;
  2032. inc(aData);
  2033. aData^ := aPixel.Data.b;
  2034. inc(aData);
  2035. end;
  2036. procedure TfdRGB_UB3.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2037. begin
  2038. aPixel.Data.r := aData^;
  2039. inc(aData);
  2040. aPixel.Data.g := aData^;
  2041. inc(aData);
  2042. aPixel.Data.b := aData^;
  2043. inc(aData);
  2044. aPixel.Data.a := 0;
  2045. end;
  2046. constructor TfdRGB_UB3.Create;
  2047. begin
  2048. inherited Create;
  2049. fPixelSize := 3.0;
  2050. fRange.r := $FF;
  2051. fRange.g := $FF;
  2052. fRange.b := $FF;
  2053. fShift.r := 0;
  2054. fShift.g := 8;
  2055. fShift.b := 16;
  2056. fglFormat := GL_RGB;
  2057. fglDataFormat := GL_UNSIGNED_BYTE;
  2058. end;
  2059. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2060. //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2061. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2062. procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2063. begin
  2064. aData^ := aPixel.Data.b;
  2065. inc(aData);
  2066. aData^ := aPixel.Data.g;
  2067. inc(aData);
  2068. aData^ := aPixel.Data.r;
  2069. inc(aData);
  2070. end;
  2071. procedure TfdBGR_UB3.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2072. begin
  2073. aPixel.Data.b := aData^;
  2074. inc(aData);
  2075. aPixel.Data.g := aData^;
  2076. inc(aData);
  2077. aPixel.Data.r := aData^;
  2078. inc(aData);
  2079. aPixel.Data.a := 0;
  2080. end;
  2081. constructor TfdBGR_UB3.Create;
  2082. begin
  2083. fPixelSize := 3.0;
  2084. fRange.r := $FF;
  2085. fRange.g := $FF;
  2086. fRange.b := $FF;
  2087. fShift.r := 16;
  2088. fShift.g := 8;
  2089. fShift.b := 0;
  2090. fglFormat := GL_BGR;
  2091. fglDataFormat := GL_UNSIGNED_BYTE;
  2092. end;
  2093. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2094. //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2095. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2096. procedure TfdRGBA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2097. begin
  2098. inherited Map(aPixel, aData, aMapData);
  2099. aData^ := aPixel.Data.a;
  2100. inc(aData);
  2101. end;
  2102. procedure TfdRGBA_UB4.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2103. begin
  2104. inherited Unmap(aData, aPixel, aMapData);
  2105. aPixel.Data.a := aData^;
  2106. inc(aData);
  2107. end;
  2108. constructor TfdRGBA_UB4.Create;
  2109. begin
  2110. inherited Create;
  2111. fPixelSize := 4.0;
  2112. fRange.a := $FF;
  2113. fShift.a := 24;
  2114. fglFormat := GL_RGBA;
  2115. fglDataFormat := GL_UNSIGNED_BYTE;
  2116. end;
  2117. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2118. //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2119. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2120. procedure TfdBGRA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2121. begin
  2122. inherited Map(aPixel, aData, aMapData);
  2123. aData^ := aPixel.Data.a;
  2124. inc(aData);
  2125. end;
  2126. procedure TfdBGRA_UB4.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2127. begin
  2128. inherited Unmap(aData, aPixel, aMapData);
  2129. aPixel.Data.a := aData^;
  2130. inc(aData);
  2131. end;
  2132. constructor TfdBGRA_UB4.Create;
  2133. begin
  2134. inherited Create;
  2135. fPixelSize := 4.0;
  2136. fRange.a := $FF;
  2137. fShift.a := 24;
  2138. fglFormat := GL_BGRA;
  2139. fglDataFormat := GL_UNSIGNED_BYTE;
  2140. end;
  2141. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2142. //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2143. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2144. procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2145. begin
  2146. PWord(aData)^ := aPixel.Data.a;
  2147. inc(aData, 2);
  2148. end;
  2149. procedure TfdAlpha_US1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2150. begin
  2151. aPixel.Data.r := 0;
  2152. aPixel.Data.g := 0;
  2153. aPixel.Data.b := 0;
  2154. aPixel.Data.a := PWord(aData)^;
  2155. inc(aData, 2);
  2156. end;
  2157. constructor TfdAlpha_US1.Create;
  2158. begin
  2159. inherited Create;
  2160. fPixelSize := 2.0;
  2161. fRange.a := $FFFF;
  2162. fglFormat := GL_ALPHA;
  2163. fglDataFormat := GL_UNSIGNED_SHORT;
  2164. end;
  2165. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2166. //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2167. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2168. procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2169. begin
  2170. PWord(aData)^ := LuminanceWeight(aPixel);
  2171. inc(aData, 2);
  2172. end;
  2173. procedure TfdLuminance_US1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2174. begin
  2175. aPixel.Data.r := PWord(aData)^;
  2176. aPixel.Data.g := PWord(aData)^;
  2177. aPixel.Data.b := PWord(aData)^;
  2178. aPixel.Data.a := 0;
  2179. inc(aData, 2);
  2180. end;
  2181. constructor TfdLuminance_US1.Create;
  2182. begin
  2183. inherited Create;
  2184. fPixelSize := 2.0;
  2185. fRange.r := $FFFF;
  2186. fRange.g := $FFFF;
  2187. fRange.b := $FFFF;
  2188. fglFormat := GL_LUMINANCE;
  2189. fglDataFormat := GL_UNSIGNED_SHORT;
  2190. end;
  2191. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2192. //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2193. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2194. procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2195. var
  2196. i: Integer;
  2197. begin
  2198. PWord(aData)^ := 0;
  2199. for i := 0 to 3 do
  2200. if (fRange.arr[i] > 0) then
  2201. PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2202. inc(aData, 2);
  2203. end;
  2204. procedure TfdUniversal_US1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2205. var
  2206. i: Integer;
  2207. begin
  2208. for i := 0 to 3 do
  2209. aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
  2210. inc(aData, 2);
  2211. end;
  2212. constructor TfdUniversal_US1.Create;
  2213. begin
  2214. inherited Create;
  2215. fPixelSize := 2.0;
  2216. end;
  2217. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2218. //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2219. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2220. procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2221. begin
  2222. PWord(aData)^ := DepthWeight(aPixel);
  2223. inc(aData, 2);
  2224. end;
  2225. procedure TfdDepth_US1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2226. begin
  2227. aPixel.Data.r := PWord(aData)^;
  2228. aPixel.Data.g := PWord(aData)^;
  2229. aPixel.Data.b := PWord(aData)^;
  2230. aPixel.Data.a := 0;
  2231. inc(aData, 2);
  2232. end;
  2233. constructor TfdDepth_US1.Create;
  2234. begin
  2235. inherited Create;
  2236. fPixelSize := 2.0;
  2237. fRange.r := $FFFF;
  2238. fRange.g := $FFFF;
  2239. fRange.b := $FFFF;
  2240. fglFormat := GL_DEPTH_COMPONENT;
  2241. fglDataFormat := GL_UNSIGNED_SHORT;
  2242. end;
  2243. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2244. //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2245. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2246. procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2247. begin
  2248. inherited Map(aPixel, aData, aMapData);
  2249. PWord(aData)^ := aPixel.Data.a;
  2250. inc(aData, 2);
  2251. end;
  2252. procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2253. begin
  2254. inherited Unmap(aData, aPixel, aMapData);
  2255. aPixel.Data.a := PWord(aData)^;
  2256. inc(aData, 2);
  2257. end;
  2258. constructor TfdLuminanceAlpha_US2.Create;
  2259. begin
  2260. inherited Create;
  2261. fPixelSize := 4.0;
  2262. fRange.a := $FFFF;
  2263. fShift.a := 16;
  2264. fglFormat := GL_LUMINANCE_ALPHA;
  2265. fglDataFormat := GL_UNSIGNED_SHORT;
  2266. end;
  2267. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2268. //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2269. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2270. procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2271. begin
  2272. PWord(aData)^ := aPixel.Data.r;
  2273. inc(aData, 2);
  2274. PWord(aData)^ := aPixel.Data.g;
  2275. inc(aData, 2);
  2276. PWord(aData)^ := aPixel.Data.b;
  2277. inc(aData, 2);
  2278. end;
  2279. procedure TfdRGB_US3.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2280. begin
  2281. aPixel.Data.r := PWord(aData)^;
  2282. inc(aData, 2);
  2283. aPixel.Data.g := PWord(aData)^;
  2284. inc(aData, 2);
  2285. aPixel.Data.b := PWord(aData)^;
  2286. inc(aData, 2);
  2287. aPixel.Data.a := 0;
  2288. end;
  2289. constructor TfdRGB_US3.Create;
  2290. begin
  2291. inherited Create;
  2292. fPixelSize := 6.0;
  2293. fRange.r := $FFFF;
  2294. fRange.g := $FFFF;
  2295. fRange.b := $FFFF;
  2296. fShift.r := 0;
  2297. fShift.g := 16;
  2298. fShift.b := 32;
  2299. fglFormat := GL_RGB;
  2300. fglDataFormat := GL_UNSIGNED_SHORT;
  2301. end;
  2302. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2303. //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2304. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2305. procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2306. begin
  2307. PWord(aData)^ := aPixel.Data.b;
  2308. inc(aData, 2);
  2309. PWord(aData)^ := aPixel.Data.g;
  2310. inc(aData, 2);
  2311. PWord(aData)^ := aPixel.Data.r;
  2312. inc(aData, 2);
  2313. end;
  2314. procedure TfdBGR_US3.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2315. begin
  2316. aPixel.Data.b := PWord(aData)^;
  2317. inc(aData, 2);
  2318. aPixel.Data.g := PWord(aData)^;
  2319. inc(aData, 2);
  2320. aPixel.Data.r := PWord(aData)^;
  2321. inc(aData, 2);
  2322. aPixel.Data.a := 0;
  2323. end;
  2324. constructor TfdBGR_US3.Create;
  2325. begin
  2326. inherited Create;
  2327. fPixelSize := 6.0;
  2328. fRange.r := $FFFF;
  2329. fRange.g := $FFFF;
  2330. fRange.b := $FFFF;
  2331. fShift.r := 32;
  2332. fShift.g := 16;
  2333. fShift.b := 0;
  2334. fglFormat := GL_BGR;
  2335. fglDataFormat := GL_UNSIGNED_SHORT;
  2336. end;
  2337. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2338. //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2339. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2340. procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2341. begin
  2342. inherited Map(aPixel, aData, aMapData);
  2343. PWord(aData)^ := aPixel.Data.a;
  2344. inc(aData, 2);
  2345. end;
  2346. procedure TfdRGBA_US4.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2347. begin
  2348. inherited Unmap(aData, aPixel, aMapData);
  2349. aPixel.Data.a := PWord(aData)^;
  2350. inc(aData, 2);
  2351. end;
  2352. constructor TfdRGBA_US4.Create;
  2353. begin
  2354. inherited Create;
  2355. fPixelSize := 8.0;
  2356. fRange.a := $FFFF;
  2357. fShift.a := 48;
  2358. fglFormat := GL_RGBA;
  2359. fglDataFormat := GL_UNSIGNED_SHORT;
  2360. end;
  2361. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2362. //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2363. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2364. procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2365. begin
  2366. inherited Map(aPixel, aData, aMapData);
  2367. PWord(aData)^ := aPixel.Data.a;
  2368. inc(aData, 2);
  2369. end;
  2370. procedure TfdBGRA_US4.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2371. begin
  2372. inherited Unmap(aData, aPixel, aMapData);
  2373. aPixel.Data.a := PWord(aData)^;
  2374. inc(aData, 2);
  2375. end;
  2376. constructor TfdBGRA_US4.Create;
  2377. begin
  2378. inherited Create;
  2379. fPixelSize := 8.0;
  2380. fRange.a := $FFFF;
  2381. fShift.a := 48;
  2382. fglFormat := GL_BGRA;
  2383. fglDataFormat := GL_UNSIGNED_SHORT;
  2384. end;
  2385. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2386. //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2387. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2388. procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2389. var
  2390. i: Integer;
  2391. begin
  2392. PCardinal(aData)^ := 0;
  2393. for i := 0 to 3 do
  2394. if (fRange.arr[i] > 0) then
  2395. PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2396. inc(aData, 4);
  2397. end;
  2398. procedure TfdUniversal_UI1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2399. var
  2400. i: Integer;
  2401. begin
  2402. for i := 0 to 3 do
  2403. aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
  2404. inc(aData, 2);
  2405. end;
  2406. constructor TfdUniversal_UI1.Create;
  2407. begin
  2408. inherited Create;
  2409. fPixelSize := 4.0;
  2410. end;
  2411. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2412. //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2413. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2414. procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2415. begin
  2416. PCardinal(aData)^ := DepthWeight(aPixel);
  2417. inc(aData, 4);
  2418. end;
  2419. procedure TfdDepth_UI1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2420. begin
  2421. aPixel.Data.r := PCardinal(aData)^;
  2422. aPixel.Data.g := PCardinal(aData)^;
  2423. aPixel.Data.b := PCardinal(aData)^;
  2424. aPixel.Data.a := 0;
  2425. inc(aData, 4);
  2426. end;
  2427. constructor TfdDepth_UI1.Create;
  2428. begin
  2429. inherited Create;
  2430. fPixelSize := 4.0;
  2431. fRange.r := $FFFFFFFF;
  2432. fRange.g := $FFFFFFFF;
  2433. fRange.b := $FFFFFFFF;
  2434. fglFormat := GL_DEPTH_COMPONENT;
  2435. fglDataFormat := GL_UNSIGNED_INT;
  2436. end;
  2437. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2438. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2439. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2440. constructor TfdAlpha4.Create;
  2441. begin
  2442. inherited Create;
  2443. fFormat := tfAlpha4;
  2444. fWithAlpha := tfAlpha4;
  2445. fglInternalFormat := GL_ALPHA4;
  2446. end;
  2447. constructor TfdAlpha8.Create;
  2448. begin
  2449. inherited Create;
  2450. fFormat := tfAlpha8;
  2451. fWithAlpha := tfAlpha8;
  2452. fglInternalFormat := GL_ALPHA8;
  2453. end;
  2454. constructor TfdAlpha12.Create;
  2455. begin
  2456. inherited Create;
  2457. fFormat := tfAlpha12;
  2458. fWithAlpha := tfAlpha12;
  2459. fglInternalFormat := GL_ALPHA12;
  2460. end;
  2461. constructor TfdAlpha16.Create;
  2462. begin
  2463. inherited Create;
  2464. fFormat := tfAlpha16;
  2465. fWithAlpha := tfAlpha16;
  2466. fglInternalFormat := GL_ALPHA16;
  2467. end;
  2468. constructor TfdLuminance4.Create;
  2469. begin
  2470. inherited Create;
  2471. fFormat := tfLuminance4;
  2472. fWithAlpha := tfLuminance4Alpha4;
  2473. fWithoutAlpha := tfLuminance4;
  2474. fglInternalFormat := GL_LUMINANCE4;
  2475. end;
  2476. constructor TfdLuminance8.Create;
  2477. begin
  2478. inherited Create;
  2479. fFormat := tfLuminance8;
  2480. fWithAlpha := tfLuminance8Alpha8;
  2481. fWithoutAlpha := tfLuminance8;
  2482. fglInternalFormat := GL_LUMINANCE8;
  2483. end;
  2484. constructor TfdLuminance12.Create;
  2485. begin
  2486. inherited Create;
  2487. fFormat := tfLuminance12;
  2488. fWithAlpha := tfLuminance12Alpha12;
  2489. fWithoutAlpha := tfLuminance12;
  2490. fglInternalFormat := GL_LUMINANCE12;
  2491. end;
  2492. constructor TfdLuminance16.Create;
  2493. begin
  2494. inherited Create;
  2495. fFormat := tfLuminance16;
  2496. fWithAlpha := tfLuminance16Alpha16;
  2497. fWithoutAlpha := tfLuminance16;
  2498. fglInternalFormat := GL_LUMINANCE16;
  2499. end;
  2500. constructor TfdLuminance4Alpha4.Create;
  2501. begin
  2502. inherited Create;
  2503. fFormat := tfLuminance4Alpha4;
  2504. fWithAlpha := tfLuminance4Alpha4;
  2505. fWithoutAlpha := tfLuminance4;
  2506. fglInternalFormat := GL_LUMINANCE4_ALPHA4;
  2507. end;
  2508. constructor TfdLuminance6Alpha2.Create;
  2509. begin
  2510. inherited Create;
  2511. fFormat := tfLuminance6Alpha2;
  2512. fWithAlpha := tfLuminance6Alpha2;
  2513. fWithoutAlpha := tfLuminance8;
  2514. fglInternalFormat := GL_LUMINANCE6_ALPHA2;
  2515. end;
  2516. constructor TfdLuminance8Alpha8.Create;
  2517. begin
  2518. inherited Create;
  2519. fFormat := tfLuminance8Alpha8;
  2520. fWithAlpha := tfLuminance8Alpha8;
  2521. fWithoutAlpha := tfLuminance8;
  2522. fglInternalFormat := GL_LUMINANCE8_ALPHA8;
  2523. end;
  2524. constructor TfdLuminance12Alpha4.Create;
  2525. begin
  2526. inherited Create;
  2527. fFormat := tfLuminance12Alpha4;
  2528. fWithAlpha := tfLuminance12Alpha4;
  2529. fWithoutAlpha := tfLuminance12;
  2530. fglInternalFormat := GL_LUMINANCE12_ALPHA4;
  2531. end;
  2532. constructor TfdLuminance12Alpha12.Create;
  2533. begin
  2534. inherited Create;
  2535. fFormat := tfLuminance12Alpha12;
  2536. fWithAlpha := tfLuminance12Alpha12;
  2537. fWithoutAlpha := tfLuminance12;
  2538. fglInternalFormat := GL_LUMINANCE12_ALPHA12;
  2539. end;
  2540. constructor TfdLuminance16Alpha16.Create;
  2541. begin
  2542. inherited Create;
  2543. fFormat := tfLuminance16Alpha16;
  2544. fWithAlpha := tfLuminance16Alpha16;
  2545. fWithoutAlpha := tfLuminance16;
  2546. fglInternalFormat := GL_LUMINANCE16_ALPHA16;
  2547. end;
  2548. constructor TfdR3G3B2.Create;
  2549. begin
  2550. inherited Create;
  2551. fFormat := tfR3G3B2;
  2552. fWithAlpha := tfRGBA2;
  2553. fWithoutAlpha := tfR3G3B2;
  2554. fRange.r := $7;
  2555. fRange.g := $7;
  2556. fRange.b := $3;
  2557. fShift.r := 0;
  2558. fShift.g := 3;
  2559. fShift.b := 6;
  2560. fglFormat := GL_RGB;
  2561. fglInternalFormat := GL_R3_G3_B2;
  2562. fglDataFormat := GL_UNSIGNED_BYTE_2_3_3_REV;
  2563. end;
  2564. constructor TfdRGB4.Create;
  2565. begin
  2566. inherited Create;
  2567. fFormat := tfRGB4;
  2568. fWithAlpha := tfRGBA4;
  2569. fWithoutAlpha := tfRGB4;
  2570. fRGBInverted := tfBGR4;
  2571. fRange.r := $F;
  2572. fRange.g := $F;
  2573. fRange.b := $F;
  2574. fShift.r := 0;
  2575. fShift.g := 4;
  2576. fShift.b := 8;
  2577. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2578. fglInternalFormat := GL_RGB4;
  2579. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2580. end;
  2581. constructor TfdR5G6B5.Create;
  2582. begin
  2583. inherited Create;
  2584. fFormat := tfR5G6B5;
  2585. fWithAlpha := tfRGBA4;
  2586. fWithoutAlpha := tfR5G6B5;
  2587. fRGBInverted := tfB5G6R5;
  2588. fRange.r := $1F;
  2589. fRange.g := $3F;
  2590. fRange.b := $1F;
  2591. fShift.r := 0;
  2592. fShift.g := 5;
  2593. fShift.b := 11;
  2594. fglFormat := GL_RGB;
  2595. fglInternalFormat := GL_RGB565;
  2596. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5_REV;
  2597. end;
  2598. constructor TfdRGB5.Create;
  2599. begin
  2600. inherited Create;
  2601. fFormat := tfRGB5;
  2602. fWithAlpha := tfRGB5A1;
  2603. fWithoutAlpha := tfRGB5;
  2604. fRGBInverted := tfBGR5;
  2605. fRange.r := $1F;
  2606. fRange.g := $1F;
  2607. fRange.b := $1F;
  2608. fShift.r := 0;
  2609. fShift.g := 5;
  2610. fShift.b := 10;
  2611. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2612. fglInternalFormat := GL_RGB5;
  2613. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2614. end;
  2615. constructor TfdRGB8.Create;
  2616. begin
  2617. inherited Create;
  2618. fFormat := tfRGB8;
  2619. fWithAlpha := tfRGBA8;
  2620. fWithoutAlpha := tfRGB8;
  2621. fRGBInverted := tfBGR8;
  2622. fglInternalFormat := GL_RGB8;
  2623. end;
  2624. constructor TfdRGB10.Create;
  2625. begin
  2626. inherited Create;
  2627. fFormat := tfRGB10;
  2628. fWithAlpha := tfRGB10A2;
  2629. fWithoutAlpha := tfRGB10;
  2630. fRGBInverted := tfBGR10;
  2631. fRange.r := $3FF;
  2632. fRange.g := $3FF;
  2633. fRange.b := $3FF;
  2634. fShift.r := 0;
  2635. fShift.g := 10;
  2636. fShift.b := 20;
  2637. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2638. fglInternalFormat := GL_RGB10;
  2639. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2640. end;
  2641. constructor TfdRGB12.Create;
  2642. begin
  2643. inherited Create;
  2644. fFormat := tfRGB12;
  2645. fWithAlpha := tfRGBA12;
  2646. fWithoutAlpha := tfRGB12;
  2647. fRGBInverted := tfBGR12;
  2648. fglInternalFormat := GL_RGB12;
  2649. end;
  2650. constructor TfdRGB16.Create;
  2651. begin
  2652. inherited Create;
  2653. fFormat := tfRGB16;
  2654. fWithAlpha := tfRGBA16;
  2655. fWithoutAlpha := tfRGB16;
  2656. fRGBInverted := tfBGR16;
  2657. fglInternalFormat := GL_RGB16;
  2658. end;
  2659. constructor TfdRGBA2.Create;
  2660. begin
  2661. inherited Create;
  2662. fFormat := tfRGBA2;
  2663. fWithAlpha := tfRGBA2;
  2664. fWithoutAlpha := tfR3G3B2;
  2665. fRGBInverted := tfBGRA2;
  2666. fglInternalFormat := GL_RGBA2;
  2667. end;
  2668. constructor TfdRGBA4.Create;
  2669. begin
  2670. inherited Create;
  2671. fFormat := tfRGBA4;
  2672. fWithAlpha := tfRGBA4;
  2673. fWithoutAlpha := tfRGB4;
  2674. fRGBInverted := tfBGRA4;
  2675. fRange.r := $F;
  2676. fRange.g := $F;
  2677. fRange.b := $F;
  2678. fRange.a := $F;
  2679. fShift.r := 0;
  2680. fShift.g := 4;
  2681. fShift.b := 8;
  2682. fShift.a := 12;
  2683. fglFormat := GL_RGBA;
  2684. fglInternalFormat := GL_RGBA4;
  2685. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2686. end;
  2687. constructor TfdRGB5A1.Create;
  2688. begin
  2689. inherited Create;
  2690. fFormat := tfRGB5A1;
  2691. fWithAlpha := tfRGB5A1;
  2692. fWithoutAlpha := tfRGB5;
  2693. fRGBInverted := tfBGR5A1;
  2694. fRange.r := $1F;
  2695. fRange.g := $1F;
  2696. fRange.b := $1F;
  2697. fRange.a := $01;
  2698. fShift.r := 0;
  2699. fShift.g := 5;
  2700. fShift.b := 10;
  2701. fShift.a := 15;
  2702. fglFormat := GL_RGBA;
  2703. fglInternalFormat := GL_RGB5_A1;
  2704. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2705. end;
  2706. constructor TfdRGBA8.Create;
  2707. begin
  2708. inherited Create;
  2709. fFormat := tfRGBA8;
  2710. fWithAlpha := tfRGBA8;
  2711. fWithoutAlpha := tfRGB8;
  2712. fRGBInverted := tfBGRA8;
  2713. fglInternalFormat := GL_RGBA8;
  2714. end;
  2715. constructor TfdRGB10A2.Create;
  2716. begin
  2717. inherited Create;
  2718. fFormat := tfRGB10A2;
  2719. fWithAlpha := tfRGB10A2;
  2720. fWithoutAlpha := tfRGB10;
  2721. fRGBInverted := tfBGR10A2;
  2722. fRange.r := $3FF;
  2723. fRange.g := $3FF;
  2724. fRange.b := $3FF;
  2725. fRange.a := $003;
  2726. fShift.r := 0;
  2727. fShift.g := 10;
  2728. fShift.b := 20;
  2729. fShift.a := 30;
  2730. fglFormat := GL_RGBA;
  2731. fglInternalFormat := GL_RGB10_A2;
  2732. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2733. end;
  2734. constructor TfdRGBA12.Create;
  2735. begin
  2736. inherited Create;
  2737. fFormat := tfRGBA12;
  2738. fWithAlpha := tfRGBA12;
  2739. fWithoutAlpha := tfRGB12;
  2740. fRGBInverted := tfBGRA12;
  2741. fglInternalFormat := GL_RGBA12;
  2742. end;
  2743. constructor TfdRGBA16.Create;
  2744. begin
  2745. inherited Create;
  2746. fFormat := tfRGBA16;
  2747. fWithAlpha := tfRGBA16;
  2748. fWithoutAlpha := tfRGB16;
  2749. fRGBInverted := tfBGRA16;
  2750. fglInternalFormat := GL_RGBA16;
  2751. end;
  2752. constructor TfdBGR4.Create;
  2753. begin
  2754. inherited Create;
  2755. fPixelSize := 2.0;
  2756. fFormat := tfBGR4;
  2757. fWithAlpha := tfBGRA4;
  2758. fWithoutAlpha := tfBGR4;
  2759. fRGBInverted := tfRGB4;
  2760. fRange.r := $F;
  2761. fRange.g := $F;
  2762. fRange.b := $F;
  2763. fRange.a := $0;
  2764. fShift.r := 8;
  2765. fShift.g := 4;
  2766. fShift.b := 0;
  2767. fShift.a := 0;
  2768. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2769. fglInternalFormat := GL_RGB4;
  2770. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2771. end;
  2772. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2773. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2774. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2775. constructor TfdB5G6R5.Create;
  2776. begin
  2777. inherited Create;
  2778. fFormat := tfB5G6R5;
  2779. fWithAlpha := tfBGRA4;
  2780. fWithoutAlpha := tfB5G6R5;
  2781. fRGBInverted := tfR5G6B5;
  2782. fRange.r := $1F;
  2783. fRange.g := $3F;
  2784. fRange.b := $1F;
  2785. fShift.r := 11;
  2786. fShift.g := 5;
  2787. fShift.b := 0;
  2788. fglFormat := GL_RGB; //B5G6R5 is only possible as R5G6B5 -> use reverted dataformat
  2789. fglInternalFormat := GL_RGB8;
  2790. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5;
  2791. end;
  2792. constructor TfdBGR5.Create;
  2793. begin
  2794. inherited Create;
  2795. fPixelSize := 2.0;
  2796. fFormat := tfBGR5;
  2797. fWithAlpha := tfBGR5A1;
  2798. fWithoutAlpha := tfBGR5;
  2799. fRGBInverted := tfRGB5;
  2800. fRange.r := $1F;
  2801. fRange.g := $1F;
  2802. fRange.b := $1F;
  2803. fRange.a := $00;
  2804. fShift.r := 10;
  2805. fShift.g := 5;
  2806. fShift.b := 0;
  2807. fShift.a := 0;
  2808. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2809. fglInternalFormat := GL_RGB5;
  2810. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2811. end;
  2812. constructor TfdBGR8.Create;
  2813. begin
  2814. inherited Create;
  2815. fFormat := tfBGR8;
  2816. fWithAlpha := tfBGRA8;
  2817. fWithoutAlpha := tfBGR8;
  2818. fRGBInverted := tfRGB8;
  2819. fglInternalFormat := GL_RGB8;
  2820. end;
  2821. constructor TfdBGR10.Create;
  2822. begin
  2823. inherited Create;
  2824. fFormat := tfBGR10;
  2825. fWithAlpha := tfBGR10A2;
  2826. fWithoutAlpha := tfBGR10;
  2827. fRGBInverted := tfRGB10;
  2828. fRange.r := $3FF;
  2829. fRange.g := $3FF;
  2830. fRange.b := $3FF;
  2831. fRange.a := $000;
  2832. fShift.r := 20;
  2833. fShift.g := 10;
  2834. fShift.b := 0;
  2835. fShift.a := 0;
  2836. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2837. fglInternalFormat := GL_RGB10;
  2838. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2839. end;
  2840. constructor TfdBGR12.Create;
  2841. begin
  2842. inherited Create;
  2843. fFormat := tfBGR12;
  2844. fWithAlpha := tfBGRA12;
  2845. fWithoutAlpha := tfBGR12;
  2846. fRGBInverted := tfRGB12;
  2847. fglInternalFormat := GL_RGB12;
  2848. end;
  2849. constructor TfdBGR16.Create;
  2850. begin
  2851. inherited Create;
  2852. fFormat := tfBGR16;
  2853. fWithAlpha := tfBGRA16;
  2854. fWithoutAlpha := tfBGR16;
  2855. fRGBInverted := tfRGB16;
  2856. fglInternalFormat := GL_RGB16;
  2857. end;
  2858. constructor TfdBGRA2.Create;
  2859. begin
  2860. inherited Create;
  2861. fFormat := tfBGRA2;
  2862. fWithAlpha := tfBGRA4;
  2863. fWithoutAlpha := tfBGR4;
  2864. fRGBInverted := tfRGBA2;
  2865. fglInternalFormat := GL_RGBA2;
  2866. end;
  2867. constructor TfdBGRA4.Create;
  2868. begin
  2869. inherited Create;
  2870. fFormat := tfBGRA4;
  2871. fWithAlpha := tfBGRA4;
  2872. fWithoutAlpha := tfBGR4;
  2873. fRGBInverted := tfRGBA4;
  2874. fRange.r := $F;
  2875. fRange.g := $F;
  2876. fRange.b := $F;
  2877. fRange.a := $F;
  2878. fShift.r := 8;
  2879. fShift.g := 4;
  2880. fShift.b := 0;
  2881. fShift.a := 12;
  2882. fglFormat := GL_BGRA;
  2883. fglInternalFormat := GL_RGBA4;
  2884. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2885. end;
  2886. constructor TfdBGR5A1.Create;
  2887. begin
  2888. inherited Create;
  2889. fFormat := tfBGR5A1;
  2890. fWithAlpha := tfBGR5A1;
  2891. fWithoutAlpha := tfBGR5;
  2892. fRGBInverted := tfRGB5A1;
  2893. fRange.r := $1F;
  2894. fRange.g := $1F;
  2895. fRange.b := $1F;
  2896. fRange.a := $01;
  2897. fShift.r := 10;
  2898. fShift.g := 5;
  2899. fShift.b := 0;
  2900. fShift.a := 15;
  2901. fglFormat := GL_BGRA;
  2902. fglInternalFormat := GL_RGB5_A1;
  2903. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2904. end;
  2905. constructor TfdBGRA8.Create;
  2906. begin
  2907. inherited Create;
  2908. fFormat := tfBGRA8;
  2909. fWithAlpha := tfBGRA8;
  2910. fWithoutAlpha := tfBGR8;
  2911. fRGBInverted := tfRGBA8;
  2912. fglInternalFormat := GL_RGBA8;
  2913. end;
  2914. constructor TfdBGR10A2.Create;
  2915. begin
  2916. inherited Create;
  2917. fFormat := tfBGR10A2;
  2918. fWithAlpha := tfBGR10A2;
  2919. fWithoutAlpha := tfBGR10;
  2920. fRGBInverted := tfRGB10A2;
  2921. fRange.r := $3FF;
  2922. fRange.g := $3FF;
  2923. fRange.b := $3FF;
  2924. fRange.a := $003;
  2925. fShift.r := 20;
  2926. fShift.g := 10;
  2927. fShift.b := 0;
  2928. fShift.a := 30;
  2929. fglFormat := GL_BGRA;
  2930. fglInternalFormat := GL_RGB10_A2;
  2931. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2932. end;
  2933. constructor TfdBGRA12.Create;
  2934. begin
  2935. inherited Create;
  2936. fFormat := tfBGRA12;
  2937. fWithAlpha := tfBGRA12;
  2938. fWithoutAlpha := tfBGR12;
  2939. fRGBInverted := tfRGBA12;
  2940. fglInternalFormat := GL_RGBA12;
  2941. end;
  2942. constructor TfdBGRA16.Create;
  2943. begin
  2944. inherited Create;
  2945. fFormat := tfBGRA16;
  2946. fWithAlpha := tfBGRA16;
  2947. fWithoutAlpha := tfBGR16;
  2948. fRGBInverted := tfRGBA16;
  2949. fglInternalFormat := GL_RGBA16;
  2950. end;
  2951. constructor TfdDepth16.Create;
  2952. begin
  2953. inherited Create;
  2954. fFormat := tfDepth16;
  2955. fWithAlpha := tfEmpty;
  2956. fWithoutAlpha := tfDepth16;
  2957. fglInternalFormat := GL_DEPTH_COMPONENT16;
  2958. end;
  2959. constructor TfdDepth24.Create;
  2960. begin
  2961. inherited Create;
  2962. fFormat := tfDepth24;
  2963. fWithAlpha := tfEmpty;
  2964. fWithoutAlpha := tfDepth24;
  2965. fglInternalFormat := GL_DEPTH_COMPONENT24;
  2966. end;
  2967. constructor TfdDepth32.Create;
  2968. begin
  2969. inherited Create;
  2970. fFormat := tfDepth32;
  2971. fWithAlpha := tfEmpty;
  2972. fWithoutAlpha := tfDepth32;
  2973. fglInternalFormat := GL_DEPTH_COMPONENT32;
  2974. end;
  2975. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2976. //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2977. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2978. procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2979. begin
  2980. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  2981. end;
  2982. procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2983. begin
  2984. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  2985. end;
  2986. constructor TfdS3tcDtx1RGBA.Create;
  2987. begin
  2988. inherited Create;
  2989. fFormat := tfS3tcDtx1RGBA;
  2990. fWithAlpha := tfS3tcDtx1RGBA;
  2991. fUncompressed := tfRGB5A1;
  2992. fPixelSize := 0.5;
  2993. fIsCompressed := true;
  2994. fglFormat := GL_COMPRESSED_RGBA;
  2995. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
  2996. fglDataFormat := GL_UNSIGNED_BYTE;
  2997. end;
  2998. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2999. //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3000. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3001. procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3002. begin
  3003. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  3004. end;
  3005. procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3006. begin
  3007. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  3008. end;
  3009. constructor TfdS3tcDtx3RGBA.Create;
  3010. begin
  3011. inherited Create;
  3012. fFormat := tfS3tcDtx3RGBA;
  3013. fWithAlpha := tfS3tcDtx3RGBA;
  3014. fUncompressed := tfRGBA8;
  3015. fPixelSize := 1.0;
  3016. fIsCompressed := true;
  3017. fglFormat := GL_COMPRESSED_RGBA;
  3018. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
  3019. fglDataFormat := GL_UNSIGNED_BYTE;
  3020. end;
  3021. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3022. //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3023. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3024. procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3025. begin
  3026. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  3027. end;
  3028. procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3029. begin
  3030. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  3031. end;
  3032. constructor TfdS3tcDtx5RGBA.Create;
  3033. begin
  3034. inherited Create;
  3035. fFormat := tfS3tcDtx3RGBA;
  3036. fWithAlpha := tfS3tcDtx3RGBA;
  3037. fUncompressed := tfRGBA8;
  3038. fPixelSize := 1.0;
  3039. fIsCompressed := true;
  3040. fglFormat := GL_COMPRESSED_RGBA;
  3041. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
  3042. fglDataFormat := GL_UNSIGNED_BYTE;
  3043. end;
  3044. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3045. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3046. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3047. class procedure TFormatDescriptor.Init;
  3048. begin
  3049. if not Assigned(FormatDescriptorCS) then
  3050. FormatDescriptorCS := TCriticalSection.Create;
  3051. end;
  3052. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3053. class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3054. begin
  3055. FormatDescriptorCS.Enter;
  3056. try
  3057. result := FormatDescriptors[aFormat];
  3058. if not Assigned(result) then begin
  3059. result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
  3060. FormatDescriptors[aFormat] := result;
  3061. end;
  3062. finally
  3063. FormatDescriptorCS.Leave;
  3064. end;
  3065. end;
  3066. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3067. class function TFormatDescriptor.GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3068. begin
  3069. result := Get(Get(aFormat).WithAlpha);
  3070. end;
  3071. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3072. class procedure TFormatDescriptor.Clear;
  3073. var
  3074. f: TglBitmapFormat;
  3075. begin
  3076. FormatDescriptorCS.Enter;
  3077. try
  3078. for f := low(FormatDescriptors) to high(FormatDescriptors) do
  3079. FreeAndNil(FormatDescriptors[f]);
  3080. finally
  3081. FormatDescriptorCS.Leave;
  3082. end;
  3083. end;
  3084. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3085. class procedure TFormatDescriptor.Finalize;
  3086. begin
  3087. Clear;
  3088. FreeAndNil(FormatDescriptorCS);
  3089. end;
  3090. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3091. //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3092. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3093. procedure TbmpBitfieldFormat.SetRedMask(const aValue: UInt64);
  3094. begin
  3095. Update(aValue, fRange.r, fShift.r);
  3096. end;
  3097. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3098. procedure TbmpBitfieldFormat.SetGreenMask(const aValue: UInt64);
  3099. begin
  3100. Update(aValue, fRange.g, fShift.g);
  3101. end;
  3102. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3103. procedure TbmpBitfieldFormat.SetBlueMask(const aValue: UInt64);
  3104. begin
  3105. Update(aValue, fRange.b, fShift.b);
  3106. end;
  3107. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3108. procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: UInt64);
  3109. begin
  3110. Update(aValue, fRange.a, fShift.a);
  3111. end;
  3112. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3113. procedure TbmpBitfieldFormat.Update(aMask: UInt64; out aRange: Cardinal; out
  3114. aShift: Byte);
  3115. begin
  3116. aShift := 0;
  3117. aRange := 0;
  3118. if (aMask = 0) then
  3119. exit;
  3120. while (aMask > 0) and ((aMask and 1) = 0) do begin
  3121. inc(aShift);
  3122. aMask := aMask shr 1;
  3123. end;
  3124. aRange := 1;
  3125. while (aMask > 0) do begin
  3126. aRange := aRange shl 1;
  3127. aMask := aMask shr 1;
  3128. end;
  3129. dec(aRange);
  3130. fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
  3131. end;
  3132. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3133. procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3134. var
  3135. data: UInt64;
  3136. s: Integer;
  3137. type
  3138. PUInt64 = ^UInt64;
  3139. begin
  3140. data :=
  3141. ((aPixel.Data.r and fRange.r) shl fShift.r) or
  3142. ((aPixel.Data.g and fRange.g) shl fShift.g) or
  3143. ((aPixel.Data.b and fRange.b) shl fShift.b) or
  3144. ((aPixel.Data.a and fRange.a) shl fShift.a);
  3145. s := Round(fPixelSize);
  3146. case s of
  3147. 1: aData^ := data;
  3148. 2: PWord(aData)^ := data;
  3149. 4: PCardinal(aData)^ := data;
  3150. 8: PUInt64(aData)^ := data;
  3151. else
  3152. raise EglBitmapException.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
  3153. end;
  3154. inc(aData, s);
  3155. end;
  3156. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3157. procedure TbmpBitfieldFormat.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3158. var
  3159. data: UInt64;
  3160. s, i: Integer;
  3161. type
  3162. PUInt64 = ^UInt64;
  3163. begin
  3164. s := Round(fPixelSize);
  3165. case s of
  3166. 1: data := aData^;
  3167. 2: data := PWord(aData)^;
  3168. 4: data := PCardinal(aData)^;
  3169. 8: data := PUInt64(aData)^;
  3170. else
  3171. raise EglBitmapException.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
  3172. end;
  3173. for i := 0 to 3 do
  3174. aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
  3175. inc(aData, s);
  3176. end;
  3177. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3178. //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3179. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3180. procedure TbmpColorTableFormat.CreateColorTable;
  3181. var
  3182. bits: Byte;
  3183. len: Integer;
  3184. i: Integer;
  3185. begin
  3186. if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
  3187. raise EglBitmapException.Create(UNSUPPORTED_FORMAT);
  3188. if (Format = tfLuminance4) then
  3189. SetLength(fColorTable, 16)
  3190. else
  3191. SetLength(fColorTable, 256);
  3192. case Format of
  3193. tfLuminance4: begin
  3194. for i := 0 to High(fColorTable) do begin
  3195. fColorTable[i].r := 16 * i;
  3196. fColorTable[i].g := 16 * i;
  3197. fColorTable[i].b := 16 * i;
  3198. fColorTable[i].a := 0;
  3199. end;
  3200. end;
  3201. tfLuminance8: begin
  3202. for i := 0 to High(fColorTable) do begin
  3203. fColorTable[i].r := i;
  3204. fColorTable[i].g := i;
  3205. fColorTable[i].b := i;
  3206. fColorTable[i].a := 0;
  3207. end;
  3208. end;
  3209. tfR3G3B2: begin
  3210. for i := 0 to High(fColorTable) do begin
  3211. fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
  3212. fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
  3213. fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
  3214. fColorTable[i].a := 0;
  3215. end;
  3216. end;
  3217. end;
  3218. end;
  3219. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3220. procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3221. var
  3222. d: Byte;
  3223. begin
  3224. if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
  3225. raise EglBitmapException.Create(UNSUPPORTED_FORMAT);
  3226. case Format of
  3227. tfLuminance4: begin
  3228. if (aMapData = nil) then
  3229. aData^ := 0;
  3230. d := LuminanceWeight(aPixel) and Range.r;
  3231. aData^ := aData^ or (d shl (4 - PtrInt(aMapData)));
  3232. inc(aMapData, 4);
  3233. if (PtrInt(aMapData) >= 8) then begin
  3234. inc(aData);
  3235. aMapData := nil;
  3236. end;
  3237. end;
  3238. tfLuminance8: begin
  3239. aData^ := LuminanceWeight(aPixel) and Range.r;
  3240. inc(aData);
  3241. end;
  3242. tfR3G3B2: begin
  3243. aData^ := Round(
  3244. ((aPixel.Data.r and Range.r) shl Shift.r) or
  3245. ((aPixel.Data.g and Range.g) shl Shift.g) or
  3246. ((aPixel.Data.b and Range.b) shl Shift.b));
  3247. inc(aData);
  3248. end;
  3249. end;
  3250. end;
  3251. procedure TbmpColorTableFormat.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3252. type
  3253. PUInt64 = ^UInt64;
  3254. var
  3255. idx: UInt64;
  3256. s: Integer;
  3257. bits: Byte;
  3258. f: Single;
  3259. begin
  3260. s := Trunc(fPixelSize);
  3261. f := fPixelSize - s;
  3262. bits := Round(8 * f);
  3263. case s of
  3264. 0: idx := (aData^ shr (8 - bits - PtrInt(aMapData))) and ((1 shl bits) - 1);
  3265. 1: idx := aData^;
  3266. 2: idx := PWord(aData)^;
  3267. 4: idx := PCardinal(aData)^;
  3268. 8: idx := PUInt64(aData)^;
  3269. else
  3270. raise EglBitmapException.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
  3271. end;
  3272. if (idx >= Length(fColorTable)) then
  3273. raise EglBitmapException.CreateFmt('invalid color index: %d', [idx]);
  3274. with fColorTable[idx] do begin
  3275. aPixel.Data.r := r;
  3276. aPixel.Data.g := g;
  3277. aPixel.Data.b := b;
  3278. aPixel.Data.a := a;
  3279. end;
  3280. inc(aMapData, bits);
  3281. if (PtrInt(aMapData) >= 8) then begin
  3282. inc(aData, 1);
  3283. dec(aMapData, 8);
  3284. end;
  3285. inc(aData, s);
  3286. end;
  3287. destructor TbmpColorTableFormat.Destroy;
  3288. begin
  3289. SetLength(fColorTable, 0);
  3290. inherited Destroy;
  3291. end;
  3292. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3293. //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3294. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3295. procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
  3296. begin
  3297. with aFuncRec do begin
  3298. if (Source.Range.r > 0) then
  3299. Dest.Data.r := Source.Data.r;
  3300. if (Source.Range.g > 0) then
  3301. Dest.Data.g := Source.Data.g;
  3302. if (Source.Range.b > 0) then
  3303. Dest.Data.b := Source.Data.b;
  3304. if (Source.Range.a > 0) then
  3305. Dest.Data.a := Source.Data.a;
  3306. end;
  3307. end;
  3308. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3309. procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3310. var
  3311. i: Integer;
  3312. begin
  3313. with aFuncRec do begin
  3314. for i := 0 to 3 do
  3315. if (Source.Range.arr[i] > 0) then
  3316. Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
  3317. end;
  3318. end;
  3319. type
  3320. TShiftData = packed record
  3321. case Integer of
  3322. 0: (r, g, b, a: SmallInt);
  3323. 1: (arr: array[0..3] of SmallInt);
  3324. end;
  3325. PShiftData = ^TShiftData;
  3326. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3327. procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3328. var
  3329. i: Integer;
  3330. begin
  3331. with aFuncRec do
  3332. for i := 0 to 3 do
  3333. if (Source.Range.arr[i] > 0) then
  3334. Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
  3335. end;
  3336. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3337. procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
  3338. begin
  3339. with aFuncRec do begin
  3340. Dest.Data.r := Source.Data.r;
  3341. Dest.Data.g := Source.Data.g;
  3342. Dest.Data.b := Source.Data.b;
  3343. Dest.Data.a := Source.Data.a;
  3344. if (Args and $1 > 0) then begin
  3345. Dest.Data.r := Dest.Data.r xor Dest.Range.r;
  3346. Dest.Data.g := Dest.Data.g xor Dest.Range.g;
  3347. Dest.Data.b := Dest.Data.b xor Dest.Range.b;
  3348. end;
  3349. if (Args and $2 > 0) then begin
  3350. Dest.Data.a := Dest.Data.a xor Dest.Range.a;
  3351. end;
  3352. end;
  3353. end;
  3354. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3355. procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
  3356. var
  3357. i: Integer;
  3358. begin
  3359. with aFuncRec do begin
  3360. for i := 0 to 3 do
  3361. Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
  3362. end;
  3363. end;
  3364. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3365. procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3366. var
  3367. Temp: Single;
  3368. begin
  3369. with FuncRec do begin
  3370. if (FuncRec.Args = 0) then begin //source has no alpha
  3371. Temp :=
  3372. Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
  3373. Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
  3374. Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
  3375. Dest.Data.a := Round(Dest.Range.a * Temp);
  3376. end else
  3377. Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
  3378. end;
  3379. end;
  3380. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3381. procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3382. type
  3383. PglBitmapPixelData = ^TglBitmapPixelData;
  3384. begin
  3385. with FuncRec do begin
  3386. Dest.Data.r := Source.Data.r;
  3387. Dest.Data.g := Source.Data.g;
  3388. Dest.Data.b := Source.Data.b;
  3389. with PglBitmapPixelData(Args)^ do
  3390. if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
  3391. (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
  3392. (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
  3393. Dest.Data.a := 0
  3394. else
  3395. Dest.Data.a := Dest.Range.a;
  3396. end;
  3397. end;
  3398. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3399. procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3400. type
  3401. PglBitmapPixelData = ^TglBitmapPixelData;
  3402. begin
  3403. with FuncRec do begin
  3404. Dest.Data.r := Source.Data.r;
  3405. Dest.Data.g := Source.Data.g;
  3406. Dest.Data.b := Source.Data.b;
  3407. Dest.Data.a := PCardinal(Args)^;
  3408. end;
  3409. end;
  3410. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3411. procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
  3412. type
  3413. PRGBPix = ^TRGBPix;
  3414. TRGBPix = array [0..2] of byte;
  3415. var
  3416. Temp: Byte;
  3417. begin
  3418. while aWidth > 0 do begin
  3419. Temp := PRGBPix(aData)^[0];
  3420. PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
  3421. PRGBPix(aData)^[2] := Temp;
  3422. if aHasAlpha then
  3423. Inc(aData, 4)
  3424. else
  3425. Inc(aData, 3);
  3426. dec(aWidth);
  3427. end;
  3428. end;
  3429. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3430. //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3431. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3432. function TglBitmap.GetWidth: Integer;
  3433. begin
  3434. if (ffX in fDimension.Fields) then
  3435. result := fDimension.X
  3436. else
  3437. result := -1;
  3438. end;
  3439. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3440. function TglBitmap.GetHeight: Integer;
  3441. begin
  3442. if (ffY in fDimension.Fields) then
  3443. result := fDimension.Y
  3444. else
  3445. result := -1;
  3446. end;
  3447. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3448. function TglBitmap.GetFileWidth: Integer;
  3449. begin
  3450. result := Max(1, Width);
  3451. end;
  3452. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3453. function TglBitmap.GetFileHeight: Integer;
  3454. begin
  3455. result := Max(1, Height);
  3456. end;
  3457. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3458. procedure TglBitmap.SetCustomData(const aValue: Pointer);
  3459. begin
  3460. if fCustomData = aValue then
  3461. exit;
  3462. fCustomData := aValue;
  3463. end;
  3464. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3465. procedure TglBitmap.SetCustomName(const aValue: String);
  3466. begin
  3467. if fCustomName = aValue then
  3468. exit;
  3469. fCustomName := aValue;
  3470. end;
  3471. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3472. procedure TglBitmap.SetCustomNameW(const aValue: WideString);
  3473. begin
  3474. if fCustomNameW = aValue then
  3475. exit;
  3476. fCustomNameW := aValue;
  3477. end;
  3478. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3479. procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
  3480. begin
  3481. if fDeleteTextureOnFree = aValue then
  3482. exit;
  3483. fDeleteTextureOnFree := aValue;
  3484. end;
  3485. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3486. procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
  3487. begin
  3488. if fFormat = aValue then
  3489. exit;
  3490. if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
  3491. raise EglBitmapUnsupportedFormatFormat.Create('SetInternalFormat - ' + UNSUPPORTED_FORMAT);
  3492. SetDataPointer(Data, aValue, Width, Height);
  3493. end;
  3494. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3495. procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
  3496. begin
  3497. if fFreeDataAfterGenTexture = aValue then
  3498. exit;
  3499. fFreeDataAfterGenTexture := aValue;
  3500. end;
  3501. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3502. procedure TglBitmap.SetID(const aValue: Cardinal);
  3503. begin
  3504. if fID = aValue then
  3505. exit;
  3506. fID := aValue;
  3507. end;
  3508. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3509. procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
  3510. begin
  3511. if fMipMap = aValue then
  3512. exit;
  3513. fMipMap := aValue;
  3514. end;
  3515. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3516. procedure TglBitmap.SetTarget(const aValue: Cardinal);
  3517. begin
  3518. if fTarget = aValue then
  3519. exit;
  3520. fTarget := aValue;
  3521. end;
  3522. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3523. procedure TglBitmap.SetAnisotropic(const aValue: Integer);
  3524. var
  3525. MaxAnisotropic: Integer;
  3526. begin
  3527. fAnisotropic := aValue;
  3528. if (ID > 0) then begin
  3529. if GL_EXT_texture_filter_anisotropic then begin
  3530. if fAnisotropic > 0 then begin
  3531. Bind(false);
  3532. glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
  3533. if aValue > MaxAnisotropic then
  3534. fAnisotropic := MaxAnisotropic;
  3535. glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
  3536. end;
  3537. end else begin
  3538. fAnisotropic := 0;
  3539. end;
  3540. end;
  3541. end;
  3542. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3543. procedure TglBitmap.CreateID;
  3544. begin
  3545. if (ID <> 0) then
  3546. glDeleteTextures(1, @fID);
  3547. glGenTextures(1, @fID);
  3548. Bind(false);
  3549. end;
  3550. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3551. procedure TglBitmap.SetupParameters(var aBuildWithGlu: Boolean);
  3552. begin
  3553. // Set Up Parameters
  3554. SetWrap(fWrapS, fWrapT, fWrapR);
  3555. SetFilter(fFilterMin, fFilterMag);
  3556. SetAnisotropic(fAnisotropic);
  3557. SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
  3558. // Mip Maps Generation Mode
  3559. aBuildWithGlu := false;
  3560. if (MipMap = mmMipmap) then begin
  3561. if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
  3562. glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
  3563. else
  3564. aBuildWithGlu := true;
  3565. end else if (MipMap = mmMipmapGlu) then
  3566. aBuildWithGlu := true;
  3567. end;
  3568. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3569. procedure TglBitmap.SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
  3570. const aWidth: Integer; const aHeight: Integer);
  3571. var
  3572. s: Single;
  3573. begin
  3574. if (Data <> aData) then begin
  3575. if (Assigned(Data)) then
  3576. FreeMem(Data);
  3577. fData := aData;
  3578. end;
  3579. FillChar(fDimension, SizeOf(fDimension), 0);
  3580. if not Assigned(fData) then begin
  3581. fFormat := tfEmpty;
  3582. fPixelSize := 0;
  3583. fRowSize := 0;
  3584. end else begin
  3585. if aWidth <> -1 then begin
  3586. fDimension.Fields := fDimension.Fields + [ffX];
  3587. fDimension.X := aWidth;
  3588. end;
  3589. if aHeight <> -1 then begin
  3590. fDimension.Fields := fDimension.Fields + [ffY];
  3591. fDimension.Y := aHeight;
  3592. end;
  3593. s := TFormatDescriptor.Get(aFormat).PixelSize;
  3594. fFormat := aFormat;
  3595. fPixelSize := Ceil(s);
  3596. fRowSize := Ceil(s * aWidth);
  3597. end;
  3598. end;
  3599. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3600. function TglBitmap.FlipHorz: Boolean;
  3601. begin
  3602. result := false;
  3603. end;
  3604. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3605. function TglBitmap.FlipVert: Boolean;
  3606. begin
  3607. result := false;
  3608. end;
  3609. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3610. //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3611. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3612. procedure TglBitmap.AfterConstruction;
  3613. begin
  3614. inherited AfterConstruction;
  3615. fID := 0;
  3616. fTarget := 0;
  3617. fIsResident := false;
  3618. fFormat := glBitmapGetDefaultFormat;
  3619. fMipMap := glBitmapDefaultMipmap;
  3620. fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
  3621. fDeleteTextureOnFree := glBitmapGetDefaultDeleteTextureOnFree;
  3622. glBitmapGetDefaultFilter (fFilterMin, fFilterMag);
  3623. glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
  3624. end;
  3625. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3626. procedure TglBitmap.BeforeDestruction;
  3627. begin
  3628. SetDataPointer(nil, tfEmpty);
  3629. if (fID > 0) and fDeleteTextureOnFree then
  3630. glDeleteTextures(1, @fID);
  3631. inherited BeforeDestruction;
  3632. end;
  3633. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3634. procedure TglBitmap.LoadFromFile(const aFilename: String);
  3635. var
  3636. fs: TFileStream;
  3637. begin
  3638. if not FileExists(aFilename) then
  3639. raise EglBitmapException.Create('file does not exist: ' + aFilename);
  3640. fFilename := aFilename;
  3641. fs := TFileStream.Create(fFilename, fmOpenRead);
  3642. try
  3643. fs.Position := 0;
  3644. LoadFromStream(fs);
  3645. finally
  3646. fs.Free;
  3647. end;
  3648. end;
  3649. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3650. procedure TglBitmap.LoadFromStream(const aStream: TStream);
  3651. begin
  3652. {$IFDEF GLB_SUPPORT_PNG_READ}
  3653. if not LoadPNG(aStream) then
  3654. {$ENDIF}
  3655. {$IFDEF GLB_SUPPORT_JPEG_READ}
  3656. if not LoadJPEG(aStream) then
  3657. {$ENDIF}
  3658. if not LoadDDS(aStream) then
  3659. if not LoadTGA(aStream) then
  3660. if not LoadBMP(aStream) then
  3661. raise EglBitmapException.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
  3662. end;
  3663. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3664. procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  3665. const aFormat: TglBitmapFormat; const aArgs: PtrInt);
  3666. var
  3667. tmpData: PByte;
  3668. size: Integer;
  3669. begin
  3670. size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  3671. GetMem(tmpData, size);
  3672. try
  3673. FillChar(tmpData^, size, #$FF);
  3674. SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y);
  3675. except
  3676. FreeMem(tmpData);
  3677. raise;
  3678. end;
  3679. AddFunc(Self, aFunc, false, Format, aArgs);
  3680. end;
  3681. {$IFDEF GLB_DELPHI}
  3682. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3683. procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil);
  3684. var
  3685. rs: TResourceStream;
  3686. TempPos: Integer;
  3687. ResTypeStr: String;
  3688. TempResType: PChar;
  3689. begin
  3690. if not Assigned(ResType) then begin
  3691. TempPos := Pos('.', Resource);
  3692. ResTypeStr := UpperCase(Copy(Resource, TempPos + 1, Length(Resource) - TempPos));
  3693. Resource := UpperCase(Copy(Resource, 0, TempPos -1));
  3694. TempResType := PChar(ResTypeStr);
  3695. end else
  3696. TempResType := ResType
  3697. rs := TResourceStream.Create(Instance, Resource, TempResType);
  3698. try
  3699. LoadFromStream(rs);
  3700. finally
  3701. rs.Free;
  3702. end;
  3703. end;
  3704. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3705. procedure TglBitmap.LoadFromResourceID(const sInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  3706. var
  3707. rs: TResourceStream;
  3708. begin
  3709. rs := TResourceStream.CreateFromID(Instance, ResourceID, ResType);
  3710. try
  3711. LoadFromStream(rs);
  3712. finally
  3713. rs.Free;
  3714. end;
  3715. end;
  3716. {$ENDIF}
  3717. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3718. procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  3719. var
  3720. fs: TFileStream;
  3721. begin
  3722. fs := TFileStream.Create(aFileName, fmCreate);
  3723. try
  3724. fs.Position := 0;
  3725. SaveToStream(fs, aFileType);
  3726. finally
  3727. fs.Free;
  3728. end;
  3729. end;
  3730. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3731. procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
  3732. begin
  3733. case aFileType of
  3734. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  3735. ftPNG: SavePng(aStream);
  3736. {$ENDIF}
  3737. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  3738. ftJPEG: SaveJPEG(aStream);
  3739. {$ENDIF}
  3740. ftDDS: SaveDDS(aStream);
  3741. ftTGA: SaveTGA(aStream);
  3742. ftBMP: SaveBMP(aStream);
  3743. end;
  3744. end;
  3745. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3746. function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: PtrInt): Boolean;
  3747. begin
  3748. result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
  3749. end;
  3750. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3751. function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  3752. const aFormat: TglBitmapFormat; const aArgs: PtrInt): Boolean;
  3753. var
  3754. DestData, TmpData, SourceData: pByte;
  3755. TempHeight, TempWidth: Integer;
  3756. SourceFD, DestFD: TFormatDescriptor;
  3757. SourceMD, DestMD: Pointer;
  3758. FuncRec: TglBitmapFunctionRec;
  3759. begin
  3760. Assert(Assigned(Data));
  3761. Assert(Assigned(aSource));
  3762. Assert(Assigned(aSource.Data));
  3763. result := false;
  3764. if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
  3765. SourceFD := TFormatDescriptor.Get(aSource.Format);
  3766. DestFD := TFormatDescriptor.Get(aFormat);
  3767. // inkompatible Formats so CreateTemp
  3768. if (SourceFD.PixelSize <> DestFD.PixelSize) then
  3769. aCreateTemp := true;
  3770. // Values
  3771. TempHeight := Max(1, aSource.Height);
  3772. TempWidth := Max(1, aSource.Width);
  3773. FuncRec.Sender := Self;
  3774. FuncRec.Args := aArgs;
  3775. TmpData := nil;
  3776. if aCreateTemp then begin
  3777. GetMem(TmpData, TFormatDescriptor.Get(aFormat).GetSize(TempWidth, TempHeight));
  3778. DestData := TmpData;
  3779. end else
  3780. DestData := Data;
  3781. try
  3782. SourceFD.PreparePixel(FuncRec.Source);
  3783. DestFD.PreparePixel (FuncRec.Dest);
  3784. SourceMD := SourceFD.CreateMappingData;
  3785. DestMD := DestFD.CreateMappingData;
  3786. FuncRec.Size := aSource.Dimension;
  3787. FuncRec.Position.Fields := FuncRec.Size.Fields;
  3788. try
  3789. SourceData := aSource.Data;
  3790. FuncRec.Position.Y := 0;
  3791. while FuncRec.Position.Y < TempHeight do begin
  3792. FuncRec.Position.X := 0;
  3793. while FuncRec.Position.X < TempWidth do begin
  3794. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  3795. aFunc(FuncRec);
  3796. DestFD.Map(FuncRec.Dest, DestData, DestMD);
  3797. inc(FuncRec.Position.X);
  3798. end;
  3799. inc(FuncRec.Position.Y);
  3800. end;
  3801. // Updating Image or InternalFormat
  3802. if aCreateTemp then
  3803. SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height)
  3804. else if (aFormat <> fFormat) then
  3805. Format := aFormat;
  3806. result := true;
  3807. finally
  3808. SourceFD.FreeMappingData(SourceMD);
  3809. DestFD.FreeMappingData(DestMD);
  3810. end;
  3811. except
  3812. if aCreateTemp then
  3813. FreeMem(TmpData);
  3814. raise;
  3815. end;
  3816. end;
  3817. end;
  3818. {$IFDEF GLB_SDL}
  3819. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3820. function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  3821. var
  3822. Row, RowSize: Integer;
  3823. SourceData, TmpData: PByte;
  3824. TempDepth: Integer;
  3825. Pix: TglBitmapPixelData;
  3826. FormatDesc: TglBitmapFormatDescriptor;
  3827. function GetRowPointer(Row: Integer): pByte;
  3828. begin
  3829. result := Surface.pixels;
  3830. Inc(result, Row * RowSize);
  3831. end;
  3832. begin
  3833. result := false;
  3834. (* TODO
  3835. if not FormatIsUncompressed(InternalFormat) then
  3836. raise EglBitmapUnsupportedInternalFormat.Create('AssignToSurface - ' + UNSUPPORTED_INTERNAL_FORMAT);
  3837. *)
  3838. FormatDesc := FORMAT_DESCRIPTORS[Format];
  3839. if Assigned(Data) then begin
  3840. case Trunc(FormatDesc.GetSize) of
  3841. 1: TempDepth := 8;
  3842. 2: TempDepth := 16;
  3843. 3: TempDepth := 24;
  3844. 4: TempDepth := 32;
  3845. else
  3846. raise EglBitmapException.Create('AssignToSurface - ' + UNSUPPORTED_INTERNAL_FORMAT);
  3847. end;
  3848. FormatDesc.PreparePixel(Pix);
  3849. with Pix.PixelDesc do
  3850. Surface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
  3851. RedRange shl RedShift, GreenRange shl GreenShift, BlueRange shl BlueShift, AlphaRange shl AlphaShift);
  3852. SourceData := Data;
  3853. RowSize := Ceil(FileWidth * FormatDesc.GetSize);
  3854. for Row := 0 to FileHeight -1 do begin
  3855. TmpData := GetRowPointer(Row);
  3856. if Assigned(TmpData) then begin
  3857. Move(SourceData^, TmpData^, RowSize);
  3858. inc(SourceData, RowSize);
  3859. end;
  3860. end;
  3861. result := true;
  3862. end;
  3863. end;
  3864. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3865. function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  3866. var
  3867. pSource, pData, pTempData: PByte;
  3868. Row, RowSize, TempWidth, TempHeight: Integer;
  3869. IntFormat, f: TglBitmapInternalFormat;
  3870. FormatDesc: TglBitmapFormatDescriptor;
  3871. function GetRowPointer(Row: Integer): pByte;
  3872. begin
  3873. result := Surface^.pixels;
  3874. Inc(result, Row * RowSize);
  3875. end;
  3876. begin
  3877. result := false;
  3878. if (Assigned(Surface)) then begin
  3879. with Surface^.format^ do begin
  3880. IntFormat := tfEmpty;
  3881. for f := Low(f) to High(f) do begin
  3882. if FORMAT_DESCRIPTORS[f].MaskMatch(RMask, GMask, BMask, AMask) then begin
  3883. IntFormat := f;
  3884. break;
  3885. end;
  3886. end;
  3887. if (IntFormat = tfEmpty) then
  3888. raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
  3889. end;
  3890. FormatDesc := FORMAT_DESCRIPTORS[IntFormat];
  3891. TempWidth := Surface^.w;
  3892. TempHeight := Surface^.h;
  3893. RowSize := Trunc(TempWidth * FormatDesc.GetSize);
  3894. GetMem(pData, TempHeight * RowSize);
  3895. try
  3896. pTempData := pData;
  3897. for Row := 0 to TempHeight -1 do begin
  3898. pSource := GetRowPointer(Row);
  3899. if (Assigned(pSource)) then begin
  3900. Move(pSource^, pTempData^, RowSize);
  3901. Inc(pTempData, RowSize);
  3902. end;
  3903. end;
  3904. SetDataPointer(pData, IntFormat, TempWidth, TempHeight);
  3905. result := true;
  3906. except
  3907. FreeMem(pData);
  3908. raise;
  3909. end;
  3910. end;
  3911. end;
  3912. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3913. function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  3914. var
  3915. Row, Col, AlphaInterleave: Integer;
  3916. pSource, pDest: PByte;
  3917. function GetRowPointer(Row: Integer): pByte;
  3918. begin
  3919. result := aSurface.pixels;
  3920. Inc(result, Row * Width);
  3921. end;
  3922. begin
  3923. result := false;
  3924. if Assigned(Data) then begin
  3925. if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
  3926. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
  3927. AlphaInterleave := 0;
  3928. case Format of
  3929. ifLuminance8Alpha8:
  3930. AlphaInterleave := 1;
  3931. ifBGRA8, ifRGBA8:
  3932. AlphaInterleave := 3;
  3933. end;
  3934. pSource := Data;
  3935. for Row := 0 to Height -1 do begin
  3936. pDest := GetRowPointer(Row);
  3937. if Assigned(pDest) then begin
  3938. for Col := 0 to Width -1 do begin
  3939. Inc(pSource, AlphaInterleave);
  3940. pDest^ := pSource^;
  3941. Inc(pDest);
  3942. Inc(pSource);
  3943. end;
  3944. end;
  3945. end;
  3946. result := true;
  3947. end;
  3948. end;
  3949. end;
  3950. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3951. function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
  3952. var
  3953. bmp: TglBitmap2D;
  3954. begin
  3955. bmp := TglBitmap2D.Create;
  3956. try
  3957. bmp.AssignFromSurface(Surface);
  3958. result := AddAlphaFromGlBitmap(bmp, Func, CustomData);
  3959. finally
  3960. bmp.Free;
  3961. end;
  3962. end;
  3963. {$ENDIF}
  3964. {$IFDEF GLB_DELPHI}
  3965. //TODO rework & test
  3966. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3967. function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
  3968. var
  3969. Row: Integer;
  3970. pSource, pData: PByte;
  3971. begin
  3972. result := false;
  3973. if Assigned(Data) then begin
  3974. if Assigned(aBitmap) then begin
  3975. aBitmap.Width := Width;
  3976. aBitmap.Height := Height;
  3977. case Format of
  3978. tfAlpha8, ifLuminance, ifDepth8:
  3979. begin
  3980. Bitmap.PixelFormat := pf8bit;
  3981. Bitmap.Palette := CreateGrayPalette;
  3982. end;
  3983. ifRGB5A1:
  3984. Bitmap.PixelFormat := pf15bit;
  3985. ifR5G6B5:
  3986. Bitmap.PixelFormat := pf16bit;
  3987. ifRGB8, ifBGR8:
  3988. Bitmap.PixelFormat := pf24bit;
  3989. ifRGBA8, ifBGRA8:
  3990. Bitmap.PixelFormat := pf32bit;
  3991. else
  3992. raise EglBitmapException.Create('AssignToBitmap - Invalid Pixelformat.');
  3993. end;
  3994. pSource := Data;
  3995. for Row := 0 to FileHeight -1 do begin
  3996. pData := Bitmap.Scanline[Row];
  3997. Move(pSource^, pData^, fRowSize);
  3998. Inc(pSource, fRowSize);
  3999. // swap RGB(A) to BGR(A)
  4000. if InternalFormat in [ifRGB8, ifRGBA8] then
  4001. SwapRGB(pData, FileWidth, InternalFormat = ifRGBA8);
  4002. end;
  4003. result := true;
  4004. end;
  4005. end;
  4006. end;
  4007. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4008. function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  4009. var
  4010. pSource, pData, pTempData: PByte;
  4011. Row, RowSize, TempWidth, TempHeight: Integer;
  4012. IntFormat: TglBitmapInternalFormat;
  4013. begin
  4014. result := false;
  4015. if (Assigned(Bitmap)) then begin
  4016. case Bitmap.PixelFormat of
  4017. pf8bit:
  4018. IntFormat := ifLuminance;
  4019. pf15bit:
  4020. IntFormat := ifRGB5A1;
  4021. pf16bit:
  4022. IntFormat := ifR5G6B5;
  4023. pf24bit:
  4024. IntFormat := ifBGR8;
  4025. pf32bit:
  4026. IntFormat := ifBGRA8;
  4027. else
  4028. raise EglBitmapException.Create('AssignFromBitmap - Invalid Pixelformat.');
  4029. end;
  4030. TempWidth := Bitmap.Width;
  4031. TempHeight := Bitmap.Height;
  4032. RowSize := Trunc(TempWidth * FormatGetSize(IntFormat));
  4033. GetMem(pData, TempHeight * RowSize);
  4034. try
  4035. pTempData := pData;
  4036. for Row := 0 to TempHeight -1 do begin
  4037. pSource := Bitmap.Scanline[Row];
  4038. if (Assigned(pSource)) then begin
  4039. Move(pSource^, pTempData^, RowSize);
  4040. Inc(pTempData, RowSize);
  4041. end;
  4042. end;
  4043. SetDataPointer(pData, IntFormat, TempWidth, TempHeight);
  4044. result := true;
  4045. except
  4046. FreeMem(pData);
  4047. raise;
  4048. end;
  4049. end;
  4050. end;
  4051. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4052. function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  4053. var
  4054. Row, Col, AlphaInterleave: Integer;
  4055. pSource, pDest: PByte;
  4056. begin
  4057. result := false;
  4058. if Assigned(Data) then begin
  4059. if InternalFormat in [ifAlpha, ifLuminanceAlpha, ifRGBA8, ifBGRA8] then begin
  4060. if Assigned(Bitmap) then begin
  4061. Bitmap.PixelFormat := pf8bit;
  4062. Bitmap.Palette := CreateGrayPalette;
  4063. Bitmap.Width := Width;
  4064. Bitmap.Height := Height;
  4065. case InternalFormat of
  4066. ifLuminanceAlpha:
  4067. AlphaInterleave := 1;
  4068. ifRGBA8, ifBGRA8:
  4069. AlphaInterleave := 3;
  4070. else
  4071. AlphaInterleave := 0;
  4072. end;
  4073. // Copy Data
  4074. pSource := Data;
  4075. for Row := 0 to Height -1 do begin
  4076. pDest := Bitmap.Scanline[Row];
  4077. if Assigned(pDest) then begin
  4078. for Col := 0 to Width -1 do begin
  4079. Inc(pSource, AlphaInterleave);
  4080. pDest^ := pSource^;
  4081. Inc(pDest);
  4082. Inc(pSource);
  4083. end;
  4084. end;
  4085. end;
  4086. result := true;
  4087. end;
  4088. end;
  4089. end;
  4090. end;
  4091. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4092. function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
  4093. var
  4094. tex: TglBitmap2D;
  4095. begin
  4096. tex := TglBitmap2D.Create;
  4097. try
  4098. tex.AssignFromBitmap(Bitmap);
  4099. result := AddAlphaFromglBitmap(tex, Func, CustomData);
  4100. finally
  4101. tex.Free;
  4102. end;
  4103. end;
  4104. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4105. function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar;
  4106. const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
  4107. var
  4108. RS: TResourceStream;
  4109. TempPos: Integer;
  4110. ResTypeStr: String;
  4111. TempResType: PChar;
  4112. begin
  4113. if Assigned(ResType) then
  4114. TempResType := ResType
  4115. else
  4116. begin
  4117. TempPos := Pos('.', Resource);
  4118. ResTypeStr := UpperCase(Copy(Resource, TempPos + 1, Length(Resource) - TempPos));
  4119. Resource := UpperCase(Copy(Resource, 0, TempPos -1));
  4120. TempResType := PChar(ResTypeStr);
  4121. end;
  4122. RS := TResourceStream.Create(Instance, Resource, TempResType);
  4123. try
  4124. result := AddAlphaFromStream(RS, Func, CustomData);
  4125. finally
  4126. RS.Free;
  4127. end;
  4128. end;
  4129. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4130. function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  4131. const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
  4132. var
  4133. RS: TResourceStream;
  4134. begin
  4135. RS := TResourceStream.CreateFromID(Instance, ResourceID, ResType);
  4136. try
  4137. result := AddAlphaFromStream(RS, Func, CustomData);
  4138. finally
  4139. RS.Free;
  4140. end;
  4141. end;
  4142. {$ENDIF}
  4143. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4144. function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
  4145. begin
  4146. (* TODO
  4147. if not FormatIsUncompressed(InternalFormat) then
  4148. raise EglBitmapUnsupportedFormatFormat.Create('AddAlphaFromFunc - ' + UNSUPPORTED_FORMAT);
  4149. *)
  4150. result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
  4151. end;
  4152. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4153. function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
  4154. var
  4155. FS: TFileStream;
  4156. begin
  4157. FS := TFileStream.Create(FileName, fmOpenRead);
  4158. try
  4159. result := AddAlphaFromStream(FS, aFunc, aArgs);
  4160. finally
  4161. FS.Free;
  4162. end;
  4163. end;
  4164. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4165. function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
  4166. var
  4167. tex: TglBitmap2D;
  4168. begin
  4169. tex := TglBitmap2D.Create(aStream);
  4170. try
  4171. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4172. finally
  4173. tex.Free;
  4174. end;
  4175. end;
  4176. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4177. function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
  4178. var
  4179. DestData, DestData2, SourceData: pByte;
  4180. TempHeight, TempWidth: Integer;
  4181. SourceFD, DestFD: TFormatDescriptor;
  4182. SourceMD, DestMD, DestMD2: Pointer;
  4183. FuncRec: TglBitmapFunctionRec;
  4184. begin
  4185. result := false;
  4186. Assert(Assigned(Data));
  4187. Assert(Assigned(aBitmap));
  4188. Assert(Assigned(aBitmap.Data));
  4189. if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
  4190. result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
  4191. if not Assigned(aFunc) then
  4192. aFunc := glBitmapAlphaFunc;
  4193. SourceFD := TFormatDescriptor.Get(aBitmap.Format);
  4194. DestFD := TFormatDescriptor.Get(Format);
  4195. // Values
  4196. TempHeight := aBitmap.FileHeight;
  4197. TempWidth := aBitmap.FileWidth;
  4198. FuncRec.Sender := Self;
  4199. FuncRec.Args := aArgs;
  4200. FuncRec.Size := Dimension;
  4201. FuncRec.Position.Fields := FuncRec.Size.Fields;
  4202. FuncRec.Args := PtrInt(SourceFD.HasAlpha) and 1;
  4203. DestData := Data;
  4204. DestData2 := Data;
  4205. SourceData := aBitmap.Data;
  4206. // Mapping
  4207. SourceFD.PreparePixel(FuncRec.Source);
  4208. DestFD.PreparePixel (FuncRec.Dest);
  4209. SourceMD := SourceFD.CreateMappingData;
  4210. DestMD := DestFD.CreateMappingData;
  4211. DestMD2 := DestFD.CreateMappingData;
  4212. try
  4213. FuncRec.Position.Y := 0;
  4214. while FuncRec.Position.Y < TempHeight do begin
  4215. FuncRec.Position.X := 0;
  4216. while FuncRec.Position.X < TempWidth do begin
  4217. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  4218. DestFD.Unmap (DestData, FuncRec.Dest, DestMD);
  4219. aFunc(FuncRec);
  4220. DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
  4221. inc(FuncRec.Position.X);
  4222. end;
  4223. inc(FuncRec.Position.Y);
  4224. end;
  4225. finally
  4226. SourceFD.FreeMappingData(SourceMD);
  4227. DestFD.FreeMappingData(DestMD);
  4228. DestFD.FreeMappingData(DestMD2);
  4229. end;
  4230. end;
  4231. end;
  4232. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4233. function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
  4234. begin
  4235. result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
  4236. end;
  4237. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4238. function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
  4239. var
  4240. PixelData: TglBitmapPixelData;
  4241. begin
  4242. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4243. result := AddAlphaFromColorKeyFloat(
  4244. aRed / PixelData.Range.r,
  4245. aGreen / PixelData.Range.g,
  4246. aBlue / PixelData.Range.b,
  4247. aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
  4248. end;
  4249. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4250. function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
  4251. var
  4252. values: array[0..2] of Single;
  4253. tmp: Cardinal;
  4254. i: Integer;
  4255. PixelData: TglBitmapPixelData;
  4256. begin
  4257. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4258. with PixelData do begin
  4259. values[0] := aRed;
  4260. values[1] := aGreen;
  4261. values[2] := aBlue;
  4262. for i := 0 to 2 do begin
  4263. tmp := Trunc(Range.arr[i] * aDeviation);
  4264. Data.arr[i] := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
  4265. Range.arr[i] := Max(0, Trunc(Range.arr[i] * values[i] - tmp));
  4266. end;
  4267. Data.a := 0;
  4268. Range.a := 0;
  4269. end;
  4270. result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, PtrInt(@PixelData));
  4271. end;
  4272. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4273. function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
  4274. begin
  4275. result := AddAlphaFromValueFloat(aAlpha / $FF);
  4276. end;
  4277. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4278. function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  4279. var
  4280. PixelData: TglBitmapPixelData;
  4281. begin
  4282. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4283. result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
  4284. end;
  4285. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4286. function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  4287. var
  4288. PixelData: TglBitmapPixelData;
  4289. begin
  4290. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4291. with PixelData do
  4292. Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
  4293. result := AddAlphaFromFunc(glBitmapValueAlphaFunc, PtrInt(@PixelData.Data.a));
  4294. end;
  4295. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4296. function TglBitmap.RemoveAlpha: Boolean;
  4297. var
  4298. FormatDesc: TFormatDescriptor;
  4299. begin
  4300. result := false;
  4301. FormatDesc := TFormatDescriptor.Get(Format);
  4302. if Assigned(Data) then begin
  4303. if not ({FormatDesc.IsUncompressed or }FormatDesc.HasAlpha) then
  4304. raise EglBitmapUnsupportedFormatFormat.Create('RemoveAlpha - ' + UNSUPPORTED_FORMAT);
  4305. result := ConvertTo(FormatDesc.WithoutAlpha);
  4306. end;
  4307. end;
  4308. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4309. function TglBitmap.Clone: TglBitmap;
  4310. var
  4311. Temp: TglBitmap;
  4312. TempPtr: PByte;
  4313. Size: Integer;
  4314. begin
  4315. result := nil;
  4316. Temp := (ClassType.Create as TglBitmap);
  4317. try
  4318. // copy texture data if assigned
  4319. if Assigned(Data) then begin
  4320. Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
  4321. GetMem(TempPtr, Size);
  4322. try
  4323. Move(Data^, TempPtr^, Size);
  4324. Temp.SetDataPointer(TempPtr, Format, Width, Height);
  4325. except
  4326. FreeMem(TempPtr);
  4327. raise;
  4328. end;
  4329. end else
  4330. Temp.SetDataPointer(nil, Format, Width, Height);
  4331. // copy properties
  4332. Temp.fID := ID;
  4333. Temp.fTarget := Target;
  4334. Temp.fFormat := Format;
  4335. Temp.fMipMap := MipMap;
  4336. Temp.fAnisotropic := Anisotropic;
  4337. Temp.fBorderColor := fBorderColor;
  4338. Temp.fDeleteTextureOnFree := DeleteTextureOnFree;
  4339. Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
  4340. Temp.fFilterMin := fFilterMin;
  4341. Temp.fFilterMag := fFilterMag;
  4342. Temp.fWrapS := fWrapS;
  4343. Temp.fWrapT := fWrapT;
  4344. Temp.fWrapR := fWrapR;
  4345. Temp.fFilename := fFilename;
  4346. Temp.fCustomName := fCustomName;
  4347. Temp.fCustomNameW := fCustomNameW;
  4348. Temp.fCustomData := fCustomData;
  4349. result := Temp;
  4350. except
  4351. FreeAndNil(Temp);
  4352. raise;
  4353. end;
  4354. end;
  4355. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4356. function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
  4357. var
  4358. SourceFD, DestFD: TFormatDescriptor;
  4359. SourcePD, DestPD: TglBitmapPixelData;
  4360. ShiftData: TShiftData;
  4361. function CanCopyDirect: Boolean;
  4362. begin
  4363. result :=
  4364. ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  4365. ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  4366. ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  4367. ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  4368. end;
  4369. function CanShift: Boolean;
  4370. begin
  4371. result :=
  4372. ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  4373. ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  4374. ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  4375. ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  4376. end;
  4377. function GetShift(aSource, aDest: Cardinal) : ShortInt;
  4378. begin
  4379. result := 0;
  4380. while (aSource > aDest) and (aSource > 0) do begin
  4381. inc(result);
  4382. aSource := aSource shr 1;
  4383. end;
  4384. end;
  4385. begin
  4386. if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
  4387. SourceFD := TFormatDescriptor.Get(Format);
  4388. DestFD := TFormatDescriptor.Get(aFormat);
  4389. SourceFD.PreparePixel(SourcePD);
  4390. DestFD.PreparePixel (DestPD);
  4391. if CanCopyDirect then
  4392. result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
  4393. else if CanShift then begin
  4394. ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
  4395. ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
  4396. ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
  4397. ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
  4398. result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, PtrInt(@ShiftData));
  4399. end else
  4400. result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
  4401. end else
  4402. result := true;
  4403. end;
  4404. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4405. procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
  4406. begin
  4407. if aUseRGB or aUseAlpha then
  4408. AddFunc(glBitmapInvertFunc, false, ((PtrInt(aUseAlpha) and 1) shl 1) or (PtrInt(aUseRGB) and 1));
  4409. end;
  4410. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4411. procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  4412. begin
  4413. fBorderColor[0] := aRed;
  4414. fBorderColor[1] := aGreen;
  4415. fBorderColor[2] := aBlue;
  4416. fBorderColor[3] := aAlpha;
  4417. if (ID > 0) then begin
  4418. Bind(false);
  4419. glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
  4420. end;
  4421. end;
  4422. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4423. procedure TglBitmap.FreeData;
  4424. begin
  4425. SetDataPointer(nil, tfEmpty);
  4426. end;
  4427. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4428. procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
  4429. const aAlpha: Byte);
  4430. begin
  4431. FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
  4432. end;
  4433. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4434. procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
  4435. var
  4436. PixelData: TglBitmapPixelData;
  4437. begin
  4438. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4439. FillWithColorFloat(
  4440. aRed / PixelData.Range.r,
  4441. aGreen / PixelData.Range.g,
  4442. aBlue / PixelData.Range.b,
  4443. aAlpha / PixelData.Range.a);
  4444. end;
  4445. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4446. procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
  4447. var
  4448. PixelData: TglBitmapPixelData;
  4449. begin
  4450. TFormatDescriptor.Get(Format).PreparePixel(PixelData);
  4451. with PixelData do begin
  4452. Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
  4453. Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
  4454. Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
  4455. Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
  4456. end;
  4457. AddFunc(glBitmapFillWithColorFunc, false, PtrInt(@PixelData));
  4458. end;
  4459. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4460. procedure TglBitmap.SetFilter(const aMin, aMag: Cardinal);
  4461. begin
  4462. //check MIN filter
  4463. case aMin of
  4464. GL_NEAREST:
  4465. fFilterMin := GL_NEAREST;
  4466. GL_LINEAR:
  4467. fFilterMin := GL_LINEAR;
  4468. GL_NEAREST_MIPMAP_NEAREST:
  4469. fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
  4470. GL_LINEAR_MIPMAP_NEAREST:
  4471. fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
  4472. GL_NEAREST_MIPMAP_LINEAR:
  4473. fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
  4474. GL_LINEAR_MIPMAP_LINEAR:
  4475. fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
  4476. else
  4477. raise EglBitmapException.Create('SetFilter - Unknow MIN filter.');
  4478. end;
  4479. //check MAG filter
  4480. case aMag of
  4481. GL_NEAREST:
  4482. fFilterMag := GL_NEAREST;
  4483. GL_LINEAR:
  4484. fFilterMag := GL_LINEAR;
  4485. else
  4486. raise EglBitmapException.Create('SetFilter - Unknow MAG filter.');
  4487. end;
  4488. //apply filter
  4489. if (ID > 0) then begin
  4490. Bind(false);
  4491. glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
  4492. if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
  4493. case fFilterMin of
  4494. GL_NEAREST, GL_LINEAR:
  4495. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  4496. GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
  4497. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
  4498. GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
  4499. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
  4500. end;
  4501. end else
  4502. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  4503. end;
  4504. end;
  4505. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4506. procedure TglBitmap.SetWrap(const S: Cardinal; const T: Cardinal; const R: Cardinal);
  4507. procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
  4508. begin
  4509. case aValue of
  4510. GL_CLAMP:
  4511. aTarget := GL_CLAMP;
  4512. GL_REPEAT:
  4513. aTarget := GL_REPEAT;
  4514. GL_CLAMP_TO_EDGE: begin
  4515. if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
  4516. aTarget := GL_CLAMP_TO_EDGE
  4517. else
  4518. aTarget := GL_CLAMP;
  4519. end;
  4520. GL_CLAMP_TO_BORDER: begin
  4521. if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
  4522. aTarget := GL_CLAMP_TO_BORDER
  4523. else
  4524. aTarget := GL_CLAMP;
  4525. end;
  4526. GL_MIRRORED_REPEAT: begin
  4527. if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
  4528. aTarget := GL_MIRRORED_REPEAT
  4529. else
  4530. raise EglBitmapException.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
  4531. end;
  4532. else
  4533. raise EglBitmapException.Create('SetWrap - Unknow Texturewrap (S).');
  4534. end;
  4535. end;
  4536. begin
  4537. CheckAndSetWrap(S, fWrapS);
  4538. CheckAndSetWrap(T, fWrapT);
  4539. CheckAndSetWrap(R, fWrapR);
  4540. if (ID > 0) then begin
  4541. Bind(false);
  4542. glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
  4543. glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
  4544. glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
  4545. end;
  4546. end;
  4547. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4548. procedure TglBitmap.GetPixel(const aPos: TglBitmapPixelPosition; var aPixel: TglBitmapPixelData);
  4549. begin
  4550. { TODO delete?
  4551. if Assigned (fGetPixelFunc) then
  4552. fGetPixelFunc(aPos, aPixel);
  4553. }
  4554. end;
  4555. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4556. procedure TglBitmap.SetPixel(const aPos: TglBitmapPixelPosition; const aPixel: TglBitmapPixelData);
  4557. begin
  4558. {TODO delete?
  4559. if Assigned (fSetPixelFunc) then
  4560. fSetPixelFuc(aPos, aPixel);
  4561. }
  4562. end;
  4563. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4564. procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
  4565. begin
  4566. if aEnableTextureUnit then
  4567. glEnable(Target);
  4568. if (ID > 0) then
  4569. glBindTexture(Target, ID);
  4570. end;
  4571. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4572. procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
  4573. begin
  4574. if aDisableTextureUnit then
  4575. glDisable(Target);
  4576. glBindTexture(Target, 0);
  4577. end;
  4578. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4579. constructor TglBitmap.Create;
  4580. begin
  4581. {$IFNDEF GLB_NO_NATIVE_GL}
  4582. ReadOpenGLExtensions;
  4583. {$ENDIF}
  4584. if (ClassType = TglBitmap) then
  4585. raise EglBitmapException.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
  4586. inherited Create;
  4587. end;
  4588. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4589. constructor TglBitmap.Create(const aFileName: String);
  4590. begin
  4591. Create;
  4592. LoadFromFile(FileName);
  4593. end;
  4594. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4595. constructor TglBitmap.Create(const aStream: TStream);
  4596. begin
  4597. Create;
  4598. LoadFromStream(aStream);
  4599. end;
  4600. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4601. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat);
  4602. var
  4603. Image: PByte;
  4604. ImageSize: Integer;
  4605. begin
  4606. Create;
  4607. TFormatDescriptor.Get(aFormat).GetSize(aSize);
  4608. GetMem(Image, ImageSize);
  4609. try
  4610. FillChar(Image^, ImageSize, #$FF);
  4611. SetDataPointer(Image, aFormat, aSize.X, aSize.Y);
  4612. except
  4613. FreeMem(Image);
  4614. raise;
  4615. end;
  4616. end;
  4617. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4618. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat;
  4619. const aFunc: TglBitmapFunction; const aArgs: PtrInt);
  4620. begin
  4621. Create;
  4622. LoadFromFunc(aSize, aFunc, aFormat, aArgs);
  4623. end;
  4624. {$IFDEF GLB_DELPHI}
  4625. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4626. constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
  4627. begin
  4628. Create;
  4629. LoadFromResource(aInstance, aResource, aResType);
  4630. end;
  4631. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4632. constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  4633. begin
  4634. Create;
  4635. LoadFromResourceID(aInstance, aResourceID, aResType);
  4636. end;
  4637. {$ENDIF}
  4638. {$IFDEF GLB_SUPPORT_PNG_READ}
  4639. {$IF DEFINED(GLB_SDL_IMAGE)}
  4640. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4641. //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4642. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4643. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  4644. var
  4645. Surface: PSDL_Surface;
  4646. RWops: PSDL_RWops;
  4647. begin
  4648. result := false;
  4649. RWops := glBitmapCreateRWops(aStream);
  4650. try
  4651. if IMG_isPNG(RWops) > 0 then begin
  4652. Surface := IMG_LoadPNG_RW(RWops);
  4653. try
  4654. AssignFromSurface(Surface);
  4655. Rresult := true;
  4656. finally
  4657. SDL_FreeSurface(Surface);
  4658. end;
  4659. end;
  4660. finally
  4661. SDL_FreeRW(RWops);
  4662. end;
  4663. end;
  4664. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  4665. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4666. procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  4667. begin
  4668. TStream(png_get_io_ptr(png)).Read(buffer^, size);
  4669. end;
  4670. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4671. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  4672. var
  4673. StreamPos: Int64;
  4674. signature: array [0..7] of byte;
  4675. png: png_structp;
  4676. png_info: png_infop;
  4677. TempHeight, TempWidth: Integer;
  4678. Format: TglBitmapInternalFormat;
  4679. png_data: pByte;
  4680. png_rows: array of pByte;
  4681. Row, LineSize: Integer;
  4682. begin
  4683. result := false;
  4684. if not init_libPNG then
  4685. raise Exception.Create('LoadPNG - unable to initialize libPNG.');
  4686. try
  4687. // signature
  4688. StreamPos := Stream.Position;
  4689. Stream.Read(signature, 8);
  4690. Stream.Position := StreamPos;
  4691. if png_check_sig(@signature, 8) <> 0 then begin
  4692. // png read struct
  4693. png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  4694. if png = nil then
  4695. raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
  4696. // png info
  4697. png_info := png_create_info_struct(png);
  4698. if png_info = nil then begin
  4699. png_destroy_read_struct(@png, nil, nil);
  4700. raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
  4701. end;
  4702. // set read callback
  4703. png_set_read_fn(png, stream, glBitmap_libPNG_read_func);
  4704. // read informations
  4705. png_read_info(png, png_info);
  4706. // size
  4707. TempHeight := png_get_image_height(png, png_info);
  4708. TempWidth := png_get_image_width(png, png_info);
  4709. // format
  4710. case png_get_color_type(png, png_info) of
  4711. PNG_COLOR_TYPE_GRAY:
  4712. Format := tfLuminance8;
  4713. PNG_COLOR_TYPE_GRAY_ALPHA:
  4714. Format := tfLuminance8Alpha8;
  4715. PNG_COLOR_TYPE_RGB:
  4716. Format := tfRGB8;
  4717. PNG_COLOR_TYPE_RGB_ALPHA:
  4718. Format := tfRGBA8;
  4719. else
  4720. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  4721. end;
  4722. // cut upper 8 bit from 16 bit formats
  4723. if png_get_bit_depth(png, png_info) > 8 then
  4724. png_set_strip_16(png);
  4725. // expand bitdepth smaller than 8
  4726. if png_get_bit_depth(png, png_info) < 8 then
  4727. png_set_expand(png);
  4728. // allocating mem for scanlines
  4729. LineSize := png_get_rowbytes(png, png_info);
  4730. GetMem(png_data, TempHeight * LineSize);
  4731. try
  4732. SetLength(png_rows, TempHeight);
  4733. for Row := Low(png_rows) to High(png_rows) do begin
  4734. png_rows[Row] := png_data;
  4735. Inc(png_rows[Row], Row * LineSize);
  4736. end;
  4737. // read complete image into scanlines
  4738. png_read_image(png, @png_rows[0]);
  4739. // read end
  4740. png_read_end(png, png_info);
  4741. // destroy read struct
  4742. png_destroy_read_struct(@png, @png_info, nil);
  4743. SetLength(png_rows, 0);
  4744. // set new data
  4745. SetDataPointer(png_data, Format, TempWidth, TempHeight);
  4746. result := true;
  4747. except
  4748. FreeMem(png_data);
  4749. raise;
  4750. end;
  4751. end;
  4752. finally
  4753. quit_libPNG;
  4754. end;
  4755. end;
  4756. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  4757. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4758. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  4759. var
  4760. StreamPos: Int64;
  4761. Png: TPNGObject;
  4762. Header: Array[0..7] of Byte;
  4763. Row, Col, PixSize, LineSize: Integer;
  4764. NewImage, pSource, pDest, pAlpha: pByte;
  4765. Format: TglBitmapInternalFormat;
  4766. const
  4767. PngHeader: Array[0..7] of Byte = (#137, #80, #78, #71, #13, #10, #26, #10);
  4768. begin
  4769. result := false;
  4770. StreamPos := Stream.Position;
  4771. Stream.Read(Header[0], SizeOf(Header));
  4772. Stream.Position := StreamPos;
  4773. {Test if the header matches}
  4774. if Header = PngHeader then begin
  4775. Png := TPNGObject.Create;
  4776. try
  4777. Png.LoadFromStream(Stream);
  4778. case Png.Header.ColorType of
  4779. COLOR_GRAYSCALE:
  4780. Format := ifLuminance;
  4781. COLOR_GRAYSCALEALPHA:
  4782. Format := ifLuminanceAlpha;
  4783. COLOR_RGB:
  4784. Format := ifBGR8;
  4785. COLOR_RGBALPHA:
  4786. Format := ifBGRA8;
  4787. else
  4788. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  4789. end;
  4790. PixSize := Trunc(FormatGetSize(Format));
  4791. LineSize := Integer(Png.Header.Width) * PixSize;
  4792. GetMem(NewImage, LineSize * Integer(Png.Header.Height));
  4793. try
  4794. pDest := NewImage;
  4795. case Png.Header.ColorType of
  4796. COLOR_RGB, COLOR_GRAYSCALE:
  4797. begin
  4798. for Row := 0 to Png.Height -1 do begin
  4799. Move (Png.Scanline[Row]^, pDest^, LineSize);
  4800. Inc(pDest, LineSize);
  4801. end;
  4802. end;
  4803. COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
  4804. begin
  4805. PixSize := PixSize -1;
  4806. for Row := 0 to Png.Height -1 do begin
  4807. pSource := Png.Scanline[Row];
  4808. pAlpha := pByte(Png.AlphaScanline[Row]);
  4809. for Col := 0 to Png.Width -1 do begin
  4810. Move (pSource^, pDest^, PixSize);
  4811. Inc(pSource, PixSize);
  4812. Inc(pDest, PixSize);
  4813. pDest^ := pAlpha^;
  4814. inc(pAlpha);
  4815. Inc(pDest);
  4816. end;
  4817. end;
  4818. end;
  4819. else
  4820. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  4821. end;
  4822. SetDataPointer(NewImage, Format, Png.Header.Width, Png.Header.Height);
  4823. result := true;
  4824. except
  4825. FreeMem(NewImage);
  4826. raise;
  4827. end;
  4828. finally
  4829. Png.Free;
  4830. end;
  4831. end;
  4832. end;
  4833. {$IFEND}
  4834. {$ENDIF}
  4835. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  4836. {$IFDEF GLB_LIB_PNG}
  4837. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4838. procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  4839. begin
  4840. TStream(png_get_io_ptr(png)).Write(buffer^, size);
  4841. end;
  4842. {$ENDIF}
  4843. {$IF DEFINED(GLB_LIB_PNG)}
  4844. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4845. procedure TglBitmap.SavePNG(const aStream: TStream);
  4846. var
  4847. png: png_structp;
  4848. png_info: png_infop;
  4849. png_rows: array of pByte;
  4850. LineSize: Integer;
  4851. ColorType: Integer;
  4852. Row: Integer;
  4853. begin
  4854. if not (ftPNG in FormatGetSupportedFiles (InternalFormat)) then
  4855. raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
  4856. if not init_libPNG then
  4857. raise Exception.Create('SavePNG - unable to initialize libPNG.');
  4858. try
  4859. case FInternalFormat of
  4860. ifAlpha, ifLuminance, ifDepth8:
  4861. ColorType := PNG_COLOR_TYPE_GRAY;
  4862. ifLuminanceAlpha:
  4863. ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
  4864. ifBGR8, ifRGB8:
  4865. ColorType := PNG_COLOR_TYPE_RGB;
  4866. ifBGRA8, ifRGBA8:
  4867. ColorType := PNG_COLOR_TYPE_RGBA;
  4868. else
  4869. raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
  4870. end;
  4871. LineSize := Trunc(FormatGetSize(FInternalFormat) * Width);
  4872. // creating array for scanline
  4873. SetLength(png_rows, Height);
  4874. try
  4875. for Row := 0 to Height - 1 do begin
  4876. png_rows[Row] := Data;
  4877. Inc(png_rows[Row], Row * LineSize)
  4878. end;
  4879. // write struct
  4880. png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  4881. if png = nil then
  4882. raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
  4883. // create png info
  4884. png_info := png_create_info_struct(png);
  4885. if png_info = nil then begin
  4886. png_destroy_write_struct(@png, nil);
  4887. raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
  4888. end;
  4889. // set read callback
  4890. png_set_write_fn(png, stream, glBitmap_libPNG_write_func, nil);
  4891. // set compression
  4892. png_set_compression_level(png, 6);
  4893. if InternalFormat in [ifBGR8, ifBGRA8] then
  4894. png_set_bgr(png);
  4895. png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
  4896. png_write_info(png, png_info);
  4897. png_write_image(png, @png_rows[0]);
  4898. png_write_end(png, png_info);
  4899. png_destroy_write_struct(@png, @png_info);
  4900. finally
  4901. SetLength(png_rows, 0);
  4902. end;
  4903. finally
  4904. quit_libPNG;
  4905. end;
  4906. end;
  4907. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  4908. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4909. procedure TglBitmap.SavePNG(const aStream: TStream);
  4910. var
  4911. Png: TPNGObject;
  4912. pSource, pDest: pByte;
  4913. X, Y, PixSize: Integer;
  4914. ColorType: Cardinal;
  4915. Alpha: Boolean;
  4916. pTemp: pByte;
  4917. Temp: Byte;
  4918. begin
  4919. if not (ftPNG in FormatGetSupportedFiles (InternalFormat)) then
  4920. raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
  4921. case FInternalFormat of
  4922. ifAlpha, ifLuminance, ifDepth8: begin
  4923. ColorType := COLOR_GRAYSCALE;
  4924. PixSize := 1;
  4925. Alpha := false;
  4926. end;
  4927. ifLuminanceAlpha: begin
  4928. ColorType := COLOR_GRAYSCALEALPHA;
  4929. PixSize := 1;
  4930. Alpha := true;
  4931. end;
  4932. ifBGR8, ifRGB8: begin
  4933. ColorType := COLOR_RGB;
  4934. PixSize := 3;
  4935. Alpha := false;
  4936. end;
  4937. ifBGRA8, ifRGBA8: begin
  4938. ColorType := COLOR_RGBALPHA;
  4939. PixSize := 3;
  4940. Alpha := true
  4941. end;
  4942. else
  4943. raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
  4944. end;
  4945. Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
  4946. try
  4947. // Copy ImageData
  4948. pSource := Data;
  4949. for Y := 0 to Height -1 do begin
  4950. pDest := png.ScanLine[Y];
  4951. for X := 0 to Width -1 do begin
  4952. Move(pSource^, pDest^, PixSize);
  4953. Inc(pDest, PixSize);
  4954. Inc(pSource, PixSize);
  4955. if Alpha then begin
  4956. png.AlphaScanline[Y]^[X] := pSource^;
  4957. Inc(pSource);
  4958. end;
  4959. end;
  4960. // convert RGB line to BGR
  4961. if InternalFormat in [ifRGB8, ifRGBA8] then begin
  4962. pTemp := png.ScanLine[Y];
  4963. for X := 0 to Width -1 do begin
  4964. Temp := pByteArray(pTemp)^[0];
  4965. pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
  4966. pByteArray(pTemp)^[2] := Temp;
  4967. Inc(pTemp, 3);
  4968. end;
  4969. end;
  4970. end;
  4971. // Save to Stream
  4972. Png.CompressionLevel := 6;
  4973. Png.SaveToStream(Stream);
  4974. finally
  4975. FreeAndNil(Png);
  4976. end;
  4977. end;
  4978. {$IFEND}
  4979. {$ENDIF}
  4980. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4981. //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4982. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4983. {$IFDEF GLB_LIB_JPEG}
  4984. type
  4985. glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
  4986. glBitmap_libJPEG_source_mgr = record
  4987. pub: jpeg_source_mgr;
  4988. SrcStream: TStream;
  4989. SrcBuffer: array [1..4096] of byte;
  4990. end;
  4991. glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
  4992. glBitmap_libJPEG_dest_mgr = record
  4993. pub: jpeg_destination_mgr;
  4994. DestStream: TStream;
  4995. DestBuffer: array [1..4096] of byte;
  4996. end;
  4997. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4998. {
  4999. procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
  5000. var
  5001. Msg: String;
  5002. begin
  5003. SetLength(Msg, 256);
  5004. cinfo^.err^.format_message(cinfo, pChar(Msg));
  5005. Writeln('ERROR [' + IntToStr(cinfo^.err^.msg_code) + '] ' + Msg);
  5006. cinfo^.global_state := 0;
  5007. jpeg_abort(cinfo);
  5008. end;
  5009. }
  5010. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5011. {
  5012. procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
  5013. var
  5014. Msg: String;
  5015. begin
  5016. SetLength(Msg, 256);
  5017. cinfo^.err^.format_message(cinfo, pChar(Msg));
  5018. Writeln('OUTPUT [' + IntToStr(cinfo^.err^.msg_code) + '] ' + Msg);
  5019. cinfo^.global_state := 0;
  5020. end;
  5021. }
  5022. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5023. {
  5024. procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
  5025. begin
  5026. end;
  5027. }
  5028. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5029. function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
  5030. var
  5031. src: glBitmap_libJPEG_source_mgr_ptr;
  5032. bytes: integer;
  5033. begin
  5034. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  5035. bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
  5036. if (bytes <= 0) then begin
  5037. src^.SrcBuffer[1] := $FF;
  5038. src^.SrcBuffer[2] := JPEG_EOI;
  5039. bytes := 2;
  5040. end;
  5041. src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
  5042. src^.pub.bytes_in_buffer := bytes;
  5043. result := true;
  5044. end;
  5045. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5046. procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
  5047. var
  5048. src: glBitmap_libJPEG_source_mgr_ptr;
  5049. begin
  5050. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  5051. if num_bytes > 0 then begin
  5052. // wanted byte isn't in buffer so set stream position and read buffer
  5053. if num_bytes > src^.pub.bytes_in_buffer then begin
  5054. src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
  5055. src^.pub.fill_input_buffer(cinfo);
  5056. end else begin
  5057. // wanted byte is in buffer so only skip
  5058. inc(src^.pub.next_input_byte, num_bytes);
  5059. dec(src^.pub.bytes_in_buffer, num_bytes);
  5060. end;
  5061. end;
  5062. end;
  5063. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5064. {
  5065. procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
  5066. begin
  5067. end;
  5068. }
  5069. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5070. {
  5071. procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
  5072. begin
  5073. end;
  5074. }
  5075. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5076. function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
  5077. var
  5078. dest: glBitmap_libJPEG_dest_mgr_ptr;
  5079. begin
  5080. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  5081. if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
  5082. // write complete buffer
  5083. dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
  5084. // reset buffer
  5085. dest^.pub.next_output_byte := @dest^.DestBuffer[1];
  5086. dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
  5087. end;
  5088. result := true;
  5089. end;
  5090. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5091. procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
  5092. var
  5093. Idx: Integer;
  5094. dest: glBitmap_libJPEG_dest_mgr_ptr;
  5095. begin
  5096. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  5097. for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
  5098. // check for endblock
  5099. if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
  5100. // write endblock
  5101. dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
  5102. // leave
  5103. break;
  5104. end else
  5105. dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
  5106. end;
  5107. end;
  5108. {$ENDIF}
  5109. {$IFDEF GLB_SUPPORT_JPEG_READ}
  5110. {$IF DEFINED(GLB_SDL_IMAGE)}
  5111. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5112. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5113. var
  5114. Surface: PSDL_Surface;
  5115. RWops: PSDL_RWops;
  5116. begin
  5117. result := false;
  5118. RWops := glBitmapCreateRWops(Stream);
  5119. try
  5120. if IMG_isJPG(RWops) > 0 then begin
  5121. Surface := IMG_LoadJPG_RW(RWops);
  5122. try
  5123. AssignFromSurface(Surface);
  5124. result := true;
  5125. finally
  5126. SDL_FreeSurface(Surface);
  5127. end;
  5128. end;
  5129. finally
  5130. SDL_FreeRW(RWops);
  5131. end;
  5132. end;
  5133. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  5134. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5135. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5136. var
  5137. StreamPos: Int64;
  5138. Temp: array[0..1]of Byte;
  5139. jpeg: jpeg_decompress_struct;
  5140. jpeg_err: jpeg_error_mgr;
  5141. IntFormat: TglBitmapInternalFormat;
  5142. pImage: pByte;
  5143. TempHeight, TempWidth: Integer;
  5144. pTemp: pByte;
  5145. Row: Integer;
  5146. begin
  5147. result := false;
  5148. if not init_libJPEG then
  5149. raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
  5150. try
  5151. // reading first two bytes to test file and set cursor back to begin
  5152. StreamPos := Stream.Position;
  5153. Stream.Read(Temp[0], 2);
  5154. Stream.Position := StreamPos;
  5155. // if Bitmap then read file.
  5156. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  5157. FillChar(jpeg, SizeOf(jpeg_decompress_struct), $00);
  5158. FillChar(jpeg_err, SizeOf(jpeg_error_mgr), $00);
  5159. // error managment
  5160. jpeg.err := jpeg_std_error(@jpeg_err);
  5161. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  5162. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  5163. // decompression struct
  5164. jpeg_create_decompress(@jpeg);
  5165. // allocation space for streaming methods
  5166. jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
  5167. // seeting up custom functions
  5168. with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
  5169. pub.init_source := glBitmap_libJPEG_init_source;
  5170. pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
  5171. pub.skip_input_data := glBitmap_libJPEG_skip_input_data;
  5172. pub.resync_to_restart := jpeg_resync_to_restart; // use default method
  5173. pub.term_source := glBitmap_libJPEG_term_source;
  5174. pub.bytes_in_buffer := 0; // forces fill_input_buffer on first read
  5175. pub.next_input_byte := nil; // until buffer loaded
  5176. SrcStream := Stream;
  5177. end;
  5178. // set global decoding state
  5179. jpeg.global_state := DSTATE_START;
  5180. // read header of jpeg
  5181. jpeg_read_header(@jpeg, false);
  5182. // setting output parameter
  5183. case jpeg.jpeg_color_space of
  5184. JCS_GRAYSCALE:
  5185. begin
  5186. jpeg.out_color_space := JCS_GRAYSCALE;
  5187. IntFormat := ifLuminance;
  5188. end;
  5189. else
  5190. jpeg.out_color_space := JCS_RGB;
  5191. IntFormat := ifRGB8;
  5192. end;
  5193. // reading image
  5194. jpeg_start_decompress(@jpeg);
  5195. TempHeight := jpeg.output_height;
  5196. TempWidth := jpeg.output_width;
  5197. // creating new image
  5198. GetMem(pImage, FormatGetImageSize(glBitmapPosition(TempWidth, TempHeight), IntFormat));
  5199. try
  5200. pTemp := pImage;
  5201. for Row := 0 to TempHeight -1 do begin
  5202. jpeg_read_scanlines(@jpeg, @pTemp, 1);
  5203. Inc(pTemp, Trunc(FormatGetSize(IntFormat) * TempWidth));
  5204. end;
  5205. // finish decompression
  5206. jpeg_finish_decompress(@jpeg);
  5207. // destroy decompression
  5208. jpeg_destroy_decompress(@jpeg);
  5209. SetDataPointer(pImage, IntFormat, TempWidth, TempHeight);
  5210. result := true;
  5211. except
  5212. FreeMem(pImage);
  5213. raise;
  5214. end;
  5215. end;
  5216. finally
  5217. quit_libJPEG;
  5218. end;
  5219. end;
  5220. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  5221. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5222. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5223. var
  5224. bmp: TBitmap;
  5225. jpg: TJPEGImage;
  5226. StreamPos: Int64;
  5227. Temp: array[0..1]of Byte;
  5228. begin
  5229. result := false;
  5230. // reading first two bytes to test file and set cursor back to begin
  5231. StreamPos := Stream.Position;
  5232. Stream.Read(Temp[0], 2);
  5233. Stream.Position := StreamPos;
  5234. // if Bitmap then read file.
  5235. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  5236. bmp := TBitmap.Create;
  5237. try
  5238. jpg := TJPEGImage.Create;
  5239. try
  5240. jpg.LoadFromStream(Stream);
  5241. bmp.Assign(jpg);
  5242. result := AssignFromBitmap(bmp);
  5243. finally
  5244. jpg.Free;
  5245. end;
  5246. finally
  5247. bmp.Free;
  5248. end;
  5249. end;
  5250. end;
  5251. {$IFEND}
  5252. {$ENDIF}
  5253. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  5254. {$IF DEFEFINED(GLB_LIB_JPEG)}
  5255. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5256. procedure TglBitmap.SaveJPEG(Stream: TStream);
  5257. var
  5258. jpeg: jpeg_compress_struct;
  5259. jpeg_err: jpeg_error_mgr;
  5260. Row: Integer;
  5261. pTemp, pTemp2: pByte;
  5262. procedure CopyRow(pDest, pSource: pByte);
  5263. var
  5264. X: Integer;
  5265. begin
  5266. for X := 0 to Width - 1 do begin
  5267. pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
  5268. pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
  5269. pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
  5270. Inc(pDest, 3);
  5271. Inc(pSource, 3);
  5272. end;
  5273. end;
  5274. begin
  5275. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  5276. raise EglBitmapUnsupportedInternalFormat.Create('SaveJpg - ' + UNSUPPORTED_INTERNAL_FORMAT);
  5277. if not init_libJPEG then
  5278. raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
  5279. try
  5280. FillChar(jpeg, SizeOf(jpeg_compress_struct), $00);
  5281. FillChar(jpeg_err, SizeOf(jpeg_error_mgr), $00);
  5282. // error managment
  5283. jpeg.err := jpeg_std_error(@jpeg_err);
  5284. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  5285. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  5286. // compression struct
  5287. jpeg_create_compress(@jpeg);
  5288. // allocation space for streaming methods
  5289. jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
  5290. // seeting up custom functions
  5291. with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
  5292. pub.init_destination := glBitmap_libJPEG_init_destination;
  5293. pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
  5294. pub.term_destination := glBitmap_libJPEG_term_destination;
  5295. pub.next_output_byte := @DestBuffer[1];
  5296. pub.free_in_buffer := Length(DestBuffer);
  5297. DestStream := Stream;
  5298. end;
  5299. // very important state
  5300. jpeg.global_state := CSTATE_START;
  5301. jpeg.image_width := Width;
  5302. jpeg.image_height := Height;
  5303. case InternalFormat of
  5304. ifAlpha, ifLuminance, ifDepth8: begin
  5305. jpeg.input_components := 1;
  5306. jpeg.in_color_space := JCS_GRAYSCALE;
  5307. end;
  5308. ifRGB8, ifBGR8: begin
  5309. jpeg.input_components := 3;
  5310. jpeg.in_color_space := JCS_RGB;
  5311. end;
  5312. end;
  5313. jpeg_set_defaults(@jpeg);
  5314. jpeg_set_quality(@jpeg, 95, true);
  5315. jpeg_start_compress(@jpeg, true);
  5316. pTemp := Data;
  5317. if InternalFormat = ifBGR8 then
  5318. GetMem(pTemp2, fRowSize)
  5319. else
  5320. pTemp2 := pTemp;
  5321. try
  5322. for Row := 0 to jpeg.image_height -1 do begin
  5323. // prepare row
  5324. if InternalFormat = ifBGR8 then
  5325. CopyRow(pTemp2, pTemp)
  5326. else
  5327. pTemp2 := pTemp;
  5328. // write row
  5329. jpeg_write_scanlines(@jpeg, @pTemp2, 1);
  5330. inc(pTemp, fRowSize);
  5331. end;
  5332. finally
  5333. // free memory
  5334. if InternalFormat = ifBGR8 then
  5335. FreeMem(pTemp2);
  5336. end;
  5337. jpeg_finish_compress(@jpeg);
  5338. jpeg_destroy_compress(@jpeg);
  5339. finally
  5340. quit_libJPEG;
  5341. end;
  5342. end;
  5343. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  5344. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5345. procedure TglBitmap.SaveJPEG(Stream: TStream);
  5346. var
  5347. Bmp: TBitmap;
  5348. Jpg: TJPEGImage;
  5349. begin
  5350. if not (ftJPEG in FormatGetSupportedFiles (InternalFormat)) then
  5351. raise EglBitmapUnsupportedInternalFormat.Create('SaveJpg - ' + UNSUPPORTED_INTERNAL_FORMAT);
  5352. Bmp := TBitmap.Create;
  5353. try
  5354. Jpg := TJPEGImage.Create;
  5355. try
  5356. AssignToBitmap(Bmp);
  5357. if FInternalFormat in [ifAlpha, ifLuminance, ifDepth8] then begin
  5358. Jpg.Grayscale := true;
  5359. Jpg.PixelFormat := jf8Bit;
  5360. end;
  5361. Jpg.Assign(Bmp);
  5362. Jpg.SaveToStream(Stream);
  5363. finally
  5364. FreeAndNil(Jpg);
  5365. end;
  5366. finally
  5367. FreeAndNil(Bmp);
  5368. end;
  5369. end;
  5370. {$ENDIF}
  5371. {$ENDIF}
  5372. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5373. //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5374. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5375. const
  5376. BMP_MAGIC = $4D42;
  5377. BMP_COMP_RGB = 0;
  5378. BMP_COMP_RLE8 = 1;
  5379. BMP_COMP_RLE4 = 2;
  5380. BMP_COMP_BITFIELDS = 3;
  5381. type
  5382. TBMPHeader = packed record
  5383. bfType: Word;
  5384. bfSize: Cardinal;
  5385. bfReserved1: Word;
  5386. bfReserved2: Word;
  5387. bfOffBits: Cardinal;
  5388. end;
  5389. TBMPInfo = packed record
  5390. biSize: Cardinal;
  5391. biWidth: Longint;
  5392. biHeight: Longint;
  5393. biPlanes: Word;
  5394. biBitCount: Word;
  5395. biCompression: Cardinal;
  5396. biSizeImage: Cardinal;
  5397. biXPelsPerMeter: Longint;
  5398. biYPelsPerMeter: Longint;
  5399. biClrUsed: Cardinal;
  5400. biClrImportant: Cardinal;
  5401. end;
  5402. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5403. function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
  5404. //////////////////////////////////////////////////////////////////////////////////////////////////
  5405. function ReadInfo(var aInfo: TBMPInfo; var aMask: TglBitmapColorRec): TglBitmapFormat;
  5406. begin
  5407. result := tfEmpty;
  5408. aStream.Read(aInfo, SizeOf(aInfo));
  5409. FillChar(aMask, SizeOf(aMask), 0);
  5410. //Read Compression
  5411. case aInfo.biCompression of
  5412. BMP_COMP_RLE4,
  5413. BMP_COMP_RLE8: begin
  5414. raise EglBitmapException.Create('RLE compression is not supported');
  5415. end;
  5416. BMP_COMP_BITFIELDS: begin
  5417. if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
  5418. aStream.Read(aMask.r, SizeOf(aMask.r));
  5419. aStream.Read(aMask.g, SizeOf(aMask.g));
  5420. aStream.Read(aMask.b, SizeOf(aMask.b));
  5421. aStream.Read(aMask.a, SizeOf(aMask.a));
  5422. end else
  5423. raise EglBitmapException.Create('Bitfields are only supported for 16bit and 32bit formats');
  5424. end;
  5425. end;
  5426. //get suitable format
  5427. case aInfo.biBitCount of
  5428. 8: result := tfLuminance8;
  5429. 16: result := tfBGR5;
  5430. 24: result := tfBGR8;
  5431. 32: result := tfBGRA8;
  5432. end;
  5433. end;
  5434. function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
  5435. var
  5436. i, c: Integer;
  5437. ColorTable: TbmpColorTable;
  5438. begin
  5439. result := nil;
  5440. if (aInfo.biBitCount >= 16) then
  5441. exit;
  5442. aFormat := tfLuminance8;
  5443. c := aInfo.biClrUsed;
  5444. if (c = 0) then
  5445. c := 1 shl aInfo.biBitCount;
  5446. SetLength(ColorTable, c);
  5447. for i := 0 to c-1 do begin
  5448. aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
  5449. if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
  5450. aFormat := tfRGB8;
  5451. end;
  5452. result := TbmpColorTableFormat.Create;
  5453. result.PixelSize := aInfo.biBitCount / 8;
  5454. result.ColorTable := ColorTable;
  5455. result.Range := glBitmapColorRec($FF, $FF, $FF, $00);
  5456. end;
  5457. //////////////////////////////////////////////////////////////////////////////////////////////////
  5458. function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
  5459. const aInfo: TBMPInfo): TbmpBitfieldFormat;
  5460. var
  5461. TmpFormat: TglBitmapFormat;
  5462. FormatDesc: TFormatDescriptor;
  5463. begin
  5464. result := nil;
  5465. if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
  5466. for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  5467. FormatDesc := TFormatDescriptor.Get(TmpFormat);
  5468. if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
  5469. aFormat := FormatDesc.Format;
  5470. exit;
  5471. end;
  5472. end;
  5473. if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
  5474. aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
  5475. if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
  5476. aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
  5477. result := TbmpBitfieldFormat.Create;
  5478. result.PixelSize := aInfo.biBitCount / 8;
  5479. result.RedMask := aMask.r;
  5480. result.GreenMask := aMask.g;
  5481. result.BlueMask := aMask.b;
  5482. result.AlphaMask := aMask.a;
  5483. end;
  5484. end;
  5485. var
  5486. //simple types
  5487. StartPos: Int64;
  5488. ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
  5489. PaddingBuff: Cardinal;
  5490. LineBuf, ImageData, TmpData: PByte;
  5491. SourceMD, DestMD: Pointer;
  5492. BmpFormat: TglBitmapFormat;
  5493. ColorTable: TbmpColorTable;
  5494. //records
  5495. Mask: TglBitmapColorRec;
  5496. Header: TBMPHeader;
  5497. Info: TBMPInfo;
  5498. //classes
  5499. SpecialFormat: TFormatDescriptor;
  5500. FormatDesc: TFormatDescriptor;
  5501. //////////////////////////////////////////////////////////////////////////////////////////////////
  5502. procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
  5503. var
  5504. i, j: Integer;
  5505. Pixel: TglBitmapPixelData;
  5506. begin
  5507. aStream.Read(aLineBuf^, rbLineSize);
  5508. SpecialFormat.PreparePixel(Pixel);
  5509. for i := 0 to Info.biWidth-1 do begin
  5510. SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
  5511. with FormatDesc do begin
  5512. //TODO: use convert function
  5513. for j := 0 to 3 do
  5514. if (SpecialFormat.Range.arr[j] <> Range.arr[j]) then begin
  5515. if (SpecialFormat.Range.arr[j] > 0) then
  5516. Pixel.Data.arr[j] := Round(Pixel.Data.arr[j] / SpecialFormat.Range.arr[j] * Range.arr[j])
  5517. else
  5518. Pixel.Data.arr[j] := 0;
  5519. end;
  5520. end;
  5521. FormatDesc.Map(Pixel, aData, DestMD);
  5522. end;
  5523. end;
  5524. begin
  5525. result := false;
  5526. BmpFormat := tfEmpty;
  5527. SpecialFormat := nil;
  5528. LineBuf := nil;
  5529. SourceMD := nil;
  5530. DestMD := nil;
  5531. // Header
  5532. StartPos := aStream.Position;
  5533. aStream.Read(Header, SizeOf(Header));
  5534. if Header.bfType = BMP_MAGIC then begin
  5535. try try
  5536. BmpFormat := ReadInfo(Info, Mask);
  5537. SpecialFormat := ReadColorTable(BmpFormat, Info);
  5538. if not Assigned(SpecialFormat) then
  5539. SpecialFormat := CheckBitfields(BmpFormat, Mask, Info);
  5540. aStream.Position := StartPos + Header.bfOffBits;
  5541. if (BmpFormat <> tfEmpty) then begin
  5542. FormatDesc := TFormatDescriptor.Get(BmpFormat);
  5543. rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
  5544. wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
  5545. Padding := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
  5546. //get Memory
  5547. DestMD := FormatDesc.CreateMappingData;
  5548. ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
  5549. GetMem(ImageData, ImageSize);
  5550. if Assigned(SpecialFormat) then begin
  5551. GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
  5552. SourceMD := SpecialFormat.CreateMappingData;
  5553. end;
  5554. //read Data
  5555. try try
  5556. FillChar(ImageData^, ImageSize, $FF);
  5557. TmpData := ImageData;
  5558. if (Info.biHeight > 0) then
  5559. Inc(TmpData, wbLineSize * (Info.biHeight-1));
  5560. for i := 0 to Abs(Info.biHeight)-1 do begin
  5561. if Assigned(SpecialFormat) then
  5562. SpecialFormatReadLine(TmpData, LineBuf) //if is special format read and convert data
  5563. else
  5564. aStream.Read(TmpData^, wbLineSize); //else only read data
  5565. if (Info.biHeight > 0) then
  5566. dec(TmpData, wbLineSize)
  5567. else
  5568. inc(TmpData, wbLineSize);
  5569. aStream.Read(PaddingBuff, Padding);
  5570. end;
  5571. SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight));
  5572. result := true;
  5573. finally
  5574. if Assigned(LineBuf) then
  5575. FreeMem(LineBuf);
  5576. if Assigned(SourceMD) then
  5577. SpecialFormat.FreeMappingData(SourceMD);
  5578. FormatDesc.FreeMappingData(DestMD);
  5579. end;
  5580. except
  5581. FreeMem(ImageData);
  5582. raise;
  5583. end;
  5584. end else
  5585. raise EglBitmapException.Create('LoadBMP - No suitable format found');
  5586. except
  5587. aStream.Position := StartPos;
  5588. raise;
  5589. end;
  5590. finally
  5591. FreeAndNil(SpecialFormat);
  5592. end;
  5593. end
  5594. else aStream.Position := StartPos;
  5595. end;
  5596. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5597. procedure TglBitmap.SaveBMP(const aStream: TStream);
  5598. var
  5599. Header: TBMPHeader;
  5600. Info: TBMPInfo;
  5601. Converter: TbmpColorTableFormat;
  5602. FormatDesc: TFormatDescriptor;
  5603. SourceFD, DestFD: Pointer;
  5604. pData, srcData, dstData, ConvertBuffer: pByte;
  5605. Pixel: TglBitmapPixelData;
  5606. PixelFormat: TglBitmapPixelData;
  5607. ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx, i: Integer;
  5608. RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
  5609. PaddingBuff: Cardinal;
  5610. function GetLineWidth : Integer;
  5611. begin
  5612. result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
  5613. end;
  5614. begin
  5615. if not (ftBMP in FormatGetSupportedFiles(Format)) then
  5616. raise EglBitmapUnsupportedFormatFormat.Create('SaveBMP - ' + UNSUPPORTED_FORMAT);
  5617. Converter := nil;
  5618. FormatDesc := TFormatDescriptor.Get(Format);
  5619. ImageSize := FormatDesc.GetSize(Dimension);
  5620. FillChar(Header, SizeOf(Header), 0);
  5621. Header.bfType := BMP_MAGIC;
  5622. Header.bfSize := SizeOf(Header) + SizeOf(Info) + ImageSize;
  5623. Header.bfReserved1 := 0;
  5624. Header.bfReserved2 := 0;
  5625. Header.bfOffBits := SizeOf(Header) + SizeOf(Info);
  5626. FillChar(Info, SizeOf(Info), 0);
  5627. Info.biSize := SizeOf(Info);
  5628. Info.biWidth := Width;
  5629. Info.biHeight := Height;
  5630. Info.biPlanes := 1;
  5631. Info.biCompression := BMP_COMP_RGB;
  5632. Info.biSizeImage := ImageSize;
  5633. try
  5634. case Format of
  5635. tfLuminance4: begin
  5636. Info.biBitCount := 4;
  5637. Header.bfSize := Header.bfSize + 16 * SizeOf(Cardinal);
  5638. Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
  5639. Converter := TbmpColorTableFormat.Create;
  5640. Converter.PixelSize := 0.5;
  5641. Converter.Format := Format;
  5642. Converter.Range := glBitmapColorRec($F, $F, $F, $0);
  5643. Converter.CreateColorTable;
  5644. end;
  5645. tfR3G3B2, tfLuminance8: begin
  5646. Info.biBitCount := 8;
  5647. Header.bfSize := Header.bfSize + 256 * SizeOf(Cardinal);
  5648. Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
  5649. Converter := TbmpColorTableFormat.Create;
  5650. Converter.PixelSize := 1;
  5651. Converter.Format := Format;
  5652. if (Format = tfR3G3B2) then begin
  5653. Converter.Range := glBitmapColorRec($7, $7, $3, $0);
  5654. Converter.Shift := glBitmapShiftRec(0, 3, 6, 0);
  5655. end else
  5656. Converter.Range := glBitmapColorRec($FF, $FF, $FF, $0);
  5657. Converter.CreateColorTable;
  5658. end;
  5659. tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
  5660. tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin
  5661. Info.biBitCount := 16;
  5662. Info.biCompression := BMP_COMP_BITFIELDS;
  5663. end;
  5664. tfBGR8, tfRGB8: begin
  5665. Info.biBitCount := 24;
  5666. end;
  5667. tfRGB10, tfRGB10A2, tfRGBA8,
  5668. tfBGR10, tfBGR10A2, tfBGRA8: begin
  5669. Info.biBitCount := 32;
  5670. Info.biCompression := BMP_COMP_BITFIELDS;
  5671. end;
  5672. else
  5673. raise EglBitmapUnsupportedFormatFormat.Create('SaveBMP - ' + UNSUPPORTED_FORMAT);
  5674. end;
  5675. Info.biXPelsPerMeter := 2835;
  5676. Info.biYPelsPerMeter := 2835;
  5677. // prepare bitmasks
  5678. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  5679. Header.bfSize := Header.bfSize + 4 * SizeOf(Cardinal);
  5680. Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
  5681. RedMask := FormatDesc.RedMask;
  5682. GreenMask := FormatDesc.GreenMask;
  5683. BlueMask := FormatDesc.BlueMask;
  5684. AlphaMask := FormatDesc.AlphaMask;
  5685. end;
  5686. // headers
  5687. aStream.Write(Header, SizeOf(Header));
  5688. aStream.Write(Info, SizeOf(Info));
  5689. // colortable
  5690. if Assigned(Converter) then
  5691. aStream.Write(Converter.ColorTable[0].b,
  5692. SizeOf(TbmpColorTableEnty) * Length(Converter.ColorTable));
  5693. // bitmasks
  5694. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  5695. aStream.Write(RedMask, SizeOf(Cardinal));
  5696. aStream.Write(GreenMask, SizeOf(Cardinal));
  5697. aStream.Write(BlueMask, SizeOf(Cardinal));
  5698. aStream.Write(AlphaMask, SizeOf(Cardinal));
  5699. end;
  5700. // image data
  5701. rbLineSize := Round(Info.biWidth * FormatDesc.PixelSize);
  5702. wbLineSize := Round(Info.biWidth * Info.biBitCount / 8);
  5703. Padding := GetLineWidth - wbLineSize;
  5704. PaddingBuff := 0;
  5705. pData := Data;
  5706. inc(pData, (Height-1) * rbLineSize);
  5707. // prepare row buffer. But only for RGB because RGBA supports color masks
  5708. // so it's possible to change color within the image.
  5709. if Assigned(Converter) then begin
  5710. FormatDesc.PreparePixel(Pixel);
  5711. GetMem(ConvertBuffer, wbLineSize);
  5712. SourceFD := FormatDesc.CreateMappingData;
  5713. DestFD := Converter.CreateMappingData;
  5714. end else
  5715. ConvertBuffer := nil;
  5716. try
  5717. for LineIdx := 0 to Height - 1 do begin
  5718. // preparing row
  5719. if Assigned(Converter) then begin
  5720. srcData := pData;
  5721. dstData := ConvertBuffer;
  5722. for PixelIdx := 0 to Info.biWidth-1 do begin
  5723. FormatDesc.Unmap(srcData, Pixel, SourceFD);
  5724. with FormatDesc do begin
  5725. //TODO use convert function
  5726. for i := 0 to 3 do
  5727. if (Converter.Range.arr[i] <> Range.arr[i]) then begin
  5728. if (Range.arr[i] > 0) then
  5729. Pixel.Data.arr[i] := Round(Pixel.Data.arr[i] / Range.arr[i] * Converter.Range.arr[i])
  5730. else
  5731. Pixel.Data.arr[i] := 0;
  5732. end;
  5733. end;
  5734. Converter.Map(Pixel, dstData, DestFD);
  5735. end;
  5736. aStream.Write(ConvertBuffer^, wbLineSize);
  5737. end else begin
  5738. aStream.Write(pData^, rbLineSize);
  5739. end;
  5740. dec(pData, rbLineSize);
  5741. if (Padding > 0) then
  5742. aStream.Write(PaddingBuff, Padding);
  5743. end;
  5744. finally
  5745. // destroy row buffer
  5746. if Assigned(ConvertBuffer) then begin
  5747. FormatDesc.FreeMappingData(SourceFD);
  5748. Converter.FreeMappingData(DestFD);
  5749. FreeMem(ConvertBuffer);
  5750. end;
  5751. end;
  5752. finally
  5753. if Assigned(Converter) then
  5754. Converter.Free;
  5755. end;
  5756. end;
  5757. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5758. //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5759. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5760. type
  5761. TTGAHeader = packed record
  5762. ImageID: Byte;
  5763. ColorMapType: Byte;
  5764. ImageType: Byte;
  5765. //ColorMapSpec: Array[0..4] of Byte;
  5766. ColorMapStart: Word;
  5767. ColorMapLength: Word;
  5768. ColorMapEntrySize: Byte;
  5769. OrigX: Word;
  5770. OrigY: Word;
  5771. Width: Word;
  5772. Height: Word;
  5773. Bpp: Byte;
  5774. ImageDesc: Byte;
  5775. end;
  5776. const
  5777. TGA_UNCOMPRESSED_COLOR_TABLE = 1;
  5778. TGA_UNCOMPRESSED_RGB = 2;
  5779. TGA_UNCOMPRESSED_GRAY = 3;
  5780. TGA_COMPRESSED_COLOR_TABLE = 9;
  5781. TGA_COMPRESSED_RGB = 10;
  5782. TGA_COMPRESSED_GRAY = 11;
  5783. TGA_NONE_COLOR_TABLE = 0;
  5784. TGA_COLOR_TABLE = 1;
  5785. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5786. function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
  5787. var
  5788. Header: TTGAHeader;
  5789. ImageData: PByte;
  5790. StartPosition: Int64;
  5791. PixelSize, LineSize: Integer;
  5792. tgaFormat: TglBitmapFormat;
  5793. FormatDesc: TFormatDescriptor;
  5794. Counter: packed record
  5795. X, Y: packed record
  5796. low, high, dir: Integer;
  5797. end;
  5798. end;
  5799. const
  5800. CACHE_SIZE = $4000;
  5801. ////////////////////////////////////////////////////////////////////////////////////////
  5802. procedure ReadUncompressed;
  5803. var
  5804. i, j: Integer;
  5805. buf, tmp1, tmp2: PByte;
  5806. begin
  5807. buf := nil;
  5808. if (Counter.X.dir < 0) then
  5809. buf := GetMem(LineSize);
  5810. try
  5811. while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
  5812. tmp1 := ImageData + (Counter.Y.low * LineSize); //pointer to LineStart
  5813. if (Counter.X.dir < 0) then begin //flip X
  5814. aStream.Read(buf^, LineSize);
  5815. tmp2 := buf + LineSize - PixelSize; //pointer to last pixel in line
  5816. for i := 0 to Header.Width-1 do begin //for all pixels in line
  5817. for j := 0 to PixelSize-1 do begin //for all bytes in pixel
  5818. tmp1^ := tmp2^;
  5819. inc(tmp1);
  5820. inc(tmp2);
  5821. end;
  5822. dec(tmp2, 2*PixelSize); //move 2 backwards, because j-loop moved 1 forward
  5823. end;
  5824. end else
  5825. aStream.Read(tmp1^, LineSize);
  5826. inc(Counter.Y.low, Counter.Y.dir); //move to next line index
  5827. end;
  5828. finally
  5829. if Assigned(buf) then
  5830. FreeMem(buf);
  5831. end;
  5832. end;
  5833. ////////////////////////////////////////////////////////////////////////////////////////
  5834. procedure ReadCompressed;
  5835. /////////////////////////////////////////////////////////////////
  5836. var
  5837. TmpData: PByte;
  5838. LinePixelsRead: Integer;
  5839. procedure CheckLine;
  5840. begin
  5841. if (LinePixelsRead >= Header.Width) then begin
  5842. LinePixelsRead := 0;
  5843. inc(Counter.Y.low, Counter.Y.dir); //next line index
  5844. TmpData := ImageData + Counter.Y.low * LineSize; //set line
  5845. if (Counter.X.dir < 0) then //if x flipped then
  5846. TmpData := TmpData + LineSize - PixelSize; //set last pixel
  5847. end;
  5848. end;
  5849. /////////////////////////////////////////////////////////////////
  5850. var
  5851. Cache: PByte;
  5852. CacheSize, CachePos: Integer;
  5853. procedure CachedRead(out Buffer; Count: Integer);
  5854. var
  5855. BytesRead: Integer;
  5856. begin
  5857. if (CachePos + Count > CacheSize) then begin
  5858. //if buffer overflow save non read bytes
  5859. BytesRead := 0;
  5860. if (CacheSize - CachePos > 0) then begin
  5861. BytesRead := CacheSize - CachePos;
  5862. Move(PByteArray(Cache)^[CachePos], Buffer, BytesRead);
  5863. inc(CachePos, BytesRead);
  5864. end;
  5865. //load cache from file
  5866. CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
  5867. aStream.Read(Cache^, CacheSize);
  5868. CachePos := 0;
  5869. //read rest of requested bytes
  5870. if (Count - BytesRead > 0) then begin
  5871. Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
  5872. inc(CachePos, Count - BytesRead);
  5873. end;
  5874. end else begin
  5875. //if no buffer overflow just read the data
  5876. Move(PByteArray(Cache)^[CachePos], Buffer, Count);
  5877. inc(CachePos, Count);
  5878. end;
  5879. end;
  5880. procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
  5881. begin
  5882. case PixelSize of
  5883. 1: begin
  5884. aBuffer^ := aData^;
  5885. inc(aBuffer, Counter.X.dir);
  5886. end;
  5887. 2: begin
  5888. PWord(aBuffer)^ := PWord(aData)^;
  5889. inc(aBuffer, 2 * Counter.X.dir);
  5890. end;
  5891. 3: begin
  5892. PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
  5893. PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
  5894. PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
  5895. inc(aBuffer, 3 * Counter.X.dir);
  5896. end;
  5897. 4: begin
  5898. PCardinal(aBuffer)^ := PCardinal(aData)^;
  5899. inc(aBuffer, 4 * Counter.X.dir);
  5900. end;
  5901. end;
  5902. end;
  5903. var
  5904. TotalPixelsToRead, TotalPixelsRead: Integer;
  5905. Temp: Byte;
  5906. buf: array [0..3] of Byte; //1 pixel is max 32bit long
  5907. PixelRepeat: Boolean;
  5908. PixelsToRead, PixelCount: Integer;
  5909. begin
  5910. CacheSize := 0;
  5911. CachePos := 0;
  5912. TotalPixelsToRead := Header.Width * Header.Height;
  5913. TotalPixelsRead := 0;
  5914. LinePixelsRead := 0;
  5915. GetMem(Cache, CACHE_SIZE);
  5916. try
  5917. TmpData := ImageData + Counter.Y.low * LineSize; //set line
  5918. if (Counter.X.dir < 0) then //if x flipped then
  5919. TmpData := TmpData + LineSize - PixelSize; //set last pixel
  5920. repeat
  5921. //read CommandByte
  5922. CachedRead(Temp, 1);
  5923. PixelRepeat := (Temp and $80) > 0;
  5924. PixelsToRead := (Temp and $7F) + 1;
  5925. inc(TotalPixelsRead, PixelsToRead);
  5926. if PixelRepeat then
  5927. CachedRead(buf[0], PixelSize);
  5928. while (PixelsToRead > 0) do begin
  5929. CheckLine;
  5930. PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
  5931. while (PixelCount > 0) do begin
  5932. if not PixelRepeat then
  5933. CachedRead(buf[0], PixelSize);
  5934. PixelToBuffer(@buf[0], TmpData);
  5935. inc(LinePixelsRead);
  5936. dec(PixelsToRead);
  5937. dec(PixelCount);
  5938. end;
  5939. end;
  5940. until (TotalPixelsRead >= TotalPixelsToRead);
  5941. finally
  5942. FreeMem(Cache);
  5943. end;
  5944. end;
  5945. function IsGrayFormat: Boolean;
  5946. begin
  5947. result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
  5948. end;
  5949. begin
  5950. result := false;
  5951. // reading header to test file and set cursor back to begin
  5952. StartPosition := aStream.Position;
  5953. aStream.Read(Header, SizeOf(Header));
  5954. // no colormapped files
  5955. if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
  5956. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
  5957. begin
  5958. try
  5959. if Header.ImageID <> 0 then // skip image ID
  5960. aStream.Position := aStream.Position + Header.ImageID;
  5961. case Header.Bpp of
  5962. 8: if IsGrayFormat then case (Header.ImageDesc and $F) of
  5963. 0: tgaFormat := tfLuminance8;
  5964. 8: tgaFormat := tfAlpha8;
  5965. end;
  5966. 16: if IsGrayFormat then case (Header.ImageDesc and $F) of
  5967. 0: tgaFormat := tfLuminance16;
  5968. 8: tgaFormat := tfLuminance8Alpha8;
  5969. end else case (Header.ImageDesc and $F) of
  5970. 0: tgaFormat := tfBGR5;
  5971. 1: tgaFormat := tfBGR5A1;
  5972. 4: tgaFormat := tfBGRA4;
  5973. end;
  5974. 24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  5975. 0: tgaFormat := tfBGR8;
  5976. end;
  5977. 32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  5978. 2: tgaFormat := tfBGR10A2;
  5979. 8: tgaFormat := tfBGRA8;
  5980. end;
  5981. end;
  5982. if (tgaFormat = tfEmpty) then
  5983. raise EglBitmapException.Create('LoadTga - unsupported format');
  5984. FormatDesc := TFormatDescriptor.Get(tgaFormat);
  5985. PixelSize := FormatDesc.GetSize(1, 1);
  5986. LineSize := FormatDesc.GetSize(Header.Width, 1);
  5987. GetMem(ImageData, LineSize * Header.Height);
  5988. try
  5989. //column direction
  5990. if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
  5991. Counter.X.low := Header.Height-1;;
  5992. Counter.X.high := 0;
  5993. Counter.X.dir := -1;
  5994. end else begin
  5995. Counter.X.low := 0;
  5996. Counter.X.high := Header.Height-1;
  5997. Counter.X.dir := 1;
  5998. end;
  5999. // Row direction
  6000. if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
  6001. Counter.Y.low := 0;
  6002. Counter.Y.high := Header.Height-1;
  6003. Counter.Y.dir := 1;
  6004. end else begin
  6005. Counter.Y.low := Header.Height-1;;
  6006. Counter.Y.high := 0;
  6007. Counter.Y.dir := -1;
  6008. end;
  6009. // Read Image
  6010. case Header.ImageType of
  6011. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
  6012. ReadUncompressed;
  6013. TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
  6014. ReadCompressed;
  6015. end;
  6016. SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height);
  6017. result := true;
  6018. except
  6019. FreeMem(ImageData);
  6020. raise;
  6021. end;
  6022. finally
  6023. aStream.Position := StartPosition;
  6024. end;
  6025. end
  6026. else aStream.Position := StartPosition;
  6027. end;
  6028. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6029. procedure TglBitmap.SaveTGA(const aStream: TStream);
  6030. var
  6031. Header: TTGAHeader;
  6032. LineSize, Size, x, y: Integer;
  6033. Pixel: TglBitmapPixelData;
  6034. LineBuf, SourceData, DestData: PByte;
  6035. SourceMD, DestMD: Pointer;
  6036. FormatDesc: TFormatDescriptor;
  6037. Converter: TFormatDescriptor;
  6038. begin
  6039. if not (ftTGA in FormatGetSupportedFiles(Format)) then
  6040. raise EglBitmapUnsupportedFormatFormat.Create('SaveTGA - ' + UNSUPPORTED_FORMAT);
  6041. //prepare header
  6042. FillChar(Header, SizeOf(Header), 0);
  6043. //set ImageType
  6044. if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
  6045. tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
  6046. Header.ImageType := TGA_UNCOMPRESSED_GRAY
  6047. else
  6048. Header.ImageType := TGA_UNCOMPRESSED_RGB;
  6049. //set BitsPerPixel
  6050. if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
  6051. Header.Bpp := 8
  6052. else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
  6053. tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
  6054. Header.Bpp := 16
  6055. else if (Format in [tfBGR8, tfRGB8]) then
  6056. Header.Bpp := 24
  6057. else
  6058. Header.Bpp := 32;
  6059. //set AlphaBitCount
  6060. case Format of
  6061. tfRGB5A1, tfBGR5A1:
  6062. Header.ImageDesc := 1 and $F;
  6063. tfRGB10A2, tfBGR10A2:
  6064. Header.ImageDesc := 2 and $F;
  6065. tfRGBA4, tfBGRA4:
  6066. Header.ImageDesc := 4 and $F;
  6067. tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
  6068. Header.ImageDesc := 8 and $F;
  6069. end;
  6070. Header.Width := Width;
  6071. Header.Height := Height;
  6072. Header.ImageDesc := Header.ImageDesc or $20; //flip y
  6073. aStream.Write(Header, SizeOf(Header));
  6074. // convert RGB(A) to BGR(A)
  6075. Converter := nil;
  6076. FormatDesc := TFormatDescriptor.Get(Format);
  6077. Size := FormatDesc.GetSize(Dimension);
  6078. if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
  6079. if (FormatDesc.RGBInverted = tfEmpty) then
  6080. raise EglBitmapException.Create('inverted RGB format is empty');
  6081. Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
  6082. if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
  6083. (Converter.PixelSize <> FormatDesc.PixelSize) then
  6084. raise EglBitmapException.Create('invalid inverted RGB format');
  6085. end;
  6086. if Assigned(Converter) then begin
  6087. LineSize := FormatDesc.GetSize(Width, 1);
  6088. LineBuf := GetMem(LineSize);
  6089. SourceMD := FormatDesc.CreateMappingData;
  6090. DestMD := Converter.CreateMappingData;
  6091. try
  6092. SourceData := Data;
  6093. for y := 0 to Height-1 do begin
  6094. DestData := LineBuf;
  6095. for x := 0 to Width-1 do begin
  6096. FormatDesc.Unmap(SourceData, Pixel, SourceMD);
  6097. Converter.Map(Pixel, DestData, DestMD);
  6098. end;
  6099. aStream.Write(LineBuf^, LineSize);
  6100. end;
  6101. finally
  6102. FreeMem(LineBuf);
  6103. FormatDesc.FreeMappingData(SourceMD);
  6104. FormatDesc.FreeMappingData(DestMD);
  6105. end;
  6106. end else
  6107. aStream.Write(Data^, Size);
  6108. end;
  6109. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6110. //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6111. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6112. const
  6113. DDS_MAGIC: Cardinal = $20534444;
  6114. // DDS_header.dwFlags
  6115. DDSD_CAPS = $00000001;
  6116. DDSD_HEIGHT = $00000002;
  6117. DDSD_WIDTH = $00000004;
  6118. DDSD_PITCH = $00000008;
  6119. DDSD_PIXELFORMAT = $00001000;
  6120. DDSD_MIPMAPCOUNT = $00020000;
  6121. DDSD_LINEARSIZE = $00080000;
  6122. DDSD_DEPTH = $00800000;
  6123. // DDS_header.sPixelFormat.dwFlags
  6124. DDPF_ALPHAPIXELS = $00000001;
  6125. DDPF_ALPHA = $00000002;
  6126. DDPF_FOURCC = $00000004;
  6127. DDPF_INDEXED = $00000020;
  6128. DDPF_RGB = $00000040;
  6129. DDPF_LUMINANCE = $00020000;
  6130. // DDS_header.sCaps.dwCaps1
  6131. DDSCAPS_COMPLEX = $00000008;
  6132. DDSCAPS_TEXTURE = $00001000;
  6133. DDSCAPS_MIPMAP = $00400000;
  6134. // DDS_header.sCaps.dwCaps2
  6135. DDSCAPS2_CUBEMAP = $00000200;
  6136. DDSCAPS2_CUBEMAP_POSITIVEX = $00000400;
  6137. DDSCAPS2_CUBEMAP_NEGATIVEX = $00000800;
  6138. DDSCAPS2_CUBEMAP_POSITIVEY = $00001000;
  6139. DDSCAPS2_CUBEMAP_NEGATIVEY = $00002000;
  6140. DDSCAPS2_CUBEMAP_POSITIVEZ = $00004000;
  6141. DDSCAPS2_CUBEMAP_NEGATIVEZ = $00008000;
  6142. DDSCAPS2_VOLUME = $00200000;
  6143. D3DFMT_DXT1 = $31545844;
  6144. D3DFMT_DXT3 = $33545844;
  6145. D3DFMT_DXT5 = $35545844;
  6146. type
  6147. TDDSPixelFormat = packed record
  6148. dwSize: Cardinal;
  6149. dwFlags: Cardinal;
  6150. dwFourCC: Cardinal;
  6151. dwRGBBitCount: Cardinal;
  6152. dwRBitMask: Cardinal;
  6153. dwGBitMask: Cardinal;
  6154. dwBBitMask: Cardinal;
  6155. dwABitMask: Cardinal;
  6156. end;
  6157. TDDSCaps = packed record
  6158. dwCaps1: Cardinal;
  6159. dwCaps2: Cardinal;
  6160. dwDDSX: Cardinal;
  6161. dwReserved: Cardinal;
  6162. end;
  6163. TDDSHeader = packed record
  6164. dwSize: Cardinal;
  6165. dwFlags: Cardinal;
  6166. dwHeight: Cardinal;
  6167. dwWidth: Cardinal;
  6168. dwPitchOrLinearSize: Cardinal;
  6169. dwDepth: Cardinal;
  6170. dwMipMapCount: Cardinal;
  6171. dwReserved: array[0..10] of Cardinal;
  6172. PixelFormat: TDDSPixelFormat;
  6173. Caps: TDDSCaps;
  6174. dwReserved2: Cardinal;
  6175. end;
  6176. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6177. function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
  6178. var
  6179. Header: TDDSHeader;
  6180. Converter: TbmpBitfieldFormat;
  6181. function GetDDSFormat: TglBitmapFormat;
  6182. var
  6183. fd: TFormatDescriptor;
  6184. i: Integer;
  6185. Range: TglBitmapColorRec;
  6186. match: Boolean;
  6187. begin
  6188. result := tfEmpty;
  6189. with Header.PixelFormat do begin
  6190. // Compresses
  6191. if ((dwFlags and DDPF_FOURCC) > 0) then begin
  6192. case Header.PixelFormat.dwFourCC of
  6193. D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
  6194. D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
  6195. D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
  6196. end;
  6197. end else if ((Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin
  6198. //find matching format
  6199. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  6200. fd := TFormatDescriptor.Get(result);
  6201. if fd.MaskMatch(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask) and
  6202. (8 * fd.PixelSize = dwRGBBitCount) then
  6203. exit;
  6204. end;
  6205. //find format with same Range
  6206. Range.r := dwRBitMask;
  6207. Range.g := dwGBitMask;
  6208. Range.b := dwBBitMask;
  6209. Range.a := dwABitMask;
  6210. for i := 0 to 3 do begin
  6211. while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do
  6212. Range.arr[i] := Range.arr[i] shr 1;
  6213. end;
  6214. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  6215. fd := TFormatDescriptor.Get(result);
  6216. match := true;
  6217. for i := 0 to 3 do
  6218. if (fd.Range.arr[i] <> Range.arr[i]) then begin
  6219. match := false;
  6220. break;
  6221. end;
  6222. if match then
  6223. break;
  6224. end;
  6225. //no format with same range found -> use default
  6226. if (result = tfEmpty) then begin
  6227. if (dwABitMask > 0) then
  6228. result := tfBGRA8
  6229. else
  6230. result := tfBGR8;
  6231. end;
  6232. Converter := TbmpBitfieldFormat.Create;
  6233. Converter.RedMask := dwRBitMask;
  6234. Converter.GreenMask := dwGBitMask;
  6235. Converter.BlueMask := dwBBitMask;
  6236. Converter.AlphaMask := dwABitMask;
  6237. Converter.PixelSize := dwRGBBitCount / 8;
  6238. end;
  6239. end;
  6240. end;
  6241. var
  6242. StreamPos: Int64;
  6243. x, y, j, LineSize, RowSize, Magic: Cardinal;
  6244. NewImage, TmpData, RowData, SrcData: PByte;
  6245. SourceMD, DestMD: Pointer;
  6246. Pixel: TglBitmapPixelData;
  6247. ddsFormat: TglBitmapFormat;
  6248. FormatDesc: TFormatDescriptor;
  6249. begin
  6250. result := false;
  6251. Converter := nil;
  6252. StreamPos := aStream.Position;
  6253. // Magic
  6254. aStream.Read(Magic, sizeof(Magic));
  6255. if (Magic <> DDS_MAGIC) then begin
  6256. aStream.Position := StreamPos;
  6257. exit;
  6258. end;
  6259. //Header
  6260. aStream.Read(Header, sizeof(Header));
  6261. if (Header.dwSize <> SizeOf(Header)) or
  6262. ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
  6263. (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
  6264. begin
  6265. aStream.Position := StreamPos;
  6266. exit;
  6267. end;
  6268. if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
  6269. raise EglBitmapException.Create('LoadDDS - CubeMaps are not supported');
  6270. ddsFormat := GetDDSFormat;
  6271. try
  6272. if (ddsFormat = tfEmpty) then
  6273. raise EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');
  6274. FormatDesc := TFormatDescriptor.Get(ddsFormat);
  6275. LineSize := Trunc(Header.dwWidth * FormatDesc.PixelSize);
  6276. GetMem(NewImage, Header.dwHeight * LineSize);
  6277. try
  6278. TmpData := NewImage;
  6279. //Converter needed
  6280. if Assigned(Converter) then begin
  6281. RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
  6282. GetMem(RowData, RowSize);
  6283. SourceMD := Converter.CreateMappingData;
  6284. DestMD := FormatDesc.CreateMappingData;
  6285. try
  6286. for y := 0 to Header.dwHeight-1 do begin
  6287. TmpData := NewImage + y * LineSize;
  6288. SrcData := RowData;
  6289. aStream.Read(SrcData^, RowSize);
  6290. for x := 0 to Header.dwWidth-1 do begin
  6291. Converter.Unmap(SrcData, Pixel, SourceMD);
  6292. //TODO use converter function
  6293. for j := 0 to 3 do
  6294. if (Converter.Range.arr[j] <> FormatDesc.Range.arr[j]) then begin
  6295. if (Converter.Range.arr[j] > 0) then
  6296. Pixel.Data.arr[j] := Round(Pixel.Data.arr[j] / Converter.Range.arr[j] * FormatDesc.Range.arr[j])
  6297. else
  6298. Pixel.Data.arr[j] := 0;
  6299. end;
  6300. FormatDesc.Map(Pixel, TmpData, DestMD);
  6301. end;
  6302. end;
  6303. finally
  6304. Converter.FreeMappingData(SourceMD);
  6305. FormatDesc.FreeMappingData(DestMD);
  6306. FreeMem(RowData);
  6307. end;
  6308. end else
  6309. // Compressed
  6310. if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
  6311. RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
  6312. for Y := 0 to Header.dwHeight-1 do begin
  6313. aStream.Read(TmpData^, RowSize);
  6314. Inc(TmpData, LineSize);
  6315. end;
  6316. end else
  6317. // Uncompressed
  6318. if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
  6319. RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
  6320. for Y := 0 to Header.dwHeight-1 do begin
  6321. aStream.Read(TmpData^, RowSize);
  6322. Inc(TmpData, LineSize);
  6323. end;
  6324. end else
  6325. raise EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');
  6326. SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight);
  6327. result := true;
  6328. except
  6329. FreeMem(NewImage);
  6330. raise;
  6331. end;
  6332. finally
  6333. FreeAndNil(Converter);
  6334. end;
  6335. end;
  6336. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6337. procedure TglBitmap.SaveDDS(const aStream: TStream);
  6338. var
  6339. Header: TDDSHeader;
  6340. FormatDesc: TFormatDescriptor;
  6341. begin
  6342. if not (ftDDS in FormatGetSupportedFiles(Format)) then
  6343. raise EglBitmapUnsupportedFormatFormat.Create('SaveDDS - ' + UNSUPPORTED_FORMAT);
  6344. FormatDesc := TFormatDescriptor.Get(Format);
  6345. // Generell
  6346. FillChar(Header, SizeOf(Header), 0);
  6347. Header.dwSize := SizeOf(Header);
  6348. Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
  6349. Header.dwWidth := Max(1, Width);
  6350. Header.dwHeight := Max(1, Height);
  6351. // Caps
  6352. Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
  6353. // Pixelformat
  6354. Header.PixelFormat.dwSize := sizeof(Header);
  6355. if (FormatDesc.IsCompressed) then begin
  6356. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
  6357. case Format of
  6358. tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
  6359. tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
  6360. tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
  6361. end;
  6362. end else if (Format in [tfAlpha8, tfAlpha16]) then begin
  6363. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHA;
  6364. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6365. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6366. end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
  6367. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
  6368. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6369. Header.PixelFormat.dwRBitMask := FormatDesc.RedMask;
  6370. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6371. end else begin
  6372. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
  6373. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6374. Header.PixelFormat.dwRBitMask := FormatDesc.RedMask;
  6375. Header.PixelFormat.dwGBitMask := FormatDesc.GreenMask;
  6376. Header.PixelFormat.dwBBitMask := FormatDesc.BlueMask;
  6377. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6378. end;
  6379. if (FormatDesc.HasAlpha) then
  6380. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
  6381. aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
  6382. aStream.Write(Header, SizeOf(Header));
  6383. aStream.Write(Data^, FormatDesc.GetSize(Dimension));
  6384. end;
  6385. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6386. //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6387. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6388. function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
  6389. begin
  6390. if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
  6391. result := fLines[aIndex]
  6392. else
  6393. result := nil;
  6394. end;
  6395. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6396. procedure TglBitmap2D.SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
  6397. const aWidth: Integer; const aHeight: Integer);
  6398. var
  6399. Idx, LineWidth: Integer;
  6400. begin
  6401. inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
  6402. if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
  6403. (* TODO PixelFuncs
  6404. fGetPixelFunc := GetPixel2DUnmap;
  6405. fSetPixelFunc := SetPixel2DUnmap;
  6406. *)
  6407. // Assigning Data
  6408. if Assigned(Data) then begin
  6409. SetLength(fLines, GetHeight);
  6410. LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
  6411. for Idx := 0 to GetHeight -1 do begin
  6412. fLines[Idx] := Data;
  6413. Inc(fLines[Idx], Idx * LineWidth);
  6414. end;
  6415. end
  6416. else SetLength(fLines, 0);
  6417. end else begin
  6418. SetLength(fLines, 0);
  6419. (*
  6420. fSetPixelFunc := nil;
  6421. case Format of
  6422. ifDXT1:
  6423. fGetPixelFunc := GetPixel2DDXT1;
  6424. ifDXT3:
  6425. fGetPixelFunc := GetPixel2DDXT3;
  6426. ifDXT5:
  6427. fGetPixelFunc := GetPixel2DDXT5;
  6428. else
  6429. fGetPixelFunc := nil;
  6430. end;
  6431. *)
  6432. end;
  6433. end;
  6434. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6435. procedure TglBitmap2D.UploadData(const aTarget: Cardinal; const aBuildWithGlu: Boolean);
  6436. var
  6437. FormatDesc: TFormatDescriptor;
  6438. begin
  6439. glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
  6440. FormatDesc := TFormatDescriptor.Get(Format);
  6441. if FormatDesc.IsCompressed then begin
  6442. glCompressedTexImage2D(Target, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
  6443. end else if aBuildWithGlu then begin
  6444. gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
  6445. FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  6446. end else begin
  6447. glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
  6448. FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  6449. end;
  6450. // Freigeben
  6451. if (FreeDataAfterGenTexture) then
  6452. FreeData;
  6453. end;
  6454. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6455. procedure TglBitmap2D.AfterConstruction;
  6456. begin
  6457. inherited;
  6458. Target := GL_TEXTURE_2D;
  6459. end;
  6460. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6461. procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  6462. var
  6463. Temp: pByte;
  6464. Size, w, h: Integer;
  6465. FormatDesc: TFormatDescriptor;
  6466. begin
  6467. FormatDesc := TFormatDescriptor.Get(Format);
  6468. if FormatDesc.IsCompressed then
  6469. raise EglBitmapUnsupportedFormatFormat.Create('TglBitmap2D.GrabScreen - ' + UNSUPPORTED_FORMAT);
  6470. w := aRight - aLeft;
  6471. h := aBottom - aTop;
  6472. Size := FormatDesc.GetSize(w, h);
  6473. GetMem(Temp, Size);
  6474. try
  6475. glPixelStorei(GL_PACK_ALIGNMENT, 1);
  6476. glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  6477. SetDataPointer(Temp, Format, w, h);
  6478. FlipVert;
  6479. except
  6480. FreeMem(Temp);
  6481. raise;
  6482. end;
  6483. end;
  6484. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6485. procedure TglBitmap2D.GetDataFromTexture;
  6486. var
  6487. Temp: PByte;
  6488. TempWidth, TempHeight: Integer;
  6489. TempType, TempIntFormat: Cardinal;
  6490. IntFormat, f: TglBitmapFormat;
  6491. FormatDesc: TFormatDescriptor;
  6492. begin
  6493. Bind;
  6494. // Request Data
  6495. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH, @TempWidth);
  6496. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT, @TempHeight);
  6497. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
  6498. IntFormat := tfEmpty;
  6499. for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do
  6500. if (TFormatDescriptor.Get(f).glInternalFormat = TempIntFormat) then begin
  6501. IntFormat := FormatDesc.Format;
  6502. break;
  6503. end;
  6504. // Getting data from OpenGL
  6505. FormatDesc := TFormatDescriptor.Get(IntFormat);
  6506. GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
  6507. try
  6508. if FormatDesc.IsCompressed then
  6509. glGetCompressedTexImage(Target, 0, Temp)
  6510. else
  6511. glGetTexImage(Target, 0, FormatDesc.glInternalFormat, FormatDesc.glDataFormat, Temp);
  6512. SetDataPointer(Temp, IntFormat, TempWidth, TempHeight);
  6513. except
  6514. FreeMem(Temp);
  6515. raise;
  6516. end;
  6517. end;
  6518. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6519. procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
  6520. var
  6521. BuildWithGlu, PotTex, TexRec: Boolean;
  6522. TexSize: Integer;
  6523. begin
  6524. if Assigned(Data) then begin
  6525. // Check Texture Size
  6526. if (aTestTextureSize) then begin
  6527. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  6528. if ((Height > TexSize) or (Width > TexSize)) then
  6529. raise EglBitmapSizeToLargeException.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  6530. PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
  6531. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE_ARB);
  6532. if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  6533. raise EglBitmapNonPowerOfTwoException.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  6534. end;
  6535. CreateId;
  6536. SetupParameters(BuildWithGlu);
  6537. UploadData(Target, BuildWithGlu);
  6538. glAreTexturesResident(1, @fID, @fIsResident);
  6539. end;
  6540. end;
  6541. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6542. function TglBitmap2D.FlipHorz: Boolean;
  6543. var
  6544. Col, Row: Integer;
  6545. TempDestData, DestData, SourceData: PByte;
  6546. ImgSize: Integer;
  6547. begin
  6548. result := inherited FlipHorz;
  6549. if Assigned(Data) then begin
  6550. SourceData := Data;
  6551. ImgSize := Height * fRowSize;
  6552. GetMem(DestData, ImgSize);
  6553. try
  6554. TempDestData := DestData;
  6555. Dec(TempDestData, fRowSize + fPixelSize);
  6556. for Row := 0 to Height -1 do begin
  6557. Inc(TempDestData, fRowSize * 2);
  6558. for Col := 0 to Width -1 do begin
  6559. Move(SourceData^, TempDestData^, fPixelSize);
  6560. Inc(SourceData, fPixelSize);
  6561. Dec(TempDestData, fPixelSize);
  6562. end;
  6563. end;
  6564. SetDataPointer(DestData, Format);
  6565. result := true;
  6566. except
  6567. FreeMem(DestData);
  6568. raise;
  6569. end;
  6570. end;
  6571. end;
  6572. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6573. function TglBitmap2D.FlipVert: Boolean;
  6574. var
  6575. Row: Integer;
  6576. TempDestData, DestData, SourceData: PByte;
  6577. begin
  6578. result := inherited FlipVert;
  6579. if Assigned(Data) then begin
  6580. SourceData := Data;
  6581. GetMem(DestData, Height * fRowSize);
  6582. try
  6583. TempDestData := DestData;
  6584. Inc(TempDestData, Width * (Height -1) * fPixelSize);
  6585. for Row := 0 to Height -1 do begin
  6586. Move(SourceData^, TempDestData^, fRowSize);
  6587. Dec(TempDestData, fRowSize);
  6588. Inc(SourceData, fRowSize);
  6589. end;
  6590. SetDataPointer(DestData, Format);
  6591. result := true;
  6592. except
  6593. FreeMem(DestData);
  6594. raise;
  6595. end;
  6596. end;
  6597. end;
  6598. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6599. //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6600. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6601. type
  6602. TMatrixItem = record
  6603. X, Y: Integer;
  6604. W: Single;
  6605. end;
  6606. PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
  6607. TglBitmapToNormalMapRec = Record
  6608. Scale: Single;
  6609. Heights: array of Single;
  6610. MatrixU : array of TMatrixItem;
  6611. MatrixV : array of TMatrixItem;
  6612. end;
  6613. const
  6614. ONE_OVER_255 = 1 / 255;
  6615. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6616. procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
  6617. var
  6618. Val: Single;
  6619. begin
  6620. with FuncRec do begin
  6621. Val :=
  6622. Source.Data.r * LUMINANCE_WEIGHT_R +
  6623. Source.Data.g * LUMINANCE_WEIGHT_G +
  6624. Source.Data.b * LUMINANCE_WEIGHT_B;
  6625. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
  6626. end;
  6627. end;
  6628. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6629. procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  6630. begin
  6631. with FuncRec do
  6632. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
  6633. end;
  6634. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6635. procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
  6636. type
  6637. TVec = Array[0..2] of Single;
  6638. var
  6639. Idx: Integer;
  6640. du, dv: Double;
  6641. Len: Single;
  6642. Vec: TVec;
  6643. function GetHeight(X, Y: Integer): Single;
  6644. begin
  6645. with FuncRec do begin
  6646. X := Max(0, Min(Size.X -1, X));
  6647. Y := Max(0, Min(Size.Y -1, Y));
  6648. result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
  6649. end;
  6650. end;
  6651. begin
  6652. with FuncRec do begin
  6653. with PglBitmapToNormalMapRec(Args)^ do begin
  6654. du := 0;
  6655. for Idx := Low(MatrixU) to High(MatrixU) do
  6656. du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
  6657. dv := 0;
  6658. for Idx := Low(MatrixU) to High(MatrixU) do
  6659. dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
  6660. Vec[0] := -du * Scale;
  6661. Vec[1] := -dv * Scale;
  6662. Vec[2] := 1;
  6663. end;
  6664. // Normalize
  6665. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  6666. if Len <> 0 then begin
  6667. Vec[0] := Vec[0] * Len;
  6668. Vec[1] := Vec[1] * Len;
  6669. Vec[2] := Vec[2] * Len;
  6670. end;
  6671. // Farbe zuweisem
  6672. Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
  6673. Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
  6674. Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
  6675. end;
  6676. end;
  6677. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6678. procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
  6679. var
  6680. Rec: TglBitmapToNormalMapRec;
  6681. procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
  6682. begin
  6683. if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
  6684. Matrix[Index].X := X;
  6685. Matrix[Index].Y := Y;
  6686. Matrix[Index].W := W;
  6687. end;
  6688. end;
  6689. begin
  6690. (* TODO Compression
  6691. if not FormatIsUncompressed(InternalFormat) then
  6692. raise EglBitmapUnsupportedFormatFormat.Create('TglBitmap2D.ToNormalMap - ' + UNSUPPORTED_FORMAT);
  6693. *)
  6694. if aScale > 100 then
  6695. Rec.Scale := 100
  6696. else if aScale < -100 then
  6697. Rec.Scale := -100
  6698. else
  6699. Rec.Scale := aScale;
  6700. SetLength(Rec.Heights, Width * Height);
  6701. try
  6702. case aFunc of
  6703. nm4Samples: begin
  6704. SetLength(Rec.MatrixU, 2);
  6705. SetEntry(Rec.MatrixU, 0, -1, 0, -0.5);
  6706. SetEntry(Rec.MatrixU, 1, 1, 0, 0.5);
  6707. SetLength(Rec.MatrixV, 2);
  6708. SetEntry(Rec.MatrixV, 0, 0, 1, 0.5);
  6709. SetEntry(Rec.MatrixV, 1, 0, -1, -0.5);
  6710. end;
  6711. nmSobel: begin
  6712. SetLength(Rec.MatrixU, 6);
  6713. SetEntry(Rec.MatrixU, 0, -1, 1, -1.0);
  6714. SetEntry(Rec.MatrixU, 1, -1, 0, -2.0);
  6715. SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
  6716. SetEntry(Rec.MatrixU, 3, 1, 1, 1.0);
  6717. SetEntry(Rec.MatrixU, 4, 1, 0, 2.0);
  6718. SetEntry(Rec.MatrixU, 5, 1, -1, 1.0);
  6719. SetLength(Rec.MatrixV, 6);
  6720. SetEntry(Rec.MatrixV, 0, -1, 1, 1.0);
  6721. SetEntry(Rec.MatrixV, 1, 0, 1, 2.0);
  6722. SetEntry(Rec.MatrixV, 2, 1, 1, 1.0);
  6723. SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
  6724. SetEntry(Rec.MatrixV, 4, 0, -1, -2.0);
  6725. SetEntry(Rec.MatrixV, 5, 1, -1, -1.0);
  6726. end;
  6727. nm3x3: begin
  6728. SetLength(Rec.MatrixU, 6);
  6729. SetEntry(Rec.MatrixU, 0, -1, 1, -1/6);
  6730. SetEntry(Rec.MatrixU, 1, -1, 0, -1/6);
  6731. SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
  6732. SetEntry(Rec.MatrixU, 3, 1, 1, 1/6);
  6733. SetEntry(Rec.MatrixU, 4, 1, 0, 1/6);
  6734. SetEntry(Rec.MatrixU, 5, 1, -1, 1/6);
  6735. SetLength(Rec.MatrixV, 6);
  6736. SetEntry(Rec.MatrixV, 0, -1, 1, 1/6);
  6737. SetEntry(Rec.MatrixV, 1, 0, 1, 1/6);
  6738. SetEntry(Rec.MatrixV, 2, 1, 1, 1/6);
  6739. SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
  6740. SetEntry(Rec.MatrixV, 4, 0, -1, -1/6);
  6741. SetEntry(Rec.MatrixV, 5, 1, -1, -1/6);
  6742. end;
  6743. nm5x5: begin
  6744. SetLength(Rec.MatrixU, 20);
  6745. SetEntry(Rec.MatrixU, 0, -2, 2, -1 / 16);
  6746. SetEntry(Rec.MatrixU, 1, -1, 2, -1 / 10);
  6747. SetEntry(Rec.MatrixU, 2, 1, 2, 1 / 10);
  6748. SetEntry(Rec.MatrixU, 3, 2, 2, 1 / 16);
  6749. SetEntry(Rec.MatrixU, 4, -2, 1, -1 / 10);
  6750. SetEntry(Rec.MatrixU, 5, -1, 1, -1 / 8);
  6751. SetEntry(Rec.MatrixU, 6, 1, 1, 1 / 8);
  6752. SetEntry(Rec.MatrixU, 7, 2, 1, 1 / 10);
  6753. SetEntry(Rec.MatrixU, 8, -2, 0, -1 / 2.8);
  6754. SetEntry(Rec.MatrixU, 9, -1, 0, -0.5);
  6755. SetEntry(Rec.MatrixU, 10, 1, 0, 0.5);
  6756. SetEntry(Rec.MatrixU, 11, 2, 0, 1 / 2.8);
  6757. SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
  6758. SetEntry(Rec.MatrixU, 13, -1, -1, -1 / 8);
  6759. SetEntry(Rec.MatrixU, 14, 1, -1, 1 / 8);
  6760. SetEntry(Rec.MatrixU, 15, 2, -1, 1 / 10);
  6761. SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
  6762. SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
  6763. SetEntry(Rec.MatrixU, 18, 1, -2, 1 / 10);
  6764. SetEntry(Rec.MatrixU, 19, 2, -2, 1 / 16);
  6765. SetLength(Rec.MatrixV, 20);
  6766. SetEntry(Rec.MatrixV, 0, -2, 2, 1 / 16);
  6767. SetEntry(Rec.MatrixV, 1, -1, 2, 1 / 10);
  6768. SetEntry(Rec.MatrixV, 2, 0, 2, 0.25);
  6769. SetEntry(Rec.MatrixV, 3, 1, 2, 1 / 10);
  6770. SetEntry(Rec.MatrixV, 4, 2, 2, 1 / 16);
  6771. SetEntry(Rec.MatrixV, 5, -2, 1, 1 / 10);
  6772. SetEntry(Rec.MatrixV, 6, -1, 1, 1 / 8);
  6773. SetEntry(Rec.MatrixV, 7, 0, 1, 0.5);
  6774. SetEntry(Rec.MatrixV, 8, 1, 1, 1 / 8);
  6775. SetEntry(Rec.MatrixV, 9, 2, 1, 1 / 16);
  6776. SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
  6777. SetEntry(Rec.MatrixV, 11, -1, -1, -1 / 8);
  6778. SetEntry(Rec.MatrixV, 12, 0, -1, -0.5);
  6779. SetEntry(Rec.MatrixV, 13, 1, -1, -1 / 8);
  6780. SetEntry(Rec.MatrixV, 14, 2, -1, -1 / 10);
  6781. SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
  6782. SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
  6783. SetEntry(Rec.MatrixV, 17, 0, -2, -0.25);
  6784. SetEntry(Rec.MatrixV, 18, 1, -2, -1 / 10);
  6785. SetEntry(Rec.MatrixV, 19, 2, -2, -1 / 16);
  6786. end;
  6787. end;
  6788. // Daten Sammeln
  6789. if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
  6790. AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, PtrInt(@Rec))
  6791. else
  6792. AddFunc(glBitmapToNormalMapPrepareFunc, false, PtrInt(@Rec));
  6793. AddFunc(glBitmapToNormalMapFunc, false, PtrInt(@Rec));
  6794. finally
  6795. SetLength(Rec.Heights, 0);
  6796. end;
  6797. end;
  6798. (*
  6799. procedure TglBitmap1D.SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width, Height: Integer);
  6800. var
  6801. pTemp: pByte;
  6802. Size: Integer;
  6803. begin
  6804. if Height > 1 then begin
  6805. // extract first line of the data
  6806. Size := FormatGetImageSize(glBitmapPosition(Width), Format);
  6807. GetMem(pTemp, Size);
  6808. Move(Data^, pTemp^, Size);
  6809. FreeMem(Data);
  6810. end else
  6811. pTemp := Data;
  6812. // set data pointer
  6813. inherited SetDataPointer(pTemp, Format, Width);
  6814. if FormatIsUncompressed(Format) then begin
  6815. fUnmapFunc := FormatGetUnMapFunc(Format);
  6816. fGetPixelFunc := GetPixel1DUnmap;
  6817. end;
  6818. end;
  6819. procedure TglBitmap1D.GetPixel1DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
  6820. var
  6821. pTemp: pByte;
  6822. begin
  6823. pTemp := Data;
  6824. Inc(pTemp, Pos.X * fPixelSize);
  6825. fUnmapFunc(pTemp, Pixel);
  6826. end;
  6827. function TglBitmap1D.FlipHorz: Boolean;
  6828. var
  6829. Col: Integer;
  6830. pTempDest, pDest, pSource: pByte;
  6831. begin
  6832. result := inherited FlipHorz;
  6833. if Assigned(Data) and FormatIsUncompressed(InternalFormat) then begin
  6834. pSource := Data;
  6835. GetMem(pDest, fRowSize);
  6836. try
  6837. pTempDest := pDest;
  6838. Inc(pTempDest, fRowSize);
  6839. for Col := 0 to Width -1 do begin
  6840. Move(pSource^, pTempDest^, fPixelSize);
  6841. Inc(pSource, fPixelSize);
  6842. Dec(pTempDest, fPixelSize);
  6843. end;
  6844. SetDataPointer(pDest, InternalFormat);
  6845. result := true;
  6846. finally
  6847. FreeMem(pDest);
  6848. end;
  6849. end;
  6850. end;
  6851. procedure TglBitmap1D.UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
  6852. begin
  6853. // Upload data
  6854. if Self.InternalFormat in [ifDXT1, ifDXT3, ifDXT5] then
  6855. glCompressedTexImage1D(Target, 0, InternalFormat, Width, 0, Trunc(Width * FormatGetSize(Self.InternalFormat)), Data)
  6856. else
  6857. // Upload data
  6858. if BuildWithGlu then
  6859. gluBuild1DMipmaps(Target, InternalFormat, Width, Format, Typ, Data)
  6860. else
  6861. glTexImage1D(Target, 0, InternalFormat, Width, 0, Format, Typ, Data);
  6862. // Freigeben
  6863. if (FreeDataAfterGenTexture) then
  6864. FreeData;
  6865. end;
  6866. procedure TglBitmap1D.GenTexture(TestTextureSize: Boolean);
  6867. var
  6868. BuildWithGlu, TexRec: Boolean;
  6869. glFormat, glInternalFormat, glType: Cardinal;
  6870. TexSize: Integer;
  6871. begin
  6872. if Assigned(Data) then begin
  6873. // Check Texture Size
  6874. if (TestTextureSize) then begin
  6875. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  6876. if (Width > TexSize) then
  6877. raise EglBitmapSizeToLargeException.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  6878. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
  6879. (Target = GL_TEXTURE_RECTANGLE_ARB);
  6880. if not (IsPowerOfTwo (Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  6881. raise EglBitmapNonPowerOfTwoException.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  6882. end;
  6883. CreateId;
  6884. SetupParameters(BuildWithGlu);
  6885. SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
  6886. UploadData(Target, glFormat, glInternalFormat, glType, BuildWithGlu);
  6887. // Infos sammeln
  6888. glAreTexturesResident(1, @fID, @fIsResident);
  6889. end;
  6890. end;
  6891. procedure TglBitmap1D.AfterConstruction;
  6892. begin
  6893. inherited;
  6894. Target := GL_TEXTURE_1D;
  6895. end;
  6896. { TglBitmapCubeMap }
  6897. procedure TglBitmapCubeMap.AfterConstruction;
  6898. begin
  6899. inherited;
  6900. if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
  6901. raise EglBitmapException.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
  6902. SetWrap; // set all to GL_CLAMP_TO_EDGE
  6903. Target := GL_TEXTURE_CUBE_MAP;
  6904. fGenMode := GL_REFLECTION_MAP;
  6905. end;
  6906. procedure TglBitmapCubeMap.Bind(EnableTexCoordsGen, EnableTextureUnit: Boolean);
  6907. begin
  6908. inherited Bind (EnableTextureUnit);
  6909. if EnableTexCoordsGen then begin
  6910. glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
  6911. glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
  6912. glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
  6913. glEnable(GL_TEXTURE_GEN_S);
  6914. glEnable(GL_TEXTURE_GEN_T);
  6915. glEnable(GL_TEXTURE_GEN_R);
  6916. end;
  6917. end;
  6918. procedure TglBitmapCubeMap.GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean);
  6919. var
  6920. glFormat, glInternalFormat, glType: Cardinal;
  6921. BuildWithGlu: Boolean;
  6922. TexSize: Integer;
  6923. begin
  6924. // Check Texture Size
  6925. if (TestTextureSize) then begin
  6926. glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
  6927. if ((Height > TexSize) or (Width > TexSize)) then
  6928. raise EglBitmapSizeToLargeException.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
  6929. if not ((IsPowerOfTwo (Height) and IsPowerOfTwo (Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
  6930. raise EglBitmapNonPowerOfTwoException.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
  6931. end;
  6932. // create Texture
  6933. if ID = 0 then begin
  6934. CreateID;
  6935. SetupParameters(BuildWithGlu);
  6936. end;
  6937. SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
  6938. UploadData (CubeTarget, glFormat, glInternalFormat, glType, BuildWithGlu);
  6939. end;
  6940. procedure TglBitmapCubeMap.GenTexture(TestTextureSize: Boolean);
  6941. begin
  6942. Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
  6943. end;
  6944. procedure TglBitmapCubeMap.Unbind(DisableTexCoordsGen,
  6945. DisableTextureUnit: Boolean);
  6946. begin
  6947. inherited Unbind (DisableTextureUnit);
  6948. if DisableTexCoordsGen then begin
  6949. glDisable(GL_TEXTURE_GEN_S);
  6950. glDisable(GL_TEXTURE_GEN_T);
  6951. glDisable(GL_TEXTURE_GEN_R);
  6952. end;
  6953. end;
  6954. { TglBitmapNormalMap }
  6955. type
  6956. TVec = Array[0..2] of Single;
  6957. TglBitmapNormalMapGetVectorFunc = procedure (var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  6958. PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
  6959. TglBitmapNormalMapRec = record
  6960. HalfSize : Integer;
  6961. Func: TglBitmapNormalMapGetVectorFunc;
  6962. end;
  6963. procedure glBitmapNormalMapPosX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  6964. begin
  6965. Vec[0] := HalfSize;
  6966. Vec[1] := - (Position.Y + 0.5 - HalfSize);
  6967. Vec[2] := - (Position.X + 0.5 - HalfSize);
  6968. end;
  6969. procedure glBitmapNormalMapNegX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  6970. begin
  6971. Vec[0] := - HalfSize;
  6972. Vec[1] := - (Position.Y + 0.5 - HalfSize);
  6973. Vec[2] := Position.X + 0.5 - HalfSize;
  6974. end;
  6975. procedure glBitmapNormalMapPosY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  6976. begin
  6977. Vec[0] := Position.X + 0.5 - HalfSize;
  6978. Vec[1] := HalfSize;
  6979. Vec[2] := Position.Y + 0.5 - HalfSize;
  6980. end;
  6981. procedure glBitmapNormalMapNegY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  6982. begin
  6983. Vec[0] := Position.X + 0.5 - HalfSize;
  6984. Vec[1] := - HalfSize;
  6985. Vec[2] := - (Position.Y + 0.5 - HalfSize);
  6986. end;
  6987. procedure glBitmapNormalMapPosZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  6988. begin
  6989. Vec[0] := Position.X + 0.5 - HalfSize;
  6990. Vec[1] := - (Position.Y + 0.5 - HalfSize);
  6991. Vec[2] := HalfSize;
  6992. end;
  6993. procedure glBitmapNormalMapNegZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  6994. begin
  6995. Vec[0] := - (Position.X + 0.5 - HalfSize);
  6996. Vec[1] := - (Position.Y + 0.5 - HalfSize);
  6997. Vec[2] := - HalfSize;
  6998. end;
  6999. procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
  7000. var
  7001. Vec : TVec;
  7002. Len: Single;
  7003. begin
  7004. with FuncRec do begin
  7005. with PglBitmapNormalMapRec (CustomData)^ do begin
  7006. Func(Vec, Position, HalfSize);
  7007. // Normalize
  7008. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  7009. if Len <> 0 then begin
  7010. Vec[0] := Vec[0] * Len;
  7011. Vec[1] := Vec[1] * Len;
  7012. Vec[2] := Vec[2] * Len;
  7013. end;
  7014. // Scale Vector and AddVectro
  7015. Vec[0] := Vec[0] * 0.5 + 0.5;
  7016. Vec[1] := Vec[1] * 0.5 + 0.5;
  7017. Vec[2] := Vec[2] * 0.5 + 0.5;
  7018. end;
  7019. // Set Color
  7020. Dest.Red := Round(Vec[0] * 255);
  7021. Dest.Green := Round(Vec[1] * 255);
  7022. Dest.Blue := Round(Vec[2] * 255);
  7023. end;
  7024. end;
  7025. procedure TglBitmapNormalMap.AfterConstruction;
  7026. begin
  7027. inherited;
  7028. fGenMode := GL_NORMAL_MAP;
  7029. end;
  7030. procedure TglBitmapNormalMap.GenerateNormalMap(Size: Integer;
  7031. TestTextureSize: Boolean);
  7032. var
  7033. Rec: TglBitmapNormalMapRec;
  7034. SizeRec: TglBitmapPixelPosition;
  7035. begin
  7036. Rec.HalfSize := Size div 2;
  7037. FreeDataAfterGenTexture := false;
  7038. SizeRec.Fields := [ffX, ffY];
  7039. SizeRec.X := Size;
  7040. SizeRec.Y := Size;
  7041. // Positive X
  7042. Rec.Func := glBitmapNormalMapPosX;
  7043. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  7044. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, TestTextureSize);
  7045. // Negative X
  7046. Rec.Func := glBitmapNormalMapNegX;
  7047. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  7048. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, TestTextureSize);
  7049. // Positive Y
  7050. Rec.Func := glBitmapNormalMapPosY;
  7051. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  7052. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, TestTextureSize);
  7053. // Negative Y
  7054. Rec.Func := glBitmapNormalMapNegY;
  7055. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  7056. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, TestTextureSize);
  7057. // Positive Z
  7058. Rec.Func := glBitmapNormalMapPosZ;
  7059. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  7060. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, TestTextureSize);
  7061. // Negative Z
  7062. Rec.Func := glBitmapNormalMapNegZ;
  7063. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  7064. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, TestTextureSize);
  7065. end;
  7066. *)
  7067. initialization
  7068. glBitmapSetDefaultFormat(tfEmpty);
  7069. glBitmapSetDefaultMipmap(mmMipmap);
  7070. glBitmapSetDefaultFilter(GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
  7071. glBitmapSetDefaultWrap (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
  7072. glBitmapSetDefaultFreeDataAfterGenTexture(true);
  7073. glBitmapSetDefaultDeleteTextureOnFree (true);
  7074. TFormatDescriptor.Init;
  7075. finalization
  7076. TFormatDescriptor.Finalize;
  7077. end.