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

7973 lines
261 KiB

  1. {***********************************************************
  2. glBitmap by Steffen Xonna aka Lossy eX (2003-2008)
  3. http://www.opengl24.de/index.php?cat=header&file=glbitmap
  4. ------------------------------------------------------------
  5. The contents of this file are used with permission, subject to
  6. the Mozilla Public License Version 1.1 (the "License"); you may
  7. not use this file except in compliance with the License. You may
  8. obtain a copy of the License at
  9. http://www.mozilla.org/MPL/MPL-1.1.html
  10. ------------------------------------------------------------
  11. Version 2.0.3
  12. ------------------------------------------------------------
  13. History
  14. 21-03-2010
  15. - The define GLB_DELPHI dosn't check versions anymore. If you say you are using delphi
  16. then it's your problem if that isn't true. This prevents the unit for incompatibility
  17. with newer versions of Delphi.
  18. - Problems with D2009+ resolved (Thanks noeska and all i forgot)
  19. - GetPixel isn't set if you are loading textures inside the constructor (Thanks Wilson)
  20. 10-08-2008
  21. - AddAlphaFromglBitmap used the custom pointer instead the imagedatapointer (Thanks Wilson)
  22. - Additional Datapointer for functioninterface now has the name CustomData
  23. 24-07-2008
  24. - AssigneAlphaToBitmap overwrites his own palette (Thanks Wilson)
  25. - If you load an texture from an file the property Filename will be set to the name of the file
  26. - Three new properties to attach custom data to the Texture objects
  27. - CustomName (free for use string)
  28. - CustomNameW (free for use widestring)
  29. - CustomDataPointer (free for use pointer to attach other objects or complex structures)
  30. 27-05-2008
  31. - RLE TGAs loaded much faster
  32. 26-05-2008
  33. - fixed some problem with reading RLE TGAs.
  34. 21-05-2008
  35. - function clone now only copys data if it's assigned and now it also copies the ID
  36. - it seems that lazarus dont like comments in comments.
  37. 01-05-2008
  38. - It's possible to set the id of the texture
  39. - define GLB_NO_NATIVE_GL deactivated by default
  40. 27-04-2008
  41. - Now supports the following libraries
  42. - SDL and SDL_image
  43. - libPNG
  44. - libJPEG
  45. - Linux compatibillity via free pascal compatibility (delphi sources optional)
  46. - BMPs now loaded manuel
  47. - Large restructuring
  48. - Property DataPtr now has the name Data
  49. - Functions are more flexible between RGB(A) and BGR(A). RGB can be saved as Bitmap and will be saved as BGR
  50. - Unused Depth removed
  51. - Function FreeData to freeing image data added
  52. 24-10-2007
  53. - ImageID flag of TGAs was ignored. (Thanks Zwoetzen)
  54. 15-11-2006
  55. - Function SetBorderColor implemented (only used by opengl if wrap is set to GL_CLAMP_TO_BORDER)
  56. - Function AddAlphaFromValue implemented to use an fixed Value as Alphachannel
  57. - Function ReadOpenGLExtension is now only intern
  58. 29-06-2006
  59. - pngimage now disabled by default like all other versions.
  60. 26-06-2006
  61. - Setting up an anisotropic filter of 0 isnt allowed by nvidia (Thanks Ogridi)
  62. 22-06-2006
  63. - Fixed some Problem with Delphi 5
  64. - Now uses the newest version of pngimage. Makes saving pngs much easier.
  65. 22-03-2006
  66. - Property IsCompressed and Size removed. Not really supported by Spec (Thanks Ogridi)
  67. 09-03-2006
  68. - Internal Format ifDepth8 added
  69. - function GrabScreen now supports all uncompressed formats
  70. 31-01-2006
  71. - AddAlphaFromglBitmap implemented
  72. 29-12-2005
  73. - LoadFromResource and LoadFromResourceId now needs an Instance and an ResourceType (for ID)
  74. 28-12-2005
  75. - Width, Height and Depth internal changed to TglBitmapPixelPosition.
  76. property Width, Height, Depth are still existing and new property Dimension are avail
  77. 11-12-2005
  78. - Added native OpenGL Support. Breaking the dglOpenGL "barrier".
  79. 19-10-2005
  80. - Added function GrabScreen to class TglBitmap2D
  81. 18-10-2005
  82. - Added support to Save images
  83. - Added function Clone to Clone Instance
  84. 11-10-2005
  85. - Functions now works with Cardinals for each channel. Up to 32 Bits per channel.
  86. Usefull for Future
  87. - Several speed optimizations
  88. 09-10-2005
  89. - Internal structure change. Loading of TGA, PNG and DDS improved.
  90. Data, format and size will now set directly with SetDataPtr.
  91. - AddFunc now works with all Types of Images and Formats
  92. - Some Funtions moved to Baseclass TglBitmap
  93. 06-10-2005
  94. - Added Support to decompress DXT3 and DXT5 compressed Images.
  95. - Added Mapping to convert data from one format into an other.
  96. 05-10-2005
  97. - Added method ConvertTo in Class TglBitmap2D. Method allows to convert every
  98. supported Input format (supported by GetPixel) into any uncompresed Format
  99. - Added Support to decompress DXT1 compressed Images.
  100. - SwapColors replaced by ConvertTo
  101. 04-10-2005
  102. - Added Support for compressed DDSs
  103. - Added new internal formats (DXT1, DXT3, DXT5)
  104. 29-09-2005
  105. - Parameter Components renamed to InternalFormat
  106. 23-09-2005
  107. - Some AllocMem replaced with GetMem (little speed change)
  108. - better exception handling. Better protection from memory leaks.
  109. 22-09-2005
  110. - Added support for Direct Draw Surfaces (.DDS) (uncompressed images only)
  111. - Added new internal formats (RGB8, RGBA8, RGBA4, RGB5A1, RGB10A2, R5G6B5)
  112. 07-09-2005
  113. - Added support for Grayscale textures
  114. - Added internal formats (Alpha, Luminance, LuminanceAlpha, BGR8, BGRA8)
  115. 10-07-2005
  116. - Added support for GL_VERSION_2_0
  117. - Added support for GL_EXT_texture_filter_anisotropic
  118. 04-07-2005
  119. - Function FillWithColor fills the Image with one Color
  120. - Function LoadNormalMap added
  121. 30-06-2005
  122. - ToNormalMap allows to Create an NormalMap from the Alphachannel
  123. - ToNormalMap now supports Sobel (nmSobel) function.
  124. 29-06-2005
  125. - support for RLE Compressed RGB TGAs added
  126. 28-06-2005
  127. - Class TglBitmapNormalMap added to support Normalmap generation
  128. - Added function ToNormalMap in class TglBitmap2D to genereate normal maps from textures.
  129. 3 Filters are supported. (4 Samples, 3x3 and 5x5)
  130. 16-06-2005
  131. - Method LoadCubeMapClass removed
  132. - LoadCubeMap returnvalue is now the Texture paramter. Such as LoadTextures
  133. - virtual abstract method GenTexture in class TglBitmap now is protected
  134. 12-06-2005
  135. - now support DescriptionFlag in LoadTga. Allows vertical flipped images to be loaded as normal
  136. 10-06-2005
  137. - little enhancement for IsPowerOfTwo
  138. - TglBitmap1D.GenTexture now tests NPOT Textures
  139. 06-06-2005
  140. - some little name changes. All properties or function with Texture in name are
  141. now without texture in name. We have allways texture so we dosn't name it.
  142. 03-06-2005
  143. - GenTexture now tests if texture is NPOT and NPOT-Texture are supported or
  144. TextureTarget is GL_TEXTURE_RECTANGLE. Else it raised an exception.
  145. 02-06-2005
  146. - added support for GL_ARB_texture_rectangle, GL_EXT_texture_rectangle and GL_NV_texture_rectangle
  147. 25-04-2005
  148. - Function Unbind added
  149. - call of SetFilter or SetTextureWrap if TextureID exists results in setting properties to opengl texture.
  150. 21-04-2005
  151. - class TglBitmapCubeMap added (allows to Create Cubemaps)
  152. 29-03-2005
  153. - Added Support for PNG Images. (http://pngdelphi.sourceforge.net/)
  154. To Enable png's use the define pngimage
  155. 22-03-2005
  156. - New Functioninterface added
  157. - Function GetPixel added
  158. 27-11-2004
  159. - Property BuildMipMaps renamed to MipMap
  160. 21-11-2004
  161. - property Name removed.
  162. - BuildMipMaps is now a set of 3 values. None, GluBuildMipmaps and SGIS_generate_mipmap
  163. 22-05-2004
  164. - property name added. Only used in glForms!
  165. 26-11-2003
  166. - property FreeDataAfterGenTexture is now available as default (default = true)
  167. - BuildMipmaps now implemented in TglBitmap1D (i've forgotten it)
  168. - function MoveMemory replaced with function Move (little speed change)
  169. - several calculations stored in variables (little speed change)
  170. 29-09-2003
  171. - property BuildMipsMaps added (default = true)
  172. if BuildMipMaps isn't set GenTextures uses glTexImage[12]D else it use gluBuild[12]dMipmaps
  173. - property FreeDataAfterGenTexture added (default = true)
  174. if FreeDataAfterGenTexture is set the texturedata were deleted after the texture was generated.
  175. - parameter DisableOtherTextureUnits of Bind removed
  176. - parameter FreeDataAfterGeneration of GenTextures removed
  177. 12-09-2003
  178. - TglBitmap dosn't delete data if class was destroyed (fixed)
  179. 09-09-2003
  180. - Bind now enables TextureUnits (by params)
  181. - GenTextures can leave data (by param)
  182. - LoadTextures now optimal
  183. 03-09-2003
  184. - Performance optimization in AddFunc
  185. - procedure Bind moved to subclasses
  186. - Added new Class TglBitmap1D to support real OpenGL 1D Textures
  187. 19-08-2003
  188. - Texturefilter and texturewrap now also as defaults
  189. Minfilter = GL_LINEAR_MIPMAP_LINEAR
  190. Magfilter = GL_LINEAR
  191. Wrap(str) = GL_CLAMP_TO_EDGE
  192. - Added new format tfCompressed to create a compressed texture.
  193. - propertys IsCompressed, TextureSize and IsResident added
  194. IsCompressed and TextureSize only contains data from level 0
  195. 18-08-2003
  196. - Added function AddFunc to add PerPixelEffects to Image
  197. - LoadFromFunc now based on AddFunc
  198. - Invert now based on AddFunc
  199. - SwapColors now based on AddFunc
  200. 16-08-2003
  201. - Added function FlipHorz
  202. 15-08-2003
  203. - Added function LaodFromFunc to create images with function
  204. - Added function FlipVert
  205. - Added internal format RGB(A) if GL_EXT_bgra or OpenGL 1.2 isn't supported
  206. 29-07-2003
  207. - Added Alphafunctions to calculate alpha per function
  208. - Added Alpha from ColorKey using alphafunctions
  209. 28-07-2003
  210. - First full functionally Version of glBitmap
  211. - Support for 24Bit and 32Bit TGA Pictures added
  212. 25-07-2003
  213. - begin of programming
  214. ***********************************************************}
  215. unit glBitmap;
  216. {.$MESSAGE warn 'Hey. I''m the glBitmap.pas and i need to be configured. My master tell me your preferences! ;)'}
  217. // Please uncomment the defines below to configure the glBitmap to your preferences.
  218. // If you have configured the unit you can uncomment the warning above.
  219. // ###### Start of preferences ################################################
  220. {$DEFINE GLB_NO_NATIVE_GL}
  221. // To enable the dglOpenGL.pas Header
  222. // With native GL then bindings are staticlly declared to support other headers
  223. // or use the glBitmap inside of DLLs (minimize codesize).
  224. {.$DEFINE GLB_SDL}
  225. // To enable the support for SDL_surfaces
  226. {.$DEFINE GLB_DELPHI}
  227. // To enable the support for TBitmap from Delphi (not lazarus)
  228. // *** image libs ***
  229. {.$DEFINE GLB_SDL_IMAGE}
  230. // To enable the support of SDL_image to load files. (READ ONLY)
  231. // If you enable SDL_image all other libraries will be ignored!
  232. {.$DEFINE GLB_PNGIMAGE}
  233. // to enable png support with the unit pngimage. You can download it from http://pngdelphi.sourceforge.net/
  234. // if you enable pngimage the libPNG will be ignored
  235. {.$DEFINE GLB_LIB_PNG}
  236. // to use the libPNG http://www.libpng.org/
  237. // You will need an aditional header.
  238. // http://www.opengl24.de/index.php?cat=header&file=libpng
  239. {.$DEFINE GLB_DELPHI_JPEG}
  240. // if you enable delphi jpegs the libJPEG will be ignored
  241. {.$DEFINE GLB_LIB_JPEG}
  242. // to use the libJPEG http://www.ijg.org/
  243. // You will need an aditional header.
  244. // http://www.opengl24.de/index.php?cat=header&file=libjpeg
  245. // ###### End of preferences ##################################################
  246. // ###### PRIVATE. Do not change anything. ####################################
  247. // *** old defines for compatibility ***
  248. {$IFDEF NO_NATIVE_GL}
  249. {$DEFINE GLB_NO_NATIVE_GL}
  250. {$ENDIF}
  251. {$IFDEF pngimage}
  252. {$definde GLB_PNGIMAGE}
  253. {$ENDIF}
  254. // *** Delphi Versions ***
  255. {$IFDEF fpc}
  256. {$MODE Delphi}
  257. {$IFDEF CPUI386}
  258. {$DEFINE CPU386}
  259. {$ASMMODE INTEL}
  260. {$ENDIF}
  261. {$IFNDEF WINDOWS}
  262. {$linklib c}
  263. {$ENDIF}
  264. {$ENDIF}
  265. // *** checking define combinations ***
  266. {$IFDEF GLB_SDL_IMAGE}
  267. {$IFNDEF GLB_SDL}
  268. {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
  269. {$DEFINE GLB_SDL}
  270. {$ENDIF}
  271. {$IFDEF GLB_PNGIMAGE}
  272. {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
  273. {$undef GLB_PNGIMAGE}
  274. {$ENDIF}
  275. {$IFDEF GLB_DELPHI_JPEG}
  276. {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
  277. {$undef GLB_DELPHI_JPEG}
  278. {$ENDIF}
  279. {$IFDEF GLB_LIB_PNG}
  280. {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
  281. {$undef GLB_LIB_PNG}
  282. {$ENDIF}
  283. {$IFDEF GLB_LIB_JPEG}
  284. {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
  285. {$undef GLB_LIB_JPEG}
  286. {$ENDIF}
  287. {$DEFINE GLB_SUPPORT_PNG_READ}
  288. {$DEFINE GLB_SUPPORT_JPEG_READ}
  289. {$ENDIF}
  290. {$IFDEF GLB_PNGIMAGE}
  291. {$IFDEF GLB_LIB_PNG}
  292. {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
  293. {$undef GLB_LIB_PNG}
  294. {$ENDIF}
  295. {$DEFINE GLB_SUPPORT_PNG_READ}
  296. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  297. {$ENDIF}
  298. {$IFDEF GLB_LIB_PNG}
  299. {$DEFINE GLB_SUPPORT_PNG_READ}
  300. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  301. {$ENDIF}
  302. {$IFDEF GLB_DELPHI_JPEG}
  303. {$IFDEF GLB_LIB_JPEG}
  304. {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
  305. {$undef GLB_LIB_JPEG}
  306. {$ENDIF}
  307. {$DEFINE GLB_SUPPORT_JPEG_READ}
  308. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  309. {$ENDIF}
  310. {$IFDEF GLB_LIB_JPEG}
  311. {$DEFINE GLB_SUPPORT_JPEG_READ}
  312. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  313. {$ENDIF}
  314. // *** general options ***
  315. {$EXTENDEDSYNTAX ON}
  316. {$LONGSTRINGS ON}
  317. {$ALIGN ON}
  318. {$IFNDEF FPC}
  319. {$OPTIMIZATION ON}
  320. {$ENDIF}
  321. interface
  322. uses
  323. {$IFDEF GLB_NO_NATIVE_GL} dglOpenGL, {$ENDIF}
  324. {$IFDEF GLB_SDL} SDL, {$ENDIF}
  325. {$IFDEF GLB_DELPHI} Dialogs, Windows, Graphics, {$ENDIF}
  326. {$IFDEF GLB_SDL_IMAGE} SDL_image, {$ENDIF}
  327. {$IFDEF GLB_PNGIMAGE} pngimage, {$ENDIF}
  328. {$IFDEF GLB_LIB_PNG} libPNG, {$ENDIF}
  329. {$IFDEF GLB_DELPHI_JPEG} JPEG, {$ENDIF}
  330. {$IFDEF GLB_LIB_JPEG} libJPEG, {$ENDIF}
  331. Classes, SysUtils;
  332. {$IFNDEF GLB_DELPHI}
  333. type
  334. HGLRC = Cardinal;
  335. DWORD = Cardinal;
  336. PDWORD = ^DWORD;
  337. TRGBQuad = packed record
  338. rgbBlue: Byte;
  339. rgbGreen: Byte;
  340. rgbRed: Byte;
  341. rgbReserved: Byte;
  342. end;
  343. {$ENDIF}
  344. (* TODO dglOpenGL
  345. {$IFNDEF GLB_NO_NATIVE_GL}
  346. // Native OpenGL Implementation
  347. type
  348. PByteBool = ^ByteBool;
  349. {$IFDEF GLB_DELPHI}
  350. var
  351. gLastContext: HGLRC;
  352. {$ENDIF}
  353. const
  354. // Generell
  355. GL_VERSION = $1F02;
  356. GL_EXTENSIONS = $1F03;
  357. GL_TRUE = 1;
  358. GL_FALSE = 0;
  359. GL_TEXTURE_1D = $0DE0;
  360. GL_TEXTURE_2D = $0DE1;
  361. GL_MAX_TEXTURE_SIZE = $0D33;
  362. GL_PACK_ALIGNMENT = $0D05;
  363. GL_UNPACK_ALIGNMENT = $0CF5;
  364. // Textureformats
  365. GL_RGB = $1907;
  366. GL_RGB4 = $804F;
  367. GL_RGB8 = $8051;
  368. GL_RGBA = $1908;
  369. GL_RGBA4 = $8056;
  370. GL_RGBA8 = $8058;
  371. GL_BGR = $80E0;
  372. GL_BGRA = $80E1;
  373. GL_ALPHA4 = $803B;
  374. GL_ALPHA8 = $803C;
  375. GL_LUMINANCE4 = $803F;
  376. GL_LUMINANCE8 = $8040;
  377. GL_LUMINANCE4_ALPHA4 = $8043;
  378. GL_LUMINANCE8_ALPHA8 = $8045;
  379. GL_DEPTH_COMPONENT = $1902;
  380. GL_UNSIGNED_BYTE = $1401;
  381. GL_ALPHA = $1906;
  382. GL_LUMINANCE = $1909;
  383. GL_LUMINANCE_ALPHA = $190A;
  384. GL_TEXTURE_WIDTH = $1000;
  385. GL_TEXTURE_HEIGHT = $1001;
  386. GL_TEXTURE_INTERNAL_FORMAT = $1003;
  387. GL_TEXTURE_RED_SIZE = $805C;
  388. GL_TEXTURE_GREEN_SIZE = $805D;
  389. GL_TEXTURE_BLUE_SIZE = $805E;
  390. GL_TEXTURE_ALPHA_SIZE = $805F;
  391. GL_TEXTURE_LUMINANCE_SIZE = $8060;
  392. // Dataformats
  393. GL_UNSIGNED_SHORT_5_6_5 = $8363;
  394. GL_UNSIGNED_SHORT_5_6_5_REV = $8364;
  395. GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;
  396. GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;
  397. GL_UNSIGNED_INT_2_10_10_10_REV = $8368;
  398. // Filter
  399. GL_NEAREST = $2600;
  400. GL_LINEAR = $2601;
  401. GL_NEAREST_MIPMAP_NEAREST = $2700;
  402. GL_LINEAR_MIPMAP_NEAREST = $2701;
  403. GL_NEAREST_MIPMAP_LINEAR = $2702;
  404. GL_LINEAR_MIPMAP_LINEAR = $2703;
  405. GL_TEXTURE_MAG_FILTER = $2800;
  406. GL_TEXTURE_MIN_FILTER = $2801;
  407. // Wrapmodes
  408. GL_TEXTURE_WRAP_S = $2802;
  409. GL_TEXTURE_WRAP_T = $2803;
  410. GL_CLAMP = $2900;
  411. GL_REPEAT = $2901;
  412. GL_CLAMP_TO_EDGE = $812F;
  413. GL_CLAMP_TO_BORDER = $812D;
  414. GL_TEXTURE_WRAP_R = $8072;
  415. GL_MIRRORED_REPEAT = $8370;
  416. // Border Color
  417. GL_TEXTURE_BORDER_COLOR = $1004;
  418. // Texgen
  419. GL_NORMAL_MAP = $8511;
  420. GL_REFLECTION_MAP = $8512;
  421. GL_S = $2000;
  422. GL_T = $2001;
  423. GL_R = $2002;
  424. GL_TEXTURE_GEN_MODE = $2500;
  425. GL_TEXTURE_GEN_S = $0C60;
  426. GL_TEXTURE_GEN_T = $0C61;
  427. GL_TEXTURE_GEN_R = $0C62;
  428. // Cubemaps
  429. GL_MAX_CUBE_MAP_TEXTURE_SIZE = $851C;
  430. GL_TEXTURE_CUBE_MAP = $8513;
  431. GL_TEXTURE_BINDING_CUBE_MAP = $8514;
  432. GL_TEXTURE_CUBE_MAP_POSITIVE_X = $8515;
  433. GL_TEXTURE_CUBE_MAP_NEGATIVE_X = $8516;
  434. GL_TEXTURE_CUBE_MAP_POSITIVE_Y = $8517;
  435. GL_TEXTURE_CUBE_MAP_NEGATIVE_Y = $8518;
  436. GL_TEXTURE_CUBE_MAP_POSITIVE_Z = $8519;
  437. GL_TEXTURE_CUBE_MAP_NEGATIVE_Z = $851A;
  438. GL_TEXTURE_RECTANGLE_ARB = $84F5;
  439. // GL_SGIS_generate_mipmap
  440. GL_GENERATE_MIPMAP = $8191;
  441. // GL_EXT_texture_compression_s3tc
  442. GL_COMPRESSED_RGB_S3TC_DXT1_EXT = $83F0;
  443. GL_COMPRESSED_RGBA_S3TC_DXT1_EXT = $83F1;
  444. GL_COMPRESSED_RGBA_S3TC_DXT3_EXT = $83F2;
  445. GL_COMPRESSED_RGBA_S3TC_DXT5_EXT = $83F3;
  446. // GL_EXT_texture_filter_anisotropic
  447. GL_TEXTURE_MAX_ANISOTROPY_EXT = $84FE;
  448. GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;
  449. // GL_ARB_texture_compression
  450. GL_COMPRESSED_RGB = $84ED;
  451. GL_COMPRESSED_RGBA = $84EE;
  452. GL_COMPRESSED_ALPHA = $84E9;
  453. GL_COMPRESSED_LUMINANCE = $84EA;
  454. GL_COMPRESSED_LUMINANCE_ALPHA = $84EB;
  455. // Extensions
  456. var
  457. GL_VERSION_1_2,
  458. GL_VERSION_1_3,
  459. GL_VERSION_1_4,
  460. GL_VERSION_2_0,
  461. GL_ARB_texture_border_clamp,
  462. GL_ARB_texture_cube_map,
  463. GL_ARB_texture_compression,
  464. GL_ARB_texture_non_power_of_two,
  465. GL_ARB_texture_rectangle,
  466. GL_ARB_texture_mirrored_repeat,
  467. GL_EXT_bgra,
  468. GL_EXT_texture_edge_clamp,
  469. GL_EXT_texture_cube_map,
  470. GL_EXT_texture_compression_s3tc,
  471. GL_EXT_texture_filter_anisotropic,
  472. GL_EXT_texture_rectangle,
  473. GL_NV_texture_rectangle,
  474. GL_IBM_texture_mirrored_repeat,
  475. GL_SGIS_generate_mipmap: Boolean;
  476. const
  477. {$IFDEF LINUX}
  478. libglu = 'libGLU.so.1';
  479. libopengl = 'libGL.so.1';
  480. {$else}
  481. libglu = 'glu32.dll';
  482. libopengl = 'opengl32.dll';
  483. {$ENDIF}
  484. {$IFDEF LINUX}
  485. function glXGetProcAddress(ProcName: PAnsiChar): Pointer; cdecl; external libopengl;
  486. {$else}
  487. function wglGetProcAddress(ProcName: PAnsiChar): Pointer; stdcall; external libopengl;
  488. {$ENDIF}
  489. function glGetString(name: Cardinal): PAnsiChar; {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
  490. procedure glEnable(cap: Cardinal); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
  491. procedure glDisable(cap: Cardinal); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
  492. procedure glGetIntegerv(pname: Cardinal; params: PInteger); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
  493. procedure glTexImage1D(target: Cardinal; level, internalformat, width, border: Integer; format, atype: Cardinal; const pixels: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
  494. procedure glTexImage2D(target: Cardinal; level, internalformat, width, height, border: Integer; format, atype: Cardinal; const pixels: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
  495. procedure glGenTextures(n: Integer; Textures: PCardinal); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
  496. procedure glBindTexture(target: Cardinal; Texture: Cardinal); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
  497. procedure glDeleteTextures(n: Integer; const textures: PCardinal); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
  498. procedure glReadPixels(x, y: Integer; width, height: Integer; format, atype: Cardinal; pixels: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
  499. procedure glPixelStorei(pname: Cardinal; param: Integer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
  500. procedure glGetTexImage(target: Cardinal; level: Integer; format: Cardinal; _type: Cardinal; pixels: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
  501. function glAreTexturesResident(n: Integer; const Textures: PCardinal; residences: PByteBool): ByteBool; {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
  502. procedure glTexParameteri(target: Cardinal; pname: Cardinal; param: Integer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
  503. procedure glTexParameterfv(target: Cardinal; pname: Cardinal; const params: PSingle); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
  504. procedure glGetTexLevelParameteriv(target: Cardinal; level: Integer; pname: Cardinal; params: PInteger); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
  505. procedure glTexGeni(coord, pname: Cardinal; param: Integer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
  506. function gluBuild1DMipmaps(Target: Cardinal; Components, Width: Integer; Format, atype: Cardinal; Data: Pointer): Integer; {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libglu;
  507. function gluBuild2DMipmaps(Target: Cardinal; Components, Width, Height: Integer; Format, aType: Cardinal; Data: Pointer): Integer; {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libglu;
  508. var
  509. glCompressedTexImage2D : procedure(target: Cardinal; level: Integer; internalformat: Cardinal; width, height: Integer; border: Integer; imageSize: Integer; const data: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF}
  510. glCompressedTexImage1D : procedure(target: Cardinal; level: Integer; internalformat: Cardinal; width: Integer; border: Integer; imageSize: Integer; const data: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF}
  511. glGetCompressedTexImage : procedure(target: Cardinal; level: Integer; img: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF}
  512. {$ENDIF}
  513. *)
  514. type
  515. ////////////////////////////////////////////////////////////////////////////////////////////////////
  516. EglBitmapException = class(Exception);
  517. EglBitmapSizeToLargeException = class(EglBitmapException);
  518. EglBitmapNonPowerOfTwoException = class(EglBitmapException);
  519. EglBitmapUnsupportedFormatFormat = class(EglBitmapException);
  520. ////////////////////////////////////////////////////////////////////////////////////////////////////
  521. TglBitmapFormat = (
  522. tfEmpty = 0,
  523. tfAlpha4,
  524. tfAlpha8,
  525. tfAlpha12,
  526. tfAlpha16,
  527. tfLuminance4,
  528. tfLuminance8,
  529. tfLuminance12,
  530. tfLuminance16,
  531. tfLuminance4Alpha4,
  532. tfLuminance6Alpha2,
  533. tfLuminance8Alpha8,
  534. tfLuminance12Alpha4,
  535. tfLuminance12Alpha12,
  536. tfLuminance16Alpha16,
  537. tfR3G3B2,
  538. tfRGB4,
  539. tfR5G6B5,
  540. tfRGB5,
  541. tfRGB8,
  542. tfRGB10,
  543. tfRGB12,
  544. tfRGB16,
  545. tfRGBA2,
  546. tfRGBA4,
  547. tfRGB5A1,
  548. tfRGBA8,
  549. tfRGB10A2,
  550. tfRGBA12,
  551. tfRGBA16,
  552. tfBGR4,
  553. tfB5G6R5,
  554. tfBGR5,
  555. tfBGR8,
  556. tfBGR10,
  557. tfBGR12,
  558. tfBGR16,
  559. tfBGRA2,
  560. tfBGRA4,
  561. tfBGR5A1,
  562. tfBGRA8,
  563. tfBGR10A2,
  564. tfBGRA12,
  565. tfBGRA16,
  566. tfDepth16,
  567. tfDepth24,
  568. tfDepth32
  569. );
  570. TglBitmapFileType = (
  571. {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG, {$ENDIF}
  572. {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
  573. ftDDS,
  574. ftTGA,
  575. ftBMP);
  576. TglBitmapFileTypes = set of TglBitmapFileType;
  577. TglBitmapMipMap = (
  578. mmNone,
  579. mmMipmap,
  580. mmMipmapGlu);
  581. TglBitmapNormalMapFunc = (
  582. nm4Samples,
  583. nmSobel,
  584. nm3x3,
  585. nm5x5);
  586. ////////////////////////////////////////////////////////////////////////////////////////////////////
  587. TglBitmapColorRec = packed record
  588. case Integer of
  589. 0: (r, g, b, a: Cardinal);
  590. 1: (arr: array[0..3] of Cardinal);
  591. end;
  592. TglBitmapPixelData = packed record
  593. Data, Range: TglBitmapColorRec;
  594. Format: TglBitmapFormat;
  595. end;
  596. PglBitmapPixelData = ^TglBitmapPixelData;
  597. ////////////////////////////////////////////////////////////////////////////////////////////////////
  598. TglBitmapPixelPositionFields = set of (ffX, ffY);
  599. TglBitmapPixelPosition = record
  600. Fields : TglBitmapPixelPositionFields;
  601. X : Word;
  602. Y : Word;
  603. end;
  604. ////////////////////////////////////////////////////////////////////////////////////////////////////
  605. TglBitmap = class;
  606. TglBitmapFunctionRec = record
  607. Sender: TglBitmap;
  608. Size: TglBitmapPixelPosition;
  609. Position: TglBitmapPixelPosition;
  610. Source: TglBitmapPixelData;
  611. Dest: TglBitmapPixelData;
  612. Args: PtrInt;
  613. end;
  614. TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
  615. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  616. TglBitmap = class
  617. protected
  618. fID: GLuint;
  619. fTarget: GLuint;
  620. fAnisotropic: Integer;
  621. fDeleteTextureOnFree: Boolean;
  622. fFreeDataAfterGenTexture: Boolean;
  623. fData: PByte;
  624. fIsResident: Boolean;
  625. fBorderColor: array[0..3] of Single;
  626. fDimension: TglBitmapPixelPosition;
  627. fMipMap: TglBitmapMipMap;
  628. fFormat: TglBitmapFormat;
  629. // Mapping
  630. fPixelSize: Integer;
  631. fRowSize: Integer;
  632. // Filtering
  633. fFilterMin: Cardinal;
  634. fFilterMag: Cardinal;
  635. // TexturWarp
  636. fWrapS: Cardinal;
  637. fWrapT: Cardinal;
  638. fWrapR: Cardinal;
  639. // CustomData
  640. fFilename: String;
  641. fCustomName: String;
  642. fCustomNameW: WideString;
  643. fCustomData: Pointer;
  644. //Getter
  645. function GetWidth: Integer; virtual;
  646. function GetHeight: Integer; virtual;
  647. function GetFileWidth: Integer; virtual;
  648. function GetFileHeight: Integer; virtual;
  649. //Setter
  650. procedure SetCustomData(const aValue: Pointer);
  651. procedure SetCustomName(const aValue: String);
  652. procedure SetCustomNameW(const aValue: WideString);
  653. procedure SetDeleteTextureOnFree(const aValue: Boolean);
  654. procedure SetFormat(const aValue: TglBitmapFormat);
  655. procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
  656. procedure SetID(const aValue: Cardinal);
  657. procedure SetMipMap(const aValue: TglBitmapMipMap);
  658. procedure SetTarget(const aValue: Cardinal);
  659. procedure SetAnisotropic(const aValue: Integer);
  660. procedure CreateID;
  661. procedure SetupParameters(var aBuildWithGlu: Boolean);
  662. procedure SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
  663. const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;
  664. procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
  665. function FlipHorz: Boolean; virtual;
  666. function FlipVert: Boolean; virtual;
  667. property Width: Integer read GetWidth;
  668. property Height: Integer read GetHeight;
  669. property FileWidth: Integer read GetFileWidth;
  670. property FileHeight: Integer read GetFileHeight;
  671. public
  672. //Properties
  673. property ID: Cardinal read fID write SetID;
  674. property Target: Cardinal read fTarget write SetTarget;
  675. property Format: TglBitmapFormat read fFormat write SetFormat;
  676. property MipMap: TglBitmapMipMap read fMipMap write SetMipMap;
  677. property Anisotropic: Integer read fAnisotropic write SetAnisotropic;
  678. property Filename: String read fFilename;
  679. property CustomName: String read fCustomName write SetCustomName;
  680. property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
  681. property CustomData: Pointer read fCustomData write SetCustomData;
  682. property DeleteTextureOnFree: Boolean read fDeleteTextureOnFree write SetDeleteTextureOnFree;
  683. property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
  684. property Dimension: TglBitmapPixelPosition read fDimension;
  685. property Data: PByte read fData;
  686. property IsResident: Boolean read fIsResident;
  687. procedure AfterConstruction; override;
  688. procedure BeforeDestruction; override;
  689. //Load
  690. procedure LoadFromFile(const aFilename: String);
  691. procedure LoadFromStream(const aStream: TStream); virtual;
  692. procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  693. const aFormat: TglBitmapFormat; const aArgs: PtrInt = 0);
  694. {$IFDEF GLB_DELPHI}
  695. procedure LoadFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil);
  696. procedure LoadFromResourceID(const sInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  697. {$ENDIF}
  698. //Save
  699. procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  700. procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
  701. //Convert
  702. function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: PtrInt = 0): Boolean; overload;
  703. function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  704. const aFormat: TglBitmapFormat; const aArgs: PtrInt = 0): Boolean; overload;
  705. public
  706. //Alpha & Co
  707. {$IFDEF GLB_SDL}
  708. function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  709. function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  710. function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  711. function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
  712. const aArgs: PtrInt = 0): Boolean;
  713. {$ENDIF}
  714. {$IFDEF GLB_DELPHI}
  715. function AssignToBitmap(const aBitmap: TBitmap): Boolean;
  716. function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  717. function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  718. function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
  719. const aArgs: PtrInt = 0): Boolean;
  720. function AddAlphaFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil;
  721. const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;
  722. function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  723. const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;
  724. {$ENDIF}
  725. function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: PtrInt = 0): Boolean; virtual;
  726. function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;
  727. function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;
  728. function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;
  729. function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
  730. function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
  731. function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
  732. function AddAlphaFromValue(const aAlpha: Byte): Boolean;
  733. function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  734. function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  735. function RemoveAlpha: Boolean; virtual;
  736. public
  737. //Common
  738. function Clone: TglBitmap;
  739. function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
  740. procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
  741. procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  742. procedure FreeData;
  743. //ColorFill
  744. procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
  745. procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
  746. procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
  747. //TexParameters
  748. procedure SetFilter(const aMin, aMag: Cardinal);
  749. procedure SetWrap(
  750. const S: Cardinal = GL_CLAMP_TO_EDGE;
  751. const T: Cardinal = GL_CLAMP_TO_EDGE;
  752. const R: Cardinal = GL_CLAMP_TO_EDGE);
  753. procedure GetPixel(const aPos: TglBitmapPixelPosition; var aPixel: TglBitmapPixelData); virtual;
  754. procedure SetPixel(const aPos: TglBitmapPixelPosition; const aPixel: TglBitmapPixelData); virtual;
  755. procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
  756. procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
  757. //Constructors
  758. constructor Create; overload;
  759. constructor Create(const aFileName: String); overload;
  760. constructor Create(const aStream: TStream); overload;
  761. constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat); overload;
  762. constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: PtrInt = 0); overload;
  763. {$IFDEF GLB_DELPHI}
  764. constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
  765. constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
  766. {$ENDIF}
  767. private
  768. {$IFDEF GLB_SUPPORT_PNG_READ}
  769. function LoadPNG(const aStream: TStream): Boolean; virtual;
  770. procedure SavePNG(const aStream: TStream); virtual;
  771. {$ENDIF}
  772. {$IFDEF GLB_SUPPORT_JPEG_READ}
  773. function LoadJPEG(const aStream: TStream): Boolean; virtual;
  774. procedure SaveJPEG(const aStream: TStream); virtual;
  775. {$ENDIF}
  776. function LoadBMP(const aStream: TStream): Boolean; virtual;
  777. procedure SaveBMP(const aStream: TStream); virtual;
  778. function LoadTGA(const aStream: TStream): Boolean; virtual;
  779. procedure SaveTGA(const aStream: TStream); virtual;
  780. function LoadDDS(const aStream: TStream): Boolean; virtual;
  781. procedure SaveDDS(const aStream: TStream); virtual;
  782. end;
  783. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  784. TglBitmap2D = class(TglBitmap)
  785. protected
  786. // Bildeinstellungen
  787. fLines: array of PByte;
  788. (* TODO
  789. procedure GetDXTColorBlock(pData: pByte; relX, relY: Integer; var Pixel: TglBitmapPixelData);
  790. procedure GetPixel2DDXT1(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
  791. procedure GetPixel2DDXT3(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
  792. procedure GetPixel2DDXT5(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
  793. procedure GetPixel2DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
  794. procedure SetPixel2DUnmap(const Pos: TglBitmapPixelPosition; const Pixel: TglBitmapPixelData);
  795. *)
  796. function GetScanline(const aIndex: Integer): Pointer;
  797. procedure SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
  798. const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
  799. procedure UploadData(const aTarget: Cardinal; const aBuildWithGlu: Boolean);
  800. public
  801. property Width;
  802. property Height;
  803. property Scanline[const aIndex: Integer]: Pointer read GetScanline;
  804. procedure AfterConstruction; override;
  805. procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  806. procedure GetDataFromTexture;
  807. procedure GenTexture(const aTestTextureSize: Boolean = true); override;
  808. function FlipHorz: Boolean; override;
  809. function FlipVert: Boolean; override;
  810. procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
  811. const aScale: Single = 2; const aUseAlpha: Boolean = false);
  812. end;
  813. (* TODO
  814. TglBitmapCubeMap = class(TglBitmap2D)
  815. protected
  816. fGenMode: Integer;
  817. // Hide GenTexture
  818. procedure GenTexture(TestTextureSize: Boolean = true); reintroduce;
  819. public
  820. procedure AfterConstruction; override;
  821. procedure GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean = true);
  822. procedure Unbind(DisableTexCoordsGen: Boolean = true; DisableTextureUnit: Boolean = true); reintroduce; virtual;
  823. procedure Bind(EnableTexCoordsGen: Boolean = true; EnableTextureUnit: Boolean = true); reintroduce; virtual;
  824. end;
  825. TglBitmapNormalMap = class(TglBitmapCubeMap)
  826. public
  827. procedure AfterConstruction; override;
  828. procedure GenerateNormalMap(Size: Integer = 32; TestTextureSize: Boolean = true);
  829. end;
  830. TglBitmap1D = class(TglBitmap)
  831. protected
  832. procedure GetPixel1DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
  833. procedure SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width: Integer = -1; Height: Integer = -1); override;
  834. procedure UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
  835. public
  836. // propertys
  837. property Width;
  838. procedure AfterConstruction; override;
  839. // Other
  840. function FlipHorz: Boolean; override;
  841. // Generation
  842. procedure GenTexture(TestTextureSize: Boolean = true); override;
  843. end;
  844. *)
  845. const
  846. NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
  847. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  848. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  849. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  850. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  851. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  852. procedure glBitmapSetDefaultWrap(
  853. const S: Cardinal = GL_CLAMP_TO_EDGE;
  854. const T: Cardinal = GL_CLAMP_TO_EDGE;
  855. const R: Cardinal = GL_CLAMP_TO_EDGE);
  856. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  857. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  858. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  859. function glBitmapGetDefaultFormat: TglBitmapFormat;
  860. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  861. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  862. function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
  863. function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
  864. function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
  865. var
  866. glBitmapDefaultDeleteTextureOnFree: Boolean;
  867. glBitmapDefaultFreeDataAfterGenTextures: Boolean;
  868. glBitmapDefaultFormat: TglBitmapFormat;
  869. glBitmapDefaultMipmap: TglBitmapMipMap;
  870. glBitmapDefaultFilterMin: Cardinal;
  871. glBitmapDefaultFilterMag: Cardinal;
  872. glBitmapDefaultWrapS: Cardinal;
  873. glBitmapDefaultWrapT: Cardinal;
  874. glBitmapDefaultWrapR: Cardinal;
  875. {$IFDEF GLB_DELPHI}
  876. function CreateGrayPalette: HPALETTE;
  877. {$ENDIF}
  878. implementation
  879. (* TODO
  880. function FormatIsCompressed(Format: TglBitmapInternalFormat): boolean;
  881. function FormatIsUncompressed(Format: TglBitmapInternalFormat): boolean;
  882. function LoadTexture(Filename: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal = 0{$ENDIF}): Boolean;
  883. function LoadCubeMap(PositiveX, NegativeX, PositiveY, NegativeY, PositiveZ, NegativeZ: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal = 0{$ENDIF}): Boolean;
  884. function LoadNormalMap(Size: Integer; var Texture: Cardinal): Boolean;
  885. *)
  886. uses
  887. Math, syncobjs;
  888. type
  889. ////////////////////////////////////////////////////////////////////////////////////////////////////
  890. TShiftRec = packed record
  891. case Integer of
  892. 0: (r, g, b, a: Byte);
  893. 1: (arr: array[0..3] of Byte);
  894. end;
  895. TFormatDescriptor = class(TObject)
  896. private
  897. function GetRedMask: UInt64;
  898. function GetGreenMask: UInt64;
  899. function GetBlueMask: UInt64;
  900. function GetAlphaMask: UInt64;
  901. protected
  902. fFormat: TglBitmapFormat;
  903. fWithAlpha: TglBitmapFormat;
  904. fWithoutAlpha: TglBitmapFormat;
  905. fRGBInverted: TglBitmapFormat;
  906. fPixelSize: Single;
  907. fRange: TglBitmapColorRec;
  908. fShift: TShiftRec;
  909. fglFormat: Cardinal;
  910. fglInternalFormat: Cardinal;
  911. fglDataFormat: Cardinal;
  912. function GetComponents: Integer; virtual;
  913. public
  914. property Format: TglBitmapFormat read fFormat;
  915. property WithAlpha: TglBitmapFormat read fWithAlpha;
  916. property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;
  917. property RGBInverted: TglBitmapFormat read fRGBInverted;
  918. property Components: Integer read GetComponents;
  919. property PixelSize: Single read fPixelSize;
  920. property glFormat: Cardinal read fglFormat;
  921. property glInternalFormat: Cardinal read fglInternalFormat;
  922. property glDataFormat: Cardinal read fglDataFormat;
  923. property Range: TglBitmapColorRec read fRange;
  924. property Shift: TShiftRec read fShift;
  925. property RedMask: UInt64 read GetRedMask;
  926. property GreenMask: UInt64 read GetGreenMask;
  927. property BlueMask: UInt64 read GetBlueMask;
  928. property AlphaMask: UInt64 read GetAlphaMask;
  929. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
  930. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
  931. function GetSize(const aSize: TglBitmapPixelPosition): Integer; virtual; overload;
  932. function GetSize(const aWidth, aHeight: Integer): Integer; virtual; overload;
  933. function CreateMappingData: Pointer; virtual;
  934. procedure FreeMappingData(var aMappingData: Pointer); virtual;
  935. function IsEmpty: Boolean; virtual;
  936. function HasAlpha: Boolean; virtual;
  937. function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: UInt64): Boolean; virtual;
  938. procedure PreparePixel(var aPixel: TglBitmapPixelData); virtual;
  939. constructor Create; virtual;
  940. public
  941. class procedure Init;
  942. class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  943. class function GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  944. class procedure Clear;
  945. class procedure Finalize;
  946. end;
  947. TFormatDescriptorClass = class of TFormatDescriptor;
  948. TfdEmpty = class(TFormatDescriptor);
  949. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  950. TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte
  951. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  952. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  953. constructor Create; override;
  954. end;
  955. TfdLuminance_UB1 = class(TFormatDescriptor) //1* unsigned byte
  956. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  957. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  958. constructor Create; override;
  959. end;
  960. TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte
  961. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  962. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  963. constructor Create; override;
  964. end;
  965. TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte
  966. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  967. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  968. constructor Create; override;
  969. end;
  970. TfdRGB_UB3 = class(TFormatDescriptor) //3* unsigned byte
  971. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  972. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  973. constructor Create; override;
  974. end;
  975. TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
  976. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  977. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  978. constructor Create; override;
  979. end;
  980. TfdRGBA_UB4 = class(TfdRGB_UB3) //4* unsigned byte
  981. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  982. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  983. constructor Create; override;
  984. end;
  985. TfdBGRA_UB4 = class(TfdBGR_UB3) //4* unsigned byte (inverse)
  986. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  987. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  988. constructor Create; override;
  989. end;
  990. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  991. TfdAlpha_US1 = class(TFormatDescriptor) //1* unsigned short
  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. TfdLuminance_US1 = class(TFormatDescriptor) //1* unsigned short
  997. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  998. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  999. constructor Create; override;
  1000. end;
  1001. TfdUniversal_US1 = class(TFormatDescriptor) //1* unsigned short
  1002. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1003. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1004. constructor Create; override;
  1005. end;
  1006. TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short
  1007. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1008. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1009. constructor Create; override;
  1010. end;
  1011. TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short
  1012. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1013. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1014. constructor Create; override;
  1015. end;
  1016. TfdRGB_US3 = class(TFormatDescriptor) //3* unsigned short
  1017. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1018. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1019. constructor Create; override;
  1020. end;
  1021. TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)
  1022. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1023. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1024. constructor Create; override;
  1025. end;
  1026. TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
  1027. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1028. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1029. constructor Create; override;
  1030. end;
  1031. TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
  1032. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1033. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1034. constructor Create; override;
  1035. end;
  1036. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1037. TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int
  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. TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int
  1043. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1044. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1045. constructor Create; override;
  1046. end;
  1047. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1048. TfdAlpha4 = class(TfdAlpha_UB1)
  1049. constructor Create; override;
  1050. end;
  1051. TfdAlpha8 = class(TfdAlpha_UB1)
  1052. constructor Create; override;
  1053. end;
  1054. TfdAlpha12 = class(TfdAlpha_US1)
  1055. constructor Create; override;
  1056. end;
  1057. TfdAlpha16 = class(TfdAlpha_US1)
  1058. constructor Create; override;
  1059. end;
  1060. TfdLuminance4 = class(TfdLuminance_UB1)
  1061. constructor Create; override;
  1062. end;
  1063. TfdLuminance8 = class(TfdLuminance_UB1)
  1064. constructor Create; override;
  1065. end;
  1066. TfdLuminance12 = class(TfdLuminance_US1)
  1067. constructor Create; override;
  1068. end;
  1069. TfdLuminance16 = class(TfdLuminance_US1)
  1070. constructor Create; override;
  1071. end;
  1072. TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
  1073. constructor Create; override;
  1074. end;
  1075. TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
  1076. constructor Create; override;
  1077. end;
  1078. TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
  1079. constructor Create; override;
  1080. end;
  1081. TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
  1082. constructor Create; override;
  1083. end;
  1084. TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)
  1085. constructor Create; override;
  1086. end;
  1087. TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
  1088. constructor Create; override;
  1089. end;
  1090. TfdR3G3B2 = class(TfdUniversal_UB1)
  1091. constructor Create; override;
  1092. end;
  1093. TfdRGB4 = class(TfdUniversal_US1)
  1094. constructor Create; override;
  1095. end;
  1096. TfdR5G6B5 = class(TfdUniversal_US1)
  1097. constructor Create; override;
  1098. end;
  1099. TfdRGB5 = class(TfdUniversal_US1)
  1100. constructor Create; override;
  1101. end;
  1102. TfdRGB8 = class(TfdRGB_UB3)
  1103. constructor Create; override;
  1104. end;
  1105. TfdRGB10 = class(TfdUniversal_UI1)
  1106. constructor Create; override;
  1107. end;
  1108. TfdRGB12 = class(TfdRGB_US3)
  1109. constructor Create; override;
  1110. end;
  1111. TfdRGB16 = class(TfdRGB_US3)
  1112. constructor Create; override;
  1113. end;
  1114. TfdRGBA2 = class(TfdRGBA_UB4)
  1115. constructor Create; override;
  1116. end;
  1117. TfdRGBA4 = class(TfdUniversal_US1)
  1118. constructor Create; override;
  1119. end;
  1120. TfdRGB5A1 = class(TfdUniversal_US1)
  1121. constructor Create; override;
  1122. end;
  1123. TfdRGBA8 = class(TfdRGBA_UB4)
  1124. constructor Create; override;
  1125. end;
  1126. TfdRGB10A2 = class(TfdUniversal_UI1)
  1127. constructor Create; override;
  1128. end;
  1129. TfdRGBA12 = class(TfdRGBA_US4)
  1130. constructor Create; override;
  1131. end;
  1132. TfdRGBA16 = class(TfdRGBA_US4)
  1133. constructor Create; override;
  1134. end;
  1135. TfdBGR4 = class(TfdUniversal_US1)
  1136. constructor Create; override;
  1137. end;
  1138. TfdB5G6R5 = class(TfdUniversal_US1)
  1139. constructor Create; override;
  1140. end;
  1141. TfdBGR5 = class(TfdUniversal_US1)
  1142. constructor Create; override;
  1143. end;
  1144. TfdBGR8 = class(TfdBGR_UB3)
  1145. constructor Create; override;
  1146. end;
  1147. TfdBGR10 = class(TfdUniversal_UI1)
  1148. constructor Create; override;
  1149. end;
  1150. TfdBGR12 = class(TfdBGR_US3)
  1151. constructor Create; override;
  1152. end;
  1153. TfdBGR16 = class(TfdBGR_US3)
  1154. constructor Create; override;
  1155. end;
  1156. TfdBGRA2 = class(TfdBGRA_UB4)
  1157. constructor Create; override;
  1158. end;
  1159. TfdBGRA4 = class(TfdUniversal_US1)
  1160. constructor Create; override;
  1161. end;
  1162. TfdBGR5A1 = class(TfdUniversal_US1)
  1163. constructor Create; override;
  1164. end;
  1165. TfdBGRA8 = class(TfdBGRA_UB4)
  1166. constructor Create; override;
  1167. end;
  1168. TfdBGR10A2 = class(TfdUniversal_UI1)
  1169. constructor Create; override;
  1170. end;
  1171. TfdBGRA12 = class(TfdBGRA_US4)
  1172. constructor Create; override;
  1173. end;
  1174. TfdBGRA16 = class(TfdBGRA_US4)
  1175. constructor Create; override;
  1176. end;
  1177. TfdDepth16 = class(TfdDepth_US1)
  1178. constructor Create; override;
  1179. end;
  1180. TfdDepth24 = class(TfdDepth_UI1)
  1181. constructor Create; override;
  1182. end;
  1183. TfdDepth32 = class(TfdDepth_UI1)
  1184. constructor Create; override;
  1185. end;
  1186. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1187. TbmpBitfieldFormat = class(TFormatDescriptor)
  1188. private
  1189. procedure SetRedMask (const aValue: UInt64);
  1190. procedure SetGreenMask(const aValue: UInt64);
  1191. procedure SetBlueMask (const aValue: UInt64);
  1192. procedure SetAlphaMask(const aValue: UInt64);
  1193. procedure Update(aMask: UInt64; out aRange: Cardinal; out aShift: Byte);
  1194. public
  1195. property RedMask: UInt64 read GetRedMask write SetRedMask;
  1196. property GreenMask: UInt64 read GetGreenMask write SetGreenMask;
  1197. property BlueMask: UInt64 read GetBlueMask write SetBlueMask;
  1198. property AlphaMask: UInt64 read GetAlphaMask write SetAlphaMask;
  1199. property PixelSize: Single read fPixelSize write fPixelSize;
  1200. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1201. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1202. end;
  1203. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1204. TbmpColorTableEnty = packed record
  1205. b, g, r, a: Byte;
  1206. end;
  1207. TbmpColorTable = array of TbmpColorTableEnty;
  1208. TbmpColorTableFormat = class(TFormatDescriptor)
  1209. private
  1210. fColorTable: TbmpColorTable;
  1211. public
  1212. property PixelSize: Single read fPixelSize write fPixelSize;
  1213. property ColorTable: TbmpColorTable read fColorTable write fColorTable;
  1214. property Range: TglBitmapColorRec read fRange write fRange;
  1215. property Shift: TShiftRec read fShift write fShift;
  1216. property Format: TglBitmapFormat read fFormat write fFormat;
  1217. procedure CreateColorTable;
  1218. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1219. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1220. destructor Destroy; override;
  1221. end;
  1222. const
  1223. LUMINANCE_WEIGHT_R = 0.30;
  1224. LUMINANCE_WEIGHT_G = 0.59;
  1225. LUMINANCE_WEIGHT_B = 0.11;
  1226. ALPHA_WEIGHT_R = 0.30;
  1227. ALPHA_WEIGHT_G = 0.59;
  1228. ALPHA_WEIGHT_B = 0.11;
  1229. DEPTH_WEIGHT_R = 0.333333333;
  1230. DEPTH_WEIGHT_G = 0.333333333;
  1231. DEPTH_WEIGHT_B = 0.333333333;
  1232. UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
  1233. FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
  1234. TfdEmpty,
  1235. TfdAlpha4,
  1236. TfdAlpha8,
  1237. TfdAlpha12,
  1238. TfdAlpha16,
  1239. TfdLuminance4,
  1240. TfdLuminance8,
  1241. TfdLuminance12,
  1242. TfdLuminance16,
  1243. TfdLuminance4Alpha4,
  1244. TfdLuminance6Alpha2,
  1245. TfdLuminance8Alpha8,
  1246. TfdLuminance12Alpha4,
  1247. TfdLuminance12Alpha12,
  1248. TfdLuminance16Alpha16,
  1249. TfdR3G3B2,
  1250. TfdRGB4,
  1251. TfdR5G6B5,
  1252. TfdRGB5,
  1253. TfdRGB8,
  1254. TfdRGB10,
  1255. TfdRGB12,
  1256. TfdRGB16,
  1257. TfdRGBA2,
  1258. TfdRGBA4,
  1259. TfdRGB5A1,
  1260. TfdRGBA8,
  1261. TfdRGB10A2,
  1262. TfdRGBA12,
  1263. TfdRGBA16,
  1264. TfdBGR4,
  1265. TfdB5G6R5,
  1266. TfdBGR5,
  1267. TfdBGR8,
  1268. TfdBGR10,
  1269. TfdBGR12,
  1270. TfdBGR16,
  1271. TfdBGRA2,
  1272. TfdBGRA4,
  1273. TfdBGR5A1,
  1274. TfdBGRA8,
  1275. TfdBGR10A2,
  1276. TfdBGRA12,
  1277. TfdBGRA16,
  1278. TfdDepth16,
  1279. TfdDepth24,
  1280. TfdDepth32
  1281. );
  1282. var
  1283. FormatDescriptorCS: TCriticalSection;
  1284. FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
  1285. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1286. function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
  1287. begin
  1288. result.Fields := [];
  1289. if X >= 0 then
  1290. result.Fields := result.Fields + [ffX];
  1291. if Y >= 0 then
  1292. result.Fields := result.Fields + [ffY];
  1293. result.X := Max(0, X);
  1294. result.Y := Max(0, Y);
  1295. end;
  1296. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1297. function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
  1298. begin
  1299. result.r := r;
  1300. result.g := g;
  1301. result.b := b;
  1302. result.a := a;
  1303. end;
  1304. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1305. function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
  1306. var
  1307. i: Integer;
  1308. begin
  1309. result := false;
  1310. for i := 0 to high(r1.arr) do
  1311. if (r1.arr[i] <> r2.arr[i]) then
  1312. exit;
  1313. result := true;
  1314. end;
  1315. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1316. function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
  1317. begin
  1318. result.r := r;
  1319. result.g := g;
  1320. result.b := b;
  1321. result.a := a;
  1322. end;
  1323. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1324. function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
  1325. begin
  1326. result := [ftDDS];
  1327. if (aFormat in [
  1328. //4 bbp
  1329. tfLuminance4,
  1330. //8bpp
  1331. tfR3G3B2, tfLuminance8,
  1332. //16bpp
  1333. tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
  1334. tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,
  1335. //24bpp
  1336. tfBGR8, tfRGB8,
  1337. //32bpp
  1338. tfRGB10, tfRGB10A2, tfRGBA8,
  1339. tfBGR10, tfBGR10A2, tfBGRA8]) then
  1340. result := result + [ftBMP];
  1341. if (aFormat in [
  1342. //8 bpp
  1343. tfLuminance8, tfAlpha8,
  1344. //16 bpp
  1345. tfLuminance16, tfLuminance8Alpha8,
  1346. tfRGB5, tfRGB5A1, tfRGBA4,
  1347. tfBGR5, tfBGR5A1, tfBGRA4,
  1348. //24 bpp
  1349. tfRGB8, tfBGR8,
  1350. //32 bpp
  1351. tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
  1352. result := result + [ftTGA];
  1353. //TODO Supported File Formats!
  1354. (*
  1355. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  1356. if aFormat in [
  1357. tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
  1358. tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
  1359. tfuminance4Alpha4, tfLuminance6Alpha2, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16,
  1360. tfR3G3B2, tfRGB4, tfRGB5, tfRGB8, tfRGB10, tfRGB12, tfRGB16,
  1361. tfRGBA2, tfRGBA4, tfRGB5A1, tfRGBA8, tfRGB10A2, tfRGBA12, tfRGBA16,
  1362. tfDepth16, tfDepth24, tfDepth32]
  1363. then
  1364. result := result + [ftPNG];
  1365. {$ENDIF}
  1366. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  1367. if Format in [
  1368. tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
  1369. tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
  1370. tfR3G3B2, tfRGB4, tfRGB5, tfRGB8, tfRGB10, tfRGB12, tfRGB16,
  1371. tfDepth16, tfDepth24, tfDepth32]
  1372. then
  1373. result := result + [ftJPEG];
  1374. {$ENDIF}
  1375. if aFormat in [
  1376. tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
  1377. tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
  1378. tfuminance4Alpha4, tfLuminance6Alpha2, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16,
  1379. tfR3G3B2, tfRGB4, tfRGB5, tfRGB8, tfRGB10, tfRGB12, tfRGB16,
  1380. tfRGBA2, tfRGBA4, tfRGB5A1, tfRGBA8, tfRGB10A2, tfRGBA12, tfRGBA16,
  1381. tfDepth16, tfDepth24, tfDepth32]
  1382. then
  1383. result := result + [ftDDS, ftTGA, ftBMP];
  1384. *)
  1385. end;
  1386. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1387. function IsPowerOfTwo(aNumber: Integer): Boolean;
  1388. begin
  1389. while (aNumber and 1) = 0 do
  1390. aNumber := aNumber shr 1;
  1391. result := aNumber = 1;
  1392. end;
  1393. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1394. function GetTopMostBit(aBitSet: UInt64): Integer;
  1395. begin
  1396. result := 0;
  1397. while aBitSet > 0 do begin
  1398. inc(result);
  1399. aBitSet := aBitSet shr 1;
  1400. end;
  1401. end;
  1402. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1403. function CountSetBits(aBitSet: UInt64): Integer;
  1404. begin
  1405. result := 0;
  1406. while aBitSet > 0 do begin
  1407. if (aBitSet and 1) = 1 then
  1408. inc(result);
  1409. aBitSet := aBitSet shr 1;
  1410. end;
  1411. end;
  1412. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1413. function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1414. begin
  1415. result := Trunc(
  1416. LUMINANCE_WEIGHT_R * aPixel.Data.r +
  1417. LUMINANCE_WEIGHT_G * aPixel.Data.g +
  1418. LUMINANCE_WEIGHT_B * aPixel.Data.b);
  1419. end;
  1420. function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1421. begin
  1422. result := Trunc(
  1423. DEPTH_WEIGHT_R * aPixel.Data.r +
  1424. DEPTH_WEIGHT_G * aPixel.Data.g +
  1425. DEPTH_WEIGHT_B * aPixel.Data.b);
  1426. end;
  1427. //TODO check _ARB functions and constants
  1428. (* GLB_NO_NATIVE_GL
  1429. {$IFNDEF GLB_NO_NATIVE_GL}
  1430. procedure ReadOpenGLExtensions;
  1431. var
  1432. {$IFDEF GLB_DELPHI}
  1433. Context: HGLRC;
  1434. {$ENDIF}
  1435. Buffer: AnsiString;
  1436. MajorVersion, MinorVersion: Integer;
  1437. procedure TrimVersionString(Buffer: AnsiString; var Major, Minor: Integer);
  1438. var
  1439. Separator: Integer;
  1440. begin
  1441. Minor := 0;
  1442. Major := 0;
  1443. Separator := Pos(AnsiString('.'), Buffer);
  1444. if (Separator > 1) and (Separator < Length(Buffer)) and
  1445. (Buffer[Separator - 1] in ['0'..'9']) and
  1446. (Buffer[Separator + 1] in ['0'..'9']) then begin
  1447. Dec(Separator);
  1448. while (Separator > 0) and (Buffer[Separator] in ['0'..'9']) do
  1449. Dec(Separator);
  1450. Delete(Buffer, 1, Separator);
  1451. Separator := Pos(AnsiString('.'), Buffer) + 1;
  1452. while (Separator <= Length(Buffer)) and (AnsiChar(Buffer[Separator]) in ['0'..'9']) do
  1453. Inc(Separator);
  1454. Delete(Buffer, Separator, 255);
  1455. Separator := Pos(AnsiString('.'), Buffer);
  1456. Major := StrToInt(Copy(String(Buffer), 1, Separator - 1));
  1457. Minor := StrToInt(Copy(String(Buffer), Separator + 1, 1));
  1458. end;
  1459. end;
  1460. function CheckExtension(const Extension: AnsiString): Boolean;
  1461. var
  1462. ExtPos: Integer;
  1463. begin
  1464. ExtPos := Pos(Extension, Buffer);
  1465. result := ExtPos > 0;
  1466. if result then
  1467. result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
  1468. end;
  1469. function glLoad (aFunc: pAnsiChar): pointer;
  1470. begin
  1471. {$IFDEF LINUX}
  1472. result := glXGetProcAddress(aFunc);
  1473. {$else}
  1474. result := wglGetProcAddress(aFunc);
  1475. {$ENDIF}
  1476. end;
  1477. begin
  1478. {$IFDEF GLB_DELPHI}
  1479. Context := wglGetCurrentContext;
  1480. if Context <> gLastContext then begin
  1481. gLastContext := Context;
  1482. {$ENDIF}
  1483. // Version
  1484. Buffer := glGetString(GL_VERSION);
  1485. TrimVersionString(Buffer, MajorVersion, MinorVersion);
  1486. GL_VERSION_1_2 := false;
  1487. GL_VERSION_1_3 := false;
  1488. GL_VERSION_1_4 := false;
  1489. GL_VERSION_2_0 := false;
  1490. if MajorVersion = 1 then begin
  1491. if MinorVersion >= 1 then begin
  1492. if MinorVersion >= 2 then
  1493. GL_VERSION_1_2 := true;
  1494. if MinorVersion >= 3 then
  1495. GL_VERSION_1_3 := true;
  1496. if MinorVersion >= 4 then
  1497. GL_VERSION_1_4 := true;
  1498. end;
  1499. end;
  1500. if MajorVersion >= 2 then begin
  1501. GL_VERSION_1_2 := true;
  1502. GL_VERSION_1_3 := true;
  1503. GL_VERSION_1_4 := true;
  1504. GL_VERSION_2_0 := true;
  1505. end;
  1506. // Extensions
  1507. Buffer := glGetString(GL_EXTENSIONS);
  1508. GL_ARB_texture_border_clamp := CheckExtension('GL_ARB_texture_border_clamp');
  1509. GL_ARB_texture_cube_map := CheckExtension('GL_ARB_texture_cube_map');
  1510. GL_ARB_texture_compression := CheckExtension('GL_ARB_texture_compression');
  1511. GL_ARB_texture_non_power_of_two := CheckExtension('GL_ARB_texture_non_power_of_two');
  1512. GL_ARB_texture_rectangle := CheckExtension('GL_ARB_texture_rectangle');
  1513. GL_ARB_texture_mirrored_repeat := CheckExtension('GL_ARB_texture_mirrored_repeat');
  1514. GL_EXT_bgra := CheckExtension('GL_EXT_bgra');
  1515. GL_EXT_texture_edge_clamp := CheckExtension('GL_EXT_texture_edge_clamp');
  1516. GL_EXT_texture_cube_map := CheckExtension('GL_EXT_texture_cube_map');
  1517. GL_EXT_texture_compression_s3tc := CheckExtension('GL_EXT_texture_compression_s3tc');
  1518. GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
  1519. GL_EXT_texture_rectangle := CheckExtension('GL_EXT_texture_rectangle');
  1520. GL_NV_texture_rectangle := CheckExtension('GL_NV_texture_rectangle');
  1521. GL_IBM_texture_mirrored_repeat := CheckExtension('GL_IBM_texture_mirrored_repeat');
  1522. GL_SGIS_generate_mipmap := CheckExtension('GL_SGIS_generate_mipmap');
  1523. // Funtions
  1524. if GL_VERSION_1_3 then begin
  1525. // Loading Core
  1526. glCompressedTexImage1D := glLoad('glCompressedTexImage1D');
  1527. glCompressedTexImage2D := glLoad('glCompressedTexImage2D');
  1528. glGetCompressedTexImage := glLoad('glGetCompressedTexImage');
  1529. end else
  1530. begin
  1531. // Try loading Extension
  1532. glCompressedTexImage1D := glLoad('glCompressedTexImage1DARB');
  1533. glCompressedTexImage2D := glLoad('glCompressedTexImage2DARB');
  1534. glGetCompressedTexImage := glLoad('glGetCompressedTexImageARB');
  1535. end;
  1536. {$IFDEF GLB_DELPHI}
  1537. end;
  1538. {$ENDIF}
  1539. end;
  1540. {$ENDIF}
  1541. *)
  1542. (* TODO GLB_DELPHI
  1543. {$IFDEF GLB_DELPHI}
  1544. function CreateGrayPalette: HPALETTE;
  1545. var
  1546. Idx: Integer;
  1547. Pal: PLogPalette;
  1548. begin
  1549. GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
  1550. Pal.palVersion := $300;
  1551. Pal.palNumEntries := 256;
  1552. {$IFOPT R+}
  1553. {$DEFINE GLB_TEMPRANGECHECK}
  1554. {$R-}
  1555. {$ENDIF}
  1556. for Idx := 0 to 256 - 1 do begin
  1557. Pal.palPalEntry[Idx].peRed := Idx;
  1558. Pal.palPalEntry[Idx].peGreen := Idx;
  1559. Pal.palPalEntry[Idx].peBlue := Idx;
  1560. Pal.palPalEntry[Idx].peFlags := 0;
  1561. end;
  1562. {$IFDEF GLB_TEMPRANGECHECK}
  1563. {$UNDEF GLB_TEMPRANGECHECK}
  1564. {$R+}
  1565. {$ENDIF}
  1566. result := CreatePalette(Pal^);
  1567. FreeMem(Pal);
  1568. end;
  1569. {$ENDIF}
  1570. *)
  1571. (* TODO GLB_SDL_IMAGE
  1572. {$IFDEF GLB_SDL_IMAGE}
  1573. function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
  1574. begin
  1575. result := TStream(context^.unknown.data1).Seek(offset, whence);
  1576. end;
  1577. function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
  1578. begin
  1579. result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
  1580. end;
  1581. function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
  1582. begin
  1583. result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
  1584. end;
  1585. function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
  1586. begin
  1587. result := 0;
  1588. end;
  1589. function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
  1590. begin
  1591. result := SDL_AllocRW;
  1592. if result = nil then
  1593. raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
  1594. result^.seek := glBitmapRWseek;
  1595. result^.read := glBitmapRWread;
  1596. result^.write := glBitmapRWwrite;
  1597. result^.close := glBitmapRWclose;
  1598. result^.unknown.data1 := Stream;
  1599. end;
  1600. {$ENDIF}
  1601. *)
  1602. (* TODO LoadFuncs
  1603. function LoadTexture(Filename: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal{$ENDIF}): Boolean;
  1604. var
  1605. glBitmap: TglBitmap2D;
  1606. begin
  1607. result := false;
  1608. Texture := 0;
  1609. {$IFDEF GLB_DELPHI}
  1610. if Instance = 0 then
  1611. Instance := HInstance;
  1612. if (LoadFromRes) then
  1613. glBitmap := TglBitmap2D.CreateFromResourceName(Instance, FileName)
  1614. else
  1615. {$ENDIF}
  1616. glBitmap := TglBitmap2D.Create(FileName);
  1617. try
  1618. glBitmap.DeleteTextureOnFree := false;
  1619. glBitmap.FreeDataAfterGenTexture := false;
  1620. glBitmap.GenTexture(true);
  1621. if (glBitmap.ID > 0) then begin
  1622. Texture := glBitmap.ID;
  1623. result := true;
  1624. end;
  1625. finally
  1626. glBitmap.Free;
  1627. end;
  1628. end;
  1629. function LoadCubeMap(PositiveX, NegativeX, PositiveY, NegativeY, PositiveZ, NegativeZ: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal{$ENDIF}): Boolean;
  1630. var
  1631. CM: TglBitmapCubeMap;
  1632. begin
  1633. Texture := 0;
  1634. {$IFDEF GLB_DELPHI}
  1635. if Instance = 0 then
  1636. Instance := HInstance;
  1637. {$ENDIF}
  1638. CM := TglBitmapCubeMap.Create;
  1639. try
  1640. CM.DeleteTextureOnFree := false;
  1641. // Maps
  1642. {$IFDEF GLB_DELPHI}
  1643. if (LoadFromRes) then
  1644. CM.LoadFromResource(Instance, PositiveX)
  1645. else
  1646. {$ENDIF}
  1647. CM.LoadFromFile(PositiveX);
  1648. CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X);
  1649. {$IFDEF GLB_DELPHI}
  1650. if (LoadFromRes) then
  1651. CM.LoadFromResource(Instance, NegativeX)
  1652. else
  1653. {$ENDIF}
  1654. CM.LoadFromFile(NegativeX);
  1655. CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X);
  1656. {$IFDEF GLB_DELPHI}
  1657. if (LoadFromRes) then
  1658. CM.LoadFromResource(Instance, PositiveY)
  1659. else
  1660. {$ENDIF}
  1661. CM.LoadFromFile(PositiveY);
  1662. CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y);
  1663. {$IFDEF GLB_DELPHI}
  1664. if (LoadFromRes) then
  1665. CM.LoadFromResource(Instance, NegativeY)
  1666. else
  1667. {$ENDIF}
  1668. CM.LoadFromFile(NegativeY);
  1669. CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y);
  1670. {$IFDEF GLB_DELPHI}
  1671. if (LoadFromRes) then
  1672. CM.LoadFromResource(Instance, PositiveZ)
  1673. else
  1674. {$ENDIF}
  1675. CM.LoadFromFile(PositiveZ);
  1676. CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z);
  1677. {$IFDEF GLB_DELPHI}
  1678. if (LoadFromRes) then
  1679. CM.LoadFromResource(Instance, NegativeZ)
  1680. else
  1681. {$ENDIF}
  1682. CM.LoadFromFile(NegativeZ);
  1683. CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z);
  1684. Texture := CM.ID;
  1685. result := true;
  1686. finally
  1687. CM.Free;
  1688. end;
  1689. end;
  1690. function LoadNormalMap(Size: Integer; var Texture: Cardinal): Boolean;
  1691. var
  1692. NM: TglBitmapNormalMap;
  1693. begin
  1694. Texture := 0;
  1695. NM := TglBitmapNormalMap.Create;
  1696. try
  1697. NM.DeleteTextureOnFree := false;
  1698. NM.GenerateNormalMap(Size);
  1699. Texture := NM.ID;
  1700. result := true;
  1701. finally
  1702. NM.Free;
  1703. end;
  1704. end;
  1705. *)
  1706. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1707. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1708. begin
  1709. glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
  1710. end;
  1711. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1712. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1713. begin
  1714. glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
  1715. end;
  1716. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1717. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1718. begin
  1719. glBitmapDefaultMipmap := aValue;
  1720. end;
  1721. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1722. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1723. begin
  1724. glBitmapDefaultFormat := aFormat;
  1725. end;
  1726. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1727. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1728. begin
  1729. glBitmapDefaultFilterMin := aMin;
  1730. glBitmapDefaultFilterMag := aMag;
  1731. end;
  1732. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1733. procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
  1734. begin
  1735. glBitmapDefaultWrapS := S;
  1736. glBitmapDefaultWrapT := T;
  1737. glBitmapDefaultWrapR := R;
  1738. end;
  1739. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1740. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1741. begin
  1742. result := glBitmapDefaultDeleteTextureOnFree;
  1743. end;
  1744. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1745. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1746. begin
  1747. result := glBitmapDefaultFreeDataAfterGenTextures;
  1748. end;
  1749. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1750. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1751. begin
  1752. result := glBitmapDefaultMipmap;
  1753. end;
  1754. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1755. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1756. begin
  1757. result := glBitmapDefaultFormat;
  1758. end;
  1759. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1760. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  1761. begin
  1762. aMin := glBitmapDefaultFilterMin;
  1763. aMag := glBitmapDefaultFilterMag;
  1764. end;
  1765. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1766. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  1767. begin
  1768. S := glBitmapDefaultWrapS;
  1769. T := glBitmapDefaultWrapT;
  1770. R := glBitmapDefaultWrapR;
  1771. end;
  1772. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1773. //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1774. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1775. function TFormatDescriptor.GetRedMask: UInt64;
  1776. begin
  1777. result := fRange.r shl fShift.r;
  1778. end;
  1779. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1780. function TFormatDescriptor.GetGreenMask: UInt64;
  1781. begin
  1782. result := fRange.g shl fShift.g;
  1783. end;
  1784. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1785. function TFormatDescriptor.GetBlueMask: UInt64;
  1786. begin
  1787. result := fRange.b shl fShift.b;
  1788. end;
  1789. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1790. function TFormatDescriptor.GetAlphaMask: UInt64;
  1791. begin
  1792. result := fRange.a shl fShift.a;
  1793. end;
  1794. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1795. function TFormatDescriptor.GetComponents: Integer;
  1796. var
  1797. i: Integer;
  1798. begin
  1799. result := 0;
  1800. for i := 0 to 3 do
  1801. if (fRange.arr[i] > 0) then
  1802. inc(result);
  1803. end;
  1804. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1805. function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
  1806. var
  1807. w, h: Integer;
  1808. begin
  1809. if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
  1810. w := Max(1, aSize.X);
  1811. h := Max(1, aSize.Y);
  1812. result := GetSize(w, h);
  1813. end else
  1814. result := 0;
  1815. end;
  1816. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1817. function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
  1818. begin
  1819. result := 0;
  1820. if (aWidth <= 0) or (aHeight <= 0) then
  1821. exit;
  1822. result := Ceil(aWidth * aHeight * fPixelSize);
  1823. end;
  1824. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1825. function TFormatDescriptor.CreateMappingData: Pointer;
  1826. begin
  1827. result := nil;
  1828. end;
  1829. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1830. procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
  1831. begin
  1832. //DUMMY
  1833. end;
  1834. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1835. function TFormatDescriptor.IsEmpty: Boolean;
  1836. begin
  1837. result := (fFormat = tfEmpty);
  1838. end;
  1839. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1840. function TFormatDescriptor.HasAlpha: Boolean;
  1841. begin
  1842. result := (fRange.a > 0);
  1843. end;
  1844. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1845. function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: UInt64): Boolean;
  1846. begin
  1847. result := false;
  1848. if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
  1849. raise EglBitmapException.Create('FormatCheckFormat - All Masks are 0');
  1850. if (aRedMask <> RedMask) then
  1851. exit;
  1852. if (aGreenMask <> GreenMask) then
  1853. exit;
  1854. if (aBlueMask <> BlueMask) then
  1855. exit;
  1856. if (aAlphaMask <> AlphaMask) then
  1857. exit;
  1858. result := true;
  1859. end;
  1860. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1861. procedure TFormatDescriptor.PreparePixel(var aPixel: TglBitmapPixelData);
  1862. begin
  1863. FillChar(aPixel, SizeOf(aPixel), 0);
  1864. aPixel.Data := fRange;
  1865. aPixel.Range := fRange;
  1866. aPixel.Format := fFormat;
  1867. end;
  1868. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1869. constructor TFormatDescriptor.Create;
  1870. begin
  1871. inherited Create;
  1872. fFormat := tfEmpty;
  1873. fWithAlpha := tfEmpty;
  1874. fWithoutAlpha := tfEmpty;
  1875. fRGBInverted := tfEmpty;
  1876. fPixelSize := 0.0;
  1877. fglFormat := 0;
  1878. fglInternalFormat := 0;
  1879. fglDataFormat := 0;
  1880. FillChar(fRange, 0, SizeOf(fRange));
  1881. FillChar(fShift, 0, SizeOf(fShift));
  1882. end;
  1883. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1884. //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1885. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1886. procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1887. begin
  1888. aData^ := aPixel.Data.a;
  1889. inc(aData);
  1890. end;
  1891. procedure TfdAlpha_UB1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1892. begin
  1893. aPixel.Data.r := 0;
  1894. aPixel.Data.g := 0;
  1895. aPixel.Data.b := 0;
  1896. aPixel.Data.a := aData^;
  1897. inc(aData^);
  1898. end;
  1899. constructor TfdAlpha_UB1.Create;
  1900. begin
  1901. inherited Create;
  1902. fPixelSize := 1.0;
  1903. fRange.a := $FF;
  1904. fglFormat := GL_ALPHA;
  1905. fglDataFormat := GL_UNSIGNED_BYTE;
  1906. end;
  1907. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1908. //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1909. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1910. procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1911. begin
  1912. aData^ := LuminanceWeight(aPixel);
  1913. inc(aData);
  1914. end;
  1915. procedure TfdLuminance_UB1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1916. begin
  1917. aPixel.Data.r := aData^;
  1918. aPixel.Data.g := aData^;
  1919. aPixel.Data.b := aData^;
  1920. aPixel.Data.a := 0;
  1921. inc(aData);
  1922. end;
  1923. constructor TfdLuminance_UB1.Create;
  1924. begin
  1925. inherited Create;
  1926. fPixelSize := 1.0;
  1927. fRange.r := $FF;
  1928. fRange.g := $FF;
  1929. fRange.b := $FF;
  1930. fglFormat := GL_LUMINANCE;
  1931. fglDataFormat := GL_UNSIGNED_BYTE;
  1932. end;
  1933. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1934. //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1935. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1936. procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1937. var
  1938. i: Integer;
  1939. begin
  1940. aData^ := 0;
  1941. for i := 0 to 3 do
  1942. if (fRange.arr[i] > 0) then
  1943. aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  1944. inc(aData);
  1945. end;
  1946. procedure TfdUniversal_UB1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1947. var
  1948. i: Integer;
  1949. begin
  1950. for i := 0 to 3 do
  1951. aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
  1952. inc(aData);
  1953. end;
  1954. constructor TfdUniversal_UB1.Create;
  1955. begin
  1956. inherited Create;
  1957. fPixelSize := 1.0;
  1958. end;
  1959. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1960. //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1961. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1962. procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1963. begin
  1964. inherited Map(aPixel, aData, aMapData);
  1965. aData^ := aPixel.Data.a;
  1966. inc(aData);
  1967. end;
  1968. procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1969. begin
  1970. inherited Unmap(aData, aPixel, aMapData);
  1971. aPixel.Data.a := aData^;
  1972. inc(aData);
  1973. end;
  1974. constructor TfdLuminanceAlpha_UB2.Create;
  1975. begin
  1976. inherited Create;
  1977. fPixelSize := 2.0;
  1978. fRange.a := $FF;
  1979. fShift.a := 8;
  1980. fglFormat := GL_LUMINANCE_ALPHA;
  1981. fglDataFormat := GL_UNSIGNED_BYTE;
  1982. end;
  1983. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1984. //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1985. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1986. procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1987. begin
  1988. aData^ := aPixel.Data.r;
  1989. inc(aData);
  1990. aData^ := aPixel.Data.g;
  1991. inc(aData);
  1992. aData^ := aPixel.Data.b;
  1993. inc(aData);
  1994. end;
  1995. procedure TfdRGB_UB3.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1996. begin
  1997. aPixel.Data.r := aData^;
  1998. inc(aData);
  1999. aPixel.Data.g := aData^;
  2000. inc(aData);
  2001. aPixel.Data.b := aData^;
  2002. inc(aData);
  2003. aPixel.Data.a := 0;
  2004. end;
  2005. constructor TfdRGB_UB3.Create;
  2006. begin
  2007. inherited Create;
  2008. fPixelSize := 3.0;
  2009. fRange.r := $FF;
  2010. fRange.g := $FF;
  2011. fRange.b := $FF;
  2012. fShift.r := 0;
  2013. fShift.g := 8;
  2014. fShift.b := 16;
  2015. fglFormat := GL_RGB;
  2016. fglDataFormat := GL_UNSIGNED_BYTE;
  2017. end;
  2018. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2019. //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2020. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2021. procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2022. begin
  2023. aData^ := aPixel.Data.b;
  2024. inc(aData);
  2025. aData^ := aPixel.Data.g;
  2026. inc(aData);
  2027. aData^ := aPixel.Data.r;
  2028. inc(aData);
  2029. end;
  2030. procedure TfdBGR_UB3.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2031. begin
  2032. aPixel.Data.b := aData^;
  2033. inc(aData);
  2034. aPixel.Data.g := aData^;
  2035. inc(aData);
  2036. aPixel.Data.r := aData^;
  2037. inc(aData);
  2038. aPixel.Data.a := 0;
  2039. end;
  2040. constructor TfdBGR_UB3.Create;
  2041. begin
  2042. fPixelSize := 3.0;
  2043. fRange.r := $FF;
  2044. fRange.g := $FF;
  2045. fRange.b := $FF;
  2046. fShift.r := 16;
  2047. fShift.g := 8;
  2048. fShift.b := 0;
  2049. fglFormat := GL_BGR;
  2050. fglDataFormat := GL_UNSIGNED_BYTE;
  2051. end;
  2052. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2053. //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2054. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2055. procedure TfdRGBA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2056. begin
  2057. inherited Map(aPixel, aData, aMapData);
  2058. aData^ := aPixel.Data.a;
  2059. inc(aData);
  2060. end;
  2061. procedure TfdRGBA_UB4.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2062. begin
  2063. inherited Unmap(aData, aPixel, aMapData);
  2064. aPixel.Data.a := aData^;
  2065. inc(aData);
  2066. end;
  2067. constructor TfdRGBA_UB4.Create;
  2068. begin
  2069. inherited Create;
  2070. fPixelSize := 4.0;
  2071. fRange.a := $FF;
  2072. fShift.a := 24;
  2073. fglFormat := GL_RGBA;
  2074. fglDataFormat := GL_UNSIGNED_BYTE;
  2075. end;
  2076. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2077. //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2078. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2079. procedure TfdBGRA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2080. begin
  2081. inherited Map(aPixel, aData, aMapData);
  2082. aData^ := aPixel.Data.a;
  2083. inc(aData);
  2084. end;
  2085. procedure TfdBGRA_UB4.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2086. begin
  2087. inherited Unmap(aData, aPixel, aMapData);
  2088. aPixel.Data.a := aData^;
  2089. inc(aData);
  2090. end;
  2091. constructor TfdBGRA_UB4.Create;
  2092. begin
  2093. inherited Create;
  2094. fPixelSize := 4.0;
  2095. fRange.a := $FF;
  2096. fShift.a := 24;
  2097. fglFormat := GL_BGRA;
  2098. fglDataFormat := GL_UNSIGNED_BYTE;
  2099. end;
  2100. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2101. //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2102. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2103. procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2104. begin
  2105. PWord(aData)^ := aPixel.Data.a;
  2106. inc(aData, 2);
  2107. end;
  2108. procedure TfdAlpha_US1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2109. begin
  2110. aPixel.Data.r := 0;
  2111. aPixel.Data.g := 0;
  2112. aPixel.Data.b := 0;
  2113. aPixel.Data.a := PWord(aData)^;
  2114. inc(aData, 2);
  2115. end;
  2116. constructor TfdAlpha_US1.Create;
  2117. begin
  2118. inherited Create;
  2119. fPixelSize := 2.0;
  2120. fRange.a := $FFFF;
  2121. fglFormat := GL_ALPHA;
  2122. fglDataFormat := GL_UNSIGNED_SHORT;
  2123. end;
  2124. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2125. //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2126. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2127. procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2128. begin
  2129. PWord(aData)^ := LuminanceWeight(aPixel);
  2130. inc(aData, 2);
  2131. end;
  2132. procedure TfdLuminance_US1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2133. begin
  2134. aPixel.Data.r := PWord(aData)^;
  2135. aPixel.Data.g := PWord(aData)^;
  2136. aPixel.Data.b := PWord(aData)^;
  2137. aPixel.Data.a := 0;
  2138. inc(aData, 2);
  2139. end;
  2140. constructor TfdLuminance_US1.Create;
  2141. begin
  2142. inherited Create;
  2143. fPixelSize := 2.0;
  2144. fRange.r := $FFFF;
  2145. fRange.g := $FFFF;
  2146. fRange.b := $FFFF;
  2147. fglFormat := GL_LUMINANCE;
  2148. fglDataFormat := GL_UNSIGNED_SHORT;
  2149. end;
  2150. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2151. //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2152. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2153. procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2154. var
  2155. i: Integer;
  2156. begin
  2157. PWord(aData)^ := 0;
  2158. for i := 0 to 3 do
  2159. if (fRange.arr[i] > 0) then
  2160. PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2161. inc(aData, 2);
  2162. end;
  2163. procedure TfdUniversal_US1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2164. var
  2165. i: Integer;
  2166. begin
  2167. for i := 0 to 3 do
  2168. aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
  2169. inc(aData, 2);
  2170. end;
  2171. constructor TfdUniversal_US1.Create;
  2172. begin
  2173. inherited Create;
  2174. fPixelSize := 2.0;
  2175. end;
  2176. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2177. //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2178. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2179. procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2180. begin
  2181. PWord(aData)^ := DepthWeight(aPixel);
  2182. inc(aData, 2);
  2183. end;
  2184. procedure TfdDepth_US1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2185. begin
  2186. aPixel.Data.r := PWord(aData)^;
  2187. aPixel.Data.g := PWord(aData)^;
  2188. aPixel.Data.b := PWord(aData)^;
  2189. aPixel.Data.a := 0;
  2190. inc(aData, 2);
  2191. end;
  2192. constructor TfdDepth_US1.Create;
  2193. begin
  2194. inherited Create;
  2195. fPixelSize := 2.0;
  2196. fRange.r := $FFFF;
  2197. fRange.g := $FFFF;
  2198. fRange.b := $FFFF;
  2199. fglFormat := GL_DEPTH_COMPONENT;
  2200. fglDataFormat := GL_UNSIGNED_SHORT;
  2201. end;
  2202. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2203. //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2204. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2205. procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2206. begin
  2207. inherited Map(aPixel, aData, aMapData);
  2208. PWord(aData)^ := aPixel.Data.a;
  2209. inc(aData, 2);
  2210. end;
  2211. procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2212. begin
  2213. inherited Unmap(aData, aPixel, aMapData);
  2214. aPixel.Data.a := PWord(aData)^;
  2215. inc(aData, 2);
  2216. end;
  2217. constructor TfdLuminanceAlpha_US2.Create;
  2218. begin
  2219. inherited Create;
  2220. fPixelSize := 4.0;
  2221. fRange.a := $FFFF;
  2222. fShift.a := 16;
  2223. fglFormat := GL_LUMINANCE_ALPHA;
  2224. fglDataFormat := GL_UNSIGNED_SHORT;
  2225. end;
  2226. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2227. //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2228. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2229. procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2230. begin
  2231. PWord(aData)^ := aPixel.Data.r;
  2232. inc(aData, 2);
  2233. PWord(aData)^ := aPixel.Data.g;
  2234. inc(aData, 2);
  2235. PWord(aData)^ := aPixel.Data.b;
  2236. inc(aData, 2);
  2237. end;
  2238. procedure TfdRGB_US3.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2239. begin
  2240. aPixel.Data.r := PWord(aData)^;
  2241. inc(aData, 2);
  2242. aPixel.Data.g := PWord(aData)^;
  2243. inc(aData, 2);
  2244. aPixel.Data.b := PWord(aData)^;
  2245. inc(aData, 2);
  2246. aPixel.Data.a := 0;
  2247. end;
  2248. constructor TfdRGB_US3.Create;
  2249. begin
  2250. inherited Create;
  2251. fPixelSize := 6.0;
  2252. fRange.r := $FFFF;
  2253. fRange.g := $FFFF;
  2254. fRange.b := $FFFF;
  2255. fShift.r := 0;
  2256. fShift.g := 16;
  2257. fShift.b := 32;
  2258. fglFormat := GL_RGB;
  2259. fglDataFormat := GL_UNSIGNED_SHORT;
  2260. end;
  2261. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2262. //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2263. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2264. procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2265. begin
  2266. PWord(aData)^ := aPixel.Data.b;
  2267. inc(aData, 2);
  2268. PWord(aData)^ := aPixel.Data.g;
  2269. inc(aData, 2);
  2270. PWord(aData)^ := aPixel.Data.r;
  2271. inc(aData, 2);
  2272. end;
  2273. procedure TfdBGR_US3.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2274. begin
  2275. aPixel.Data.b := PWord(aData)^;
  2276. inc(aData, 2);
  2277. aPixel.Data.g := PWord(aData)^;
  2278. inc(aData, 2);
  2279. aPixel.Data.r := PWord(aData)^;
  2280. inc(aData, 2);
  2281. aPixel.Data.a := 0;
  2282. end;
  2283. constructor TfdBGR_US3.Create;
  2284. begin
  2285. inherited Create;
  2286. fPixelSize := 6.0;
  2287. fRange.r := $FFFF;
  2288. fRange.g := $FFFF;
  2289. fRange.b := $FFFF;
  2290. fShift.r := 32;
  2291. fShift.g := 16;
  2292. fShift.b := 0;
  2293. fglFormat := GL_BGR;
  2294. fglDataFormat := GL_UNSIGNED_SHORT;
  2295. end;
  2296. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2297. //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2298. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2299. procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2300. begin
  2301. inherited Map(aPixel, aData, aMapData);
  2302. PWord(aData)^ := aPixel.Data.a;
  2303. inc(aData, 2);
  2304. end;
  2305. procedure TfdRGBA_US4.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2306. begin
  2307. inherited Unmap(aData, aPixel, aMapData);
  2308. aPixel.Data.a := PWord(aData)^;
  2309. inc(aData, 2);
  2310. end;
  2311. constructor TfdRGBA_US4.Create;
  2312. begin
  2313. inherited Create;
  2314. fPixelSize := 8.0;
  2315. fRange.a := $FFFF;
  2316. fShift.a := 48;
  2317. fglFormat := GL_RGBA;
  2318. fglDataFormat := GL_UNSIGNED_SHORT;
  2319. end;
  2320. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2321. //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2322. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2323. procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2324. begin
  2325. inherited Map(aPixel, aData, aMapData);
  2326. PWord(aData)^ := aPixel.Data.a;
  2327. inc(aData, 2);
  2328. end;
  2329. procedure TfdBGRA_US4.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2330. begin
  2331. inherited Unmap(aData, aPixel, aMapData);
  2332. aPixel.Data.a := PWord(aData)^;
  2333. inc(aData, 2);
  2334. end;
  2335. constructor TfdBGRA_US4.Create;
  2336. begin
  2337. inherited Create;
  2338. fPixelSize := 8.0;
  2339. fRange.a := $FFFF;
  2340. fShift.a := 48;
  2341. fglFormat := GL_BGRA;
  2342. fglDataFormat := GL_UNSIGNED_SHORT;
  2343. end;
  2344. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2345. //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2346. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2347. procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2348. var
  2349. i: Integer;
  2350. begin
  2351. PCardinal(aData)^ := 0;
  2352. for i := 0 to 3 do
  2353. if (fRange.arr[i] > 0) then
  2354. PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2355. inc(aData, 4);
  2356. end;
  2357. procedure TfdUniversal_UI1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2358. var
  2359. i: Integer;
  2360. begin
  2361. for i := 0 to 3 do
  2362. aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
  2363. inc(aData, 2);
  2364. end;
  2365. constructor TfdUniversal_UI1.Create;
  2366. begin
  2367. inherited Create;
  2368. fPixelSize := 4.0;
  2369. end;
  2370. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2371. //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2372. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2373. procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2374. begin
  2375. PCardinal(aData)^ := DepthWeight(aPixel);
  2376. inc(aData, 4);
  2377. end;
  2378. procedure TfdDepth_UI1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2379. begin
  2380. aPixel.Data.r := PCardinal(aData)^;
  2381. aPixel.Data.g := PCardinal(aData)^;
  2382. aPixel.Data.b := PCardinal(aData)^;
  2383. aPixel.Data.a := 0;
  2384. inc(aData, 4);
  2385. end;
  2386. constructor TfdDepth_UI1.Create;
  2387. begin
  2388. inherited Create;
  2389. fPixelSize := 4.0;
  2390. fRange.r := $FFFFFFFF;
  2391. fRange.g := $FFFFFFFF;
  2392. fRange.b := $FFFFFFFF;
  2393. fglFormat := GL_DEPTH_COMPONENT;
  2394. fglDataFormat := GL_UNSIGNED_INT;
  2395. end;
  2396. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2397. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2398. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2399. constructor TfdAlpha4.Create;
  2400. begin
  2401. inherited Create;
  2402. fFormat := tfAlpha4;
  2403. fWithAlpha := tfAlpha4;
  2404. fglInternalFormat := GL_ALPHA4;
  2405. end;
  2406. constructor TfdAlpha8.Create;
  2407. begin
  2408. inherited Create;
  2409. fFormat := tfAlpha8;
  2410. fWithAlpha := tfAlpha8;
  2411. fglInternalFormat := GL_ALPHA8;
  2412. end;
  2413. constructor TfdAlpha12.Create;
  2414. begin
  2415. inherited Create;
  2416. fFormat := tfAlpha12;
  2417. fWithAlpha := tfAlpha12;
  2418. fglInternalFormat := GL_ALPHA12;
  2419. end;
  2420. constructor TfdAlpha16.Create;
  2421. begin
  2422. inherited Create;
  2423. fFormat := tfAlpha16;
  2424. fWithAlpha := tfAlpha16;
  2425. fglInternalFormat := GL_ALPHA16;
  2426. end;
  2427. constructor TfdLuminance4.Create;
  2428. begin
  2429. inherited Create;
  2430. fFormat := tfLuminance4;
  2431. fWithAlpha := tfLuminance4Alpha4;
  2432. fWithoutAlpha := tfLuminance4;
  2433. fglInternalFormat := GL_LUMINANCE4;
  2434. end;
  2435. constructor TfdLuminance8.Create;
  2436. begin
  2437. inherited Create;
  2438. fFormat := tfLuminance8;
  2439. fWithAlpha := tfLuminance8Alpha8;
  2440. fWithoutAlpha := tfLuminance8;
  2441. fglInternalFormat := GL_LUMINANCE8;
  2442. end;
  2443. constructor TfdLuminance12.Create;
  2444. begin
  2445. inherited Create;
  2446. fFormat := tfLuminance12;
  2447. fWithAlpha := tfLuminance12Alpha12;
  2448. fWithoutAlpha := tfLuminance12;
  2449. fglInternalFormat := GL_LUMINANCE12;
  2450. end;
  2451. constructor TfdLuminance16.Create;
  2452. begin
  2453. inherited Create;
  2454. fFormat := tfLuminance16;
  2455. fWithAlpha := tfLuminance16Alpha16;
  2456. fWithoutAlpha := tfLuminance16;
  2457. fglInternalFormat := GL_LUMINANCE16;
  2458. end;
  2459. constructor TfdLuminance4Alpha4.Create;
  2460. begin
  2461. inherited Create;
  2462. fFormat := tfLuminance4Alpha4;
  2463. fWithAlpha := tfLuminance4Alpha4;
  2464. fWithoutAlpha := tfLuminance4;
  2465. fglInternalFormat := GL_LUMINANCE4_ALPHA4;
  2466. end;
  2467. constructor TfdLuminance6Alpha2.Create;
  2468. begin
  2469. inherited Create;
  2470. fFormat := tfLuminance6Alpha2;
  2471. fWithAlpha := tfLuminance6Alpha2;
  2472. fWithoutAlpha := tfLuminance8;
  2473. fglInternalFormat := GL_LUMINANCE6_ALPHA2;
  2474. end;
  2475. constructor TfdLuminance8Alpha8.Create;
  2476. begin
  2477. inherited Create;
  2478. fFormat := tfLuminance8Alpha8;
  2479. fWithAlpha := tfLuminance8Alpha8;
  2480. fWithoutAlpha := tfLuminance8;
  2481. fglInternalFormat := GL_LUMINANCE8_ALPHA8;
  2482. end;
  2483. constructor TfdLuminance12Alpha4.Create;
  2484. begin
  2485. inherited Create;
  2486. fFormat := tfLuminance12Alpha4;
  2487. fWithAlpha := tfLuminance12Alpha4;
  2488. fWithoutAlpha := tfLuminance12;
  2489. fglInternalFormat := GL_LUMINANCE12_ALPHA4;
  2490. end;
  2491. constructor TfdLuminance12Alpha12.Create;
  2492. begin
  2493. inherited Create;
  2494. fFormat := tfLuminance12Alpha12;
  2495. fWithAlpha := tfLuminance12Alpha12;
  2496. fWithoutAlpha := tfLuminance12;
  2497. fglInternalFormat := GL_LUMINANCE12_ALPHA12;
  2498. end;
  2499. constructor TfdLuminance16Alpha16.Create;
  2500. begin
  2501. inherited Create;
  2502. fFormat := tfLuminance16Alpha16;
  2503. fWithAlpha := tfLuminance16Alpha16;
  2504. fWithoutAlpha := tfLuminance16;
  2505. fglInternalFormat := GL_LUMINANCE16_ALPHA16;
  2506. end;
  2507. constructor TfdR3G3B2.Create;
  2508. begin
  2509. inherited Create;
  2510. fFormat := tfR3G3B2;
  2511. fWithAlpha := tfRGBA2;
  2512. fWithoutAlpha := tfR3G3B2;
  2513. fRange.r := $7;
  2514. fRange.g := $7;
  2515. fRange.b := $3;
  2516. fShift.r := 0;
  2517. fShift.g := 3;
  2518. fShift.b := 6;
  2519. fglFormat := GL_RGB;
  2520. fglInternalFormat := GL_R3_G3_B2;
  2521. fglDataFormat := GL_UNSIGNED_BYTE_2_3_3_REV;
  2522. end;
  2523. constructor TfdRGB4.Create;
  2524. begin
  2525. inherited Create;
  2526. fFormat := tfRGB4;
  2527. fWithAlpha := tfRGBA4;
  2528. fWithoutAlpha := tfRGB4;
  2529. fRGBInverted := tfBGR4;
  2530. fRange.r := $F;
  2531. fRange.g := $F;
  2532. fRange.b := $F;
  2533. fShift.r := 0;
  2534. fShift.g := 4;
  2535. fShift.b := 8;
  2536. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2537. fglInternalFormat := GL_RGB4;
  2538. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2539. end;
  2540. constructor TfdR5G6B5.Create;
  2541. begin
  2542. inherited Create;
  2543. fFormat := tfR5G6B5;
  2544. fWithAlpha := tfRGBA4;
  2545. fWithoutAlpha := tfR5G6B5;
  2546. fRGBInverted := tfB5G6R5;
  2547. fRange.r := $1F;
  2548. fRange.g := $3F;
  2549. fRange.b := $1F;
  2550. fShift.r := 0;
  2551. fShift.g := 5;
  2552. fShift.b := 11;
  2553. fglFormat := GL_RGB;
  2554. fglInternalFormat := GL_RGB565;
  2555. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5_REV;
  2556. end;
  2557. constructor TfdRGB5.Create;
  2558. begin
  2559. inherited Create;
  2560. fFormat := tfRGB5;
  2561. fWithAlpha := tfRGB5A1;
  2562. fWithoutAlpha := tfRGB5;
  2563. fRGBInverted := tfBGR5;
  2564. fRange.r := $1F;
  2565. fRange.g := $1F;
  2566. fRange.b := $1F;
  2567. fShift.r := 0;
  2568. fShift.g := 5;
  2569. fShift.b := 10;
  2570. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2571. fglInternalFormat := GL_RGB5;
  2572. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2573. end;
  2574. constructor TfdRGB8.Create;
  2575. begin
  2576. inherited Create;
  2577. fFormat := tfRGB8;
  2578. fWithAlpha := tfRGBA8;
  2579. fWithoutAlpha := tfRGB8;
  2580. fRGBInverted := tfBGR8;
  2581. fglInternalFormat := GL_RGB8;
  2582. end;
  2583. constructor TfdRGB10.Create;
  2584. begin
  2585. inherited Create;
  2586. fFormat := tfRGB10;
  2587. fWithAlpha := tfRGB10A2;
  2588. fWithoutAlpha := tfRGB10;
  2589. fRGBInverted := tfBGR10;
  2590. fRange.r := $3FF;
  2591. fRange.g := $3FF;
  2592. fRange.b := $3FF;
  2593. fShift.r := 0;
  2594. fShift.g := 10;
  2595. fShift.b := 20;
  2596. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2597. fglInternalFormat := GL_RGB10;
  2598. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2599. end;
  2600. constructor TfdRGB12.Create;
  2601. begin
  2602. inherited Create;
  2603. fFormat := tfRGB12;
  2604. fWithAlpha := tfRGBA12;
  2605. fWithoutAlpha := tfRGB12;
  2606. fRGBInverted := tfBGR12;
  2607. fglInternalFormat := GL_RGB12;
  2608. end;
  2609. constructor TfdRGB16.Create;
  2610. begin
  2611. inherited Create;
  2612. fFormat := tfRGB16;
  2613. fWithAlpha := tfRGBA16;
  2614. fWithoutAlpha := tfRGB16;
  2615. fRGBInverted := tfBGR16;
  2616. fglInternalFormat := GL_RGB16;
  2617. end;
  2618. constructor TfdRGBA2.Create;
  2619. begin
  2620. inherited Create;
  2621. fFormat := tfRGBA2;
  2622. fWithAlpha := tfRGBA2;
  2623. fWithoutAlpha := tfR3G3B2;
  2624. fRGBInverted := tfBGRA2;
  2625. fglInternalFormat := GL_RGBA2;
  2626. end;
  2627. constructor TfdRGBA4.Create;
  2628. begin
  2629. inherited Create;
  2630. fFormat := tfRGBA4;
  2631. fWithAlpha := tfRGBA4;
  2632. fWithoutAlpha := tfRGB4;
  2633. fRGBInverted := tfBGRA4;
  2634. fRange.r := $F;
  2635. fRange.g := $F;
  2636. fRange.b := $F;
  2637. fRange.a := $F;
  2638. fShift.r := 0;
  2639. fShift.g := 4;
  2640. fShift.b := 8;
  2641. fShift.a := 12;
  2642. fglFormat := GL_RGBA;
  2643. fglInternalFormat := GL_RGBA4;
  2644. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2645. end;
  2646. constructor TfdRGB5A1.Create;
  2647. begin
  2648. inherited Create;
  2649. fFormat := tfRGB5A1;
  2650. fWithAlpha := tfRGB5A1;
  2651. fWithoutAlpha := tfRGB5;
  2652. fRGBInverted := tfBGR5A1;
  2653. fRange.r := $1F;
  2654. fRange.g := $1F;
  2655. fRange.b := $1F;
  2656. fRange.a := $01;
  2657. fShift.r := 0;
  2658. fShift.g := 5;
  2659. fShift.b := 10;
  2660. fShift.a := 15;
  2661. fglFormat := GL_RGBA;
  2662. fglInternalFormat := GL_RGB5_A1;
  2663. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2664. end;
  2665. constructor TfdRGBA8.Create;
  2666. begin
  2667. inherited Create;
  2668. fFormat := tfRGBA8;
  2669. fWithAlpha := tfRGBA8;
  2670. fWithoutAlpha := tfRGB8;
  2671. fRGBInverted := tfBGRA8;
  2672. fglInternalFormat := GL_RGBA8;
  2673. end;
  2674. constructor TfdRGB10A2.Create;
  2675. begin
  2676. inherited Create;
  2677. fFormat := tfRGB10A2;
  2678. fWithAlpha := tfRGB10A2;
  2679. fWithoutAlpha := tfRGB10;
  2680. fRGBInverted := tfBGR10A2;
  2681. fRange.r := $3FF;
  2682. fRange.g := $3FF;
  2683. fRange.b := $3FF;
  2684. fRange.a := $003;
  2685. fShift.r := 0;
  2686. fShift.g := 10;
  2687. fShift.b := 20;
  2688. fShift.a := 30;
  2689. fglFormat := GL_RGBA;
  2690. fglInternalFormat := GL_RGB10_A2;
  2691. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2692. end;
  2693. constructor TfdRGBA12.Create;
  2694. begin
  2695. inherited Create;
  2696. fFormat := tfRGBA12;
  2697. fWithAlpha := tfRGBA12;
  2698. fWithoutAlpha := tfRGB12;
  2699. fRGBInverted := tfBGRA12;
  2700. fglInternalFormat := GL_RGBA12;
  2701. end;
  2702. constructor TfdRGBA16.Create;
  2703. begin
  2704. inherited Create;
  2705. fFormat := tfRGBA16;
  2706. fWithAlpha := tfRGBA16;
  2707. fWithoutAlpha := tfRGB16;
  2708. fRGBInverted := tfBGRA16;
  2709. fglInternalFormat := GL_RGBA16;
  2710. end;
  2711. constructor TfdBGR4.Create;
  2712. begin
  2713. inherited Create;
  2714. fPixelSize := 2.0;
  2715. fFormat := tfBGR4;
  2716. fWithAlpha := tfBGRA4;
  2717. fWithoutAlpha := tfBGR4;
  2718. fRGBInverted := tfRGB4;
  2719. fRange.r := $F;
  2720. fRange.g := $F;
  2721. fRange.b := $F;
  2722. fRange.a := $0;
  2723. fShift.r := 8;
  2724. fShift.g := 4;
  2725. fShift.b := 0;
  2726. fShift.a := 0;
  2727. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2728. fglInternalFormat := GL_RGB4;
  2729. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2730. end;
  2731. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2732. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2733. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2734. constructor TfdB5G6R5.Create;
  2735. begin
  2736. inherited Create;
  2737. fFormat := tfB5G6R5;
  2738. fWithAlpha := tfBGRA4;
  2739. fWithoutAlpha := tfB5G6R5;
  2740. fRGBInverted := tfR5G6B5;
  2741. fRange.r := $1F;
  2742. fRange.g := $3F;
  2743. fRange.b := $1F;
  2744. fShift.r := 11;
  2745. fShift.g := 5;
  2746. fShift.b := 0;
  2747. fglFormat := GL_RGB; //B5G6R5 is only possible as R5G6B5 -> use reverted dataformat
  2748. fglInternalFormat := GL_RGB8;
  2749. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5;
  2750. end;
  2751. constructor TfdBGR5.Create;
  2752. begin
  2753. inherited Create;
  2754. fPixelSize := 2.0;
  2755. fFormat := tfBGR5;
  2756. fWithAlpha := tfBGR5A1;
  2757. fWithoutAlpha := tfBGR5;
  2758. fRGBInverted := tfRGB5;
  2759. fRange.r := $1F;
  2760. fRange.g := $1F;
  2761. fRange.b := $1F;
  2762. fRange.a := $00;
  2763. fShift.r := 10;
  2764. fShift.g := 5;
  2765. fShift.b := 0;
  2766. fShift.a := 0;
  2767. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2768. fglInternalFormat := GL_RGB5;
  2769. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2770. end;
  2771. constructor TfdBGR8.Create;
  2772. begin
  2773. inherited Create;
  2774. fFormat := tfBGR8;
  2775. fWithAlpha := tfBGRA8;
  2776. fWithoutAlpha := tfBGR8;
  2777. fRGBInverted := tfRGB8;
  2778. fglInternalFormat := GL_RGB8;
  2779. end;
  2780. constructor TfdBGR10.Create;
  2781. begin
  2782. inherited Create;
  2783. fFormat := tfBGR10;
  2784. fWithAlpha := tfBGR10A2;
  2785. fWithoutAlpha := tfBGR10;
  2786. fRGBInverted := tfRGB10;
  2787. fRange.r := $3FF;
  2788. fRange.g := $3FF;
  2789. fRange.b := $3FF;
  2790. fRange.a := $000;
  2791. fShift.r := 20;
  2792. fShift.g := 10;
  2793. fShift.b := 0;
  2794. fShift.a := 0;
  2795. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2796. fglInternalFormat := GL_RGB10;
  2797. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2798. end;
  2799. constructor TfdBGR12.Create;
  2800. begin
  2801. inherited Create;
  2802. fFormat := tfBGR12;
  2803. fWithAlpha := tfBGRA12;
  2804. fWithoutAlpha := tfBGR12;
  2805. fRGBInverted := tfRGB12;
  2806. fglInternalFormat := GL_RGB12;
  2807. end;
  2808. constructor TfdBGR16.Create;
  2809. begin
  2810. inherited Create;
  2811. fFormat := tfBGR16;
  2812. fWithAlpha := tfBGRA16;
  2813. fWithoutAlpha := tfBGR16;
  2814. fRGBInverted := tfRGB16;
  2815. fglInternalFormat := GL_RGB16;
  2816. end;
  2817. constructor TfdBGRA2.Create;
  2818. begin
  2819. inherited Create;
  2820. fFormat := tfBGRA2;
  2821. fWithAlpha := tfBGRA4;
  2822. fWithoutAlpha := tfBGR4;
  2823. fRGBInverted := tfRGBA2;
  2824. fglInternalFormat := GL_RGBA2;
  2825. end;
  2826. constructor TfdBGRA4.Create;
  2827. begin
  2828. inherited Create;
  2829. fFormat := tfBGRA4;
  2830. fWithAlpha := tfBGRA4;
  2831. fWithoutAlpha := tfBGR4;
  2832. fRGBInverted := tfRGBA4;
  2833. fRange.r := $F;
  2834. fRange.g := $F;
  2835. fRange.b := $F;
  2836. fRange.a := $F;
  2837. fShift.r := 8;
  2838. fShift.g := 4;
  2839. fShift.b := 0;
  2840. fShift.a := 12;
  2841. fglFormat := GL_BGRA;
  2842. fglInternalFormat := GL_RGBA4;
  2843. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2844. end;
  2845. constructor TfdBGR5A1.Create;
  2846. begin
  2847. inherited Create;
  2848. fFormat := tfBGR5A1;
  2849. fWithAlpha := tfBGR5A1;
  2850. fWithoutAlpha := tfBGR5;
  2851. fRGBInverted := tfRGB5A1;
  2852. fRange.r := $1F;
  2853. fRange.g := $1F;
  2854. fRange.b := $1F;
  2855. fRange.a := $01;
  2856. fShift.r := 10;
  2857. fShift.g := 5;
  2858. fShift.b := 0;
  2859. fShift.a := 15;
  2860. fglFormat := GL_BGRA;
  2861. fglInternalFormat := GL_RGB5_A1;
  2862. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2863. end;
  2864. constructor TfdBGRA8.Create;
  2865. begin
  2866. inherited Create;
  2867. fFormat := tfBGRA8;
  2868. fWithAlpha := tfBGRA8;
  2869. fWithoutAlpha := tfBGR8;
  2870. fRGBInverted := tfRGBA8;
  2871. fglInternalFormat := GL_RGBA8;
  2872. end;
  2873. constructor TfdBGR10A2.Create;
  2874. begin
  2875. inherited Create;
  2876. fFormat := tfBGR10A2;
  2877. fWithAlpha := tfBGR10A2;
  2878. fWithoutAlpha := tfBGR10;
  2879. fRGBInverted := tfRGB10A2;
  2880. fRange.r := $3FF;
  2881. fRange.g := $3FF;
  2882. fRange.b := $3FF;
  2883. fRange.a := $003;
  2884. fShift.r := 20;
  2885. fShift.g := 10;
  2886. fShift.b := 0;
  2887. fShift.a := 30;
  2888. fglFormat := GL_BGRA;
  2889. fglInternalFormat := GL_RGB10_A2;
  2890. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2891. end;
  2892. constructor TfdBGRA12.Create;
  2893. begin
  2894. inherited Create;
  2895. fFormat := tfBGRA12;
  2896. fWithAlpha := tfBGRA12;
  2897. fWithoutAlpha := tfBGR12;
  2898. fRGBInverted := tfRGBA12;
  2899. fglInternalFormat := GL_RGBA12;
  2900. end;
  2901. constructor TfdBGRA16.Create;
  2902. begin
  2903. inherited Create;
  2904. fFormat := tfBGRA16;
  2905. fWithAlpha := tfBGRA16;
  2906. fWithoutAlpha := tfBGR16;
  2907. fRGBInverted := tfRGBA16;
  2908. fglInternalFormat := GL_RGBA16;
  2909. end;
  2910. constructor TfdDepth16.Create;
  2911. begin
  2912. inherited Create;
  2913. fFormat := tfDepth16;
  2914. fWithAlpha := tfEmpty;
  2915. fWithoutAlpha := tfDepth16;
  2916. fglInternalFormat := GL_DEPTH_COMPONENT16;
  2917. end;
  2918. constructor TfdDepth24.Create;
  2919. begin
  2920. inherited Create;
  2921. fFormat := tfDepth24;
  2922. fWithAlpha := tfEmpty;
  2923. fWithoutAlpha := tfDepth24;
  2924. fglInternalFormat := GL_DEPTH_COMPONENT24;
  2925. end;
  2926. constructor TfdDepth32.Create;
  2927. begin
  2928. inherited Create;
  2929. fFormat := tfDepth32;
  2930. fWithAlpha := tfEmpty;
  2931. fWithoutAlpha := tfDepth32;
  2932. fglInternalFormat := GL_DEPTH_COMPONENT32;
  2933. end;
  2934. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2935. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2936. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2937. class procedure TFormatDescriptor.Init;
  2938. begin
  2939. if not Assigned(FormatDescriptorCS) then
  2940. FormatDescriptorCS := TCriticalSection.Create;
  2941. end;
  2942. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2943. class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  2944. begin
  2945. FormatDescriptorCS.Enter;
  2946. try
  2947. result := FormatDescriptors[aFormat];
  2948. if not Assigned(result) then begin
  2949. result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
  2950. FormatDescriptors[aFormat] := result;
  2951. end;
  2952. finally
  2953. FormatDescriptorCS.Leave;
  2954. end;
  2955. end;
  2956. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2957. class function TFormatDescriptor.GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  2958. begin
  2959. result := Get(Get(aFormat).WithAlpha);
  2960. end;
  2961. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2962. class procedure TFormatDescriptor.Clear;
  2963. var
  2964. f: TglBitmapFormat;
  2965. begin
  2966. FormatDescriptorCS.Enter;
  2967. try
  2968. for f := low(FormatDescriptors) to high(FormatDescriptors) do
  2969. FreeAndNil(FormatDescriptors[f]);
  2970. finally
  2971. FormatDescriptorCS.Leave;
  2972. end;
  2973. end;
  2974. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2975. class procedure TFormatDescriptor.Finalize;
  2976. begin
  2977. Clear;
  2978. FreeAndNil(FormatDescriptorCS);
  2979. end;
  2980. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2981. //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2982. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2983. procedure TbmpBitfieldFormat.SetRedMask(const aValue: UInt64);
  2984. begin
  2985. Update(aValue, fRange.r, fShift.r);
  2986. end;
  2987. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2988. procedure TbmpBitfieldFormat.SetGreenMask(const aValue: UInt64);
  2989. begin
  2990. Update(aValue, fRange.g, fShift.g);
  2991. end;
  2992. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2993. procedure TbmpBitfieldFormat.SetBlueMask(const aValue: UInt64);
  2994. begin
  2995. Update(aValue, fRange.b, fShift.b);
  2996. end;
  2997. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2998. procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: UInt64);
  2999. begin
  3000. Update(aValue, fRange.a, fShift.a);
  3001. end;
  3002. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3003. procedure TbmpBitfieldFormat.Update(aMask: UInt64; out aRange: Cardinal; out
  3004. aShift: Byte);
  3005. begin
  3006. aShift := 0;
  3007. aRange := 0;
  3008. if (aMask = 0) then
  3009. exit;
  3010. while (aMask > 0) and ((aMask and 1) = 0) do begin
  3011. inc(aShift);
  3012. aMask := aMask shr 1;
  3013. end;
  3014. aRange := 1;
  3015. while (aMask > 0) do begin
  3016. aRange := aRange shl 1;
  3017. aMask := aMask shr 1;
  3018. end;
  3019. dec(aRange);
  3020. fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
  3021. end;
  3022. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3023. procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3024. var
  3025. data: UInt64;
  3026. s: Integer;
  3027. type
  3028. PUInt64 = ^UInt64;
  3029. begin
  3030. data :=
  3031. ((aPixel.Data.r and fRange.r) shl fShift.r) or
  3032. ((aPixel.Data.g and fRange.g) shl fShift.g) or
  3033. ((aPixel.Data.b and fRange.b) shl fShift.b) or
  3034. ((aPixel.Data.a and fRange.a) shl fShift.a);
  3035. s := Round(fPixelSize);
  3036. case s of
  3037. 1: aData^ := data;
  3038. 2: PWord(aData)^ := data;
  3039. 4: PCardinal(aData)^ := data;
  3040. 8: PUInt64(aData)^ := data;
  3041. else
  3042. raise EglBitmapException.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
  3043. end;
  3044. inc(aData, s);
  3045. end;
  3046. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3047. procedure TbmpBitfieldFormat.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3048. var
  3049. data: UInt64;
  3050. s, i: Integer;
  3051. type
  3052. PUInt64 = ^UInt64;
  3053. begin
  3054. s := Round(fPixelSize);
  3055. case s of
  3056. 1: data := aData^;
  3057. 2: data := PWord(aData)^;
  3058. 4: data := PCardinal(aData)^;
  3059. 8: data := PUInt64(aData)^;
  3060. else
  3061. raise EglBitmapException.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
  3062. end;
  3063. for i := 0 to 3 do
  3064. aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
  3065. inc(aData, s);
  3066. end;
  3067. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3068. //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3069. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3070. procedure TbmpColorTableFormat.CreateColorTable;
  3071. var
  3072. bits: Byte;
  3073. len: Integer;
  3074. i: Integer;
  3075. begin
  3076. if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
  3077. raise EglBitmapException.Create(UNSUPPORTED_FORMAT);
  3078. if (Format = tfLuminance4) then
  3079. SetLength(fColorTable, 16)
  3080. else
  3081. SetLength(fColorTable, 256);
  3082. case Format of
  3083. tfLuminance4: begin
  3084. for i := 0 to High(fColorTable) do begin
  3085. fColorTable[i].r := 16 * i;
  3086. fColorTable[i].g := 16 * i;
  3087. fColorTable[i].b := 16 * i;
  3088. fColorTable[i].a := 0;
  3089. end;
  3090. end;
  3091. tfLuminance8: begin
  3092. for i := 0 to High(fColorTable) do begin
  3093. fColorTable[i].r := i;
  3094. fColorTable[i].g := i;
  3095. fColorTable[i].b := i;
  3096. fColorTable[i].a := 0;
  3097. end;
  3098. end;
  3099. tfR3G3B2: begin
  3100. for i := 0 to High(fColorTable) do begin
  3101. fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
  3102. fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
  3103. fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
  3104. fColorTable[i].a := 0;
  3105. end;
  3106. end;
  3107. end;
  3108. end;
  3109. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3110. procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3111. var
  3112. d: Byte;
  3113. begin
  3114. if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
  3115. raise EglBitmapException.Create(UNSUPPORTED_FORMAT);
  3116. case Format of
  3117. tfLuminance4: begin
  3118. if (aMapData = nil) then
  3119. aData^ := 0;
  3120. d := LuminanceWeight(aPixel) and Range.r;
  3121. aData^ := aData^ or (d shl (4 - PtrInt(aMapData)));
  3122. inc(aMapData, 4);
  3123. if (PtrInt(aMapData) >= 8) then begin
  3124. inc(aData);
  3125. aMapData := nil;
  3126. end;
  3127. end;
  3128. tfLuminance8: begin
  3129. aData^ := LuminanceWeight(aPixel) and Range.r;
  3130. inc(aData);
  3131. end;
  3132. tfR3G3B2: begin
  3133. aData^ := Round(
  3134. ((aPixel.Data.r and Range.r) shl Shift.r) or
  3135. ((aPixel.Data.g and Range.g) shl Shift.g) or
  3136. ((aPixel.Data.b and Range.b) shl Shift.b));
  3137. inc(aData);
  3138. end;
  3139. end;
  3140. end;
  3141. procedure TbmpColorTableFormat.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3142. type
  3143. PUInt64 = ^UInt64;
  3144. var
  3145. idx: UInt64;
  3146. s: Integer;
  3147. bits: Byte;
  3148. f: Single;
  3149. begin
  3150. s := Trunc(fPixelSize);
  3151. f := fPixelSize - s;
  3152. bits := Round(8 * f);
  3153. case s of
  3154. 0: idx := (aData^ shr (8 - bits - PtrInt(aMapData))) and ((1 shl bits) - 1);
  3155. 1: idx := aData^;
  3156. 2: idx := PWord(aData)^;
  3157. 4: idx := PCardinal(aData)^;
  3158. 8: idx := PUInt64(aData)^;
  3159. else
  3160. raise EglBitmapException.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
  3161. end;
  3162. if (idx >= Length(fColorTable)) then
  3163. raise EglBitmapException.CreateFmt('invalid color index: %d', [idx]);
  3164. with fColorTable[idx] do begin
  3165. aPixel.Data.r := r;
  3166. aPixel.Data.g := g;
  3167. aPixel.Data.b := b;
  3168. aPixel.Data.a := a;
  3169. end;
  3170. inc(aMapData, bits);
  3171. if (PtrInt(aMapData) >= 8) then begin
  3172. inc(aData, 1);
  3173. dec(aMapData, 8);
  3174. end;
  3175. inc(aData, s);
  3176. end;
  3177. destructor TbmpColorTableFormat.Destroy;
  3178. begin
  3179. SetLength(fColorTable, 0);
  3180. inherited Destroy;
  3181. end;
  3182. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3183. //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3184. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3185. procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
  3186. begin
  3187. with aFuncRec do begin
  3188. if (Source.Range.r > 0) then
  3189. Dest.Data.r := Source.Data.r;
  3190. if (Source.Range.g > 0) then
  3191. Dest.Data.g := Source.Data.g;
  3192. if (Source.Range.b > 0) then
  3193. Dest.Data.b := Source.Data.b;
  3194. if (Source.Range.a > 0) then
  3195. Dest.Data.a := Source.Data.a;
  3196. end;
  3197. end;
  3198. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3199. procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3200. var
  3201. i: Integer;
  3202. begin
  3203. with aFuncRec do begin
  3204. for i := 0 to 3 do
  3205. if (Source.Range.arr[i] > 0) then
  3206. Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
  3207. end;
  3208. end;
  3209. type
  3210. TShiftData = packed record
  3211. case Integer of
  3212. 0: (r, g, b, a: SmallInt);
  3213. 1: (arr: array[0..3] of SmallInt);
  3214. end;
  3215. PShiftData = ^TShiftData;
  3216. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3217. procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3218. var
  3219. i: Integer;
  3220. begin
  3221. with aFuncRec do
  3222. for i := 0 to 3 do
  3223. if (Source.Range.arr[i] > 0) then
  3224. Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
  3225. end;
  3226. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3227. procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
  3228. begin
  3229. with aFuncRec do begin
  3230. Dest.Data.r := Source.Data.r;
  3231. Dest.Data.g := Source.Data.g;
  3232. Dest.Data.b := Source.Data.b;
  3233. Dest.Data.a := Source.Data.a;
  3234. if (Args and $1 > 0) then begin
  3235. Dest.Data.r := Dest.Data.r xor Dest.Range.r;
  3236. Dest.Data.g := Dest.Data.g xor Dest.Range.g;
  3237. Dest.Data.b := Dest.Data.b xor Dest.Range.b;
  3238. end;
  3239. if (Args and $2 > 0) then begin
  3240. Dest.Data.a := Dest.Data.a xor Dest.Range.a;
  3241. end;
  3242. end;
  3243. end;
  3244. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3245. procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
  3246. var
  3247. i: Integer;
  3248. begin
  3249. with aFuncRec do begin
  3250. for i := 0 to 3 do
  3251. Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
  3252. end;
  3253. end;
  3254. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3255. procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3256. var
  3257. Temp: Single;
  3258. begin
  3259. with FuncRec do begin
  3260. if (FuncRec.Args = 0) then begin //source has no alpha
  3261. Temp :=
  3262. Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
  3263. Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
  3264. Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
  3265. Dest.Data.a := Round(Dest.Range.a * Temp);
  3266. end else
  3267. Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
  3268. end;
  3269. end;
  3270. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3271. procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3272. type
  3273. PglBitmapPixelData = ^TglBitmapPixelData;
  3274. begin
  3275. with FuncRec do begin
  3276. Dest.Data.r := Source.Data.r;
  3277. Dest.Data.g := Source.Data.g;
  3278. Dest.Data.b := Source.Data.b;
  3279. with PglBitmapPixelData(Args)^ do
  3280. if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
  3281. (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
  3282. (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
  3283. Dest.Data.a := 0
  3284. else
  3285. Dest.Data.a := Dest.Range.a;
  3286. end;
  3287. end;
  3288. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3289. procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3290. type
  3291. PglBitmapPixelData = ^TglBitmapPixelData;
  3292. begin
  3293. with FuncRec do begin
  3294. Dest.Data.r := Source.Data.r;
  3295. Dest.Data.g := Source.Data.g;
  3296. Dest.Data.b := Source.Data.b;
  3297. Dest.Data.a := PCardinal(Args)^;
  3298. end;
  3299. end;
  3300. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3301. procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
  3302. type
  3303. PRGBPix = ^TRGBPix;
  3304. TRGBPix = array [0..2] of byte;
  3305. var
  3306. Temp: Byte;
  3307. begin
  3308. while aWidth > 0 do begin
  3309. Temp := PRGBPix(aData)^[0];
  3310. PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
  3311. PRGBPix(aData)^[2] := Temp;
  3312. if aHasAlpha then
  3313. Inc(aData, 4)
  3314. else
  3315. Inc(aData, 3);
  3316. dec(aWidth);
  3317. end;
  3318. end;
  3319. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3320. //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3321. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3322. function TglBitmap.GetWidth: Integer;
  3323. begin
  3324. if (ffX in fDimension.Fields) then
  3325. result := fDimension.X
  3326. else
  3327. result := -1;
  3328. end;
  3329. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3330. function TglBitmap.GetHeight: Integer;
  3331. begin
  3332. if (ffY in fDimension.Fields) then
  3333. result := fDimension.Y
  3334. else
  3335. result := -1;
  3336. end;
  3337. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3338. function TglBitmap.GetFileWidth: Integer;
  3339. begin
  3340. result := Max(1, Width);
  3341. end;
  3342. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3343. function TglBitmap.GetFileHeight: Integer;
  3344. begin
  3345. result := Max(1, Height);
  3346. end;
  3347. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3348. procedure TglBitmap.SetCustomData(const aValue: Pointer);
  3349. begin
  3350. if fCustomData = aValue then
  3351. exit;
  3352. fCustomData := aValue;
  3353. end;
  3354. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3355. procedure TglBitmap.SetCustomName(const aValue: String);
  3356. begin
  3357. if fCustomName = aValue then
  3358. exit;
  3359. fCustomName := aValue;
  3360. end;
  3361. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3362. procedure TglBitmap.SetCustomNameW(const aValue: WideString);
  3363. begin
  3364. if fCustomNameW = aValue then
  3365. exit;
  3366. fCustomNameW := aValue;
  3367. end;
  3368. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3369. procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
  3370. begin
  3371. if fDeleteTextureOnFree = aValue then
  3372. exit;
  3373. fDeleteTextureOnFree := aValue;
  3374. end;
  3375. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3376. procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
  3377. begin
  3378. if fFormat = aValue then
  3379. exit;
  3380. if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
  3381. raise EglBitmapUnsupportedFormatFormat.Create('SetInternalFormat - ' + UNSUPPORTED_FORMAT);
  3382. SetDataPointer(Data, aValue, Width, Height);
  3383. end;
  3384. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3385. procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
  3386. begin
  3387. if fFreeDataAfterGenTexture = aValue then
  3388. exit;
  3389. fFreeDataAfterGenTexture := aValue;
  3390. end;
  3391. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3392. procedure TglBitmap.SetID(const aValue: Cardinal);
  3393. begin
  3394. if fID = aValue then
  3395. exit;
  3396. fID := aValue;
  3397. end;
  3398. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3399. procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
  3400. begin
  3401. if fMipMap = aValue then
  3402. exit;
  3403. fMipMap := aValue;
  3404. end;
  3405. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3406. procedure TglBitmap.SetTarget(const aValue: Cardinal);
  3407. begin
  3408. if fTarget = aValue then
  3409. exit;
  3410. fTarget := aValue;
  3411. end;
  3412. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3413. procedure TglBitmap.SetAnisotropic(const aValue: Integer);
  3414. var
  3415. MaxAnisotropic: Integer;
  3416. begin
  3417. fAnisotropic := aValue;
  3418. if (ID > 0) then begin
  3419. if GL_EXT_texture_filter_anisotropic then begin
  3420. if fAnisotropic > 0 then begin
  3421. Bind(false);
  3422. glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
  3423. if aValue > MaxAnisotropic then
  3424. fAnisotropic := MaxAnisotropic;
  3425. glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
  3426. end;
  3427. end else begin
  3428. fAnisotropic := 0;
  3429. end;
  3430. end;
  3431. end;
  3432. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3433. procedure TglBitmap.CreateID;
  3434. begin
  3435. if (ID <> 0) then
  3436. glDeleteTextures(1, @fID);
  3437. glGenTextures(1, @fID);
  3438. Bind(false);
  3439. end;
  3440. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3441. procedure TglBitmap.SetupParameters(var aBuildWithGlu: Boolean);
  3442. begin
  3443. // Set Up Parameters
  3444. SetWrap(fWrapS, fWrapT, fWrapR);
  3445. SetFilter(fFilterMin, fFilterMag);
  3446. SetAnisotropic(fAnisotropic);
  3447. SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
  3448. // Mip Maps Generation Mode
  3449. aBuildWithGlu := false;
  3450. if (MipMap = mmMipmap) then begin
  3451. if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
  3452. glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
  3453. else
  3454. aBuildWithGlu := true;
  3455. end else if (MipMap = mmMipmapGlu) then
  3456. aBuildWithGlu := true;
  3457. end;
  3458. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3459. procedure TglBitmap.SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
  3460. const aWidth: Integer; const aHeight: Integer);
  3461. var
  3462. s: Single;
  3463. begin
  3464. if (Data <> aData) then begin
  3465. if (Assigned(Data)) then
  3466. FreeMem(Data);
  3467. fData := aData;
  3468. end;
  3469. FillChar(fDimension, SizeOf(fDimension), 0);
  3470. if not Assigned(fData) then begin
  3471. fFormat := tfEmpty;
  3472. fPixelSize := 0;
  3473. fRowSize := 0;
  3474. end else begin
  3475. if aWidth <> -1 then begin
  3476. fDimension.Fields := fDimension.Fields + [ffX];
  3477. fDimension.X := aWidth;
  3478. end;
  3479. if aHeight <> -1 then begin
  3480. fDimension.Fields := fDimension.Fields + [ffY];
  3481. fDimension.Y := aHeight;
  3482. end;
  3483. s := TFormatDescriptor.Get(aFormat).PixelSize;
  3484. fFormat := aFormat;
  3485. fPixelSize := Ceil(s);
  3486. fRowSize := Ceil(s * aWidth);
  3487. end;
  3488. end;
  3489. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3490. function TglBitmap.FlipHorz: Boolean;
  3491. begin
  3492. result := false;
  3493. end;
  3494. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3495. function TglBitmap.FlipVert: Boolean;
  3496. begin
  3497. result := false;
  3498. end;
  3499. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3500. //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3501. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3502. procedure TglBitmap.AfterConstruction;
  3503. begin
  3504. inherited AfterConstruction;
  3505. fID := 0;
  3506. fTarget := 0;
  3507. fIsResident := false;
  3508. fFormat := glBitmapGetDefaultFormat;
  3509. fMipMap := glBitmapDefaultMipmap;
  3510. fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
  3511. fDeleteTextureOnFree := glBitmapGetDefaultDeleteTextureOnFree;
  3512. glBitmapGetDefaultFilter (fFilterMin, fFilterMag);
  3513. glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
  3514. end;
  3515. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3516. procedure TglBitmap.BeforeDestruction;
  3517. begin
  3518. SetDataPointer(nil, tfEmpty);
  3519. if (fID > 0) and fDeleteTextureOnFree then
  3520. glDeleteTextures(1, @fID);
  3521. inherited BeforeDestruction;
  3522. end;
  3523. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3524. procedure TglBitmap.LoadFromFile(const aFilename: String);
  3525. var
  3526. fs: TFileStream;
  3527. begin
  3528. if not FileExists(aFilename) then
  3529. raise EglBitmapException.Create('file does not exist: ' + aFilename);
  3530. fFilename := aFilename;
  3531. fs := TFileStream.Create(fFilename, fmOpenRead);
  3532. try
  3533. fs.Position := 0;
  3534. LoadFromStream(fs);
  3535. finally
  3536. fs.Free;
  3537. end;
  3538. end;
  3539. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3540. procedure TglBitmap.LoadFromStream(const aStream: TStream);
  3541. begin
  3542. {$IFDEF GLB_SUPPORT_PNG_READ}
  3543. if not LoadPNG(aStream) then
  3544. {$ENDIF}
  3545. {$IFDEF GLB_SUPPORT_JPEG_READ}
  3546. if not LoadJPEG(aStream) then
  3547. {$ENDIF}
  3548. if not LoadDDS(aStream) then
  3549. if not LoadTGA(aStream) then
  3550. if not LoadBMP(aStream) then
  3551. raise EglBitmapException.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
  3552. end;
  3553. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3554. procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  3555. const aFormat: TglBitmapFormat; const aArgs: PtrInt);
  3556. var
  3557. tmpData: PByte;
  3558. size: Integer;
  3559. begin
  3560. size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  3561. GetMem(tmpData, size);
  3562. try
  3563. FillChar(tmpData^, size, #$FF);
  3564. SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y);
  3565. except
  3566. FreeMem(tmpData);
  3567. raise;
  3568. end;
  3569. AddFunc(Self, aFunc, false, Format, aArgs);
  3570. end;
  3571. {$IFDEF GLB_DELPHI}
  3572. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3573. procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil);
  3574. var
  3575. rs: TResourceStream;
  3576. TempPos: Integer;
  3577. ResTypeStr: String;
  3578. TempResType: PChar;
  3579. begin
  3580. if not Assigned(ResType) then begin
  3581. TempPos := Pos('.', Resource);
  3582. ResTypeStr := UpperCase(Copy(Resource, TempPos + 1, Length(Resource) - TempPos));
  3583. Resource := UpperCase(Copy(Resource, 0, TempPos -1));
  3584. TempResType := PChar(ResTypeStr);
  3585. end else
  3586. TempResType := ResType
  3587. rs := TResourceStream.Create(Instance, Resource, TempResType);
  3588. try
  3589. LoadFromStream(rs);
  3590. finally
  3591. rs.Free;
  3592. end;
  3593. end;
  3594. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3595. procedure TglBitmap.LoadFromResourceID(const sInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  3596. var
  3597. rs: TResourceStream;
  3598. begin
  3599. rs := TResourceStream.CreateFromID(Instance, ResourceID, ResType);
  3600. try
  3601. LoadFromStream(rs);
  3602. finally
  3603. rs.Free;
  3604. end;
  3605. end;
  3606. {$ENDIF}
  3607. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3608. procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  3609. var
  3610. fs: TFileStream;
  3611. begin
  3612. fs := TFileStream.Create(aFileName, fmCreate);
  3613. try
  3614. fs.Position := 0;
  3615. SaveToStream(fs, aFileType);
  3616. finally
  3617. fs.Free;
  3618. end;
  3619. end;
  3620. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3621. procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
  3622. begin
  3623. case aFileType of
  3624. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  3625. ftPNG: SavePng(aStream);
  3626. {$ENDIF}
  3627. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  3628. ftJPEG: SaveJPEG(aStream);
  3629. {$ENDIF}
  3630. ftDDS: SaveDDS(aStream);
  3631. ftTGA: SaveTGA(aStream);
  3632. ftBMP: SaveBMP(aStream);
  3633. end;
  3634. end;
  3635. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3636. function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: PtrInt): Boolean;
  3637. begin
  3638. result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
  3639. end;
  3640. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3641. function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  3642. const aFormat: TglBitmapFormat; const aArgs: PtrInt): Boolean;
  3643. var
  3644. DestData, TmpData, SourceData: pByte;
  3645. TempHeight, TempWidth: Integer;
  3646. SourceFD, DestFD: TFormatDescriptor;
  3647. SourceMD, DestMD: Pointer;
  3648. FuncRec: TglBitmapFunctionRec;
  3649. begin
  3650. Assert(Assigned(Data));
  3651. Assert(Assigned(aSource));
  3652. Assert(Assigned(aSource.Data));
  3653. result := false;
  3654. if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
  3655. SourceFD := TFormatDescriptor.Get(aSource.Format);
  3656. DestFD := TFormatDescriptor.Get(aFormat);
  3657. // inkompatible Formats so CreateTemp
  3658. if (SourceFD.PixelSize <> DestFD.PixelSize) then
  3659. aCreateTemp := true;
  3660. // Values
  3661. TempHeight := Max(1, aSource.Height);
  3662. TempWidth := Max(1, aSource.Width);
  3663. FuncRec.Sender := Self;
  3664. FuncRec.Args := aArgs;
  3665. TmpData := nil;
  3666. if aCreateTemp then begin
  3667. GetMem(TmpData, TFormatDescriptor.Get(aFormat).GetSize(TempWidth, TempHeight));
  3668. DestData := TmpData;
  3669. end else
  3670. DestData := Data;
  3671. try
  3672. SourceFD.PreparePixel(FuncRec.Source);
  3673. DestFD.PreparePixel (FuncRec.Dest);
  3674. SourceMD := SourceFD.CreateMappingData;
  3675. DestMD := DestFD.CreateMappingData;
  3676. FuncRec.Size := aSource.Dimension;
  3677. FuncRec.Position.Fields := FuncRec.Size.Fields;
  3678. try
  3679. SourceData := aSource.Data;
  3680. FuncRec.Position.Y := 0;
  3681. while FuncRec.Position.Y < TempHeight do begin
  3682. FuncRec.Position.X := 0;
  3683. while FuncRec.Position.X < TempWidth do begin
  3684. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  3685. aFunc(FuncRec);
  3686. DestFD.Map(FuncRec.Dest, DestData, DestMD);
  3687. inc(FuncRec.Position.X);
  3688. end;
  3689. inc(FuncRec.Position.Y);
  3690. end;
  3691. // Updating Image or InternalFormat
  3692. if aCreateTemp then
  3693. SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height)
  3694. else if (aFormat <> fFormat) then
  3695. Format := aFormat;
  3696. result := true;
  3697. finally
  3698. SourceFD.FreeMappingData(SourceMD);
  3699. DestFD.FreeMappingData(DestMD);
  3700. end;
  3701. except
  3702. if aCreateTemp then
  3703. FreeMem(TmpData);
  3704. raise;
  3705. end;
  3706. end;
  3707. end;
  3708. {$IFDEF GLB_SDL}
  3709. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3710. function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  3711. var
  3712. Row, RowSize: Integer;
  3713. SourceData, TmpData: PByte;
  3714. TempDepth: Integer;
  3715. Pix: TglBitmapPixelData;
  3716. FormatDesc: TglBitmapFormatDescriptor;
  3717. function GetRowPointer(Row: Integer): pByte;
  3718. begin
  3719. result := Surface.pixels;
  3720. Inc(result, Row * RowSize);
  3721. end;
  3722. begin
  3723. result := false;
  3724. (* TODO
  3725. if not FormatIsUncompressed(InternalFormat) then
  3726. raise EglBitmapUnsupportedInternalFormat.Create('AssignToSurface - ' + UNSUPPORTED_INTERNAL_FORMAT);
  3727. *)
  3728. FormatDesc := FORMAT_DESCRIPTORS[Format];
  3729. if Assigned(Data) then begin
  3730. case Trunc(FormatDesc.GetSize) of
  3731. 1: TempDepth := 8;
  3732. 2: TempDepth := 16;
  3733. 3: TempDepth := 24;
  3734. 4: TempDepth := 32;
  3735. else
  3736. raise EglBitmapException.Create('AssignToSurface - ' + UNSUPPORTED_INTERNAL_FORMAT);
  3737. end;
  3738. FormatDesc.PreparePixel(Pix);
  3739. with Pix.PixelDesc do
  3740. Surface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
  3741. RedRange shl RedShift, GreenRange shl GreenShift, BlueRange shl BlueShift, AlphaRange shl AlphaShift);
  3742. SourceData := Data;
  3743. RowSize := Ceil(FileWidth * FormatDesc.GetSize);
  3744. for Row := 0 to FileHeight -1 do begin
  3745. TmpData := GetRowPointer(Row);
  3746. if Assigned(TmpData) then begin
  3747. Move(SourceData^, TmpData^, RowSize);
  3748. inc(SourceData, RowSize);
  3749. end;
  3750. end;
  3751. result := true;
  3752. end;
  3753. end;
  3754. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3755. function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  3756. var
  3757. pSource, pData, pTempData: PByte;
  3758. Row, RowSize, TempWidth, TempHeight: Integer;
  3759. IntFormat, f: TglBitmapInternalFormat;
  3760. FormatDesc: TglBitmapFormatDescriptor;
  3761. function GetRowPointer(Row: Integer): pByte;
  3762. begin
  3763. result := Surface^.pixels;
  3764. Inc(result, Row * RowSize);
  3765. end;
  3766. begin
  3767. result := false;
  3768. if (Assigned(Surface)) then begin
  3769. with Surface^.format^ do begin
  3770. IntFormat := tfEmpty;
  3771. for f := Low(f) to High(f) do begin
  3772. if FORMAT_DESCRIPTORS[f].MaskMatch(RMask, GMask, BMask, AMask) then begin
  3773. IntFormat := f;
  3774. break;
  3775. end;
  3776. end;
  3777. if (IntFormat = tfEmpty) then
  3778. raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
  3779. end;
  3780. FormatDesc := FORMAT_DESCRIPTORS[IntFormat];
  3781. TempWidth := Surface^.w;
  3782. TempHeight := Surface^.h;
  3783. RowSize := Trunc(TempWidth * FormatDesc.GetSize);
  3784. GetMem(pData, TempHeight * RowSize);
  3785. try
  3786. pTempData := pData;
  3787. for Row := 0 to TempHeight -1 do begin
  3788. pSource := GetRowPointer(Row);
  3789. if (Assigned(pSource)) then begin
  3790. Move(pSource^, pTempData^, RowSize);
  3791. Inc(pTempData, RowSize);
  3792. end;
  3793. end;
  3794. SetDataPointer(pData, IntFormat, TempWidth, TempHeight);
  3795. result := true;
  3796. except
  3797. FreeMem(pData);
  3798. raise;
  3799. end;
  3800. end;
  3801. end;
  3802. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3803. function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  3804. var
  3805. Row, Col, AlphaInterleave: Integer;
  3806. pSource, pDest: PByte;
  3807. function GetRowPointer(Row: Integer): pByte;
  3808. begin
  3809. result := aSurface.pixels;
  3810. Inc(result, Row * Width);
  3811. end;
  3812. begin
  3813. result := false;
  3814. if Assigned(Data) then begin
  3815. if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
  3816. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
  3817. AlphaInterleave := 0;
  3818. case Format of
  3819. ifLuminance8Alpha8:
  3820. AlphaInterleave := 1;
  3821. ifBGRA8, ifRGBA8:
  3822. AlphaInterleave := 3;
  3823. end;
  3824. pSource := Data;
  3825. for Row := 0 to Height -1 do begin
  3826. pDest := GetRowPointer(Row);
  3827. if Assigned(pDest) then begin
  3828. for Col := 0 to Width -1 do begin
  3829. Inc(pSource, AlphaInterleave);
  3830. pDest^ := pSource^;
  3831. Inc(pDest);
  3832. Inc(pSource);
  3833. end;
  3834. end;
  3835. end;
  3836. result := true;
  3837. end;
  3838. end;
  3839. end;
  3840. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3841. function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
  3842. var
  3843. bmp: TglBitmap2D;
  3844. begin
  3845. bmp := TglBitmap2D.Create;
  3846. try
  3847. bmp.AssignFromSurface(Surface);
  3848. result := AddAlphaFromGlBitmap(bmp, Func, CustomData);
  3849. finally
  3850. bmp.Free;
  3851. end;
  3852. end;
  3853. {$ENDIF}
  3854. {$IFDEF GLB_DELPHI}
  3855. //TODO rework & test
  3856. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3857. function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
  3858. var
  3859. Row: Integer;
  3860. pSource, pData: PByte;
  3861. begin
  3862. result := false;
  3863. if Assigned(Data) then begin
  3864. if Assigned(aBitmap) then begin
  3865. aBitmap.Width := Width;
  3866. aBitmap.Height := Height;
  3867. case Format of
  3868. tfAlpha8, ifLuminance, ifDepth8:
  3869. begin
  3870. Bitmap.PixelFormat := pf8bit;
  3871. Bitmap.Palette := CreateGrayPalette;
  3872. end;
  3873. ifRGB5A1:
  3874. Bitmap.PixelFormat := pf15bit;
  3875. ifR5G6B5:
  3876. Bitmap.PixelFormat := pf16bit;
  3877. ifRGB8, ifBGR8:
  3878. Bitmap.PixelFormat := pf24bit;
  3879. ifRGBA8, ifBGRA8:
  3880. Bitmap.PixelFormat := pf32bit;
  3881. else
  3882. raise EglBitmapException.Create('AssignToBitmap - Invalid Pixelformat.');
  3883. end;
  3884. pSource := Data;
  3885. for Row := 0 to FileHeight -1 do begin
  3886. pData := Bitmap.Scanline[Row];
  3887. Move(pSource^, pData^, fRowSize);
  3888. Inc(pSource, fRowSize);
  3889. // swap RGB(A) to BGR(A)
  3890. if InternalFormat in [ifRGB8, ifRGBA8] then
  3891. SwapRGB(pData, FileWidth, InternalFormat = ifRGBA8);
  3892. end;
  3893. result := true;
  3894. end;
  3895. end;
  3896. end;
  3897. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3898. function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  3899. var
  3900. pSource, pData, pTempData: PByte;
  3901. Row, RowSize, TempWidth, TempHeight: Integer;
  3902. IntFormat: TglBitmapInternalFormat;
  3903. begin
  3904. result := false;
  3905. if (Assigned(Bitmap)) then begin
  3906. case Bitmap.PixelFormat of
  3907. pf8bit:
  3908. IntFormat := ifLuminance;
  3909. pf15bit:
  3910. IntFormat := ifRGB5A1;
  3911. pf16bit:
  3912. IntFormat := ifR5G6B5;
  3913. pf24bit:
  3914. IntFormat := ifBGR8;
  3915. pf32bit:
  3916. IntFormat := ifBGRA8;
  3917. else
  3918. raise EglBitmapException.Create('AssignFromBitmap - Invalid Pixelformat.');
  3919. end;
  3920. TempWidth := Bitmap.Width;
  3921. TempHeight := Bitmap.Height;
  3922. RowSize := Trunc(TempWidth * FormatGetSize(IntFormat));
  3923. GetMem(pData, TempHeight * RowSize);
  3924. try
  3925. pTempData := pData;
  3926. for Row := 0 to TempHeight -1 do begin
  3927. pSource := Bitmap.Scanline[Row];
  3928. if (Assigned(pSource)) then begin
  3929. Move(pSource^, pTempData^, RowSize);
  3930. Inc(pTempData, RowSize);
  3931. end;
  3932. end;
  3933. SetDataPointer(pData, IntFormat, TempWidth, TempHeight);
  3934. result := true;
  3935. except
  3936. FreeMem(pData);
  3937. raise;
  3938. end;
  3939. end;
  3940. end;
  3941. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3942. function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  3943. var
  3944. Row, Col, AlphaInterleave: Integer;
  3945. pSource, pDest: PByte;
  3946. begin
  3947. result := false;
  3948. if Assigned(Data) then begin
  3949. if InternalFormat in [ifAlpha, ifLuminanceAlpha, ifRGBA8, ifBGRA8] then begin
  3950. if Assigned(Bitmap) then begin
  3951. Bitmap.PixelFormat := pf8bit;
  3952. Bitmap.Palette := CreateGrayPalette;
  3953. Bitmap.Width := Width;
  3954. Bitmap.Height := Height;
  3955. case InternalFormat of
  3956. ifLuminanceAlpha:
  3957. AlphaInterleave := 1;
  3958. ifRGBA8, ifBGRA8:
  3959. AlphaInterleave := 3;
  3960. else
  3961. AlphaInterleave := 0;
  3962. end;
  3963. // Copy Data
  3964. pSource := Data;
  3965. for Row := 0 to Height -1 do begin
  3966. pDest := Bitmap.Scanline[Row];
  3967. if Assigned(pDest) then begin
  3968. for Col := 0 to Width -1 do begin
  3969. Inc(pSource, AlphaInterleave);
  3970. pDest^ := pSource^;
  3971. Inc(pDest);
  3972. Inc(pSource);
  3973. end;
  3974. end;
  3975. end;
  3976. result := true;
  3977. end;
  3978. end;
  3979. end;
  3980. end;
  3981. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3982. function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
  3983. var
  3984. tex: TglBitmap2D;
  3985. begin
  3986. tex := TglBitmap2D.Create;
  3987. try
  3988. tex.AssignFromBitmap(Bitmap);
  3989. result := AddAlphaFromglBitmap(tex, Func, CustomData);
  3990. finally
  3991. tex.Free;
  3992. end;
  3993. end;
  3994. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3995. function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar;
  3996. const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
  3997. var
  3998. RS: TResourceStream;
  3999. TempPos: Integer;
  4000. ResTypeStr: String;
  4001. TempResType: PChar;
  4002. begin
  4003. if Assigned(ResType) then
  4004. TempResType := ResType
  4005. else
  4006. begin
  4007. TempPos := Pos('.', Resource);
  4008. ResTypeStr := UpperCase(Copy(Resource, TempPos + 1, Length(Resource) - TempPos));
  4009. Resource := UpperCase(Copy(Resource, 0, TempPos -1));
  4010. TempResType := PChar(ResTypeStr);
  4011. end;
  4012. RS := TResourceStream.Create(Instance, Resource, TempResType);
  4013. try
  4014. result := AddAlphaFromStream(RS, Func, CustomData);
  4015. finally
  4016. RS.Free;
  4017. end;
  4018. end;
  4019. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4020. function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  4021. const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
  4022. var
  4023. RS: TResourceStream;
  4024. begin
  4025. RS := TResourceStream.CreateFromID(Instance, ResourceID, ResType);
  4026. try
  4027. result := AddAlphaFromStream(RS, Func, CustomData);
  4028. finally
  4029. RS.Free;
  4030. end;
  4031. end;
  4032. {$ENDIF}
  4033. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4034. function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
  4035. begin
  4036. (* TODO
  4037. if not FormatIsUncompressed(InternalFormat) then
  4038. raise EglBitmapUnsupportedFormatFormat.Create('AddAlphaFromFunc - ' + UNSUPPORTED_FORMAT);
  4039. *)
  4040. result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
  4041. end;
  4042. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4043. function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
  4044. var
  4045. FS: TFileStream;
  4046. begin
  4047. FS := TFileStream.Create(FileName, fmOpenRead);
  4048. try
  4049. result := AddAlphaFromStream(FS, aFunc, aArgs);
  4050. finally
  4051. FS.Free;
  4052. end;
  4053. end;
  4054. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4055. function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
  4056. var
  4057. tex: TglBitmap2D;
  4058. begin
  4059. tex := TglBitmap2D.Create(aStream);
  4060. try
  4061. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4062. finally
  4063. tex.Free;
  4064. end;
  4065. end;
  4066. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4067. function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
  4068. var
  4069. DestData, DestData2, SourceData: pByte;
  4070. TempHeight, TempWidth: Integer;
  4071. SourceFD, DestFD: TFormatDescriptor;
  4072. SourceMD, DestMD, DestMD2: Pointer;
  4073. FuncRec: TglBitmapFunctionRec;
  4074. begin
  4075. result := false;
  4076. Assert(Assigned(Data));
  4077. Assert(Assigned(aBitmap));
  4078. Assert(Assigned(aBitmap.Data));
  4079. if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
  4080. result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
  4081. if not Assigned(aFunc) then
  4082. aFunc := glBitmapAlphaFunc;
  4083. SourceFD := TFormatDescriptor.Get(aBitmap.Format);
  4084. DestFD := TFormatDescriptor.Get(Format);
  4085. // Values
  4086. TempHeight := aBitmap.FileHeight;
  4087. TempWidth := aBitmap.FileWidth;
  4088. FuncRec.Sender := Self;
  4089. FuncRec.Args := aArgs;
  4090. FuncRec.Size := Dimension;
  4091. FuncRec.Position.Fields := FuncRec.Size.Fields;
  4092. FuncRec.Args := PtrInt(SourceFD.HasAlpha) and 1;
  4093. DestData := Data;
  4094. DestData2 := Data;
  4095. SourceData := aBitmap.Data;
  4096. // Mapping
  4097. SourceFD.PreparePixel(FuncRec.Source);
  4098. DestFD.PreparePixel (FuncRec.Dest);
  4099. SourceMD := SourceFD.CreateMappingData;
  4100. DestMD := DestFD.CreateMappingData;
  4101. DestMD2 := DestFD.CreateMappingData;
  4102. try
  4103. FuncRec.Position.Y := 0;
  4104. while FuncRec.Position.Y < TempHeight do begin
  4105. FuncRec.Position.X := 0;
  4106. while FuncRec.Position.X < TempWidth do begin
  4107. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  4108. DestFD.Unmap (DestData, FuncRec.Dest, DestMD);
  4109. aFunc(FuncRec);
  4110. DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
  4111. inc(FuncRec.Position.X);
  4112. end;
  4113. inc(FuncRec.Position.Y);
  4114. end;
  4115. finally
  4116. SourceFD.FreeMappingData(SourceMD);
  4117. DestFD.FreeMappingData(DestMD);
  4118. DestFD.FreeMappingData(DestMD2);
  4119. end;
  4120. end;
  4121. end;
  4122. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4123. function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
  4124. begin
  4125. result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
  4126. end;
  4127. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4128. function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
  4129. var
  4130. PixelData: TglBitmapPixelData;
  4131. begin
  4132. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4133. result := AddAlphaFromColorKeyFloat(
  4134. aRed / PixelData.Range.r,
  4135. aGreen / PixelData.Range.g,
  4136. aBlue / PixelData.Range.b,
  4137. aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
  4138. end;
  4139. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4140. function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
  4141. var
  4142. values: array[0..2] of Single;
  4143. tmp: Cardinal;
  4144. i: Integer;
  4145. PixelData: TglBitmapPixelData;
  4146. begin
  4147. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4148. with PixelData do begin
  4149. values[0] := aRed;
  4150. values[1] := aGreen;
  4151. values[2] := aBlue;
  4152. for i := 0 to 2 do begin
  4153. tmp := Trunc(Range.arr[i] * aDeviation);
  4154. Data.arr[i] := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
  4155. Range.arr[i] := Max(0, Trunc(Range.arr[i] * values[i] - tmp));
  4156. end;
  4157. Data.a := 0;
  4158. Range.a := 0;
  4159. end;
  4160. result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, PtrInt(@PixelData));
  4161. end;
  4162. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4163. function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
  4164. begin
  4165. result := AddAlphaFromValueFloat(aAlpha / $FF);
  4166. end;
  4167. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4168. function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  4169. var
  4170. PixelData: TglBitmapPixelData;
  4171. begin
  4172. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4173. result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
  4174. end;
  4175. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4176. function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  4177. var
  4178. PixelData: TglBitmapPixelData;
  4179. begin
  4180. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4181. with PixelData do
  4182. Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
  4183. result := AddAlphaFromFunc(glBitmapValueAlphaFunc, PtrInt(@PixelData.Data.a));
  4184. end;
  4185. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4186. function TglBitmap.RemoveAlpha: Boolean;
  4187. var
  4188. FormatDesc: TFormatDescriptor;
  4189. begin
  4190. result := false;
  4191. FormatDesc := TFormatDescriptor.Get(Format);
  4192. if Assigned(Data) then begin
  4193. if not ({FormatDesc.IsUncompressed or }FormatDesc.HasAlpha) then
  4194. raise EglBitmapUnsupportedFormatFormat.Create('RemoveAlpha - ' + UNSUPPORTED_FORMAT);
  4195. result := ConvertTo(FormatDesc.WithoutAlpha);
  4196. end;
  4197. end;
  4198. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4199. function TglBitmap.Clone: TglBitmap;
  4200. var
  4201. Temp: TglBitmap;
  4202. TempPtr: PByte;
  4203. Size: Integer;
  4204. begin
  4205. result := nil;
  4206. Temp := (ClassType.Create as TglBitmap);
  4207. try
  4208. // copy texture data if assigned
  4209. if Assigned(Data) then begin
  4210. Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
  4211. GetMem(TempPtr, Size);
  4212. try
  4213. Move(Data^, TempPtr^, Size);
  4214. Temp.SetDataPointer(TempPtr, Format, Width, Height);
  4215. except
  4216. FreeMem(TempPtr);
  4217. raise;
  4218. end;
  4219. end else
  4220. Temp.SetDataPointer(nil, Format, Width, Height);
  4221. // copy properties
  4222. Temp.fID := ID;
  4223. Temp.fTarget := Target;
  4224. Temp.fFormat := Format;
  4225. Temp.fMipMap := MipMap;
  4226. Temp.fAnisotropic := Anisotropic;
  4227. Temp.fBorderColor := fBorderColor;
  4228. Temp.fDeleteTextureOnFree := DeleteTextureOnFree;
  4229. Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
  4230. Temp.fFilterMin := fFilterMin;
  4231. Temp.fFilterMag := fFilterMag;
  4232. Temp.fWrapS := fWrapS;
  4233. Temp.fWrapT := fWrapT;
  4234. Temp.fWrapR := fWrapR;
  4235. Temp.fFilename := fFilename;
  4236. Temp.fCustomName := fCustomName;
  4237. Temp.fCustomNameW := fCustomNameW;
  4238. Temp.fCustomData := fCustomData;
  4239. result := Temp;
  4240. except
  4241. FreeAndNil(Temp);
  4242. raise;
  4243. end;
  4244. end;
  4245. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4246. function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
  4247. var
  4248. SourceFD, DestFD: TFormatDescriptor;
  4249. SourcePD, DestPD: TglBitmapPixelData;
  4250. ShiftData: TShiftData;
  4251. function CanCopyDirect: Boolean;
  4252. begin
  4253. result :=
  4254. ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  4255. ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  4256. ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  4257. ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  4258. end;
  4259. function CanShift: Boolean;
  4260. begin
  4261. result :=
  4262. ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  4263. ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  4264. ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  4265. ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  4266. end;
  4267. function GetShift(aSource, aDest: Cardinal) : ShortInt;
  4268. begin
  4269. result := 0;
  4270. while (aSource > aDest) and (aSource > 0) do begin
  4271. inc(result);
  4272. aSource := aSource shr 1;
  4273. end;
  4274. end;
  4275. begin
  4276. if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
  4277. SourceFD := TFormatDescriptor.Get(Format);
  4278. DestFD := TFormatDescriptor.Get(aFormat);
  4279. SourceFD.PreparePixel(SourcePD);
  4280. DestFD.PreparePixel (DestPD);
  4281. if CanCopyDirect then
  4282. result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
  4283. else if CanShift then begin
  4284. ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
  4285. ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
  4286. ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
  4287. ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
  4288. result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, PtrInt(@ShiftData));
  4289. end else
  4290. result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
  4291. end else
  4292. result := true;
  4293. end;
  4294. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4295. procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
  4296. begin
  4297. if aUseRGB or aUseAlpha then
  4298. AddFunc(glBitmapInvertFunc, false, ((PtrInt(aUseAlpha) and 1) shl 1) or (PtrInt(aUseRGB) and 1));
  4299. end;
  4300. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4301. procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  4302. begin
  4303. fBorderColor[0] := aRed;
  4304. fBorderColor[1] := aGreen;
  4305. fBorderColor[2] := aBlue;
  4306. fBorderColor[3] := aAlpha;
  4307. if (ID > 0) then begin
  4308. Bind(false);
  4309. glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
  4310. end;
  4311. end;
  4312. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4313. procedure TglBitmap.FreeData;
  4314. begin
  4315. SetDataPointer(nil, tfEmpty);
  4316. end;
  4317. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4318. procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
  4319. const aAlpha: Byte);
  4320. begin
  4321. FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
  4322. end;
  4323. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4324. procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
  4325. var
  4326. PixelData: TglBitmapPixelData;
  4327. begin
  4328. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4329. FillWithColorFloat(
  4330. aRed / PixelData.Range.r,
  4331. aGreen / PixelData.Range.g,
  4332. aBlue / PixelData.Range.b,
  4333. aAlpha / PixelData.Range.a);
  4334. end;
  4335. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4336. procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
  4337. var
  4338. PixelData: TglBitmapPixelData;
  4339. begin
  4340. TFormatDescriptor.Get(Format).PreparePixel(PixelData);
  4341. with PixelData do begin
  4342. Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
  4343. Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
  4344. Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
  4345. Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
  4346. end;
  4347. AddFunc(glBitmapFillWithColorFunc, false, PtrInt(@PixelData));
  4348. end;
  4349. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4350. procedure TglBitmap.SetFilter(const aMin, aMag: Cardinal);
  4351. begin
  4352. //check MIN filter
  4353. case aMin of
  4354. GL_NEAREST:
  4355. fFilterMin := GL_NEAREST;
  4356. GL_LINEAR:
  4357. fFilterMin := GL_LINEAR;
  4358. GL_NEAREST_MIPMAP_NEAREST:
  4359. fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
  4360. GL_LINEAR_MIPMAP_NEAREST:
  4361. fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
  4362. GL_NEAREST_MIPMAP_LINEAR:
  4363. fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
  4364. GL_LINEAR_MIPMAP_LINEAR:
  4365. fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
  4366. else
  4367. raise EglBitmapException.Create('SetFilter - Unknow MIN filter.');
  4368. end;
  4369. //check MAG filter
  4370. case aMag of
  4371. GL_NEAREST:
  4372. fFilterMag := GL_NEAREST;
  4373. GL_LINEAR:
  4374. fFilterMag := GL_LINEAR;
  4375. else
  4376. raise EglBitmapException.Create('SetFilter - Unknow MAG filter.');
  4377. end;
  4378. //apply filter
  4379. if (ID > 0) then begin
  4380. Bind(false);
  4381. glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
  4382. if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
  4383. case fFilterMin of
  4384. GL_NEAREST, GL_LINEAR:
  4385. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  4386. GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
  4387. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
  4388. GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
  4389. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
  4390. end;
  4391. end else
  4392. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  4393. end;
  4394. end;
  4395. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4396. procedure TglBitmap.SetWrap(const S: Cardinal; const T: Cardinal; const R: Cardinal);
  4397. procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
  4398. begin
  4399. case aValue of
  4400. GL_CLAMP:
  4401. aTarget := GL_CLAMP;
  4402. GL_REPEAT:
  4403. aTarget := GL_REPEAT;
  4404. GL_CLAMP_TO_EDGE: begin
  4405. if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
  4406. aTarget := GL_CLAMP_TO_EDGE
  4407. else
  4408. aTarget := GL_CLAMP;
  4409. end;
  4410. GL_CLAMP_TO_BORDER: begin
  4411. if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
  4412. aTarget := GL_CLAMP_TO_BORDER
  4413. else
  4414. aTarget := GL_CLAMP;
  4415. end;
  4416. GL_MIRRORED_REPEAT: begin
  4417. if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
  4418. aTarget := GL_MIRRORED_REPEAT
  4419. else
  4420. raise EglBitmapException.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
  4421. end;
  4422. else
  4423. raise EglBitmapException.Create('SetWrap - Unknow Texturewrap (S).');
  4424. end;
  4425. end;
  4426. begin
  4427. CheckAndSetWrap(S, fWrapS);
  4428. CheckAndSetWrap(T, fWrapT);
  4429. CheckAndSetWrap(R, fWrapR);
  4430. if (ID > 0) then begin
  4431. Bind(false);
  4432. glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
  4433. glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
  4434. glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
  4435. end;
  4436. end;
  4437. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4438. procedure TglBitmap.GetPixel(const aPos: TglBitmapPixelPosition; var aPixel: TglBitmapPixelData);
  4439. begin
  4440. { TODO delete?
  4441. if Assigned (fGetPixelFunc) then
  4442. fGetPixelFunc(aPos, aPixel);
  4443. }
  4444. end;
  4445. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4446. procedure TglBitmap.SetPixel(const aPos: TglBitmapPixelPosition; const aPixel: TglBitmapPixelData);
  4447. begin
  4448. {TODO delete?
  4449. if Assigned (fSetPixelFunc) then
  4450. fSetPixelFuc(aPos, aPixel);
  4451. }
  4452. end;
  4453. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4454. procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
  4455. begin
  4456. if aEnableTextureUnit then
  4457. glEnable(Target);
  4458. if (ID > 0) then
  4459. glBindTexture(Target, ID);
  4460. end;
  4461. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4462. procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
  4463. begin
  4464. if aDisableTextureUnit then
  4465. glDisable(Target);
  4466. glBindTexture(Target, 0);
  4467. end;
  4468. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4469. constructor TglBitmap.Create;
  4470. begin
  4471. {$IFNDEF GLB_NO_NATIVE_GL}
  4472. ReadOpenGLExtensions;
  4473. {$ENDIF}
  4474. if (ClassType = TglBitmap) then
  4475. raise EglBitmapException.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
  4476. inherited Create;
  4477. end;
  4478. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4479. constructor TglBitmap.Create(const aFileName: String);
  4480. begin
  4481. Create;
  4482. LoadFromFile(FileName);
  4483. end;
  4484. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4485. constructor TglBitmap.Create(const aStream: TStream);
  4486. begin
  4487. Create;
  4488. LoadFromStream(aStream);
  4489. end;
  4490. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4491. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat);
  4492. var
  4493. Image: PByte;
  4494. ImageSize: Integer;
  4495. begin
  4496. Create;
  4497. TFormatDescriptor.Get(aFormat).GetSize(aSize);
  4498. GetMem(Image, ImageSize);
  4499. try
  4500. FillChar(Image^, ImageSize, #$FF);
  4501. SetDataPointer(Image, aFormat, aSize.X, aSize.Y);
  4502. except
  4503. FreeMem(Image);
  4504. raise;
  4505. end;
  4506. end;
  4507. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4508. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat;
  4509. const aFunc: TglBitmapFunction; const aArgs: PtrInt);
  4510. begin
  4511. Create;
  4512. LoadFromFunc(aSize, aFunc, aFormat, aArgs);
  4513. end;
  4514. {$IFDEF GLB_DELPHI}
  4515. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4516. constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
  4517. begin
  4518. Create;
  4519. LoadFromResource(aInstance, aResource, aResType);
  4520. end;
  4521. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4522. constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  4523. begin
  4524. Create;
  4525. LoadFromResourceID(aInstance, aResourceID, aResType);
  4526. end;
  4527. {$ENDIF}
  4528. {$IFDEF GLB_SUPPORT_PNG_READ}
  4529. {$IF DEFINED(GLB_SDL_IMAGE)}
  4530. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4531. //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4532. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4533. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  4534. var
  4535. Surface: PSDL_Surface;
  4536. RWops: PSDL_RWops;
  4537. begin
  4538. result := false;
  4539. RWops := glBitmapCreateRWops(aStream);
  4540. try
  4541. if IMG_isPNG(RWops) > 0 then begin
  4542. Surface := IMG_LoadPNG_RW(RWops);
  4543. try
  4544. AssignFromSurface(Surface);
  4545. Rresult := true;
  4546. finally
  4547. SDL_FreeSurface(Surface);
  4548. end;
  4549. end;
  4550. finally
  4551. SDL_FreeRW(RWops);
  4552. end;
  4553. end;
  4554. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  4555. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4556. procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  4557. begin
  4558. TStream(png_get_io_ptr(png)).Read(buffer^, size);
  4559. end;
  4560. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4561. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  4562. var
  4563. StreamPos: Int64;
  4564. signature: array [0..7] of byte;
  4565. png: png_structp;
  4566. png_info: png_infop;
  4567. TempHeight, TempWidth: Integer;
  4568. Format: TglBitmapInternalFormat;
  4569. png_data: pByte;
  4570. png_rows: array of pByte;
  4571. Row, LineSize: Integer;
  4572. begin
  4573. result := false;
  4574. if not init_libPNG then
  4575. raise Exception.Create('LoadPNG - unable to initialize libPNG.');
  4576. try
  4577. // signature
  4578. StreamPos := Stream.Position;
  4579. Stream.Read(signature, 8);
  4580. Stream.Position := StreamPos;
  4581. if png_check_sig(@signature, 8) <> 0 then begin
  4582. // png read struct
  4583. png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  4584. if png = nil then
  4585. raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
  4586. // png info
  4587. png_info := png_create_info_struct(png);
  4588. if png_info = nil then begin
  4589. png_destroy_read_struct(@png, nil, nil);
  4590. raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
  4591. end;
  4592. // set read callback
  4593. png_set_read_fn(png, stream, glBitmap_libPNG_read_func);
  4594. // read informations
  4595. png_read_info(png, png_info);
  4596. // size
  4597. TempHeight := png_get_image_height(png, png_info);
  4598. TempWidth := png_get_image_width(png, png_info);
  4599. // format
  4600. case png_get_color_type(png, png_info) of
  4601. PNG_COLOR_TYPE_GRAY:
  4602. Format := tfLuminance8;
  4603. PNG_COLOR_TYPE_GRAY_ALPHA:
  4604. Format := tfLuminance8Alpha8;
  4605. PNG_COLOR_TYPE_RGB:
  4606. Format := tfRGB8;
  4607. PNG_COLOR_TYPE_RGB_ALPHA:
  4608. Format := tfRGBA8;
  4609. else
  4610. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  4611. end;
  4612. // cut upper 8 bit from 16 bit formats
  4613. if png_get_bit_depth(png, png_info) > 8 then
  4614. png_set_strip_16(png);
  4615. // expand bitdepth smaller than 8
  4616. if png_get_bit_depth(png, png_info) < 8 then
  4617. png_set_expand(png);
  4618. // allocating mem for scanlines
  4619. LineSize := png_get_rowbytes(png, png_info);
  4620. GetMem(png_data, TempHeight * LineSize);
  4621. try
  4622. SetLength(png_rows, TempHeight);
  4623. for Row := Low(png_rows) to High(png_rows) do begin
  4624. png_rows[Row] := png_data;
  4625. Inc(png_rows[Row], Row * LineSize);
  4626. end;
  4627. // read complete image into scanlines
  4628. png_read_image(png, @png_rows[0]);
  4629. // read end
  4630. png_read_end(png, png_info);
  4631. // destroy read struct
  4632. png_destroy_read_struct(@png, @png_info, nil);
  4633. SetLength(png_rows, 0);
  4634. // set new data
  4635. SetDataPointer(png_data, Format, TempWidth, TempHeight);
  4636. result := true;
  4637. except
  4638. FreeMem(png_data);
  4639. raise;
  4640. end;
  4641. end;
  4642. finally
  4643. quit_libPNG;
  4644. end;
  4645. end;
  4646. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  4647. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4648. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  4649. var
  4650. StreamPos: Int64;
  4651. Png: TPNGObject;
  4652. Header: Array[0..7] of Byte;
  4653. Row, Col, PixSize, LineSize: Integer;
  4654. NewImage, pSource, pDest, pAlpha: pByte;
  4655. Format: TglBitmapInternalFormat;
  4656. const
  4657. PngHeader: Array[0..7] of Byte = (#137, #80, #78, #71, #13, #10, #26, #10);
  4658. begin
  4659. result := false;
  4660. StreamPos := Stream.Position;
  4661. Stream.Read(Header[0], SizeOf(Header));
  4662. Stream.Position := StreamPos;
  4663. {Test if the header matches}
  4664. if Header = PngHeader then begin
  4665. Png := TPNGObject.Create;
  4666. try
  4667. Png.LoadFromStream(Stream);
  4668. case Png.Header.ColorType of
  4669. COLOR_GRAYSCALE:
  4670. Format := ifLuminance;
  4671. COLOR_GRAYSCALEALPHA:
  4672. Format := ifLuminanceAlpha;
  4673. COLOR_RGB:
  4674. Format := ifBGR8;
  4675. COLOR_RGBALPHA:
  4676. Format := ifBGRA8;
  4677. else
  4678. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  4679. end;
  4680. PixSize := Trunc(FormatGetSize(Format));
  4681. LineSize := Integer(Png.Header.Width) * PixSize;
  4682. GetMem(NewImage, LineSize * Integer(Png.Header.Height));
  4683. try
  4684. pDest := NewImage;
  4685. case Png.Header.ColorType of
  4686. COLOR_RGB, COLOR_GRAYSCALE:
  4687. begin
  4688. for Row := 0 to Png.Height -1 do begin
  4689. Move (Png.Scanline[Row]^, pDest^, LineSize);
  4690. Inc(pDest, LineSize);
  4691. end;
  4692. end;
  4693. COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
  4694. begin
  4695. PixSize := PixSize -1;
  4696. for Row := 0 to Png.Height -1 do begin
  4697. pSource := Png.Scanline[Row];
  4698. pAlpha := pByte(Png.AlphaScanline[Row]);
  4699. for Col := 0 to Png.Width -1 do begin
  4700. Move (pSource^, pDest^, PixSize);
  4701. Inc(pSource, PixSize);
  4702. Inc(pDest, PixSize);
  4703. pDest^ := pAlpha^;
  4704. inc(pAlpha);
  4705. Inc(pDest);
  4706. end;
  4707. end;
  4708. end;
  4709. else
  4710. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  4711. end;
  4712. SetDataPointer(NewImage, Format, Png.Header.Width, Png.Header.Height);
  4713. result := true;
  4714. except
  4715. FreeMem(NewImage);
  4716. raise;
  4717. end;
  4718. finally
  4719. Png.Free;
  4720. end;
  4721. end;
  4722. end;
  4723. {$IFEND}
  4724. {$ENDIF}
  4725. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  4726. {$IFDEF GLB_LIB_PNG}
  4727. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4728. procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  4729. begin
  4730. TStream(png_get_io_ptr(png)).Write(buffer^, size);
  4731. end;
  4732. {$ENDIF}
  4733. {$IF DEFINED(GLB_LIB_PNG)}
  4734. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4735. procedure TglBitmap.SavePNG(const aStream: TStream);
  4736. var
  4737. png: png_structp;
  4738. png_info: png_infop;
  4739. png_rows: array of pByte;
  4740. LineSize: Integer;
  4741. ColorType: Integer;
  4742. Row: Integer;
  4743. begin
  4744. if not (ftPNG in FormatGetSupportedFiles (InternalFormat)) then
  4745. raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
  4746. if not init_libPNG then
  4747. raise Exception.Create('SavePNG - unable to initialize libPNG.');
  4748. try
  4749. case FInternalFormat of
  4750. ifAlpha, ifLuminance, ifDepth8:
  4751. ColorType := PNG_COLOR_TYPE_GRAY;
  4752. ifLuminanceAlpha:
  4753. ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
  4754. ifBGR8, ifRGB8:
  4755. ColorType := PNG_COLOR_TYPE_RGB;
  4756. ifBGRA8, ifRGBA8:
  4757. ColorType := PNG_COLOR_TYPE_RGBA;
  4758. else
  4759. raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
  4760. end;
  4761. LineSize := Trunc(FormatGetSize(FInternalFormat) * Width);
  4762. // creating array for scanline
  4763. SetLength(png_rows, Height);
  4764. try
  4765. for Row := 0 to Height - 1 do begin
  4766. png_rows[Row] := Data;
  4767. Inc(png_rows[Row], Row * LineSize)
  4768. end;
  4769. // write struct
  4770. png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  4771. if png = nil then
  4772. raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
  4773. // create png info
  4774. png_info := png_create_info_struct(png);
  4775. if png_info = nil then begin
  4776. png_destroy_write_struct(@png, nil);
  4777. raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
  4778. end;
  4779. // set read callback
  4780. png_set_write_fn(png, stream, glBitmap_libPNG_write_func, nil);
  4781. // set compression
  4782. png_set_compression_level(png, 6);
  4783. if InternalFormat in [ifBGR8, ifBGRA8] then
  4784. png_set_bgr(png);
  4785. png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
  4786. png_write_info(png, png_info);
  4787. png_write_image(png, @png_rows[0]);
  4788. png_write_end(png, png_info);
  4789. png_destroy_write_struct(@png, @png_info);
  4790. finally
  4791. SetLength(png_rows, 0);
  4792. end;
  4793. finally
  4794. quit_libPNG;
  4795. end;
  4796. end;
  4797. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  4798. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4799. procedure TglBitmap.SavePNG(const aStream: TStream);
  4800. var
  4801. Png: TPNGObject;
  4802. pSource, pDest: pByte;
  4803. X, Y, PixSize: Integer;
  4804. ColorType: Cardinal;
  4805. Alpha: Boolean;
  4806. pTemp: pByte;
  4807. Temp: Byte;
  4808. begin
  4809. if not (ftPNG in FormatGetSupportedFiles (InternalFormat)) then
  4810. raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
  4811. case FInternalFormat of
  4812. ifAlpha, ifLuminance, ifDepth8: begin
  4813. ColorType := COLOR_GRAYSCALE;
  4814. PixSize := 1;
  4815. Alpha := false;
  4816. end;
  4817. ifLuminanceAlpha: begin
  4818. ColorType := COLOR_GRAYSCALEALPHA;
  4819. PixSize := 1;
  4820. Alpha := true;
  4821. end;
  4822. ifBGR8, ifRGB8: begin
  4823. ColorType := COLOR_RGB;
  4824. PixSize := 3;
  4825. Alpha := false;
  4826. end;
  4827. ifBGRA8, ifRGBA8: begin
  4828. ColorType := COLOR_RGBALPHA;
  4829. PixSize := 3;
  4830. Alpha := true
  4831. end;
  4832. else
  4833. raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
  4834. end;
  4835. Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
  4836. try
  4837. // Copy ImageData
  4838. pSource := Data;
  4839. for Y := 0 to Height -1 do begin
  4840. pDest := png.ScanLine[Y];
  4841. for X := 0 to Width -1 do begin
  4842. Move(pSource^, pDest^, PixSize);
  4843. Inc(pDest, PixSize);
  4844. Inc(pSource, PixSize);
  4845. if Alpha then begin
  4846. png.AlphaScanline[Y]^[X] := pSource^;
  4847. Inc(pSource);
  4848. end;
  4849. end;
  4850. // convert RGB line to BGR
  4851. if InternalFormat in [ifRGB8, ifRGBA8] then begin
  4852. pTemp := png.ScanLine[Y];
  4853. for X := 0 to Width -1 do begin
  4854. Temp := pByteArray(pTemp)^[0];
  4855. pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
  4856. pByteArray(pTemp)^[2] := Temp;
  4857. Inc(pTemp, 3);
  4858. end;
  4859. end;
  4860. end;
  4861. // Save to Stream
  4862. Png.CompressionLevel := 6;
  4863. Png.SaveToStream(Stream);
  4864. finally
  4865. FreeAndNil(Png);
  4866. end;
  4867. end;
  4868. {$IFEND}
  4869. {$ENDIF}
  4870. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4871. //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4872. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4873. {$IFDEF GLB_LIB_JPEG}
  4874. type
  4875. glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
  4876. glBitmap_libJPEG_source_mgr = record
  4877. pub: jpeg_source_mgr;
  4878. SrcStream: TStream;
  4879. SrcBuffer: array [1..4096] of byte;
  4880. end;
  4881. glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
  4882. glBitmap_libJPEG_dest_mgr = record
  4883. pub: jpeg_destination_mgr;
  4884. DestStream: TStream;
  4885. DestBuffer: array [1..4096] of byte;
  4886. end;
  4887. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4888. {
  4889. procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
  4890. var
  4891. Msg: String;
  4892. begin
  4893. SetLength(Msg, 256);
  4894. cinfo^.err^.format_message(cinfo, pChar(Msg));
  4895. Writeln('ERROR [' + IntToStr(cinfo^.err^.msg_code) + '] ' + Msg);
  4896. cinfo^.global_state := 0;
  4897. jpeg_abort(cinfo);
  4898. end;
  4899. }
  4900. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4901. {
  4902. procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
  4903. var
  4904. Msg: String;
  4905. begin
  4906. SetLength(Msg, 256);
  4907. cinfo^.err^.format_message(cinfo, pChar(Msg));
  4908. Writeln('OUTPUT [' + IntToStr(cinfo^.err^.msg_code) + '] ' + Msg);
  4909. cinfo^.global_state := 0;
  4910. end;
  4911. }
  4912. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4913. {
  4914. procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
  4915. begin
  4916. end;
  4917. }
  4918. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4919. function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
  4920. var
  4921. src: glBitmap_libJPEG_source_mgr_ptr;
  4922. bytes: integer;
  4923. begin
  4924. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  4925. bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
  4926. if (bytes <= 0) then begin
  4927. src^.SrcBuffer[1] := $FF;
  4928. src^.SrcBuffer[2] := JPEG_EOI;
  4929. bytes := 2;
  4930. end;
  4931. src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
  4932. src^.pub.bytes_in_buffer := bytes;
  4933. result := true;
  4934. end;
  4935. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4936. procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
  4937. var
  4938. src: glBitmap_libJPEG_source_mgr_ptr;
  4939. begin
  4940. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  4941. if num_bytes > 0 then begin
  4942. // wanted byte isn't in buffer so set stream position and read buffer
  4943. if num_bytes > src^.pub.bytes_in_buffer then begin
  4944. src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
  4945. src^.pub.fill_input_buffer(cinfo);
  4946. end else begin
  4947. // wanted byte is in buffer so only skip
  4948. inc(src^.pub.next_input_byte, num_bytes);
  4949. dec(src^.pub.bytes_in_buffer, num_bytes);
  4950. end;
  4951. end;
  4952. end;
  4953. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4954. {
  4955. procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
  4956. begin
  4957. end;
  4958. }
  4959. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4960. {
  4961. procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
  4962. begin
  4963. end;
  4964. }
  4965. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4966. function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
  4967. var
  4968. dest: glBitmap_libJPEG_dest_mgr_ptr;
  4969. begin
  4970. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  4971. if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
  4972. // write complete buffer
  4973. dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
  4974. // reset buffer
  4975. dest^.pub.next_output_byte := @dest^.DestBuffer[1];
  4976. dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
  4977. end;
  4978. result := true;
  4979. end;
  4980. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4981. procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
  4982. var
  4983. Idx: Integer;
  4984. dest: glBitmap_libJPEG_dest_mgr_ptr;
  4985. begin
  4986. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  4987. for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
  4988. // check for endblock
  4989. if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
  4990. // write endblock
  4991. dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
  4992. // leave
  4993. break;
  4994. end else
  4995. dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
  4996. end;
  4997. end;
  4998. {$ENDIF}
  4999. {$IFDEF GLB_SUPPORT_JPEG_READ}
  5000. {$IF DEFINED(GLB_SDL_IMAGE)}
  5001. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5002. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5003. var
  5004. Surface: PSDL_Surface;
  5005. RWops: PSDL_RWops;
  5006. begin
  5007. result := false;
  5008. RWops := glBitmapCreateRWops(Stream);
  5009. try
  5010. if IMG_isJPG(RWops) > 0 then begin
  5011. Surface := IMG_LoadJPG_RW(RWops);
  5012. try
  5013. AssignFromSurface(Surface);
  5014. result := true;
  5015. finally
  5016. SDL_FreeSurface(Surface);
  5017. end;
  5018. end;
  5019. finally
  5020. SDL_FreeRW(RWops);
  5021. end;
  5022. end;
  5023. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  5024. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5025. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5026. var
  5027. StreamPos: Int64;
  5028. Temp: array[0..1]of Byte;
  5029. jpeg: jpeg_decompress_struct;
  5030. jpeg_err: jpeg_error_mgr;
  5031. IntFormat: TglBitmapInternalFormat;
  5032. pImage: pByte;
  5033. TempHeight, TempWidth: Integer;
  5034. pTemp: pByte;
  5035. Row: Integer;
  5036. begin
  5037. result := false;
  5038. if not init_libJPEG then
  5039. raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
  5040. try
  5041. // reading first two bytes to test file and set cursor back to begin
  5042. StreamPos := Stream.Position;
  5043. Stream.Read(Temp[0], 2);
  5044. Stream.Position := StreamPos;
  5045. // if Bitmap then read file.
  5046. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  5047. FillChar(jpeg, SizeOf(jpeg_decompress_struct), $00);
  5048. FillChar(jpeg_err, SizeOf(jpeg_error_mgr), $00);
  5049. // error managment
  5050. jpeg.err := jpeg_std_error(@jpeg_err);
  5051. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  5052. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  5053. // decompression struct
  5054. jpeg_create_decompress(@jpeg);
  5055. // allocation space for streaming methods
  5056. jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
  5057. // seeting up custom functions
  5058. with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
  5059. pub.init_source := glBitmap_libJPEG_init_source;
  5060. pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
  5061. pub.skip_input_data := glBitmap_libJPEG_skip_input_data;
  5062. pub.resync_to_restart := jpeg_resync_to_restart; // use default method
  5063. pub.term_source := glBitmap_libJPEG_term_source;
  5064. pub.bytes_in_buffer := 0; // forces fill_input_buffer on first read
  5065. pub.next_input_byte := nil; // until buffer loaded
  5066. SrcStream := Stream;
  5067. end;
  5068. // set global decoding state
  5069. jpeg.global_state := DSTATE_START;
  5070. // read header of jpeg
  5071. jpeg_read_header(@jpeg, false);
  5072. // setting output parameter
  5073. case jpeg.jpeg_color_space of
  5074. JCS_GRAYSCALE:
  5075. begin
  5076. jpeg.out_color_space := JCS_GRAYSCALE;
  5077. IntFormat := ifLuminance;
  5078. end;
  5079. else
  5080. jpeg.out_color_space := JCS_RGB;
  5081. IntFormat := ifRGB8;
  5082. end;
  5083. // reading image
  5084. jpeg_start_decompress(@jpeg);
  5085. TempHeight := jpeg.output_height;
  5086. TempWidth := jpeg.output_width;
  5087. // creating new image
  5088. GetMem(pImage, FormatGetImageSize(glBitmapPosition(TempWidth, TempHeight), IntFormat));
  5089. try
  5090. pTemp := pImage;
  5091. for Row := 0 to TempHeight -1 do begin
  5092. jpeg_read_scanlines(@jpeg, @pTemp, 1);
  5093. Inc(pTemp, Trunc(FormatGetSize(IntFormat) * TempWidth));
  5094. end;
  5095. // finish decompression
  5096. jpeg_finish_decompress(@jpeg);
  5097. // destroy decompression
  5098. jpeg_destroy_decompress(@jpeg);
  5099. SetDataPointer(pImage, IntFormat, TempWidth, TempHeight);
  5100. result := true;
  5101. except
  5102. FreeMem(pImage);
  5103. raise;
  5104. end;
  5105. end;
  5106. finally
  5107. quit_libJPEG;
  5108. end;
  5109. end;
  5110. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  5111. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5112. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5113. var
  5114. bmp: TBitmap;
  5115. jpg: TJPEGImage;
  5116. StreamPos: Int64;
  5117. Temp: array[0..1]of Byte;
  5118. begin
  5119. result := false;
  5120. // reading first two bytes to test file and set cursor back to begin
  5121. StreamPos := Stream.Position;
  5122. Stream.Read(Temp[0], 2);
  5123. Stream.Position := StreamPos;
  5124. // if Bitmap then read file.
  5125. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  5126. bmp := TBitmap.Create;
  5127. try
  5128. jpg := TJPEGImage.Create;
  5129. try
  5130. jpg.LoadFromStream(Stream);
  5131. bmp.Assign(jpg);
  5132. result := AssignFromBitmap(bmp);
  5133. finally
  5134. jpg.Free;
  5135. end;
  5136. finally
  5137. bmp.Free;
  5138. end;
  5139. end;
  5140. end;
  5141. {$IFEND}
  5142. {$ENDIF}
  5143. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  5144. {$IF DEFEFINED(GLB_LIB_JPEG)}
  5145. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5146. procedure TglBitmap.SaveJPEG(Stream: TStream);
  5147. var
  5148. jpeg: jpeg_compress_struct;
  5149. jpeg_err: jpeg_error_mgr;
  5150. Row: Integer;
  5151. pTemp, pTemp2: pByte;
  5152. procedure CopyRow(pDest, pSource: pByte);
  5153. var
  5154. X: Integer;
  5155. begin
  5156. for X := 0 to Width - 1 do begin
  5157. pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
  5158. pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
  5159. pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
  5160. Inc(pDest, 3);
  5161. Inc(pSource, 3);
  5162. end;
  5163. end;
  5164. begin
  5165. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  5166. raise EglBitmapUnsupportedInternalFormat.Create('SaveJpg - ' + UNSUPPORTED_INTERNAL_FORMAT);
  5167. if not init_libJPEG then
  5168. raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
  5169. try
  5170. FillChar(jpeg, SizeOf(jpeg_compress_struct), $00);
  5171. FillChar(jpeg_err, SizeOf(jpeg_error_mgr), $00);
  5172. // error managment
  5173. jpeg.err := jpeg_std_error(@jpeg_err);
  5174. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  5175. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  5176. // compression struct
  5177. jpeg_create_compress(@jpeg);
  5178. // allocation space for streaming methods
  5179. jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
  5180. // seeting up custom functions
  5181. with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
  5182. pub.init_destination := glBitmap_libJPEG_init_destination;
  5183. pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
  5184. pub.term_destination := glBitmap_libJPEG_term_destination;
  5185. pub.next_output_byte := @DestBuffer[1];
  5186. pub.free_in_buffer := Length(DestBuffer);
  5187. DestStream := Stream;
  5188. end;
  5189. // very important state
  5190. jpeg.global_state := CSTATE_START;
  5191. jpeg.image_width := Width;
  5192. jpeg.image_height := Height;
  5193. case InternalFormat of
  5194. ifAlpha, ifLuminance, ifDepth8: begin
  5195. jpeg.input_components := 1;
  5196. jpeg.in_color_space := JCS_GRAYSCALE;
  5197. end;
  5198. ifRGB8, ifBGR8: begin
  5199. jpeg.input_components := 3;
  5200. jpeg.in_color_space := JCS_RGB;
  5201. end;
  5202. end;
  5203. jpeg_set_defaults(@jpeg);
  5204. jpeg_set_quality(@jpeg, 95, true);
  5205. jpeg_start_compress(@jpeg, true);
  5206. pTemp := Data;
  5207. if InternalFormat = ifBGR8 then
  5208. GetMem(pTemp2, fRowSize)
  5209. else
  5210. pTemp2 := pTemp;
  5211. try
  5212. for Row := 0 to jpeg.image_height -1 do begin
  5213. // prepare row
  5214. if InternalFormat = ifBGR8 then
  5215. CopyRow(pTemp2, pTemp)
  5216. else
  5217. pTemp2 := pTemp;
  5218. // write row
  5219. jpeg_write_scanlines(@jpeg, @pTemp2, 1);
  5220. inc(pTemp, fRowSize);
  5221. end;
  5222. finally
  5223. // free memory
  5224. if InternalFormat = ifBGR8 then
  5225. FreeMem(pTemp2);
  5226. end;
  5227. jpeg_finish_compress(@jpeg);
  5228. jpeg_destroy_compress(@jpeg);
  5229. finally
  5230. quit_libJPEG;
  5231. end;
  5232. end;
  5233. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  5234. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5235. procedure TglBitmap.SaveJPEG(Stream: TStream);
  5236. var
  5237. Bmp: TBitmap;
  5238. Jpg: TJPEGImage;
  5239. begin
  5240. if not (ftJPEG in FormatGetSupportedFiles (InternalFormat)) then
  5241. raise EglBitmapUnsupportedInternalFormat.Create('SaveJpg - ' + UNSUPPORTED_INTERNAL_FORMAT);
  5242. Bmp := TBitmap.Create;
  5243. try
  5244. Jpg := TJPEGImage.Create;
  5245. try
  5246. AssignToBitmap(Bmp);
  5247. if FInternalFormat in [ifAlpha, ifLuminance, ifDepth8] then begin
  5248. Jpg.Grayscale := true;
  5249. Jpg.PixelFormat := jf8Bit;
  5250. end;
  5251. Jpg.Assign(Bmp);
  5252. Jpg.SaveToStream(Stream);
  5253. finally
  5254. FreeAndNil(Jpg);
  5255. end;
  5256. finally
  5257. FreeAndNil(Bmp);
  5258. end;
  5259. end;
  5260. {$ENDIF}
  5261. {$ENDIF}
  5262. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5263. //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5264. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5265. const
  5266. BMP_MAGIC = $4D42;
  5267. BMP_COMP_RGB = 0;
  5268. BMP_COMP_RLE8 = 1;
  5269. BMP_COMP_RLE4 = 2;
  5270. BMP_COMP_BITFIELDS = 3;
  5271. type
  5272. TBMPHeader = packed record
  5273. bfType: Word;
  5274. bfSize: Cardinal;
  5275. bfReserved1: Word;
  5276. bfReserved2: Word;
  5277. bfOffBits: Cardinal;
  5278. end;
  5279. TBMPInfo = packed record
  5280. biSize: Cardinal;
  5281. biWidth: Longint;
  5282. biHeight: Longint;
  5283. biPlanes: Word;
  5284. biBitCount: Word;
  5285. biCompression: Cardinal;
  5286. biSizeImage: Cardinal;
  5287. biXPelsPerMeter: Longint;
  5288. biYPelsPerMeter: Longint;
  5289. biClrUsed: Cardinal;
  5290. biClrImportant: Cardinal;
  5291. end;
  5292. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5293. function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
  5294. //////////////////////////////////////////////////////////////////////////////////////////////////
  5295. function ReadInfo(var aInfo: TBMPInfo; var aMask: TglBitmapColorRec): TglBitmapFormat;
  5296. begin
  5297. result := tfEmpty;
  5298. aStream.Read(aInfo, SizeOf(aInfo));
  5299. FillChar(aMask, SizeOf(aMask), 0);
  5300. //Read Compression
  5301. case aInfo.biCompression of
  5302. BMP_COMP_RLE4,
  5303. BMP_COMP_RLE8: begin
  5304. raise EglBitmapException.Create('RLE compression is not supported');
  5305. end;
  5306. BMP_COMP_BITFIELDS: begin
  5307. if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
  5308. aStream.Read(aMask.r, SizeOf(aMask.r));
  5309. aStream.Read(aMask.g, SizeOf(aMask.g));
  5310. aStream.Read(aMask.b, SizeOf(aMask.b));
  5311. aStream.Read(aMask.a, SizeOf(aMask.a));
  5312. end else
  5313. raise EglBitmapException.Create('Bitfields are only supported for 16bit and 32bit formats');
  5314. end;
  5315. end;
  5316. //get suitable format
  5317. case aInfo.biBitCount of
  5318. 8: result := tfLuminance8;
  5319. 16: result := tfBGR5;
  5320. 24: result := tfBGR8;
  5321. 32: result := tfBGRA8;
  5322. end;
  5323. end;
  5324. function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
  5325. var
  5326. i, c: Integer;
  5327. ColorTable: TbmpColorTable;
  5328. begin
  5329. result := nil;
  5330. if (aInfo.biBitCount >= 16) then
  5331. exit;
  5332. aFormat := tfLuminance8;
  5333. c := aInfo.biClrUsed;
  5334. if (c = 0) then
  5335. c := 1 shl aInfo.biBitCount;
  5336. SetLength(ColorTable, c);
  5337. for i := 0 to c-1 do begin
  5338. aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
  5339. if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
  5340. aFormat := tfRGB8;
  5341. end;
  5342. result := TbmpColorTableFormat.Create;
  5343. result.PixelSize := aInfo.biBitCount / 8;
  5344. result.ColorTable := ColorTable;
  5345. result.Range := glBitmapColorRec($FF, $FF, $FF, $00);
  5346. end;
  5347. //////////////////////////////////////////////////////////////////////////////////////////////////
  5348. function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
  5349. const aInfo: TBMPInfo): TbmpBitfieldFormat;
  5350. var
  5351. TmpFormat: TglBitmapFormat;
  5352. FormatDesc: TFormatDescriptor;
  5353. begin
  5354. result := nil;
  5355. if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
  5356. for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  5357. FormatDesc := TFormatDescriptor.Get(TmpFormat);
  5358. if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
  5359. aFormat := FormatDesc.Format;
  5360. exit;
  5361. end;
  5362. end;
  5363. if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
  5364. aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
  5365. if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
  5366. aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
  5367. result := TbmpBitfieldFormat.Create;
  5368. result.PixelSize := aInfo.biBitCount / 8;
  5369. result.RedMask := aMask.r;
  5370. result.GreenMask := aMask.g;
  5371. result.BlueMask := aMask.b;
  5372. result.AlphaMask := aMask.a;
  5373. end;
  5374. end;
  5375. var
  5376. //simple types
  5377. StartPos: Int64;
  5378. ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
  5379. PaddingBuff: Cardinal;
  5380. LineBuf, ImageData, TmpData: PByte;
  5381. SourceMD, DestMD: Pointer;
  5382. BmpFormat: TglBitmapFormat;
  5383. ColorTable: TbmpColorTable;
  5384. //records
  5385. Mask: TglBitmapColorRec;
  5386. Header: TBMPHeader;
  5387. Info: TBMPInfo;
  5388. //classes
  5389. SpecialFormat: TFormatDescriptor;
  5390. FormatDesc: TFormatDescriptor;
  5391. //////////////////////////////////////////////////////////////////////////////////////////////////
  5392. procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
  5393. var
  5394. i, j: Integer;
  5395. Pixel: TglBitmapPixelData;
  5396. begin
  5397. aStream.Read(aLineBuf^, rbLineSize);
  5398. SpecialFormat.PreparePixel(Pixel);
  5399. for i := 0 to Info.biWidth-1 do begin
  5400. SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
  5401. with FormatDesc do begin
  5402. //TODO: use convert function
  5403. for j := 0 to 3 do
  5404. if (SpecialFormat.Range.arr[j] <> Range.arr[j]) then begin
  5405. if (SpecialFormat.Range.arr[j] > 0) then
  5406. Pixel.Data.arr[j] := Round(Pixel.Data.arr[j] / SpecialFormat.Range.arr[j] * Range.arr[j])
  5407. else
  5408. Pixel.Data.arr[j] := 0;
  5409. end;
  5410. end;
  5411. FormatDesc.Map(Pixel, aData, DestMD);
  5412. end;
  5413. end;
  5414. begin
  5415. result := false;
  5416. BmpFormat := tfEmpty;
  5417. SpecialFormat := nil;
  5418. LineBuf := nil;
  5419. SourceMD := nil;
  5420. DestMD := nil;
  5421. // Header
  5422. StartPos := aStream.Position;
  5423. aStream.Read(Header, SizeOf(Header));
  5424. if Header.bfType = BMP_MAGIC then begin
  5425. try try
  5426. BmpFormat := ReadInfo(Info, Mask);
  5427. SpecialFormat := ReadColorTable(BmpFormat, Info);
  5428. if not Assigned(SpecialFormat) then
  5429. SpecialFormat := CheckBitfields(BmpFormat, Mask, Info);
  5430. aStream.Position := StartPos + Header.bfOffBits;
  5431. if (BmpFormat <> tfEmpty) then begin
  5432. FormatDesc := TFormatDescriptor.Get(BmpFormat);
  5433. rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
  5434. wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
  5435. Padding := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
  5436. //get Memory
  5437. DestMD := FormatDesc.CreateMappingData;
  5438. ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
  5439. GetMem(ImageData, ImageSize);
  5440. if Assigned(SpecialFormat) then begin
  5441. GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
  5442. SourceMD := SpecialFormat.CreateMappingData;
  5443. end;
  5444. //read Data
  5445. try try
  5446. FillChar(ImageData^, ImageSize, $FF);
  5447. TmpData := ImageData;
  5448. if (Info.biHeight > 0) then
  5449. Inc(TmpData, wbLineSize * (Info.biHeight-1));
  5450. for i := 0 to Abs(Info.biHeight)-1 do begin
  5451. if Assigned(SpecialFormat) then
  5452. SpecialFormatReadLine(TmpData, LineBuf) //if is special format read and convert data
  5453. else
  5454. aStream.Read(TmpData^, wbLineSize); //else only read data
  5455. if (Info.biHeight > 0) then
  5456. dec(TmpData, wbLineSize)
  5457. else
  5458. inc(TmpData, wbLineSize);
  5459. aStream.Read(PaddingBuff, Padding);
  5460. end;
  5461. SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight));
  5462. result := true;
  5463. finally
  5464. if Assigned(LineBuf) then
  5465. FreeMem(LineBuf);
  5466. if Assigned(SourceMD) then
  5467. SpecialFormat.FreeMappingData(SourceMD);
  5468. FormatDesc.FreeMappingData(DestMD);
  5469. end;
  5470. except
  5471. FreeMem(ImageData);
  5472. raise;
  5473. end;
  5474. end else
  5475. raise EglBitmapException.Create('LoadBMP - No suitable format found');
  5476. except
  5477. aStream.Position := StartPos;
  5478. raise;
  5479. end;
  5480. finally
  5481. FreeAndNil(SpecialFormat);
  5482. end;
  5483. end
  5484. else aStream.Position := StartPos;
  5485. end;
  5486. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5487. procedure TglBitmap.SaveBMP(const aStream: TStream);
  5488. var
  5489. Header: TBMPHeader;
  5490. Info: TBMPInfo;
  5491. Converter: TbmpColorTableFormat;
  5492. FormatDesc: TFormatDescriptor;
  5493. SourceFD, DestFD: Pointer;
  5494. pData, srcData, dstData, ConvertBuffer: pByte;
  5495. Pixel: TglBitmapPixelData;
  5496. PixelFormat: TglBitmapPixelData;
  5497. ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx, i: Integer;
  5498. RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
  5499. PaddingBuff: Cardinal;
  5500. function GetLineWidth : Integer;
  5501. begin
  5502. result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
  5503. end;
  5504. begin
  5505. if not (ftBMP in FormatGetSupportedFiles(Format)) then
  5506. raise EglBitmapUnsupportedFormatFormat.Create('SaveBMP - ' + UNSUPPORTED_FORMAT);
  5507. Converter := nil;
  5508. FormatDesc := TFormatDescriptor.Get(Format);
  5509. ImageSize := FormatDesc.GetSize(Dimension);
  5510. FillChar(Header, SizeOf(Header), 0);
  5511. Header.bfType := BMP_MAGIC;
  5512. Header.bfSize := SizeOf(Header) + SizeOf(Info) + ImageSize;
  5513. Header.bfReserved1 := 0;
  5514. Header.bfReserved2 := 0;
  5515. Header.bfOffBits := SizeOf(Header) + SizeOf(Info);
  5516. FillChar(Info, SizeOf(Info), 0);
  5517. Info.biSize := SizeOf(Info);
  5518. Info.biWidth := Width;
  5519. Info.biHeight := Height;
  5520. Info.biPlanes := 1;
  5521. Info.biCompression := BMP_COMP_RGB;
  5522. Info.biSizeImage := ImageSize;
  5523. try
  5524. case Format of
  5525. tfLuminance4: begin
  5526. Info.biBitCount := 4;
  5527. Header.bfSize := Header.bfSize + 16 * SizeOf(Cardinal);
  5528. Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
  5529. Converter := TbmpColorTableFormat.Create;
  5530. Converter.PixelSize := 0.5;
  5531. Converter.Format := Format;
  5532. Converter.Range := glBitmapColorRec($F, $F, $F, $0);
  5533. Converter.CreateColorTable;
  5534. end;
  5535. tfR3G3B2, tfLuminance8: begin
  5536. Info.biBitCount := 8;
  5537. Header.bfSize := Header.bfSize + 256 * SizeOf(Cardinal);
  5538. Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
  5539. Converter := TbmpColorTableFormat.Create;
  5540. Converter.PixelSize := 1;
  5541. Converter.Format := Format;
  5542. if (Format = tfR3G3B2) then begin
  5543. Converter.Range := glBitmapColorRec($7, $7, $3, $0);
  5544. Converter.Shift := glBitmapShiftRec(0, 3, 6, 0);
  5545. end else
  5546. Converter.Range := glBitmapColorRec($FF, $FF, $FF, $0);
  5547. Converter.CreateColorTable;
  5548. end;
  5549. tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
  5550. tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin
  5551. Info.biBitCount := 16;
  5552. Info.biCompression := BMP_COMP_BITFIELDS;
  5553. end;
  5554. tfBGR8, tfRGB8: begin
  5555. Info.biBitCount := 24;
  5556. end;
  5557. tfRGB10, tfRGB10A2, tfRGBA8,
  5558. tfBGR10, tfBGR10A2, tfBGRA8: begin
  5559. Info.biBitCount := 32;
  5560. Info.biCompression := BMP_COMP_BITFIELDS;
  5561. end;
  5562. else
  5563. raise EglBitmapUnsupportedFormatFormat.Create('SaveBMP - ' + UNSUPPORTED_FORMAT);
  5564. end;
  5565. Info.biXPelsPerMeter := 2835;
  5566. Info.biYPelsPerMeter := 2835;
  5567. // prepare bitmasks
  5568. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  5569. Header.bfSize := Header.bfSize + 4 * SizeOf(Cardinal);
  5570. Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
  5571. RedMask := FormatDesc.RedMask;
  5572. GreenMask := FormatDesc.GreenMask;
  5573. BlueMask := FormatDesc.BlueMask;
  5574. AlphaMask := FormatDesc.AlphaMask;
  5575. end;
  5576. // headers
  5577. aStream.Write(Header, SizeOf(Header));
  5578. aStream.Write(Info, SizeOf(Info));
  5579. // colortable
  5580. if Assigned(Converter) then
  5581. aStream.Write(Converter.ColorTable[0].b,
  5582. SizeOf(TbmpColorTableEnty) * Length(Converter.ColorTable));
  5583. // bitmasks
  5584. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  5585. aStream.Write(RedMask, SizeOf(Cardinal));
  5586. aStream.Write(GreenMask, SizeOf(Cardinal));
  5587. aStream.Write(BlueMask, SizeOf(Cardinal));
  5588. aStream.Write(AlphaMask, SizeOf(Cardinal));
  5589. end;
  5590. // image data
  5591. rbLineSize := Round(Info.biWidth * FormatDesc.PixelSize);
  5592. wbLineSize := Round(Info.biWidth * Info.biBitCount / 8);
  5593. Padding := GetLineWidth - wbLineSize;
  5594. PaddingBuff := 0;
  5595. pData := Data;
  5596. inc(pData, (Height-1) * rbLineSize);
  5597. // prepare row buffer. But only for RGB because RGBA supports color masks
  5598. // so it's possible to change color within the image.
  5599. if Assigned(Converter) then begin
  5600. FormatDesc.PreparePixel(Pixel);
  5601. GetMem(ConvertBuffer, wbLineSize);
  5602. SourceFD := FormatDesc.CreateMappingData;
  5603. DestFD := Converter.CreateMappingData;
  5604. end else
  5605. ConvertBuffer := nil;
  5606. try
  5607. for LineIdx := 0 to Height - 1 do begin
  5608. // preparing row
  5609. if Assigned(Converter) then begin
  5610. srcData := pData;
  5611. dstData := ConvertBuffer;
  5612. for PixelIdx := 0 to Info.biWidth-1 do begin
  5613. FormatDesc.Unmap(srcData, Pixel, SourceFD);
  5614. with FormatDesc do begin
  5615. //TODO use convert function
  5616. for i := 0 to 3 do
  5617. if (Converter.Range.arr[i] <> Range.arr[i]) then begin
  5618. if (Range.arr[i] > 0) then
  5619. Pixel.Data.arr[i] := Round(Pixel.Data.arr[i] / Range.arr[i] * Converter.Range.arr[i])
  5620. else
  5621. Pixel.Data.arr[i] := 0;
  5622. end;
  5623. end;
  5624. Converter.Map(Pixel, dstData, DestFD);
  5625. end;
  5626. aStream.Write(ConvertBuffer^, wbLineSize);
  5627. end else begin
  5628. aStream.Write(pData^, rbLineSize);
  5629. end;
  5630. dec(pData, rbLineSize);
  5631. if (Padding > 0) then
  5632. aStream.Write(PaddingBuff, Padding);
  5633. end;
  5634. finally
  5635. // destroy row buffer
  5636. if Assigned(ConvertBuffer) then begin
  5637. FormatDesc.FreeMappingData(SourceFD);
  5638. Converter.FreeMappingData(DestFD);
  5639. FreeMem(ConvertBuffer);
  5640. end;
  5641. end;
  5642. finally
  5643. if Assigned(Converter) then
  5644. Converter.Free;
  5645. end;
  5646. end;
  5647. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5648. //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5649. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5650. type
  5651. TTGAHeader = packed record
  5652. ImageID: Byte;
  5653. ColorMapType: Byte;
  5654. ImageType: Byte;
  5655. //ColorMapSpec: Array[0..4] of Byte;
  5656. ColorMapStart: Word;
  5657. ColorMapLength: Word;
  5658. ColorMapEntrySize: Byte;
  5659. OrigX: Word;
  5660. OrigY: Word;
  5661. Width: Word;
  5662. Height: Word;
  5663. Bpp: Byte;
  5664. ImageDesc: Byte;
  5665. end;
  5666. const
  5667. TGA_UNCOMPRESSED_COLOR_TABLE = 1;
  5668. TGA_UNCOMPRESSED_RGB = 2;
  5669. TGA_UNCOMPRESSED_GRAY = 3;
  5670. TGA_COMPRESSED_COLOR_TABLE = 9;
  5671. TGA_COMPRESSED_RGB = 10;
  5672. TGA_COMPRESSED_GRAY = 11;
  5673. TGA_NONE_COLOR_TABLE = 0;
  5674. TGA_COLOR_TABLE = 1;
  5675. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5676. function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
  5677. var
  5678. Header: TTGAHeader;
  5679. ImageData: PByte;
  5680. StartPosition: Int64;
  5681. PixelSize, LineSize: Integer;
  5682. tgaFormat: TglBitmapFormat;
  5683. FormatDesc: TFormatDescriptor;
  5684. Counter: packed record
  5685. X, Y: packed record
  5686. low, high, dir: Integer;
  5687. end;
  5688. end;
  5689. const
  5690. CACHE_SIZE = $4000;
  5691. ////////////////////////////////////////////////////////////////////////////////////////
  5692. procedure ReadUncompressed;
  5693. var
  5694. i, j: Integer;
  5695. buf, tmp1, tmp2: PByte;
  5696. begin
  5697. buf := nil;
  5698. if (Counter.X.dir < 0) then
  5699. buf := GetMem(LineSize);
  5700. try
  5701. while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
  5702. tmp1 := ImageData + (Counter.Y.low * LineSize); //pointer to LineStart
  5703. if (Counter.X.dir < 0) then begin //flip X
  5704. aStream.Read(buf^, LineSize);
  5705. tmp2 := buf + LineSize - PixelSize; //pointer to last pixel in line
  5706. for i := 0 to Header.Width-1 do begin //for all pixels in line
  5707. for j := 0 to PixelSize-1 do begin //for all bytes in pixel
  5708. tmp1^ := tmp2^;
  5709. inc(tmp1);
  5710. inc(tmp2);
  5711. end;
  5712. dec(tmp2, 2*PixelSize); //move 2 backwards, because j-loop moved 1 forward
  5713. end;
  5714. end else
  5715. aStream.Read(tmp1^, LineSize);
  5716. inc(Counter.Y.low, Counter.Y.dir); //move to next line index
  5717. end;
  5718. finally
  5719. if Assigned(buf) then
  5720. FreeMem(buf);
  5721. end;
  5722. end;
  5723. ////////////////////////////////////////////////////////////////////////////////////////
  5724. procedure ReadCompressed;
  5725. /////////////////////////////////////////////////////////////////
  5726. var
  5727. TmpData: PByte;
  5728. LinePixelsRead: Integer;
  5729. procedure CheckLine;
  5730. begin
  5731. if (LinePixelsRead >= Header.Width) then begin
  5732. LinePixelsRead := 0;
  5733. inc(Counter.Y.low, Counter.Y.dir); //next line index
  5734. TmpData := ImageData + Counter.Y.low * LineSize; //set line
  5735. if (Counter.X.dir < 0) then //if x flipped then
  5736. TmpData := TmpData + LineSize - PixelSize; //set last pixel
  5737. end;
  5738. end;
  5739. /////////////////////////////////////////////////////////////////
  5740. var
  5741. Cache: PByte;
  5742. CacheSize, CachePos: Integer;
  5743. procedure CachedRead(out Buffer; Count: Integer);
  5744. var
  5745. BytesRead: Integer;
  5746. begin
  5747. if (CachePos + Count > CacheSize) then begin
  5748. //if buffer overflow save non read bytes
  5749. BytesRead := 0;
  5750. if (CacheSize - CachePos > 0) then begin
  5751. BytesRead := CacheSize - CachePos;
  5752. Move(PByteArray(Cache)^[CachePos], Buffer, BytesRead);
  5753. inc(CachePos, BytesRead);
  5754. end;
  5755. //load cache from file
  5756. CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
  5757. aStream.Read(Cache^, CacheSize);
  5758. CachePos := 0;
  5759. //read rest of requested bytes
  5760. if (Count - BytesRead > 0) then begin
  5761. Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
  5762. inc(CachePos, Count - BytesRead);
  5763. end;
  5764. end else begin
  5765. //if no buffer overflow just read the data
  5766. Move(PByteArray(Cache)^[CachePos], Buffer, Count);
  5767. inc(CachePos, Count);
  5768. end;
  5769. end;
  5770. procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
  5771. begin
  5772. case PixelSize of
  5773. 1: begin
  5774. aBuffer^ := aData^;
  5775. inc(aBuffer, Counter.X.dir);
  5776. end;
  5777. 2: begin
  5778. PWord(aBuffer)^ := PWord(aData)^;
  5779. inc(aBuffer, 2 * Counter.X.dir);
  5780. end;
  5781. 3: begin
  5782. PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
  5783. PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
  5784. PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
  5785. inc(aBuffer, 3 * Counter.X.dir);
  5786. end;
  5787. 4: begin
  5788. PCardinal(aBuffer)^ := PCardinal(aData)^;
  5789. inc(aBuffer, 4 * Counter.X.dir);
  5790. end;
  5791. end;
  5792. end;
  5793. var
  5794. TotalPixelsToRead, TotalPixelsRead: Integer;
  5795. Temp: Byte;
  5796. buf: array [0..3] of Byte; //1 pixel is max 32bit long
  5797. PixelRepeat: Boolean;
  5798. PixelsToRead, PixelCount: Integer;
  5799. begin
  5800. CacheSize := 0;
  5801. CachePos := 0;
  5802. TotalPixelsToRead := Header.Width * Header.Height;
  5803. TotalPixelsRead := 0;
  5804. LinePixelsRead := 0;
  5805. GetMem(Cache, CACHE_SIZE);
  5806. try
  5807. TmpData := ImageData + Counter.Y.low * LineSize; //set line
  5808. if (Counter.X.dir < 0) then //if x flipped then
  5809. TmpData := TmpData + LineSize - PixelSize; //set last pixel
  5810. repeat
  5811. //read CommandByte
  5812. CachedRead(Temp, 1);
  5813. PixelRepeat := (Temp and $80) > 0;
  5814. PixelsToRead := (Temp and $7F) + 1;
  5815. inc(TotalPixelsRead, PixelsToRead);
  5816. if PixelRepeat then
  5817. CachedRead(buf[0], PixelSize);
  5818. while (PixelsToRead > 0) do begin
  5819. CheckLine;
  5820. PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
  5821. while (PixelCount > 0) do begin
  5822. if not PixelRepeat then
  5823. CachedRead(buf[0], PixelSize);
  5824. PixelToBuffer(@buf[0], TmpData);
  5825. inc(LinePixelsRead);
  5826. dec(PixelsToRead);
  5827. dec(PixelCount);
  5828. end;
  5829. end;
  5830. until (TotalPixelsRead >= TotalPixelsToRead);
  5831. finally
  5832. FreeMem(Cache);
  5833. end;
  5834. end;
  5835. function IsGrayFormat: Boolean;
  5836. begin
  5837. result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
  5838. end;
  5839. begin
  5840. result := false;
  5841. // reading header to test file and set cursor back to begin
  5842. StartPosition := aStream.Position;
  5843. aStream.Read(Header, SizeOf(Header));
  5844. // no colormapped files
  5845. if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
  5846. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
  5847. begin
  5848. try
  5849. if Header.ImageID <> 0 then // skip image ID
  5850. aStream.Position := aStream.Position + Header.ImageID;
  5851. case Header.Bpp of
  5852. 8: if IsGrayFormat then case (Header.ImageDesc and $F) of
  5853. 0: tgaFormat := tfLuminance8;
  5854. 8: tgaFormat := tfAlpha8;
  5855. end;
  5856. 16: if IsGrayFormat then case (Header.ImageDesc and $F) of
  5857. 0: tgaFormat := tfLuminance16;
  5858. 8: tgaFormat := tfLuminance8Alpha8;
  5859. end else case (Header.ImageDesc and $F) of
  5860. 0: tgaFormat := tfBGR5;
  5861. 1: tgaFormat := tfBGR5A1;
  5862. 4: tgaFormat := tfBGRA4;
  5863. end;
  5864. 24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  5865. 0: tgaFormat := tfBGR8;
  5866. end;
  5867. 32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  5868. 2: tgaFormat := tfBGR10A2;
  5869. 8: tgaFormat := tfBGRA8;
  5870. end;
  5871. end;
  5872. if (tgaFormat = tfEmpty) then
  5873. raise EglBitmapException.Create('LoadTga - unsupported format');
  5874. FormatDesc := TFormatDescriptor.Get(tgaFormat);
  5875. PixelSize := FormatDesc.GetSize(1, 1);
  5876. LineSize := FormatDesc.GetSize(Header.Width, 1);
  5877. GetMem(ImageData, LineSize * Header.Height);
  5878. try
  5879. //column direction
  5880. if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
  5881. Counter.X.low := Header.Height-1;;
  5882. Counter.X.high := 0;
  5883. Counter.X.dir := -1;
  5884. end else begin
  5885. Counter.X.low := 0;
  5886. Counter.X.high := Header.Height-1;
  5887. Counter.X.dir := 1;
  5888. end;
  5889. // Row direction
  5890. if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
  5891. Counter.Y.low := 0;
  5892. Counter.Y.high := Header.Height-1;
  5893. Counter.Y.dir := 1;
  5894. end else begin
  5895. Counter.Y.low := Header.Height-1;;
  5896. Counter.Y.high := 0;
  5897. Counter.Y.dir := -1;
  5898. end;
  5899. // Read Image
  5900. case Header.ImageType of
  5901. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
  5902. ReadUncompressed;
  5903. TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
  5904. ReadCompressed;
  5905. end;
  5906. SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height);
  5907. result := true;
  5908. except
  5909. FreeMem(ImageData);
  5910. raise;
  5911. end;
  5912. finally
  5913. aStream.Position := StartPosition;
  5914. end;
  5915. end
  5916. else aStream.Position := StartPosition;
  5917. end;
  5918. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5919. procedure TglBitmap.SaveTGA(const aStream: TStream);
  5920. var
  5921. Header: TTGAHeader;
  5922. LineSize, Size, x, y: Integer;
  5923. Pixel: TglBitmapPixelData;
  5924. LineBuf, SourceData, DestData: PByte;
  5925. SourceMD, DestMD: Pointer;
  5926. FormatDesc: TFormatDescriptor;
  5927. Converter: TFormatDescriptor;
  5928. begin
  5929. if not (ftTGA in FormatGetSupportedFiles(Format)) then
  5930. raise EglBitmapUnsupportedFormatFormat.Create('SaveTGA - ' + UNSUPPORTED_FORMAT);
  5931. //prepare header
  5932. FillChar(Header, SizeOf(Header), 0);
  5933. //set ImageType
  5934. if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
  5935. tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
  5936. Header.ImageType := TGA_UNCOMPRESSED_GRAY
  5937. else
  5938. Header.ImageType := TGA_UNCOMPRESSED_RGB;
  5939. //set BitsPerPixel
  5940. if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
  5941. Header.Bpp := 8
  5942. else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
  5943. tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
  5944. Header.Bpp := 16
  5945. else if (Format in [tfBGR8, tfRGB8]) then
  5946. Header.Bpp := 24
  5947. else
  5948. Header.Bpp := 32;
  5949. //set AlphaBitCount
  5950. case Format of
  5951. tfRGB5A1, tfBGR5A1:
  5952. Header.ImageDesc := 1 and $F;
  5953. tfRGB10A2, tfBGR10A2:
  5954. Header.ImageDesc := 2 and $F;
  5955. tfRGBA4, tfBGRA4:
  5956. Header.ImageDesc := 4 and $F;
  5957. tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
  5958. Header.ImageDesc := 8 and $F;
  5959. end;
  5960. Header.Width := Width;
  5961. Header.Height := Height;
  5962. Header.ImageDesc := Header.ImageDesc or $20; //flip y
  5963. aStream.Write(Header, SizeOf(Header));
  5964. // convert RGB(A) to BGR(A)
  5965. Converter := nil;
  5966. FormatDesc := TFormatDescriptor.Get(Format);
  5967. Size := FormatDesc.GetSize(Dimension);
  5968. if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
  5969. if (FormatDesc.RGBInverted = tfEmpty) then
  5970. raise EglBitmapException.Create('inverted RGB format is empty');
  5971. Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
  5972. if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
  5973. (Converter.PixelSize <> FormatDesc.PixelSize) then
  5974. raise EglBitmapException.Create('invalid inverted RGB format');
  5975. end;
  5976. if Assigned(Converter) then begin
  5977. LineSize := FormatDesc.GetSize(Width, 1);
  5978. LineBuf := GetMem(LineSize);
  5979. SourceMD := FormatDesc.CreateMappingData;
  5980. DestMD := Converter.CreateMappingData;
  5981. try
  5982. SourceData := Data;
  5983. for y := 0 to Height-1 do begin
  5984. DestData := LineBuf;
  5985. for x := 0 to Width-1 do begin
  5986. FormatDesc.Unmap(SourceData, Pixel, SourceMD);
  5987. Converter.Map(Pixel, DestData, DestMD);
  5988. end;
  5989. aStream.Write(LineBuf^, LineSize);
  5990. end;
  5991. finally
  5992. FreeMem(LineBuf);
  5993. FormatDesc.FreeMappingData(SourceMD);
  5994. FormatDesc.FreeMappingData(DestMD);
  5995. end;
  5996. end else
  5997. aStream.Write(Data^, Size);
  5998. end;
  5999. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6000. //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6001. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6002. const
  6003. DDS_MAGIC = $20534444;
  6004. // DDS_header.dwFlags
  6005. DDSD_CAPS = $00000001;
  6006. DDSD_HEIGHT = $00000002;
  6007. DDSD_WIDTH = $00000004;
  6008. DDSD_PITCH = $00000008;
  6009. DDSD_PIXELFORMAT = $00001000;
  6010. DDSD_MIPMAPCOUNT = $00020000;
  6011. DDSD_LINEARSIZE = $00080000;
  6012. DDSD_DEPTH = $00800000;
  6013. // DDS_header.sPixelFormat.dwFlags
  6014. DDPF_ALPHAPIXELS = $00000001;
  6015. DDPF_FOURCC = $00000004;
  6016. DDPF_INDEXED = $00000020;
  6017. DDPF_RGB = $00000040;
  6018. // DDS_header.sCaps.dwCaps1
  6019. DDSCAPS_COMPLEX = $00000008;
  6020. DDSCAPS_TEXTURE = $00001000;
  6021. DDSCAPS_MIPMAP = $00400000;
  6022. // DDS_header.sCaps.dwCaps2
  6023. DDSCAPS2_CUBEMAP = $00000200;
  6024. DDSCAPS2_CUBEMAP_POSITIVEX = $00000400;
  6025. DDSCAPS2_CUBEMAP_NEGATIVEX = $00000800;
  6026. DDSCAPS2_CUBEMAP_POSITIVEY = $00001000;
  6027. DDSCAPS2_CUBEMAP_NEGATIVEY = $00002000;
  6028. DDSCAPS2_CUBEMAP_POSITIVEZ = $00004000;
  6029. DDSCAPS2_CUBEMAP_NEGATIVEZ = $00008000;
  6030. DDSCAPS2_VOLUME = $00200000;
  6031. D3DFMT_DXT1 = $31545844;
  6032. D3DFMT_DXT3 = $33545844;
  6033. D3DFMT_DXT5 = $35545844;
  6034. type
  6035. TDDSPixelFormat = packed record
  6036. dwSize: Cardinal;
  6037. dwFlags: Cardinal;
  6038. dwFourCC: Cardinal;
  6039. dwRGBBitCount: Cardinal;
  6040. dwRBitMask: Cardinal;
  6041. dwGBitMask: Cardinal;
  6042. dwBBitMask: Cardinal;
  6043. dwABitMask: Cardinal;
  6044. end;
  6045. TDDSCaps = packed record
  6046. dwCaps1: Cardinal;
  6047. dwCaps2: Cardinal;
  6048. dwDDSX: Cardinal;
  6049. dwReserved: Cardinal;
  6050. end;
  6051. TDDSHeader = packed record
  6052. dwMagic: Cardinal;
  6053. dwSize: Cardinal;
  6054. dwFlags: Cardinal;
  6055. dwHeight: Cardinal;
  6056. dwWidth: Cardinal;
  6057. dwPitchOrLinearSize: Cardinal;
  6058. dwDepth: Cardinal;
  6059. dwMipMapCount: Cardinal;
  6060. dwReserved: array[0..10] of Cardinal;
  6061. PixelFormat: TDDSPixelFormat;
  6062. Caps: TDDSCaps;
  6063. dwReserved2: Cardinal;
  6064. end;
  6065. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6066. function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
  6067. var
  6068. Header: TDDSHeader;
  6069. StreamPos: Int64;
  6070. Y, LineSize: Cardinal;
  6071. RowSize: Cardinal;
  6072. NewImage, pData: pByte;
  6073. ddsFormat: TglBitmapFormat;
  6074. function RaiseEx : Exception;
  6075. begin
  6076. result := EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');
  6077. end;
  6078. function GetDDSFormat: TglBitmapFormat;
  6079. begin
  6080. with Header.PixelFormat do begin
  6081. // Compresses
  6082. if (dwFlags and DDPF_FOURCC) > 0 then begin
  6083. (* TODO
  6084. case Header.PixelFormat.dwFourCC of
  6085. D3DFMT_DXT1: result := ifDXT1;
  6086. D3DFMT_DXT3: result := ifDXT3;
  6087. D3DFMT_DXT5: result := ifDXT5;
  6088. else
  6089. raise RaiseEx;
  6090. end;
  6091. *)
  6092. raise RaiseEx;
  6093. end else
  6094. // RGB
  6095. if (dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS)) > 0 then begin
  6096. case dwRGBBitCount of
  6097. 8: begin
  6098. (* TODO if dwFlags and DDPF_ALPHAPIXELS > 0 then
  6099. result := tfAlpha
  6100. else
  6101. *)
  6102. result := tfLuminance8;
  6103. end;
  6104. 16: begin
  6105. if dwFlags and DDPF_ALPHAPIXELS > 0 then begin
  6106. // Alpha
  6107. case CountSetBits(dwRBitMask) of
  6108. 5: result := tfRGB5A1;
  6109. //TODO 4: result := tfRGBA4;
  6110. else
  6111. result := tfLuminance8Alpha8;
  6112. end;
  6113. end else begin
  6114. // no Alpha
  6115. //TODO result := ifR5G6B5;
  6116. raise RaiseEx;
  6117. end;
  6118. end;
  6119. 24: begin
  6120. if dwRBitMask > dwBBitMask then
  6121. result := tfBGR8
  6122. else
  6123. result := tfRGB8;
  6124. end;
  6125. 32: begin
  6126. if CountSetBits(dwRBitMask) = 10 then
  6127. //TODO result := tfRGB10A2
  6128. raise RaiseEx
  6129. else
  6130. if dwRBitMask > dwBBitMask then
  6131. result := tfBGRA8
  6132. else
  6133. result := tfRGBA8;
  6134. end;
  6135. else
  6136. raise RaiseEx;
  6137. end;
  6138. end else
  6139. raise RaiseEx;
  6140. end;
  6141. end;
  6142. begin
  6143. result := false;
  6144. // Header
  6145. StreamPos := aStream.Position;
  6146. aStream.Read(Header, sizeof(Header));
  6147. if ((Header.dwMagic <> DDS_MAGIC) or (Header.dwSize <> 124) or
  6148. ((Header.dwFlags and DDSD_PIXELFORMAT) = 0) or ((Header.dwFlags and DDSD_CAPS) = 0)) then begin
  6149. aStream.Position := StreamPos;
  6150. exit;
  6151. end;
  6152. ddsFormat := GetDDSFormat;
  6153. LineSize := Trunc(Header.dwWidth * TFormatDescriptor.Get(ddsFormat).PixelSize);
  6154. GetMem(NewImage, Header.dwHeight * LineSize);
  6155. try
  6156. pData := NewImage;
  6157. // Compressed
  6158. if (Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0 then begin
  6159. RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
  6160. for Y := 0 to Header.dwHeight -1 do begin
  6161. aStream.Read(pData^, RowSize);
  6162. Inc(pData, LineSize);
  6163. end;
  6164. end else
  6165. // RGB(A)
  6166. if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS)) > 0 then begin
  6167. RowSize := Header.dwPitchOrLinearSize;
  6168. for Y := 0 to Header.dwHeight -1 do begin
  6169. aStream.Read(pData^, RowSize);
  6170. Inc(pData, LineSize);
  6171. end;
  6172. end else
  6173. raise RaiseEx;
  6174. SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight);
  6175. result := true;
  6176. except
  6177. FreeMem(NewImage);
  6178. raise;
  6179. end;
  6180. end;
  6181. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6182. procedure TglBitmap.SaveDDS(const aStream: TStream);
  6183. var
  6184. Header: TDDSHeader;
  6185. Pix: TglBitmapPixelData;
  6186. FormatDesc: TFormatDescriptor;
  6187. begin
  6188. //if not FormatIsUncompressed(InternalFormat) then
  6189. // raise EglBitmapUnsupportedFormatFormat.Create('SaveDDS - ' + UNSUPPORTED_FORMAT);
  6190. (* TODO if Format = tfAlpha8 then
  6191. FORMAT_DESCRIPTORS[tfLuminance8].PreparePixel(Pix);
  6192. else *)
  6193. TFormatDescriptor.Get(Format).PreparePixel(Pix);
  6194. // Generell
  6195. FillChar(Header, SizeOf(Header), 0);
  6196. Header.dwMagic := DDS_MAGIC;
  6197. Header.dwSize := 124;
  6198. Header.dwFlags := DDSD_PITCH or DDSD_CAPS or DDSD_PIXELFORMAT;
  6199. if Width > 0 then begin
  6200. Header.dwWidth := Width;
  6201. Header.dwFlags := Header.dwFlags or DDSD_WIDTH;
  6202. end;
  6203. if Height > 0 then begin
  6204. Header.dwHeight := Height;
  6205. Header.dwFlags := Header.dwFlags or DDSD_HEIGHT;
  6206. end;
  6207. Header.dwPitchOrLinearSize := fRowSize;
  6208. Header.dwMipMapCount := 1;
  6209. // Caps
  6210. Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
  6211. // Pixelformat
  6212. Header.PixelFormat.dwSize := Sizeof(Header.PixelFormat);
  6213. Header.PixelFormat.dwFlags := DDPF_RGB;
  6214. (* TODO tfAlpha8
  6215. if FORMAT_DESCRIPTORS[Format].HasAlpha and (Format <> tfAlpha8) then
  6216. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
  6217. *)
  6218. FormatDesc := TFormatDescriptor.Get(Format);
  6219. Header.PixelFormat.dwRGBBitCount := Trunc(FormatDesc.PixelSize * 8);
  6220. Header.PixelFormat.dwRBitMask := FormatDesc.RedMask;
  6221. Header.PixelFormat.dwGBitMask := FormatDesc.GreenMask;
  6222. Header.PixelFormat.dwBBitMask := FormatDesc.BlueMask;
  6223. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6224. aStream.Write(Header, SizeOf(Header));
  6225. aStream.Write(Data^, FormatDesc.GetSize(Dimension));
  6226. end;
  6227. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6228. //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6229. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6230. function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
  6231. begin
  6232. if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
  6233. result := fLines[aIndex]
  6234. else
  6235. result := nil;
  6236. end;
  6237. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6238. procedure TglBitmap2D.SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
  6239. const aWidth: Integer; const aHeight: Integer);
  6240. var
  6241. Idx, LineWidth: Integer;
  6242. begin
  6243. inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
  6244. //TODO compression
  6245. if {FormatIsUncompressed(Format)} true then begin
  6246. (* TODO PixelFuncs
  6247. fGetPixelFunc := GetPixel2DUnmap;
  6248. fSetPixelFunc := SetPixel2DUnmap;
  6249. *)
  6250. // Assigning Data
  6251. if Assigned(Data) then begin
  6252. SetLength(fLines, GetHeight);
  6253. LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
  6254. for Idx := 0 to GetHeight -1 do begin
  6255. fLines[Idx] := Data;
  6256. Inc(fLines[Idx], Idx * LineWidth);
  6257. end;
  6258. end
  6259. else SetLength(fLines, 0);
  6260. end else begin
  6261. (*
  6262. SetLength(fLines, 0);
  6263. fSetPixelFunc := nil;
  6264. case Format of
  6265. ifDXT1:
  6266. fGetPixelFunc := GetPixel2DDXT1;
  6267. ifDXT3:
  6268. fGetPixelFunc := GetPixel2DDXT3;
  6269. ifDXT5:
  6270. fGetPixelFunc := GetPixel2DDXT5;
  6271. else
  6272. fGetPixelFunc := nil;
  6273. end;
  6274. *)
  6275. end;
  6276. end;
  6277. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6278. procedure TglBitmap2D.UploadData(const aTarget: Cardinal; const aBuildWithGlu: Boolean);
  6279. var
  6280. FormatDesc: TFormatDescriptor;
  6281. begin
  6282. glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
  6283. (* TODO compression
  6284. if Self.InternalFormat in [ifDXT1, ifDXT3, ifDXT5] then
  6285. glCompressedTexImage2D(Target, 0, InternalFormat, Width, Height, 0, Trunc(Width * Height * FormatGetSize(Self.InternalFormat)), Data)
  6286. else
  6287. *)
  6288. FormatDesc := TFormatDescriptor.Get(Format);
  6289. if aBuildWithGlu then
  6290. gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
  6291. FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  6292. else
  6293. glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
  6294. FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  6295. // Freigeben
  6296. if (FreeDataAfterGenTexture) then
  6297. FreeData;
  6298. end;
  6299. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6300. procedure TglBitmap2D.AfterConstruction;
  6301. begin
  6302. inherited;
  6303. Target := GL_TEXTURE_2D;
  6304. end;
  6305. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6306. procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  6307. var
  6308. Temp: pByte;
  6309. Size, w, h: Integer;
  6310. FormatDesc: TFormatDescriptor;
  6311. begin
  6312. (* TODO compression
  6313. if not FormatIsUncompressed(Format) then
  6314. raise EglBitmapUnsupportedFormatFormat.Create('TglBitmap2D.GrabScreen - ' + UNSUPPORTED_FORMAT);
  6315. *)
  6316. w := aRight - aLeft;
  6317. h := aBottom - aTop;
  6318. FormatDesc := TFormatDescriptor.Get(Format);
  6319. Size := FormatDesc.GetSize(w, h);
  6320. GetMem(Temp, Size);
  6321. try
  6322. glPixelStorei(GL_PACK_ALIGNMENT, 1);
  6323. glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  6324. SetDataPointer(Temp, Format, w, h);
  6325. FlipVert;
  6326. except
  6327. FreeMem(Temp);
  6328. raise;
  6329. end;
  6330. end;
  6331. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6332. procedure TglBitmap2D.GetDataFromTexture;
  6333. var
  6334. Temp: PByte;
  6335. TempWidth, TempHeight: Integer;
  6336. TempType, TempIntFormat: Cardinal;
  6337. IntFormat, f: TglBitmapFormat;
  6338. FormatDesc: TFormatDescriptor;
  6339. begin
  6340. Bind;
  6341. // Request Data
  6342. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH, @TempWidth);
  6343. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT, @TempHeight);
  6344. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
  6345. IntFormat := tfEmpty;
  6346. for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do
  6347. if (TFormatDescriptor.Get(f).glInternalFormat = TempIntFormat) then begin
  6348. IntFormat := FormatDesc.Format;
  6349. break;
  6350. end;
  6351. // Getting data from OpenGL
  6352. FormatDesc := TFormatDescriptor.Get(IntFormat);
  6353. GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
  6354. try
  6355. (* TODO Compression
  6356. if FormatIsCompressed(IntFormat) and (GL_VERSION_1_3 or GL_ARB_texture_compression) then
  6357. glGetCompressedTexImage(Target, 0, Temp)
  6358. else
  6359. *)
  6360. glGetTexImage(Target, 0, FormatDesc.glInternalFormat, FormatDesc.glDataFormat, Temp);
  6361. SetDataPointer(Temp, IntFormat, TempWidth, TempHeight);
  6362. except
  6363. FreeMem(Temp);
  6364. raise;
  6365. end;
  6366. end;
  6367. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6368. procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
  6369. var
  6370. BuildWithGlu, PotTex, TexRec: Boolean;
  6371. TexSize: Integer;
  6372. begin
  6373. if Assigned(Data) then begin
  6374. // Check Texture Size
  6375. if (aTestTextureSize) then begin
  6376. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  6377. if ((Height > TexSize) or (Width > TexSize)) then
  6378. raise EglBitmapSizeToLargeException.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  6379. PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
  6380. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE_ARB);
  6381. if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  6382. raise EglBitmapNonPowerOfTwoException.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  6383. end;
  6384. CreateId;
  6385. SetupParameters(BuildWithGlu);
  6386. UploadData(Target, BuildWithGlu);
  6387. glAreTexturesResident(1, @fID, @fIsResident);
  6388. end;
  6389. end;
  6390. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6391. function TglBitmap2D.FlipHorz: Boolean;
  6392. var
  6393. Col, Row: Integer;
  6394. TempDestData, DestData, SourceData: PByte;
  6395. ImgSize: Integer;
  6396. begin
  6397. result := inherited FlipHorz;
  6398. if Assigned(Data) then begin
  6399. SourceData := Data;
  6400. ImgSize := Height * fRowSize;
  6401. GetMem(DestData, ImgSize);
  6402. try
  6403. TempDestData := DestData;
  6404. Dec(TempDestData, fRowSize + fPixelSize);
  6405. for Row := 0 to Height -1 do begin
  6406. Inc(TempDestData, fRowSize * 2);
  6407. for Col := 0 to Width -1 do begin
  6408. Move(SourceData^, TempDestData^, fPixelSize);
  6409. Inc(SourceData, fPixelSize);
  6410. Dec(TempDestData, fPixelSize);
  6411. end;
  6412. end;
  6413. SetDataPointer(DestData, Format);
  6414. result := true;
  6415. except
  6416. FreeMem(DestData);
  6417. raise;
  6418. end;
  6419. end;
  6420. end;
  6421. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6422. function TglBitmap2D.FlipVert: Boolean;
  6423. var
  6424. Row: Integer;
  6425. TempDestData, DestData, SourceData: PByte;
  6426. begin
  6427. result := inherited FlipVert;
  6428. if Assigned(Data) then begin
  6429. SourceData := Data;
  6430. GetMem(DestData, Height * fRowSize);
  6431. try
  6432. TempDestData := DestData;
  6433. Inc(TempDestData, Width * (Height -1) * fPixelSize);
  6434. for Row := 0 to Height -1 do begin
  6435. Move(SourceData^, TempDestData^, fRowSize);
  6436. Dec(TempDestData, fRowSize);
  6437. Inc(SourceData, fRowSize);
  6438. end;
  6439. SetDataPointer(DestData, Format);
  6440. result := true;
  6441. except
  6442. FreeMem(DestData);
  6443. raise;
  6444. end;
  6445. end;
  6446. end;
  6447. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6448. //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6449. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6450. type
  6451. TMatrixItem = record
  6452. X, Y: Integer;
  6453. W: Single;
  6454. end;
  6455. PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
  6456. TglBitmapToNormalMapRec = Record
  6457. Scale: Single;
  6458. Heights: array of Single;
  6459. MatrixU : array of TMatrixItem;
  6460. MatrixV : array of TMatrixItem;
  6461. end;
  6462. const
  6463. ONE_OVER_255 = 1 / 255;
  6464. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6465. procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
  6466. var
  6467. Val: Single;
  6468. begin
  6469. with FuncRec do begin
  6470. Val :=
  6471. Source.Data.r * LUMINANCE_WEIGHT_R +
  6472. Source.Data.g * LUMINANCE_WEIGHT_G +
  6473. Source.Data.b * LUMINANCE_WEIGHT_B;
  6474. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
  6475. end;
  6476. end;
  6477. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6478. procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  6479. begin
  6480. with FuncRec do
  6481. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
  6482. end;
  6483. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6484. procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
  6485. type
  6486. TVec = Array[0..2] of Single;
  6487. var
  6488. Idx: Integer;
  6489. du, dv: Double;
  6490. Len: Single;
  6491. Vec: TVec;
  6492. function GetHeight(X, Y: Integer): Single;
  6493. begin
  6494. with FuncRec do begin
  6495. X := Max(0, Min(Size.X -1, X));
  6496. Y := Max(0, Min(Size.Y -1, Y));
  6497. result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
  6498. end;
  6499. end;
  6500. begin
  6501. with FuncRec do begin
  6502. with PglBitmapToNormalMapRec(Args)^ do begin
  6503. du := 0;
  6504. for Idx := Low(MatrixU) to High(MatrixU) do
  6505. du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
  6506. dv := 0;
  6507. for Idx := Low(MatrixU) to High(MatrixU) do
  6508. dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
  6509. Vec[0] := -du * Scale;
  6510. Vec[1] := -dv * Scale;
  6511. Vec[2] := 1;
  6512. end;
  6513. // Normalize
  6514. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  6515. if Len <> 0 then begin
  6516. Vec[0] := Vec[0] * Len;
  6517. Vec[1] := Vec[1] * Len;
  6518. Vec[2] := Vec[2] * Len;
  6519. end;
  6520. // Farbe zuweisem
  6521. Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
  6522. Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
  6523. Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
  6524. end;
  6525. end;
  6526. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6527. procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
  6528. var
  6529. Rec: TglBitmapToNormalMapRec;
  6530. procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
  6531. begin
  6532. if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
  6533. Matrix[Index].X := X;
  6534. Matrix[Index].Y := Y;
  6535. Matrix[Index].W := W;
  6536. end;
  6537. end;
  6538. begin
  6539. (* TODO Compression
  6540. if not FormatIsUncompressed(InternalFormat) then
  6541. raise EglBitmapUnsupportedFormatFormat.Create('TglBitmap2D.ToNormalMap - ' + UNSUPPORTED_FORMAT);
  6542. *)
  6543. if aScale > 100 then
  6544. Rec.Scale := 100
  6545. else if aScale < -100 then
  6546. Rec.Scale := -100
  6547. else
  6548. Rec.Scale := aScale;
  6549. SetLength(Rec.Heights, Width * Height);
  6550. try
  6551. case aFunc of
  6552. nm4Samples: begin
  6553. SetLength(Rec.MatrixU, 2);
  6554. SetEntry(Rec.MatrixU, 0, -1, 0, -0.5);
  6555. SetEntry(Rec.MatrixU, 1, 1, 0, 0.5);
  6556. SetLength(Rec.MatrixV, 2);
  6557. SetEntry(Rec.MatrixV, 0, 0, 1, 0.5);
  6558. SetEntry(Rec.MatrixV, 1, 0, -1, -0.5);
  6559. end;
  6560. nmSobel: begin
  6561. SetLength(Rec.MatrixU, 6);
  6562. SetEntry(Rec.MatrixU, 0, -1, 1, -1.0);
  6563. SetEntry(Rec.MatrixU, 1, -1, 0, -2.0);
  6564. SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
  6565. SetEntry(Rec.MatrixU, 3, 1, 1, 1.0);
  6566. SetEntry(Rec.MatrixU, 4, 1, 0, 2.0);
  6567. SetEntry(Rec.MatrixU, 5, 1, -1, 1.0);
  6568. SetLength(Rec.MatrixV, 6);
  6569. SetEntry(Rec.MatrixV, 0, -1, 1, 1.0);
  6570. SetEntry(Rec.MatrixV, 1, 0, 1, 2.0);
  6571. SetEntry(Rec.MatrixV, 2, 1, 1, 1.0);
  6572. SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
  6573. SetEntry(Rec.MatrixV, 4, 0, -1, -2.0);
  6574. SetEntry(Rec.MatrixV, 5, 1, -1, -1.0);
  6575. end;
  6576. nm3x3: begin
  6577. SetLength(Rec.MatrixU, 6);
  6578. SetEntry(Rec.MatrixU, 0, -1, 1, -1/6);
  6579. SetEntry(Rec.MatrixU, 1, -1, 0, -1/6);
  6580. SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
  6581. SetEntry(Rec.MatrixU, 3, 1, 1, 1/6);
  6582. SetEntry(Rec.MatrixU, 4, 1, 0, 1/6);
  6583. SetEntry(Rec.MatrixU, 5, 1, -1, 1/6);
  6584. SetLength(Rec.MatrixV, 6);
  6585. SetEntry(Rec.MatrixV, 0, -1, 1, 1/6);
  6586. SetEntry(Rec.MatrixV, 1, 0, 1, 1/6);
  6587. SetEntry(Rec.MatrixV, 2, 1, 1, 1/6);
  6588. SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
  6589. SetEntry(Rec.MatrixV, 4, 0, -1, -1/6);
  6590. SetEntry(Rec.MatrixV, 5, 1, -1, -1/6);
  6591. end;
  6592. nm5x5: begin
  6593. SetLength(Rec.MatrixU, 20);
  6594. SetEntry(Rec.MatrixU, 0, -2, 2, -1 / 16);
  6595. SetEntry(Rec.MatrixU, 1, -1, 2, -1 / 10);
  6596. SetEntry(Rec.MatrixU, 2, 1, 2, 1 / 10);
  6597. SetEntry(Rec.MatrixU, 3, 2, 2, 1 / 16);
  6598. SetEntry(Rec.MatrixU, 4, -2, 1, -1 / 10);
  6599. SetEntry(Rec.MatrixU, 5, -1, 1, -1 / 8);
  6600. SetEntry(Rec.MatrixU, 6, 1, 1, 1 / 8);
  6601. SetEntry(Rec.MatrixU, 7, 2, 1, 1 / 10);
  6602. SetEntry(Rec.MatrixU, 8, -2, 0, -1 / 2.8);
  6603. SetEntry(Rec.MatrixU, 9, -1, 0, -0.5);
  6604. SetEntry(Rec.MatrixU, 10, 1, 0, 0.5);
  6605. SetEntry(Rec.MatrixU, 11, 2, 0, 1 / 2.8);
  6606. SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
  6607. SetEntry(Rec.MatrixU, 13, -1, -1, -1 / 8);
  6608. SetEntry(Rec.MatrixU, 14, 1, -1, 1 / 8);
  6609. SetEntry(Rec.MatrixU, 15, 2, -1, 1 / 10);
  6610. SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
  6611. SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
  6612. SetEntry(Rec.MatrixU, 18, 1, -2, 1 / 10);
  6613. SetEntry(Rec.MatrixU, 19, 2, -2, 1 / 16);
  6614. SetLength(Rec.MatrixV, 20);
  6615. SetEntry(Rec.MatrixV, 0, -2, 2, 1 / 16);
  6616. SetEntry(Rec.MatrixV, 1, -1, 2, 1 / 10);
  6617. SetEntry(Rec.MatrixV, 2, 0, 2, 0.25);
  6618. SetEntry(Rec.MatrixV, 3, 1, 2, 1 / 10);
  6619. SetEntry(Rec.MatrixV, 4, 2, 2, 1 / 16);
  6620. SetEntry(Rec.MatrixV, 5, -2, 1, 1 / 10);
  6621. SetEntry(Rec.MatrixV, 6, -1, 1, 1 / 8);
  6622. SetEntry(Rec.MatrixV, 7, 0, 1, 0.5);
  6623. SetEntry(Rec.MatrixV, 8, 1, 1, 1 / 8);
  6624. SetEntry(Rec.MatrixV, 9, 2, 1, 1 / 16);
  6625. SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
  6626. SetEntry(Rec.MatrixV, 11, -1, -1, -1 / 8);
  6627. SetEntry(Rec.MatrixV, 12, 0, -1, -0.5);
  6628. SetEntry(Rec.MatrixV, 13, 1, -1, -1 / 8);
  6629. SetEntry(Rec.MatrixV, 14, 2, -1, -1 / 10);
  6630. SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
  6631. SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
  6632. SetEntry(Rec.MatrixV, 17, 0, -2, -0.25);
  6633. SetEntry(Rec.MatrixV, 18, 1, -2, -1 / 10);
  6634. SetEntry(Rec.MatrixV, 19, 2, -2, -1 / 16);
  6635. end;
  6636. end;
  6637. // Daten Sammeln
  6638. if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
  6639. AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, PtrInt(@Rec))
  6640. else
  6641. AddFunc(glBitmapToNormalMapPrepareFunc, false, PtrInt(@Rec));
  6642. AddFunc(glBitmapToNormalMapFunc, false, PtrInt(@Rec));
  6643. finally
  6644. SetLength(Rec.Heights, 0);
  6645. end;
  6646. end;
  6647. (*
  6648. procedure TglBitmap1D.SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width, Height: Integer);
  6649. var
  6650. pTemp: pByte;
  6651. Size: Integer;
  6652. begin
  6653. if Height > 1 then begin
  6654. // extract first line of the data
  6655. Size := FormatGetImageSize(glBitmapPosition(Width), Format);
  6656. GetMem(pTemp, Size);
  6657. Move(Data^, pTemp^, Size);
  6658. FreeMem(Data);
  6659. end else
  6660. pTemp := Data;
  6661. // set data pointer
  6662. inherited SetDataPointer(pTemp, Format, Width);
  6663. if FormatIsUncompressed(Format) then begin
  6664. fUnmapFunc := FormatGetUnMapFunc(Format);
  6665. fGetPixelFunc := GetPixel1DUnmap;
  6666. end;
  6667. end;
  6668. procedure TglBitmap1D.GetPixel1DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
  6669. var
  6670. pTemp: pByte;
  6671. begin
  6672. pTemp := Data;
  6673. Inc(pTemp, Pos.X * fPixelSize);
  6674. fUnmapFunc(pTemp, Pixel);
  6675. end;
  6676. function TglBitmap1D.FlipHorz: Boolean;
  6677. var
  6678. Col: Integer;
  6679. pTempDest, pDest, pSource: pByte;
  6680. begin
  6681. result := inherited FlipHorz;
  6682. if Assigned(Data) and FormatIsUncompressed(InternalFormat) then begin
  6683. pSource := Data;
  6684. GetMem(pDest, fRowSize);
  6685. try
  6686. pTempDest := pDest;
  6687. Inc(pTempDest, fRowSize);
  6688. for Col := 0 to Width -1 do begin
  6689. Move(pSource^, pTempDest^, fPixelSize);
  6690. Inc(pSource, fPixelSize);
  6691. Dec(pTempDest, fPixelSize);
  6692. end;
  6693. SetDataPointer(pDest, InternalFormat);
  6694. result := true;
  6695. finally
  6696. FreeMem(pDest);
  6697. end;
  6698. end;
  6699. end;
  6700. procedure TglBitmap1D.UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
  6701. begin
  6702. // Upload data
  6703. if Self.InternalFormat in [ifDXT1, ifDXT3, ifDXT5] then
  6704. glCompressedTexImage1D(Target, 0, InternalFormat, Width, 0, Trunc(Width * FormatGetSize(Self.InternalFormat)), Data)
  6705. else
  6706. // Upload data
  6707. if BuildWithGlu then
  6708. gluBuild1DMipmaps(Target, InternalFormat, Width, Format, Typ, Data)
  6709. else
  6710. glTexImage1D(Target, 0, InternalFormat, Width, 0, Format, Typ, Data);
  6711. // Freigeben
  6712. if (FreeDataAfterGenTexture) then
  6713. FreeData;
  6714. end;
  6715. procedure TglBitmap1D.GenTexture(TestTextureSize: Boolean);
  6716. var
  6717. BuildWithGlu, TexRec: Boolean;
  6718. glFormat, glInternalFormat, glType: Cardinal;
  6719. TexSize: Integer;
  6720. begin
  6721. if Assigned(Data) then begin
  6722. // Check Texture Size
  6723. if (TestTextureSize) then begin
  6724. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  6725. if (Width > TexSize) then
  6726. raise EglBitmapSizeToLargeException.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  6727. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
  6728. (Target = GL_TEXTURE_RECTANGLE_ARB);
  6729. if not (IsPowerOfTwo (Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  6730. raise EglBitmapNonPowerOfTwoException.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  6731. end;
  6732. CreateId;
  6733. SetupParameters(BuildWithGlu);
  6734. SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
  6735. UploadData(Target, glFormat, glInternalFormat, glType, BuildWithGlu);
  6736. // Infos sammeln
  6737. glAreTexturesResident(1, @fID, @fIsResident);
  6738. end;
  6739. end;
  6740. procedure TglBitmap1D.AfterConstruction;
  6741. begin
  6742. inherited;
  6743. Target := GL_TEXTURE_1D;
  6744. end;
  6745. { TglBitmapCubeMap }
  6746. procedure TglBitmapCubeMap.AfterConstruction;
  6747. begin
  6748. inherited;
  6749. if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
  6750. raise EglBitmapException.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
  6751. SetWrap; // set all to GL_CLAMP_TO_EDGE
  6752. Target := GL_TEXTURE_CUBE_MAP;
  6753. fGenMode := GL_REFLECTION_MAP;
  6754. end;
  6755. procedure TglBitmapCubeMap.Bind(EnableTexCoordsGen, EnableTextureUnit: Boolean);
  6756. begin
  6757. inherited Bind (EnableTextureUnit);
  6758. if EnableTexCoordsGen then begin
  6759. glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
  6760. glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
  6761. glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
  6762. glEnable(GL_TEXTURE_GEN_S);
  6763. glEnable(GL_TEXTURE_GEN_T);
  6764. glEnable(GL_TEXTURE_GEN_R);
  6765. end;
  6766. end;
  6767. procedure TglBitmapCubeMap.GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean);
  6768. var
  6769. glFormat, glInternalFormat, glType: Cardinal;
  6770. BuildWithGlu: Boolean;
  6771. TexSize: Integer;
  6772. begin
  6773. // Check Texture Size
  6774. if (TestTextureSize) then begin
  6775. glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
  6776. if ((Height > TexSize) or (Width > TexSize)) then
  6777. raise EglBitmapSizeToLargeException.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
  6778. if not ((IsPowerOfTwo (Height) and IsPowerOfTwo (Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
  6779. raise EglBitmapNonPowerOfTwoException.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
  6780. end;
  6781. // create Texture
  6782. if ID = 0 then begin
  6783. CreateID;
  6784. SetupParameters(BuildWithGlu);
  6785. end;
  6786. SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
  6787. UploadData (CubeTarget, glFormat, glInternalFormat, glType, BuildWithGlu);
  6788. end;
  6789. procedure TglBitmapCubeMap.GenTexture(TestTextureSize: Boolean);
  6790. begin
  6791. Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
  6792. end;
  6793. procedure TglBitmapCubeMap.Unbind(DisableTexCoordsGen,
  6794. DisableTextureUnit: Boolean);
  6795. begin
  6796. inherited Unbind (DisableTextureUnit);
  6797. if DisableTexCoordsGen then begin
  6798. glDisable(GL_TEXTURE_GEN_S);
  6799. glDisable(GL_TEXTURE_GEN_T);
  6800. glDisable(GL_TEXTURE_GEN_R);
  6801. end;
  6802. end;
  6803. { TglBitmapNormalMap }
  6804. type
  6805. TVec = Array[0..2] of Single;
  6806. TglBitmapNormalMapGetVectorFunc = procedure (var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  6807. PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
  6808. TglBitmapNormalMapRec = record
  6809. HalfSize : Integer;
  6810. Func: TglBitmapNormalMapGetVectorFunc;
  6811. end;
  6812. procedure glBitmapNormalMapPosX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  6813. begin
  6814. Vec[0] := HalfSize;
  6815. Vec[1] := - (Position.Y + 0.5 - HalfSize);
  6816. Vec[2] := - (Position.X + 0.5 - HalfSize);
  6817. end;
  6818. procedure glBitmapNormalMapNegX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  6819. begin
  6820. Vec[0] := - HalfSize;
  6821. Vec[1] := - (Position.Y + 0.5 - HalfSize);
  6822. Vec[2] := Position.X + 0.5 - HalfSize;
  6823. end;
  6824. procedure glBitmapNormalMapPosY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  6825. begin
  6826. Vec[0] := Position.X + 0.5 - HalfSize;
  6827. Vec[1] := HalfSize;
  6828. Vec[2] := Position.Y + 0.5 - HalfSize;
  6829. end;
  6830. procedure glBitmapNormalMapNegY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  6831. begin
  6832. Vec[0] := Position.X + 0.5 - HalfSize;
  6833. Vec[1] := - HalfSize;
  6834. Vec[2] := - (Position.Y + 0.5 - HalfSize);
  6835. end;
  6836. procedure glBitmapNormalMapPosZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  6837. begin
  6838. Vec[0] := Position.X + 0.5 - HalfSize;
  6839. Vec[1] := - (Position.Y + 0.5 - HalfSize);
  6840. Vec[2] := HalfSize;
  6841. end;
  6842. procedure glBitmapNormalMapNegZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  6843. begin
  6844. Vec[0] := - (Position.X + 0.5 - HalfSize);
  6845. Vec[1] := - (Position.Y + 0.5 - HalfSize);
  6846. Vec[2] := - HalfSize;
  6847. end;
  6848. procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
  6849. var
  6850. Vec : TVec;
  6851. Len: Single;
  6852. begin
  6853. with FuncRec do begin
  6854. with PglBitmapNormalMapRec (CustomData)^ do begin
  6855. Func(Vec, Position, HalfSize);
  6856. // Normalize
  6857. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  6858. if Len <> 0 then begin
  6859. Vec[0] := Vec[0] * Len;
  6860. Vec[1] := Vec[1] * Len;
  6861. Vec[2] := Vec[2] * Len;
  6862. end;
  6863. // Scale Vector and AddVectro
  6864. Vec[0] := Vec[0] * 0.5 + 0.5;
  6865. Vec[1] := Vec[1] * 0.5 + 0.5;
  6866. Vec[2] := Vec[2] * 0.5 + 0.5;
  6867. end;
  6868. // Set Color
  6869. Dest.Red := Round(Vec[0] * 255);
  6870. Dest.Green := Round(Vec[1] * 255);
  6871. Dest.Blue := Round(Vec[2] * 255);
  6872. end;
  6873. end;
  6874. procedure TglBitmapNormalMap.AfterConstruction;
  6875. begin
  6876. inherited;
  6877. fGenMode := GL_NORMAL_MAP;
  6878. end;
  6879. procedure TglBitmapNormalMap.GenerateNormalMap(Size: Integer;
  6880. TestTextureSize: Boolean);
  6881. var
  6882. Rec: TglBitmapNormalMapRec;
  6883. SizeRec: TglBitmapPixelPosition;
  6884. begin
  6885. Rec.HalfSize := Size div 2;
  6886. FreeDataAfterGenTexture := false;
  6887. SizeRec.Fields := [ffX, ffY];
  6888. SizeRec.X := Size;
  6889. SizeRec.Y := Size;
  6890. // Positive X
  6891. Rec.Func := glBitmapNormalMapPosX;
  6892. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  6893. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, TestTextureSize);
  6894. // Negative X
  6895. Rec.Func := glBitmapNormalMapNegX;
  6896. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  6897. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, TestTextureSize);
  6898. // Positive Y
  6899. Rec.Func := glBitmapNormalMapPosY;
  6900. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  6901. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, TestTextureSize);
  6902. // Negative Y
  6903. Rec.Func := glBitmapNormalMapNegY;
  6904. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  6905. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, TestTextureSize);
  6906. // Positive Z
  6907. Rec.Func := glBitmapNormalMapPosZ;
  6908. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  6909. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, TestTextureSize);
  6910. // Negative Z
  6911. Rec.Func := glBitmapNormalMapNegZ;
  6912. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  6913. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, TestTextureSize);
  6914. end;
  6915. *)
  6916. initialization
  6917. glBitmapSetDefaultFormat(tfEmpty);
  6918. glBitmapSetDefaultMipmap(mmMipmap);
  6919. glBitmapSetDefaultFilter(GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
  6920. glBitmapSetDefaultWrap (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
  6921. glBitmapSetDefaultFreeDataAfterGenTexture(true);
  6922. glBitmapSetDefaultDeleteTextureOnFree (true);
  6923. TFormatDescriptor.Init;
  6924. finalization
  6925. TFormatDescriptor.Finalize;
  6926. end.