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.

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