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.

8325 lines
278 KiB

  1. {***********************************************************
  2. glBitmap by Steffen Xonna aka Lossy eX (2003-2008)
  3. http://www.opengl24.de/index.php?cat=header&file=glbitmap
  4. ------------------------------------------------------------
  5. The contents of this file are used with permission, subject to
  6. the Mozilla Public License Version 1.1 (the "License"); you may
  7. not use this file except in compliance with the License. You may
  8. obtain a copy of the License at
  9. http://www.mozilla.org/MPL/MPL-1.1.html
  10. ------------------------------------------------------------
  11. Version 2.0.3
  12. ------------------------------------------------------------
  13. History
  14. 21-03-2010
  15. - The define GLB_DELPHI dosn't check versions anymore. If you say you are using delphi
  16. then it's your problem if that isn't true. This prevents the unit for incompatibility
  17. with newer versions of Delphi.
  18. - Problems with D2009+ resolved (Thanks noeska and all i forgot)
  19. - GetPixel isn't set if you are loading textures inside the constructor (Thanks Wilson)
  20. 10-08-2008
  21. - AddAlphaFromglBitmap used the custom pointer instead the imagedatapointer (Thanks Wilson)
  22. - Additional Datapointer for functioninterface now has the name CustomData
  23. 24-07-2008
  24. - AssigneAlphaToBitmap overwrites his own palette (Thanks Wilson)
  25. - If you load an texture from an file the property Filename will be set to the name of the file
  26. - Three new properties to attach custom data to the Texture objects
  27. - CustomName (free for use string)
  28. - CustomNameW (free for use widestring)
  29. - CustomDataPointer (free for use pointer to attach other objects or complex structures)
  30. 27-05-2008
  31. - RLE TGAs loaded much faster
  32. 26-05-2008
  33. - fixed some problem with reading RLE TGAs.
  34. 21-05-2008
  35. - function clone now only copys data if it's assigned and now it also copies the ID
  36. - it seems that lazarus dont like comments in comments.
  37. 01-05-2008
  38. - It's possible to set the id of the texture
  39. - define GLB_NO_NATIVE_GL deactivated by default
  40. 27-04-2008
  41. - Now supports the following libraries
  42. - SDL and SDL_image
  43. - libPNG
  44. - libJPEG
  45. - Linux compatibillity via free pascal compatibility (delphi sources optional)
  46. - BMPs now loaded manuel
  47. - Large restructuring
  48. - Property DataPtr now has the name Data
  49. - Functions are more flexible between RGB(A) and BGR(A). RGB can be saved as Bitmap and will be saved as BGR
  50. - Unused Depth removed
  51. - Function FreeData to freeing image data added
  52. 24-10-2007
  53. - ImageID flag of TGAs was ignored. (Thanks Zwoetzen)
  54. 15-11-2006
  55. - Function SetBorderColor implemented (only used by opengl if wrap is set to GL_CLAMP_TO_BORDER)
  56. - Function AddAlphaFromValue implemented to use an fixed Value as Alphachannel
  57. - Function ReadOpenGLExtension is now only intern
  58. 29-06-2006
  59. - pngimage now disabled by default like all other versions.
  60. 26-06-2006
  61. - Setting up an anisotropic filter of 0 isnt allowed by nvidia (Thanks Ogridi)
  62. 22-06-2006
  63. - Fixed some Problem with Delphi 5
  64. - Now uses the newest version of pngimage. Makes saving pngs much easier.
  65. 22-03-2006
  66. - Property IsCompressed and Size removed. Not really supported by Spec (Thanks Ogridi)
  67. 09-03-2006
  68. - Internal Format ifDepth8 added
  69. - function GrabScreen now supports all uncompressed formats
  70. 31-01-2006
  71. - AddAlphaFromglBitmap implemented
  72. 29-12-2005
  73. - LoadFromResource and LoadFromResourceId now needs an Instance and an ResourceType (for ID)
  74. 28-12-2005
  75. - Width, Height and Depth internal changed to TglBitmapPixelPosition.
  76. property Width, Height, Depth are still existing and new property Dimension are avail
  77. 11-12-2005
  78. - Added native OpenGL Support. Breaking the dglOpenGL "barrier".
  79. 19-10-2005
  80. - Added function GrabScreen to class TglBitmap2D
  81. 18-10-2005
  82. - Added support to Save images
  83. - Added function Clone to Clone Instance
  84. 11-10-2005
  85. - Functions now works with Cardinals for each channel. Up to 32 Bits per channel.
  86. Usefull for Future
  87. - Several speed optimizations
  88. 09-10-2005
  89. - Internal structure change. Loading of TGA, PNG and DDS improved.
  90. Data, format and size will now set directly with SetDataPtr.
  91. - AddFunc now works with all Types of Images and Formats
  92. - Some Funtions moved to Baseclass TglBitmap
  93. 06-10-2005
  94. - Added Support to decompress DXT3 and DXT5 compressed Images.
  95. - Added Mapping to convert data from one format into an other.
  96. 05-10-2005
  97. - Added method ConvertTo in Class TglBitmap2D. Method allows to convert every
  98. supported Input format (supported by GetPixel) into any uncompresed Format
  99. - Added Support to decompress DXT1 compressed Images.
  100. - SwapColors replaced by ConvertTo
  101. 04-10-2005
  102. - Added Support for compressed DDSs
  103. - Added new internal formats (DXT1, DXT3, DXT5)
  104. 29-09-2005
  105. - Parameter Components renamed to InternalFormat
  106. 23-09-2005
  107. - Some AllocMem replaced with GetMem (little speed change)
  108. - better exception handling. Better protection from memory leaks.
  109. 22-09-2005
  110. - Added support for Direct Draw Surfaces (.DDS) (uncompressed images only)
  111. - Added new internal formats (RGB8, RGBA8, RGBA4, RGB5A1, RGB10A2, R5G6B5)
  112. 07-09-2005
  113. - Added support for Grayscale textures
  114. - Added internal formats (Alpha, Luminance, LuminanceAlpha, BGR8, BGRA8)
  115. 10-07-2005
  116. - Added support for GL_VERSION_2_0
  117. - Added support for GL_EXT_texture_filter_anisotropic
  118. 04-07-2005
  119. - Function FillWithColor fills the Image with one Color
  120. - Function LoadNormalMap added
  121. 30-06-2005
  122. - ToNormalMap allows to Create an NormalMap from the Alphachannel
  123. - ToNormalMap now supports Sobel (nmSobel) function.
  124. 29-06-2005
  125. - support for RLE Compressed RGB TGAs added
  126. 28-06-2005
  127. - Class TglBitmapNormalMap added to support Normalmap generation
  128. - Added function ToNormalMap in class TglBitmap2D to genereate normal maps from textures.
  129. 3 Filters are supported. (4 Samples, 3x3 and 5x5)
  130. 16-06-2005
  131. - Method LoadCubeMapClass removed
  132. - LoadCubeMap returnvalue is now the Texture paramter. Such as LoadTextures
  133. - virtual abstract method GenTexture in class TglBitmap now is protected
  134. 12-06-2005
  135. - now support DescriptionFlag in LoadTga. Allows vertical flipped images to be loaded as normal
  136. 10-06-2005
  137. - little enhancement for IsPowerOfTwo
  138. - TglBitmap1D.GenTexture now tests NPOT Textures
  139. 06-06-2005
  140. - some little name changes. All properties or function with Texture in name are
  141. now without texture in name. We have allways texture so we dosn't name it.
  142. 03-06-2005
  143. - GenTexture now tests if texture is NPOT and NPOT-Texture are supported or
  144. TextureTarget is GL_TEXTURE_RECTANGLE. Else it raised an exception.
  145. 02-06-2005
  146. - added support for GL_ARB_texture_rectangle, GL_EXT_texture_rectangle and GL_NV_texture_rectangle
  147. 25-04-2005
  148. - Function Unbind added
  149. - call of SetFilter or SetTextureWrap if TextureID exists results in setting properties to opengl texture.
  150. 21-04-2005
  151. - class TglBitmapCubeMap added (allows to Create Cubemaps)
  152. 29-03-2005
  153. - Added Support for PNG Images. (http://pngdelphi.sourceforge.net/)
  154. To Enable png's use the define pngimage
  155. 22-03-2005
  156. - New Functioninterface added
  157. - Function GetPixel added
  158. 27-11-2004
  159. - Property BuildMipMaps renamed to MipMap
  160. 21-11-2004
  161. - property Name removed.
  162. - BuildMipMaps is now a set of 3 values. None, GluBuildMipmaps and SGIS_generate_mipmap
  163. 22-05-2004
  164. - property name added. Only used in glForms!
  165. 26-11-2003
  166. - property FreeDataAfterGenTexture is now available as default (default = true)
  167. - BuildMipmaps now implemented in TglBitmap1D (i've forgotten it)
  168. - function MoveMemory replaced with function Move (little speed change)
  169. - several calculations stored in variables (little speed change)
  170. 29-09-2003
  171. - property BuildMipsMaps added (default = true)
  172. if BuildMipMaps isn't set GenTextures uses glTexImage[12]D else it use gluBuild[12]dMipmaps
  173. - property FreeDataAfterGenTexture added (default = true)
  174. if FreeDataAfterGenTexture is set the texturedata were deleted after the texture was generated.
  175. - parameter DisableOtherTextureUnits of Bind removed
  176. - parameter FreeDataAfterGeneration of GenTextures removed
  177. 12-09-2003
  178. - TglBitmap dosn't delete data if class was destroyed (fixed)
  179. 09-09-2003
  180. - Bind now enables TextureUnits (by params)
  181. - GenTextures can leave data (by param)
  182. - LoadTextures now optimal
  183. 03-09-2003
  184. - Performance optimization in AddFunc
  185. - procedure Bind moved to subclasses
  186. - Added new Class TglBitmap1D to support real OpenGL 1D Textures
  187. 19-08-2003
  188. - Texturefilter and texturewrap now also as defaults
  189. Minfilter = GL_LINEAR_MIPMAP_LINEAR
  190. Magfilter = GL_LINEAR
  191. Wrap(str) = GL_CLAMP_TO_EDGE
  192. - Added new format tfCompressed to create a compressed texture.
  193. - propertys IsCompressed, TextureSize and IsResident added
  194. IsCompressed and TextureSize only contains data from level 0
  195. 18-08-2003
  196. - Added function AddFunc to add PerPixelEffects to Image
  197. - LoadFromFunc now based on AddFunc
  198. - Invert now based on AddFunc
  199. - SwapColors now based on AddFunc
  200. 16-08-2003
  201. - Added function FlipHorz
  202. 15-08-2003
  203. - Added function LaodFromFunc to create images with function
  204. - Added function FlipVert
  205. - Added internal format RGB(A) if GL_EXT_bgra or OpenGL 1.2 isn't supported
  206. 29-07-2003
  207. - Added Alphafunctions to calculate alpha per function
  208. - Added Alpha from ColorKey using alphafunctions
  209. 28-07-2003
  210. - First full functionally Version of glBitmap
  211. - Support for 24Bit and 32Bit TGA Pictures added
  212. 25-07-2003
  213. - begin of programming
  214. ***********************************************************}
  215. unit glBitmap;
  216. {.$MESSAGE warn 'Hey. I''m the glBitmap.pas and i need to be configured. My master tell me your preferences! ;)'}
  217. // Please uncomment the defines below to configure the glBitmap to your preferences.
  218. // If you have configured the unit you can uncomment the warning above.
  219. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  220. // Preferences ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  221. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  222. // activate to enable build-in OpenGL support with statically linked methods
  223. // use dglOpenGL.pas if not enabled
  224. {$DEFINE GLB_NATIVE_OGL_STATIC}
  225. // activate to enable build-in OpenGL support with dynamically linked methods
  226. // use dglOpenGL.pas if not enabled
  227. {$DEFINE GLB_NATIVE_OGL_DYNAMIC}
  228. // activate to enable the support for SDL_surfaces
  229. {.$DEFINE GLB_SDL}
  230. // activate to enable the support for TBitmap from Delphi (not lazarus)
  231. {.$DEFINE GLB_DELPHI}
  232. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  233. // activate to enable the support of SDL_image to load files. (READ ONLY)
  234. // If you enable SDL_image all other libraries will be ignored!
  235. {.$DEFINE GLB_SDL_IMAGE}
  236. // activate to enable png support with the unit pngimage. You can download it from http://pngdelphi.sourceforge.net/
  237. // if you enable pngimage the libPNG will be ignored
  238. {.$DEFINE GLB_PNGIMAGE}
  239. // activate to use the libPNG http://www.libpng.org/
  240. // You will need an aditional header.
  241. // http://www.opengl24.de/index.php?cat=header&file=libpng
  242. {.$DEFINE GLB_LIB_PNG}
  243. // if you enable delphi jpegs the libJPEG will be ignored
  244. {.$DEFINE GLB_DELPHI_JPEG}
  245. // activateto use the libJPEG http://www.ijg.org/
  246. // You will need an aditional header.
  247. // http://www.opengl24.de/index.php?cat=header&file=libjpeg
  248. {.$DEFINE GLB_LIB_JPEG}
  249. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  250. // PRIVATE: DO not change anything! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  251. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  252. // Delphi Versions
  253. {$IFDEF fpc}
  254. {$MODE Delphi}
  255. {$IFDEF CPUI386}
  256. {$DEFINE CPU386}
  257. {$ASMMODE INTEL}
  258. {$ENDIF}
  259. {$IFNDEF WINDOWS}
  260. {$linklib c}
  261. {$ENDIF}
  262. {$ENDIF}
  263. // Operation System
  264. {$IF DEFINED(WIN32) or DEFINED(WIN64)}
  265. {$DEFINE GLB_WIN}
  266. {$ELSEIF DEFINED(LINUX)}
  267. {$DEFINE GLB_LINUX}
  268. {$IFEND}
  269. // native OpenGL Support
  270. {$IF DEFINED(GLB_NATIVE_OGL_STATIC) OR DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
  271. {$DEFINE GLB_NATIVE_OGL}
  272. {$IFEND}
  273. // checking define combinations
  274. //SDL Image
  275. {$IFDEF GLB_SDL_IMAGE}
  276. {$IFNDEF GLB_SDL}
  277. {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
  278. {$DEFINE GLB_SDL}
  279. {$ENDIF}
  280. {$IFDEF GLB_PNGIMAGE}
  281. {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
  282. {$undef GLB_PNGIMAGE}
  283. {$ENDIF}
  284. {$IFDEF GLB_DELPHI_JPEG}
  285. {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
  286. {$undef GLB_DELPHI_JPEG}
  287. {$ENDIF}
  288. {$IFDEF GLB_LIB_PNG}
  289. {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
  290. {$undef GLB_LIB_PNG}
  291. {$ENDIF}
  292. {$IFDEF GLB_LIB_JPEG}
  293. {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
  294. {$undef GLB_LIB_JPEG}
  295. {$ENDIF}
  296. {$DEFINE GLB_SUPPORT_PNG_READ}
  297. {$DEFINE GLB_SUPPORT_JPEG_READ}
  298. {$ENDIF}
  299. // PNG Image
  300. {$IFDEF GLB_PNGIMAGE}
  301. {$IFDEF GLB_LIB_PNG}
  302. {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
  303. {$undef GLB_LIB_PNG}
  304. {$ENDIF}
  305. {$DEFINE GLB_SUPPORT_PNG_READ}
  306. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  307. {$ENDIF}
  308. // libPNG
  309. {$IFDEF GLB_LIB_PNG}
  310. {$DEFINE GLB_SUPPORT_PNG_READ}
  311. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  312. {$ENDIF}
  313. // JPEG Image
  314. {$IFDEF GLB_DELPHI_JPEG}
  315. {$IFDEF GLB_LIB_JPEG}
  316. {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
  317. {$undef GLB_LIB_JPEG}
  318. {$ENDIF}
  319. {$DEFINE GLB_SUPPORT_JPEG_READ}
  320. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  321. {$ENDIF}
  322. // libJPEG
  323. {$IFDEF GLB_LIB_JPEG}
  324. {$DEFINE GLB_SUPPORT_JPEG_READ}
  325. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  326. {$ENDIF}
  327. // native OpenGL
  328. {$IF DEFINED(GLB_NATIVE_OGL_STATIC) AND DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
  329. {$MESSAGE warn 'GLB_NATIVE_OGL_STATIC will be ignored because you enabled GLB_NATIVE_OGL_DYNAMIC'}
  330. {$ENDIF}
  331. // general options
  332. {$EXTENDEDSYNTAX ON}
  333. {$LONGSTRINGS ON}
  334. {$ALIGN ON}
  335. {$IFNDEF FPC}
  336. {$OPTIMIZATION ON}
  337. {$ENDIF}
  338. interface
  339. uses
  340. {$IFNDEF GLB_NATIVE_OGL} dglOpenGL, {$ENDIF}
  341. {$IF DEFINED(GLB_WIN) AND
  342. DEFINED(GLB_NATIVE_OGL)} windows, {$IFEND}
  343. {$IFDEF GLB_SDL} SDL, {$ENDIF}
  344. {$IFDEF GLB_DELPHI} Dialogs, Graphics, {$ENDIF}
  345. {$IFDEF GLB_SDL_IMAGE} SDL_image, {$ENDIF}
  346. {$IFDEF GLB_PNGIMAGE} pngimage, {$ENDIF}
  347. {$IFDEF GLB_LIB_PNG} libPNG, {$ENDIF}
  348. {$IFDEF GLB_DELPHI_JPEG} JPEG, {$ENDIF}
  349. {$IFDEF GLB_LIB_JPEG} libJPEG, {$ENDIF}
  350. Classes, SysUtils;
  351. {$IFNDEF GLB_DELPHI}
  352. type
  353. HGLRC = Cardinal;
  354. DWORD = Cardinal;
  355. PDWORD = ^DWORD;
  356. TRGBQuad = packed record
  357. rgbBlue: Byte;
  358. rgbGreen: Byte;
  359. rgbRed: Byte;
  360. rgbReserved: Byte;
  361. end;
  362. {$ENDIF}
  363. {$IFDEF GLB_NATIVE_OGL}
  364. const
  365. GL_TRUE = 1;
  366. GL_FALSE = 0;
  367. GL_VERSION = $1F02;
  368. GL_EXTENSIONS = $1F03;
  369. GL_TEXTURE_1D = $0DE0;
  370. GL_TEXTURE_2D = $0DE1;
  371. GL_TEXTURE_RECTANGLE = $84F5;
  372. GL_TEXTURE_WIDTH = $1000;
  373. GL_TEXTURE_HEIGHT = $1001;
  374. GL_TEXTURE_INTERNAL_FORMAT = $1003;
  375. GL_ALPHA = $1906;
  376. GL_ALPHA4 = $803B;
  377. GL_ALPHA8 = $803C;
  378. GL_ALPHA12 = $803D;
  379. GL_ALPHA16 = $803E;
  380. GL_LUMINANCE = $1909;
  381. GL_LUMINANCE4 = $803F;
  382. GL_LUMINANCE8 = $8040;
  383. GL_LUMINANCE12 = $8041;
  384. GL_LUMINANCE16 = $8042;
  385. GL_LUMINANCE_ALPHA = $190A;
  386. GL_LUMINANCE4_ALPHA4 = $8043;
  387. GL_LUMINANCE6_ALPHA2 = $8044;
  388. GL_LUMINANCE8_ALPHA8 = $8045;
  389. GL_LUMINANCE12_ALPHA4 = $8046;
  390. GL_LUMINANCE12_ALPHA12 = $8047;
  391. GL_LUMINANCE16_ALPHA16 = $8048;
  392. GL_RGB = $1907;
  393. GL_BGR = $80E0;
  394. GL_R3_G3_B2 = $2A10;
  395. GL_RGB4 = $804F;
  396. GL_RGB5 = $8050;
  397. GL_RGB565 = $8D62;
  398. GL_RGB8 = $8051;
  399. GL_RGB10 = $8052;
  400. GL_RGB12 = $8053;
  401. GL_RGB16 = $8054;
  402. GL_RGBA = $1908;
  403. GL_BGRA = $80E1;
  404. GL_RGBA2 = $8055;
  405. GL_RGBA4 = $8056;
  406. GL_RGB5_A1 = $8057;
  407. GL_RGBA8 = $8058;
  408. GL_RGB10_A2 = $8059;
  409. GL_RGBA12 = $805A;
  410. GL_RGBA16 = $805B;
  411. GL_DEPTH_COMPONENT = $1902;
  412. GL_DEPTH_COMPONENT16 = $81A5;
  413. GL_DEPTH_COMPONENT24 = $81A6;
  414. GL_DEPTH_COMPONENT32 = $81A7;
  415. GL_COMPRESSED_RGB = $84ED;
  416. GL_COMPRESSED_RGBA = $84EE;
  417. GL_COMPRESSED_RGB_S3TC_DXT1_EXT = $83F0;
  418. GL_COMPRESSED_RGBA_S3TC_DXT1_EXT = $83F1;
  419. GL_COMPRESSED_RGBA_S3TC_DXT3_EXT = $83F2;
  420. GL_COMPRESSED_RGBA_S3TC_DXT5_EXT = $83F3;
  421. GL_UNSIGNED_BYTE = $1401;
  422. GL_UNSIGNED_BYTE_3_3_2 = $8032;
  423. GL_UNSIGNED_BYTE_2_3_3_REV = $8362;
  424. GL_UNSIGNED_SHORT = $1403;
  425. GL_UNSIGNED_SHORT_5_6_5 = $8363;
  426. GL_UNSIGNED_SHORT_4_4_4_4 = $8033;
  427. GL_UNSIGNED_SHORT_5_5_5_1 = $8034;
  428. GL_UNSIGNED_SHORT_5_6_5_REV = $8364;
  429. GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;
  430. GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;
  431. GL_UNSIGNED_INT = $1405;
  432. GL_UNSIGNED_INT_8_8_8_8 = $8035;
  433. GL_UNSIGNED_INT_10_10_10_2 = $8036;
  434. GL_UNSIGNED_INT_8_8_8_8_REV = $8367;
  435. GL_UNSIGNED_INT_2_10_10_10_REV = $8368;
  436. { Texture Filter }
  437. GL_TEXTURE_MAG_FILTER = $2800;
  438. GL_TEXTURE_MIN_FILTER = $2801;
  439. GL_NEAREST = $2600;
  440. GL_NEAREST_MIPMAP_NEAREST = $2700;
  441. GL_NEAREST_MIPMAP_LINEAR = $2702;
  442. GL_LINEAR = $2601;
  443. GL_LINEAR_MIPMAP_NEAREST = $2701;
  444. GL_LINEAR_MIPMAP_LINEAR = $2703;
  445. { Texture Wrap }
  446. GL_TEXTURE_WRAP_S = $2802;
  447. GL_TEXTURE_WRAP_T = $2803;
  448. GL_TEXTURE_WRAP_R = $8072;
  449. GL_CLAMP = $2900;
  450. GL_REPEAT = $2901;
  451. GL_CLAMP_TO_EDGE = $812F;
  452. GL_CLAMP_TO_BORDER = $812D;
  453. GL_MIRRORED_REPEAT = $8370;
  454. { Other }
  455. GL_GENERATE_MIPMAP = $8191;
  456. GL_TEXTURE_BORDER_COLOR = $1004;
  457. GL_MAX_TEXTURE_SIZE = $0D33;
  458. GL_PACK_ALIGNMENT = $0D05;
  459. GL_UNPACK_ALIGNMENT = $0CF5;
  460. GL_TEXTURE_MAX_ANISOTROPY_EXT = $84FE;
  461. GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;
  462. {$ifdef LINUX}
  463. libglu = 'libGLU.so.1';
  464. libopengl = 'libGL.so.1';
  465. {$else}
  466. libglu = 'glu32.dll';
  467. libopengl = 'opengl32.dll';
  468. {$endif}
  469. type
  470. GLboolean = BYTEBOOL;
  471. GLint = Integer;
  472. GLsizei = Integer;
  473. GLuint = Cardinal;
  474. GLfloat = Single;
  475. GLenum = Cardinal;
  476. PGLvoid = Pointer;
  477. PGLboolean = ^GLboolean;
  478. PGLint = ^GLint;
  479. PGLuint = ^GLuint;
  480. PGLfloat = ^GLfloat;
  481. TglCompressedTexImage1D = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  482. TglCompressedTexImage2D = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; height: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  483. TglGetCompressedTexImage = procedure(target: GLenum; level: GLint; img: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  484. {$IF DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
  485. TglEnable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  486. TglDisable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  487. TglGetString = function(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  488. TglGetIntegerv = procedure(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  489. TglTexParameteri = procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  490. TglTexParameterfv = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  491. TglGetTexParameteriv = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  492. TglGetTexParameterfv = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  493. TglGetTexLevelParameteriv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  494. TglGetTexLevelParameterfv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  495. TglGenTextures = procedure(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  496. TglBindTexture = procedure(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  497. TglDeleteTextures = procedure(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  498. TglAreTexturesResident = function(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  499. TglReadPixels = procedure(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  500. TglPixelStorei = procedure(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  501. TglTexImage1D = procedure(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  502. TglTexImage2D = procedure(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; height: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  503. TglGetTexImage = procedure(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  504. TgluBuild1DMipmaps = function(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  505. TgluBuild2DMipmaps = function(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  506. {$IFDEF GLB_LINUX}
  507. TglXGetProcAddress = function(ProcName: PAnsiChar): Pointer; cdecl;
  508. {$ELSE}
  509. TwglGetProcAddress = function (ProcName: PAnsiChar): Pointer; stdcall;
  510. {$ENDIF}
  511. {$ELSEIF DEFINED(GLB_NATIVE_OGL_STATIC)}
  512. procedure glEnable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  513. procedure glDisable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  514. function glGetString(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  515. procedure glGetIntegerv(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  516. procedure glTexParameteri(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  517. procedure glTexParameterfv(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  518. procedure glGetTexParameteriv(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  519. procedure glGetTexParameterfv(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  520. procedure glGetTexLevelParameteriv(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  521. procedure glGetTexLevelParameterfv(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  522. procedure glGenTextures(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  523. procedure glBindTexture(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  524. procedure glDeleteTextures(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  525. function glAreTexturesResident(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  526. procedure glReadPixels(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  527. procedure glPixelStorei(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  528. procedure glTexImage1D(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  529. procedure glTexImage2D(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; height: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  530. procedure glGetTexImage(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  531. function gluBuild1DMipmaps(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
  532. function gluBuild2DMipmaps(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
  533. {$ENDIF}
  534. var
  535. GL_VERSION_1_2,
  536. GL_VERSION_1_3,
  537. GL_VERSION_1_4,
  538. GL_VERSION_2_0,
  539. GL_SGIS_generate_mipmap,
  540. GL_ARB_texture_border_clamp,
  541. GL_ARB_texture_mirrored_repeat,
  542. GL_ARB_texture_rectangle,
  543. GL_ARB_texture_non_power_of_two,
  544. GL_IBM_texture_mirrored_repeat,
  545. GL_NV_texture_rectangle,
  546. GL_EXT_texture_edge_clamp,
  547. GL_EXT_texture_rectangle,
  548. GL_EXT_texture_filter_anisotropic: Boolean;
  549. glCompressedTexImage1D: TglCompressedTexImage1D;
  550. glCompressedTexImage2D: TglCompressedTexImage2D;
  551. glGetCompressedTexImage: TglGetCompressedTexImage;
  552. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  553. glEnable: TglEnable;
  554. glDisable: TglDisable;
  555. glGetString: TglGetString;
  556. glGetIntegerv: TglGetIntegerv;
  557. glTexParameteri: TglTexParameteri;
  558. glTexParameterfv: TglTexParameterfv;
  559. glGetTexParameteriv: TglGetTexParameteriv;
  560. glGetTexParameterfv: TglGetTexParameterfv;
  561. glGetTexLevelParameteriv: TglGetTexLevelParameteriv;
  562. glGetTexLevelParameterfv: TglGetTexLevelParameterfv;
  563. glGenTextures: TglGenTextures;
  564. glBindTexture: TglBindTexture;
  565. glDeleteTextures: TglDeleteTextures;
  566. glAreTexturesResident: TglAreTexturesResident;
  567. glReadPixels: TglReadPixels;
  568. glPixelStorei: TglPixelStorei;
  569. glTexImage1D: TglTexImage1D;
  570. glTexImage2D: TglTexImage2D;
  571. glGetTexImage: TglGetTexImage;
  572. gluBuild1DMipmaps: TgluBuild1DMipmaps;
  573. gluBuild2DMipmaps: TgluBuild2DMipmaps;
  574. {$IF DEFINED(GLB_WIN)}
  575. wglGetProcAddress: TwglGetProcAddress;
  576. {$ELSEIF DEFINED(GLB_LINUX)}
  577. glXGetProcAddress: TglXGetProcAddress;
  578. glXGetProcAddressARB: TglXGetProcAddressARB;
  579. {$ENDIF}
  580. {$ENDIF}
  581. (*
  582. {$IFDEF GLB_DELPHI}
  583. var
  584. gLastContext: HGLRC;
  585. {$ENDIF}
  586. *)
  587. {$ENDIF}
  588. type
  589. ////////////////////////////////////////////////////////////////////////////////////////////////////
  590. EglBitmapException = class(Exception);
  591. EglBitmapSizeToLargeException = class(EglBitmapException);
  592. EglBitmapNonPowerOfTwoException = class(EglBitmapException);
  593. EglBitmapUnsupportedFormatFormat = class(EglBitmapException);
  594. ////////////////////////////////////////////////////////////////////////////////////////////////////
  595. TglBitmapFormat = (
  596. tfEmpty = 0, //must be smallest value!
  597. tfAlpha4,
  598. tfAlpha8,
  599. tfAlpha12,
  600. tfAlpha16,
  601. tfLuminance4,
  602. tfLuminance8,
  603. tfLuminance12,
  604. tfLuminance16,
  605. tfLuminance4Alpha4,
  606. tfLuminance6Alpha2,
  607. tfLuminance8Alpha8,
  608. tfLuminance12Alpha4,
  609. tfLuminance12Alpha12,
  610. tfLuminance16Alpha16,
  611. tfR3G3B2,
  612. tfRGB4,
  613. tfR5G6B5,
  614. tfRGB5,
  615. tfRGB8,
  616. tfRGB10,
  617. tfRGB12,
  618. tfRGB16,
  619. tfRGBA2,
  620. tfRGBA4,
  621. tfRGB5A1,
  622. tfRGBA8,
  623. tfRGB10A2,
  624. tfRGBA12,
  625. tfRGBA16,
  626. tfBGR4,
  627. tfB5G6R5,
  628. tfBGR5,
  629. tfBGR8,
  630. tfBGR10,
  631. tfBGR12,
  632. tfBGR16,
  633. tfBGRA2,
  634. tfBGRA4,
  635. tfBGR5A1,
  636. tfBGRA8,
  637. tfBGR10A2,
  638. tfBGRA12,
  639. tfBGRA16,
  640. tfDepth16,
  641. tfDepth24,
  642. tfDepth32,
  643. tfS3tcDtx1RGBA,
  644. tfS3tcDtx3RGBA,
  645. tfS3tcDtx5RGBA
  646. );
  647. TglBitmapFileType = (
  648. {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG, {$ENDIF}
  649. {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
  650. ftDDS,
  651. ftTGA,
  652. ftBMP);
  653. TglBitmapFileTypes = set of TglBitmapFileType;
  654. TglBitmapMipMap = (
  655. mmNone,
  656. mmMipmap,
  657. mmMipmapGlu);
  658. TglBitmapNormalMapFunc = (
  659. nm4Samples,
  660. nmSobel,
  661. nm3x3,
  662. nm5x5);
  663. ////////////////////////////////////////////////////////////////////////////////////////////////////
  664. TglBitmapColorRec = packed record
  665. case Integer of
  666. 0: (r, g, b, a: Cardinal);
  667. 1: (arr: array[0..3] of Cardinal);
  668. end;
  669. TglBitmapPixelData = packed record
  670. Data, Range: TglBitmapColorRec;
  671. Format: TglBitmapFormat;
  672. end;
  673. PglBitmapPixelData = ^TglBitmapPixelData;
  674. ////////////////////////////////////////////////////////////////////////////////////////////////////
  675. TglBitmapPixelPositionFields = set of (ffX, ffY);
  676. TglBitmapPixelPosition = record
  677. Fields : TglBitmapPixelPositionFields;
  678. X : Word;
  679. Y : Word;
  680. end;
  681. ////////////////////////////////////////////////////////////////////////////////////////////////////
  682. TglBitmap = class;
  683. TglBitmapFunctionRec = record
  684. Sender: TglBitmap;
  685. Size: TglBitmapPixelPosition;
  686. Position: TglBitmapPixelPosition;
  687. Source: TglBitmapPixelData;
  688. Dest: TglBitmapPixelData;
  689. Args: PtrInt;
  690. end;
  691. TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
  692. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  693. TglBitmap = class
  694. protected
  695. fID: GLuint;
  696. fTarget: GLuint;
  697. fAnisotropic: Integer;
  698. fDeleteTextureOnFree: Boolean;
  699. fFreeDataAfterGenTexture: Boolean;
  700. fData: PByte;
  701. fIsResident: Boolean;
  702. fBorderColor: array[0..3] of Single;
  703. fDimension: TglBitmapPixelPosition;
  704. fMipMap: TglBitmapMipMap;
  705. fFormat: TglBitmapFormat;
  706. // Mapping
  707. fPixelSize: Integer;
  708. fRowSize: Integer;
  709. // Filtering
  710. fFilterMin: Cardinal;
  711. fFilterMag: Cardinal;
  712. // TexturWarp
  713. fWrapS: Cardinal;
  714. fWrapT: Cardinal;
  715. fWrapR: Cardinal;
  716. // CustomData
  717. fFilename: String;
  718. fCustomName: String;
  719. fCustomNameW: WideString;
  720. fCustomData: Pointer;
  721. //Getter
  722. function GetWidth: Integer; virtual;
  723. function GetHeight: Integer; virtual;
  724. function GetFileWidth: Integer; virtual;
  725. function GetFileHeight: Integer; virtual;
  726. //Setter
  727. procedure SetCustomData(const aValue: Pointer);
  728. procedure SetCustomName(const aValue: String);
  729. procedure SetCustomNameW(const aValue: WideString);
  730. procedure SetDeleteTextureOnFree(const aValue: Boolean);
  731. procedure SetFormat(const aValue: TglBitmapFormat);
  732. procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
  733. procedure SetID(const aValue: Cardinal);
  734. procedure SetMipMap(const aValue: TglBitmapMipMap);
  735. procedure SetTarget(const aValue: Cardinal);
  736. procedure SetAnisotropic(const aValue: Integer);
  737. procedure CreateID;
  738. procedure SetupParameters(var aBuildWithGlu: Boolean);
  739. procedure SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
  740. const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;
  741. procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
  742. function FlipHorz: Boolean; virtual;
  743. function FlipVert: Boolean; virtual;
  744. property Width: Integer read GetWidth;
  745. property Height: Integer read GetHeight;
  746. property FileWidth: Integer read GetFileWidth;
  747. property FileHeight: Integer read GetFileHeight;
  748. public
  749. //Properties
  750. property ID: Cardinal read fID write SetID;
  751. property Target: Cardinal read fTarget write SetTarget;
  752. property Format: TglBitmapFormat read fFormat write SetFormat;
  753. property MipMap: TglBitmapMipMap read fMipMap write SetMipMap;
  754. property Anisotropic: Integer read fAnisotropic write SetAnisotropic;
  755. property Filename: String read fFilename;
  756. property CustomName: String read fCustomName write SetCustomName;
  757. property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
  758. property CustomData: Pointer read fCustomData write SetCustomData;
  759. property DeleteTextureOnFree: Boolean read fDeleteTextureOnFree write SetDeleteTextureOnFree;
  760. property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
  761. property Dimension: TglBitmapPixelPosition read fDimension;
  762. property Data: PByte read fData;
  763. property IsResident: Boolean read fIsResident;
  764. procedure AfterConstruction; override;
  765. procedure BeforeDestruction; override;
  766. //Load
  767. procedure LoadFromFile(const aFilename: String);
  768. procedure LoadFromStream(const aStream: TStream); virtual;
  769. procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  770. const aFormat: TglBitmapFormat; const aArgs: PtrInt = 0);
  771. {$IFDEF GLB_DELPHI}
  772. procedure LoadFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil);
  773. procedure LoadFromResourceID(const sInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  774. {$ENDIF}
  775. //Save
  776. procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  777. procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
  778. //Convert
  779. function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: PtrInt = 0): Boolean; overload;
  780. function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  781. const aFormat: TglBitmapFormat; const aArgs: PtrInt = 0): Boolean; overload;
  782. public
  783. //Alpha & Co
  784. {$IFDEF GLB_SDL}
  785. function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  786. function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  787. function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  788. function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
  789. const aArgs: PtrInt = 0): Boolean;
  790. {$ENDIF}
  791. {$IFDEF GLB_DELPHI}
  792. function AssignToBitmap(const aBitmap: TBitmap): Boolean;
  793. function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  794. function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  795. function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
  796. const aArgs: PtrInt = 0): Boolean;
  797. function AddAlphaFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil;
  798. const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;
  799. function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  800. const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;
  801. {$ENDIF}
  802. function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: PtrInt = 0): Boolean; virtual;
  803. function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;
  804. function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;
  805. function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;
  806. function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
  807. function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
  808. function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
  809. function AddAlphaFromValue(const aAlpha: Byte): Boolean;
  810. function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  811. function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  812. function RemoveAlpha: Boolean; virtual;
  813. public
  814. //Common
  815. function Clone: TglBitmap;
  816. function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
  817. procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
  818. procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  819. procedure FreeData;
  820. //ColorFill
  821. procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
  822. procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
  823. procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
  824. //TexParameters
  825. procedure SetFilter(const aMin, aMag: Cardinal);
  826. procedure SetWrap(
  827. const S: Cardinal = GL_CLAMP_TO_EDGE;
  828. const T: Cardinal = GL_CLAMP_TO_EDGE;
  829. const R: Cardinal = GL_CLAMP_TO_EDGE);
  830. procedure GetPixel(const aPos: TglBitmapPixelPosition; var aPixel: TglBitmapPixelData); virtual;
  831. procedure SetPixel(const aPos: TglBitmapPixelPosition; const aPixel: TglBitmapPixelData); virtual;
  832. procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
  833. procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
  834. //Constructors
  835. constructor Create; overload;
  836. constructor Create(const aFileName: String); overload;
  837. constructor Create(const aStream: TStream); overload;
  838. constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat); overload;
  839. constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: PtrInt = 0); overload;
  840. {$IFDEF GLB_DELPHI}
  841. constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
  842. constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
  843. {$ENDIF}
  844. private
  845. {$IFDEF GLB_SUPPORT_PNG_READ}
  846. function LoadPNG(const aStream: TStream): Boolean; virtual;
  847. procedure SavePNG(const aStream: TStream); virtual;
  848. {$ENDIF}
  849. {$IFDEF GLB_SUPPORT_JPEG_READ}
  850. function LoadJPEG(const aStream: TStream): Boolean; virtual;
  851. procedure SaveJPEG(const aStream: TStream); virtual;
  852. {$ENDIF}
  853. function LoadBMP(const aStream: TStream): Boolean; virtual;
  854. procedure SaveBMP(const aStream: TStream); virtual;
  855. function LoadTGA(const aStream: TStream): Boolean; virtual;
  856. procedure SaveTGA(const aStream: TStream); virtual;
  857. function LoadDDS(const aStream: TStream): Boolean; virtual;
  858. procedure SaveDDS(const aStream: TStream); virtual;
  859. end;
  860. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  861. TglBitmap2D = class(TglBitmap)
  862. protected
  863. // Bildeinstellungen
  864. fLines: array of PByte;
  865. (* TODO
  866. procedure GetDXTColorBlock(pData: pByte; relX, relY: Integer; var Pixel: TglBitmapPixelData);
  867. procedure GetPixel2DDXT1(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
  868. procedure GetPixel2DDXT3(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
  869. procedure GetPixel2DDXT5(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
  870. procedure GetPixel2DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
  871. procedure SetPixel2DUnmap(const Pos: TglBitmapPixelPosition; const Pixel: TglBitmapPixelData);
  872. *)
  873. function GetScanline(const aIndex: Integer): Pointer;
  874. procedure SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
  875. const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
  876. procedure UploadData(const aTarget: Cardinal; const aBuildWithGlu: Boolean);
  877. public
  878. property Width;
  879. property Height;
  880. property Scanline[const aIndex: Integer]: Pointer read GetScanline;
  881. procedure AfterConstruction; override;
  882. procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  883. procedure GetDataFromTexture;
  884. procedure GenTexture(const aTestTextureSize: Boolean = true); override;
  885. function FlipHorz: Boolean; override;
  886. function FlipVert: Boolean; override;
  887. procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
  888. const aScale: Single = 2; const aUseAlpha: Boolean = false);
  889. end;
  890. (* TODO
  891. TglBitmapCubeMap = class(TglBitmap2D)
  892. protected
  893. fGenMode: Integer;
  894. // Hide GenTexture
  895. procedure GenTexture(TestTextureSize: Boolean = true); reintroduce;
  896. public
  897. procedure AfterConstruction; override;
  898. procedure GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean = true);
  899. procedure Unbind(DisableTexCoordsGen: Boolean = true; DisableTextureUnit: Boolean = true); reintroduce; virtual;
  900. procedure Bind(EnableTexCoordsGen: Boolean = true; EnableTextureUnit: Boolean = true); reintroduce; virtual;
  901. end;
  902. TglBitmapNormalMap = class(TglBitmapCubeMap)
  903. public
  904. procedure AfterConstruction; override;
  905. procedure GenerateNormalMap(Size: Integer = 32; TestTextureSize: Boolean = true);
  906. end;
  907. TglBitmap1D = class(TglBitmap)
  908. protected
  909. procedure GetPixel1DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
  910. procedure SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width: Integer = -1; Height: Integer = -1); override;
  911. procedure UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
  912. public
  913. // propertys
  914. property Width;
  915. procedure AfterConstruction; override;
  916. // Other
  917. function FlipHorz: Boolean; override;
  918. // Generation
  919. procedure GenTexture(TestTextureSize: Boolean = true); override;
  920. end;
  921. *)
  922. const
  923. NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
  924. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  925. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  926. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  927. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  928. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  929. procedure glBitmapSetDefaultWrap(
  930. const S: Cardinal = GL_CLAMP_TO_EDGE;
  931. const T: Cardinal = GL_CLAMP_TO_EDGE;
  932. const R: Cardinal = GL_CLAMP_TO_EDGE);
  933. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  934. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  935. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  936. function glBitmapGetDefaultFormat: TglBitmapFormat;
  937. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  938. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  939. function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
  940. function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
  941. function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
  942. var
  943. glBitmapDefaultDeleteTextureOnFree: Boolean;
  944. glBitmapDefaultFreeDataAfterGenTextures: Boolean;
  945. glBitmapDefaultFormat: TglBitmapFormat;
  946. glBitmapDefaultMipmap: TglBitmapMipMap;
  947. glBitmapDefaultFilterMin: Cardinal;
  948. glBitmapDefaultFilterMag: Cardinal;
  949. glBitmapDefaultWrapS: Cardinal;
  950. glBitmapDefaultWrapT: Cardinal;
  951. glBitmapDefaultWrapR: Cardinal;
  952. {$IFDEF GLB_DELPHI}
  953. function CreateGrayPalette: HPALETTE;
  954. {$ENDIF}
  955. implementation
  956. (* TODO
  957. function FormatIsCompressed(Format: TglBitmapInternalFormat): boolean;
  958. function FormatIsUncompressed(Format: TglBitmapInternalFormat): boolean;
  959. function LoadTexture(Filename: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal = 0{$ENDIF}): Boolean;
  960. function LoadCubeMap(PositiveX, NegativeX, PositiveY, NegativeY, PositiveZ, NegativeZ: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal = 0{$ENDIF}): Boolean;
  961. function LoadNormalMap(Size: Integer; var Texture: Cardinal): Boolean;
  962. *)
  963. uses
  964. Math, syncobjs;
  965. type
  966. ////////////////////////////////////////////////////////////////////////////////////////////////////
  967. TShiftRec = packed record
  968. case Integer of
  969. 0: (r, g, b, a: Byte);
  970. 1: (arr: array[0..3] of Byte);
  971. end;
  972. TFormatDescriptor = class(TObject)
  973. private
  974. function GetRedMask: UInt64;
  975. function GetGreenMask: UInt64;
  976. function GetBlueMask: UInt64;
  977. function GetAlphaMask: UInt64;
  978. protected
  979. fFormat: TglBitmapFormat;
  980. fWithAlpha: TglBitmapFormat;
  981. fWithoutAlpha: TglBitmapFormat;
  982. fRGBInverted: TglBitmapFormat;
  983. fUncompressed: TglBitmapFormat;
  984. fPixelSize: Single;
  985. fIsCompressed: Boolean;
  986. fRange: TglBitmapColorRec;
  987. fShift: TShiftRec;
  988. fglFormat: Cardinal;
  989. fglInternalFormat: Cardinal;
  990. fglDataFormat: Cardinal;
  991. function GetComponents: Integer; virtual;
  992. public
  993. property Format: TglBitmapFormat read fFormat;
  994. property WithAlpha: TglBitmapFormat read fWithAlpha;
  995. property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;
  996. property RGBInverted: TglBitmapFormat read fRGBInverted;
  997. property Components: Integer read GetComponents;
  998. property PixelSize: Single read fPixelSize;
  999. property IsCompressed: Boolean read fIsCompressed;
  1000. property glFormat: Cardinal read fglFormat;
  1001. property glInternalFormat: Cardinal read fglInternalFormat;
  1002. property glDataFormat: Cardinal read fglDataFormat;
  1003. property Range: TglBitmapColorRec read fRange;
  1004. property Shift: TShiftRec read fShift;
  1005. property RedMask: UInt64 read GetRedMask;
  1006. property GreenMask: UInt64 read GetGreenMask;
  1007. property BlueMask: UInt64 read GetBlueMask;
  1008. property AlphaMask: UInt64 read GetAlphaMask;
  1009. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
  1010. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
  1011. function GetSize(const aSize: TglBitmapPixelPosition): Integer; virtual; overload;
  1012. function GetSize(const aWidth, aHeight: Integer): Integer; virtual; overload;
  1013. function CreateMappingData: Pointer; virtual;
  1014. procedure FreeMappingData(var aMappingData: Pointer); virtual;
  1015. function IsEmpty: Boolean; virtual;
  1016. function HasAlpha: Boolean; virtual;
  1017. function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: UInt64): Boolean; virtual;
  1018. procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
  1019. constructor Create; virtual;
  1020. public
  1021. class procedure Init;
  1022. class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1023. class function GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1024. class procedure Clear;
  1025. class procedure Finalize;
  1026. end;
  1027. TFormatDescriptorClass = class of TFormatDescriptor;
  1028. TfdEmpty = class(TFormatDescriptor);
  1029. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1030. TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1031. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1032. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1033. constructor Create; override;
  1034. end;
  1035. TfdLuminance_UB1 = class(TFormatDescriptor) //1* unsigned byte
  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. TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1041. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1042. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1043. constructor Create; override;
  1044. end;
  1045. TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte
  1046. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1047. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1048. constructor Create; override;
  1049. end;
  1050. TfdRGB_UB3 = class(TFormatDescriptor) //3* unsigned byte
  1051. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1052. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1053. constructor Create; override;
  1054. end;
  1055. TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
  1056. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1057. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1058. constructor Create; override;
  1059. end;
  1060. TfdRGBA_UB4 = class(TfdRGB_UB3) //4* unsigned byte
  1061. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1062. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1063. constructor Create; override;
  1064. end;
  1065. TfdBGRA_UB4 = class(TfdBGR_UB3) //4* unsigned byte (inverse)
  1066. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1067. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1068. constructor Create; override;
  1069. end;
  1070. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1071. TfdAlpha_US1 = class(TFormatDescriptor) //1* unsigned short
  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. TfdLuminance_US1 = class(TFormatDescriptor) //1* unsigned short
  1077. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1078. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1079. constructor Create; override;
  1080. end;
  1081. TfdUniversal_US1 = class(TFormatDescriptor) //1* unsigned short
  1082. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1083. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1084. constructor Create; override;
  1085. end;
  1086. TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short
  1087. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1088. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1089. constructor Create; override;
  1090. end;
  1091. TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short
  1092. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1093. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1094. constructor Create; override;
  1095. end;
  1096. TfdRGB_US3 = class(TFormatDescriptor) //3* unsigned short
  1097. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1098. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1099. constructor Create; override;
  1100. end;
  1101. TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)
  1102. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1103. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1104. constructor Create; override;
  1105. end;
  1106. TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
  1107. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1108. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1109. constructor Create; override;
  1110. end;
  1111. TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
  1112. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1113. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1114. constructor Create; override;
  1115. end;
  1116. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1117. TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int
  1118. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1119. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1120. constructor Create; override;
  1121. end;
  1122. TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int
  1123. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1124. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1125. constructor Create; override;
  1126. end;
  1127. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1128. TfdAlpha4 = class(TfdAlpha_UB1)
  1129. constructor Create; override;
  1130. end;
  1131. TfdAlpha8 = class(TfdAlpha_UB1)
  1132. constructor Create; override;
  1133. end;
  1134. TfdAlpha12 = class(TfdAlpha_US1)
  1135. constructor Create; override;
  1136. end;
  1137. TfdAlpha16 = class(TfdAlpha_US1)
  1138. constructor Create; override;
  1139. end;
  1140. TfdLuminance4 = class(TfdLuminance_UB1)
  1141. constructor Create; override;
  1142. end;
  1143. TfdLuminance8 = class(TfdLuminance_UB1)
  1144. constructor Create; override;
  1145. end;
  1146. TfdLuminance12 = class(TfdLuminance_US1)
  1147. constructor Create; override;
  1148. end;
  1149. TfdLuminance16 = class(TfdLuminance_US1)
  1150. constructor Create; override;
  1151. end;
  1152. TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
  1153. constructor Create; override;
  1154. end;
  1155. TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
  1156. constructor Create; override;
  1157. end;
  1158. TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
  1159. constructor Create; override;
  1160. end;
  1161. TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
  1162. constructor Create; override;
  1163. end;
  1164. TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)
  1165. constructor Create; override;
  1166. end;
  1167. TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
  1168. constructor Create; override;
  1169. end;
  1170. TfdR3G3B2 = class(TfdUniversal_UB1)
  1171. constructor Create; override;
  1172. end;
  1173. TfdRGB4 = class(TfdUniversal_US1)
  1174. constructor Create; override;
  1175. end;
  1176. TfdR5G6B5 = class(TfdUniversal_US1)
  1177. constructor Create; override;
  1178. end;
  1179. TfdRGB5 = class(TfdUniversal_US1)
  1180. constructor Create; override;
  1181. end;
  1182. TfdRGB8 = class(TfdRGB_UB3)
  1183. constructor Create; override;
  1184. end;
  1185. TfdRGB10 = class(TfdUniversal_UI1)
  1186. constructor Create; override;
  1187. end;
  1188. TfdRGB12 = class(TfdRGB_US3)
  1189. constructor Create; override;
  1190. end;
  1191. TfdRGB16 = class(TfdRGB_US3)
  1192. constructor Create; override;
  1193. end;
  1194. TfdRGBA2 = class(TfdRGBA_UB4)
  1195. constructor Create; override;
  1196. end;
  1197. TfdRGBA4 = class(TfdUniversal_US1)
  1198. constructor Create; override;
  1199. end;
  1200. TfdRGB5A1 = class(TfdUniversal_US1)
  1201. constructor Create; override;
  1202. end;
  1203. TfdRGBA8 = class(TfdRGBA_UB4)
  1204. constructor Create; override;
  1205. end;
  1206. TfdRGB10A2 = class(TfdUniversal_UI1)
  1207. constructor Create; override;
  1208. end;
  1209. TfdRGBA12 = class(TfdRGBA_US4)
  1210. constructor Create; override;
  1211. end;
  1212. TfdRGBA16 = class(TfdRGBA_US4)
  1213. constructor Create; override;
  1214. end;
  1215. TfdBGR4 = class(TfdUniversal_US1)
  1216. constructor Create; override;
  1217. end;
  1218. TfdB5G6R5 = class(TfdUniversal_US1)
  1219. constructor Create; override;
  1220. end;
  1221. TfdBGR5 = class(TfdUniversal_US1)
  1222. constructor Create; override;
  1223. end;
  1224. TfdBGR8 = class(TfdBGR_UB3)
  1225. constructor Create; override;
  1226. end;
  1227. TfdBGR10 = class(TfdUniversal_UI1)
  1228. constructor Create; override;
  1229. end;
  1230. TfdBGR12 = class(TfdBGR_US3)
  1231. constructor Create; override;
  1232. end;
  1233. TfdBGR16 = class(TfdBGR_US3)
  1234. constructor Create; override;
  1235. end;
  1236. TfdBGRA2 = class(TfdBGRA_UB4)
  1237. constructor Create; override;
  1238. end;
  1239. TfdBGRA4 = class(TfdUniversal_US1)
  1240. constructor Create; override;
  1241. end;
  1242. TfdBGR5A1 = class(TfdUniversal_US1)
  1243. constructor Create; override;
  1244. end;
  1245. TfdBGRA8 = class(TfdBGRA_UB4)
  1246. constructor Create; override;
  1247. end;
  1248. TfdBGR10A2 = class(TfdUniversal_UI1)
  1249. constructor Create; override;
  1250. end;
  1251. TfdBGRA12 = class(TfdBGRA_US4)
  1252. constructor Create; override;
  1253. end;
  1254. TfdBGRA16 = class(TfdBGRA_US4)
  1255. constructor Create; override;
  1256. end;
  1257. TfdDepth16 = class(TfdDepth_US1)
  1258. constructor Create; override;
  1259. end;
  1260. TfdDepth24 = class(TfdDepth_UI1)
  1261. constructor Create; override;
  1262. end;
  1263. TfdDepth32 = class(TfdDepth_UI1)
  1264. constructor Create; override;
  1265. end;
  1266. TfdS3tcDtx1RGBA = class(TFormatDescriptor)
  1267. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1268. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1269. constructor Create; override;
  1270. end;
  1271. TfdS3tcDtx3RGBA = class(TFormatDescriptor)
  1272. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1273. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1274. constructor Create; override;
  1275. end;
  1276. TfdS3tcDtx5RGBA = class(TFormatDescriptor)
  1277. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1278. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1279. constructor Create; override;
  1280. end;
  1281. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1282. TbmpBitfieldFormat = class(TFormatDescriptor)
  1283. private
  1284. procedure SetRedMask (const aValue: UInt64);
  1285. procedure SetGreenMask(const aValue: UInt64);
  1286. procedure SetBlueMask (const aValue: UInt64);
  1287. procedure SetAlphaMask(const aValue: UInt64);
  1288. procedure Update(aMask: UInt64; out aRange: Cardinal; out aShift: Byte);
  1289. public
  1290. property RedMask: UInt64 read GetRedMask write SetRedMask;
  1291. property GreenMask: UInt64 read GetGreenMask write SetGreenMask;
  1292. property BlueMask: UInt64 read GetBlueMask write SetBlueMask;
  1293. property AlphaMask: UInt64 read GetAlphaMask write SetAlphaMask;
  1294. property PixelSize: Single read fPixelSize write fPixelSize;
  1295. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1296. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1297. end;
  1298. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1299. TbmpColorTableEnty = packed record
  1300. b, g, r, a: Byte;
  1301. end;
  1302. TbmpColorTable = array of TbmpColorTableEnty;
  1303. TbmpColorTableFormat = class(TFormatDescriptor)
  1304. private
  1305. fColorTable: TbmpColorTable;
  1306. public
  1307. property PixelSize: Single read fPixelSize write fPixelSize;
  1308. property ColorTable: TbmpColorTable read fColorTable write fColorTable;
  1309. property Range: TglBitmapColorRec read fRange write fRange;
  1310. property Shift: TShiftRec read fShift write fShift;
  1311. property Format: TglBitmapFormat read fFormat write fFormat;
  1312. procedure CreateColorTable;
  1313. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1314. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1315. destructor Destroy; override;
  1316. end;
  1317. const
  1318. LUMINANCE_WEIGHT_R = 0.30;
  1319. LUMINANCE_WEIGHT_G = 0.59;
  1320. LUMINANCE_WEIGHT_B = 0.11;
  1321. ALPHA_WEIGHT_R = 0.30;
  1322. ALPHA_WEIGHT_G = 0.59;
  1323. ALPHA_WEIGHT_B = 0.11;
  1324. DEPTH_WEIGHT_R = 0.333333333;
  1325. DEPTH_WEIGHT_G = 0.333333333;
  1326. DEPTH_WEIGHT_B = 0.333333333;
  1327. UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
  1328. FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
  1329. TfdEmpty,
  1330. TfdAlpha4,
  1331. TfdAlpha8,
  1332. TfdAlpha12,
  1333. TfdAlpha16,
  1334. TfdLuminance4,
  1335. TfdLuminance8,
  1336. TfdLuminance12,
  1337. TfdLuminance16,
  1338. TfdLuminance4Alpha4,
  1339. TfdLuminance6Alpha2,
  1340. TfdLuminance8Alpha8,
  1341. TfdLuminance12Alpha4,
  1342. TfdLuminance12Alpha12,
  1343. TfdLuminance16Alpha16,
  1344. TfdR3G3B2,
  1345. TfdRGB4,
  1346. TfdR5G6B5,
  1347. TfdRGB5,
  1348. TfdRGB8,
  1349. TfdRGB10,
  1350. TfdRGB12,
  1351. TfdRGB16,
  1352. TfdRGBA2,
  1353. TfdRGBA4,
  1354. TfdRGB5A1,
  1355. TfdRGBA8,
  1356. TfdRGB10A2,
  1357. TfdRGBA12,
  1358. TfdRGBA16,
  1359. TfdBGR4,
  1360. TfdB5G6R5,
  1361. TfdBGR5,
  1362. TfdBGR8,
  1363. TfdBGR10,
  1364. TfdBGR12,
  1365. TfdBGR16,
  1366. TfdBGRA2,
  1367. TfdBGRA4,
  1368. TfdBGR5A1,
  1369. TfdBGRA8,
  1370. TfdBGR10A2,
  1371. TfdBGRA12,
  1372. TfdBGRA16,
  1373. TfdDepth16,
  1374. TfdDepth24,
  1375. TfdDepth32,
  1376. TfdS3tcDtx1RGBA,
  1377. TfdS3tcDtx3RGBA,
  1378. TfdS3tcDtx5RGBA
  1379. );
  1380. var
  1381. FormatDescriptorCS: TCriticalSection;
  1382. FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
  1383. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1384. function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
  1385. begin
  1386. result.Fields := [];
  1387. if X >= 0 then
  1388. result.Fields := result.Fields + [ffX];
  1389. if Y >= 0 then
  1390. result.Fields := result.Fields + [ffY];
  1391. result.X := Max(0, X);
  1392. result.Y := Max(0, Y);
  1393. end;
  1394. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1395. function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
  1396. begin
  1397. result.r := r;
  1398. result.g := g;
  1399. result.b := b;
  1400. result.a := a;
  1401. end;
  1402. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1403. function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
  1404. var
  1405. i: Integer;
  1406. begin
  1407. result := false;
  1408. for i := 0 to high(r1.arr) do
  1409. if (r1.arr[i] <> r2.arr[i]) then
  1410. exit;
  1411. result := true;
  1412. end;
  1413. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1414. function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
  1415. begin
  1416. result.r := r;
  1417. result.g := g;
  1418. result.b := b;
  1419. result.a := a;
  1420. end;
  1421. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1422. function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
  1423. begin
  1424. result := [];
  1425. if (aFormat in [
  1426. //4 bbp
  1427. tfLuminance4,
  1428. //8bpp
  1429. tfR3G3B2, tfLuminance8,
  1430. //16bpp
  1431. tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
  1432. tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,
  1433. //24bpp
  1434. tfBGR8, tfRGB8,
  1435. //32bpp
  1436. tfRGB10, tfRGB10A2, tfRGBA8,
  1437. tfBGR10, tfBGR10A2, tfBGRA8]) then
  1438. result := result + [ftBMP];
  1439. if (aFormat in [
  1440. //8 bpp
  1441. tfLuminance8, tfAlpha8,
  1442. //16 bpp
  1443. tfLuminance16, tfLuminance8Alpha8,
  1444. tfRGB5, tfRGB5A1, tfRGBA4,
  1445. tfBGR5, tfBGR5A1, tfBGRA4,
  1446. //24 bpp
  1447. tfRGB8, tfBGR8,
  1448. //32 bpp
  1449. tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
  1450. result := result + [ftTGA];
  1451. if (aFormat in [
  1452. //8 bpp
  1453. tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,
  1454. tfR3G3B2, tfRGBA2, tfBGRA2,
  1455. //16 bpp
  1456. tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,
  1457. tfRGB4, tfR5G6B5, tfRGB5, tfRGBA4, tfRGB5A1,
  1458. tfBGR4, tfB5G6R5, tfBGR5, tfBGRA4, tfBGR5A1,
  1459. //24 bpp
  1460. tfRGB8, tfBGR8,
  1461. //32 bbp
  1462. tfLuminance16Alpha16,
  1463. tfRGBA8, tfRGB10A2,
  1464. tfBGRA8, tfBGR10A2,
  1465. //compressed
  1466. tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then
  1467. result := result + [ftDDS];
  1468. (* TODO
  1469. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  1470. if aFormat in [
  1471. tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
  1472. tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
  1473. tfuminance4Alpha4, tfLuminance6Alpha2, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16,
  1474. tfR3G3B2, tfRGB4, tfRGB5, tfRGB8, tfRGB10, tfRGB12, tfRGB16,
  1475. tfRGBA2, tfRGBA4, tfRGB5A1, tfRGBA8, tfRGB10A2, tfRGBA12, tfRGBA16,
  1476. tfDepth16, tfDepth24, tfDepth32]
  1477. then
  1478. result := result + [ftPNG];
  1479. {$ENDIF}
  1480. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  1481. if Format in [
  1482. tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
  1483. tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
  1484. tfR3G3B2, tfRGB4, tfRGB5, tfRGB8, tfRGB10, tfRGB12, tfRGB16,
  1485. tfDepth16, tfDepth24, tfDepth32]
  1486. then
  1487. result := result + [ftJPEG];
  1488. {$ENDIF}
  1489. if aFormat in [
  1490. tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
  1491. tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
  1492. tfuminance4Alpha4, tfLuminance6Alpha2, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16,
  1493. tfR3G3B2, tfRGB4, tfRGB5, tfRGB8, tfRGB10, tfRGB12, tfRGB16,
  1494. tfRGBA2, tfRGBA4, tfRGB5A1, tfRGBA8, tfRGB10A2, tfRGBA12, tfRGBA16,
  1495. tfDepth16, tfDepth24, tfDepth32]
  1496. then
  1497. result := result + [ftDDS, ftTGA, ftBMP];
  1498. *)
  1499. end;
  1500. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1501. function IsPowerOfTwo(aNumber: Integer): Boolean;
  1502. begin
  1503. while (aNumber and 1) = 0 do
  1504. aNumber := aNumber shr 1;
  1505. result := aNumber = 1;
  1506. end;
  1507. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1508. function GetTopMostBit(aBitSet: UInt64): Integer;
  1509. begin
  1510. result := 0;
  1511. while aBitSet > 0 do begin
  1512. inc(result);
  1513. aBitSet := aBitSet shr 1;
  1514. end;
  1515. end;
  1516. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1517. function CountSetBits(aBitSet: UInt64): Integer;
  1518. begin
  1519. result := 0;
  1520. while aBitSet > 0 do begin
  1521. if (aBitSet and 1) = 1 then
  1522. inc(result);
  1523. aBitSet := aBitSet shr 1;
  1524. end;
  1525. end;
  1526. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1527. function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1528. begin
  1529. result := Trunc(
  1530. LUMINANCE_WEIGHT_R * aPixel.Data.r +
  1531. LUMINANCE_WEIGHT_G * aPixel.Data.g +
  1532. LUMINANCE_WEIGHT_B * aPixel.Data.b);
  1533. end;
  1534. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1535. function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1536. begin
  1537. result := Trunc(
  1538. DEPTH_WEIGHT_R * aPixel.Data.r +
  1539. DEPTH_WEIGHT_G * aPixel.Data.g +
  1540. DEPTH_WEIGHT_B * aPixel.Data.b);
  1541. end;
  1542. {$IFDEF GLB_NATIVE_OGL}
  1543. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1544. //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1545. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1546. var
  1547. GL_LibHandle: Pointer = nil;
  1548. function glbGetProcAddress(aProcName: PChar; aLibHandle: Pointer = nil): Pointer;
  1549. begin
  1550. result := nil;
  1551. if not Assigned(aLibHandle) then
  1552. aLibHandle := GL_LibHandle;
  1553. {$IF DEFINED(GLB_WIN)}
  1554. result := GetProcAddress(HMODULE(aLibHandle), aProcName);
  1555. if Assigned(result) then
  1556. exit;
  1557. if Assigned(wglGetProcAddress) then
  1558. result := wglGetProcAddress(aProcName);
  1559. {$ELSEIF DEFINED(GLB_LINUX)}
  1560. if Assigned(glXGetProcAddress) then begin
  1561. result := glXGetProcAddress(aProcName);
  1562. if Assigned(result) then
  1563. exit;
  1564. end;
  1565. if Assigned(glXGetProcAddressARB) then begin
  1566. result := glXGetProcAddressARB(aProcName);
  1567. if Assigned(result) then
  1568. exit;
  1569. end;
  1570. result := dlsym(aLibHandle, aProcName);
  1571. {$ENDIF}
  1572. if not Assigned(result) then
  1573. raise EglBitmapException.Create('unable to load procedure form library: ' + aProcName);
  1574. end;
  1575. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  1576. var
  1577. GLU_LibHandle: Pointer = nil;
  1578. OpenGLInitialized: Boolean;
  1579. InitOpenGLCS: TCriticalSection;
  1580. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1581. procedure glbInitOpenGL;
  1582. ////////////////////////////////////////////////////////////////////////////////
  1583. function glbLoadLibrary(const aName: PChar): Pointer;
  1584. begin
  1585. {$IF DEFINED(GLB_WIN)}
  1586. result := Pointer(LoadLibrary(aName));
  1587. {$ELSEIF DEFINED(GLB_LINUX)}
  1588. result := dlopen(Name, RTLD_LAZY);
  1589. {$ELSE}
  1590. result := nil;
  1591. {$ENDIF}
  1592. end;
  1593. ////////////////////////////////////////////////////////////////////////////////
  1594. function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
  1595. begin
  1596. result := false;
  1597. if not Assigned(aLibHandle) then
  1598. exit;
  1599. {$IF DEFINED(GLB_WIN)}
  1600. Result := FreeLibrary(HINST(aLibHandle));
  1601. {$ELSEIF DEFINED(GLB_LINUX)}
  1602. Result := dlclose(aLibHandle) = 0;
  1603. {$ENDIF}
  1604. end;
  1605. var
  1606. p: Pointer;
  1607. begin
  1608. if Assigned(GL_LibHandle) then
  1609. glbFreeLibrary(GL_LibHandle);
  1610. if Assigned(GLU_LibHandle) then
  1611. glbFreeLibrary(GLU_LibHandle);
  1612. GL_LibHandle := glbLoadLibrary(libopengl);
  1613. if not Assigned(GL_LibHandle) then
  1614. raise EglBitmapException.Create('unable to load library: ' + libopengl);
  1615. GLU_LibHandle := glbLoadLibrary(libglu);
  1616. if not Assigned(GLU_LibHandle) then
  1617. raise EglBitmapException.Create('unable to load library: ' + libglu);
  1618. try
  1619. {$IF DEFINED(GLB_WIN)}
  1620. wglGetProcAddress := glbGetProcAddress('wglGetProcAddress');
  1621. {$ELSEIF DEFINED(GLB_LINUX)}
  1622. glXGetProcAddress := glbGetProcAddress('glXGetProcAddress');
  1623. glXGetProcAddressARB := dglGetProcAddress('glXGetProcAddressARB');
  1624. {$ENDIF}
  1625. glEnable := glbGetProcAddress('glEnable');
  1626. glDisable := glbGetProcAddress('glDisable');
  1627. glGetString := glbGetProcAddress('glGetString');
  1628. glGetIntegerv := glbGetProcAddress('glGetIntegerv');
  1629. glTexParameteri := glbGetProcAddress('glTexParameteri');
  1630. glTexParameterfv := glbGetProcAddress('glTexParameterfv');
  1631. glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
  1632. glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
  1633. glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
  1634. glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
  1635. glGenTextures := glbGetProcAddress('glGenTextures');
  1636. glBindTexture := glbGetProcAddress('glBindTexture');
  1637. glDeleteTextures := glbGetProcAddress('glDeleteTextures');
  1638. glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
  1639. glReadPixels := glbGetProcAddress('glReadPixels');
  1640. glPixelStorei := glbGetProcAddress('glPixelStorei');
  1641. glTexImage1D := glbGetProcAddress('glTexImage1D');
  1642. glTexImage2D := glbGetProcAddress('glTexImage2D');
  1643. glGetTexImage := glbGetProcAddress('glGetTexImage');
  1644. gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
  1645. gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
  1646. finally
  1647. glbFreeLibrary(GL_LibHandle);
  1648. glbFreeLibrary(GLU_LibHandle);
  1649. end;
  1650. end;
  1651. {$ENDIF}
  1652. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1653. procedure glbReadOpenGLExtensions;
  1654. var
  1655. {$IFDEF GLB_DELPHI}
  1656. Context: HGLRC;
  1657. {$ENDIF}
  1658. Buffer: AnsiString;
  1659. MajorVersion, MinorVersion: Integer;
  1660. ///////////////////////////////////////////////////////////////////////////////////////////
  1661. procedure TrimVersionString(Buffer: AnsiString; var Major, Minor: Integer);
  1662. var
  1663. Separator: Integer;
  1664. begin
  1665. Minor := 0;
  1666. Major := 0;
  1667. Separator := Pos(AnsiString('.'), Buffer);
  1668. if (Separator > 1) and (Separator < Length(Buffer)) and
  1669. (Buffer[Separator - 1] in ['0'..'9']) and
  1670. (Buffer[Separator + 1] in ['0'..'9']) then begin
  1671. Dec(Separator);
  1672. while (Separator > 0) and (Buffer[Separator] in ['0'..'9']) do
  1673. Dec(Separator);
  1674. Delete(Buffer, 1, Separator);
  1675. Separator := Pos(AnsiString('.'), Buffer) + 1;
  1676. while (Separator <= Length(Buffer)) and (AnsiChar(Buffer[Separator]) in ['0'..'9']) do
  1677. Inc(Separator);
  1678. Delete(Buffer, Separator, 255);
  1679. Separator := Pos(AnsiString('.'), Buffer);
  1680. Major := StrToInt(Copy(String(Buffer), 1, Separator - 1));
  1681. Minor := StrToInt(Copy(String(Buffer), Separator + 1, 1));
  1682. end;
  1683. end;
  1684. ///////////////////////////////////////////////////////////////////////////////////////////
  1685. function CheckExtension(const Extension: AnsiString): Boolean;
  1686. var
  1687. ExtPos: Integer;
  1688. begin
  1689. ExtPos := Pos(Extension, Buffer);
  1690. result := ExtPos > 0;
  1691. if result then
  1692. result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
  1693. end;
  1694. begin
  1695. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  1696. InitOpenGLCS.Enter;
  1697. try
  1698. if not OpenGLInitialized then begin
  1699. glbInitOpenGL;
  1700. OpenGLInitialized := true;
  1701. end;
  1702. finally
  1703. InitOpenGLCS.Leave;
  1704. end;
  1705. {$ENDIF}
  1706. {$IFDEF GLB_DELPHI}
  1707. Context := wglGetCurrentContext;
  1708. if (Context <> gLastContext) then begin
  1709. gLastContext := Context;
  1710. {$ENDIF}
  1711. // Version
  1712. Buffer := glGetString(GL_VERSION);
  1713. TrimVersionString(Buffer, MajorVersion, MinorVersion);
  1714. GL_VERSION_1_2 := false;
  1715. GL_VERSION_1_3 := false;
  1716. GL_VERSION_1_4 := false;
  1717. GL_VERSION_2_0 := false;
  1718. if MajorVersion = 1 then begin
  1719. if MinorVersion >= 2 then
  1720. GL_VERSION_1_2 := true;
  1721. if MinorVersion >= 3 then
  1722. GL_VERSION_1_3 := true;
  1723. if MinorVersion >= 4 then
  1724. GL_VERSION_1_4 := true;
  1725. end else if MajorVersion >= 2 then begin
  1726. GL_VERSION_1_2 := true;
  1727. GL_VERSION_1_3 := true;
  1728. GL_VERSION_1_4 := true;
  1729. GL_VERSION_2_0 := true;
  1730. end;
  1731. // Extensions
  1732. Buffer := glGetString(GL_EXTENSIONS);
  1733. GL_ARB_texture_border_clamp := CheckExtension('GL_ARB_texture_border_clamp');
  1734. GL_ARB_texture_non_power_of_two := CheckExtension('GL_ARB_texture_non_power_of_two');
  1735. GL_ARB_texture_rectangle := CheckExtension('GL_ARB_texture_rectangle');
  1736. GL_ARB_texture_mirrored_repeat := CheckExtension('GL_ARB_texture_mirrored_repeat');
  1737. GL_EXT_texture_edge_clamp := CheckExtension('GL_EXT_texture_edge_clamp');
  1738. GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
  1739. GL_EXT_texture_rectangle := CheckExtension('GL_EXT_texture_rectangle');
  1740. GL_NV_texture_rectangle := CheckExtension('GL_NV_texture_rectangle');
  1741. GL_IBM_texture_mirrored_repeat := CheckExtension('GL_IBM_texture_mirrored_repeat');
  1742. GL_SGIS_generate_mipmap := CheckExtension('GL_SGIS_generate_mipmap');
  1743. if GL_VERSION_1_3 then begin
  1744. glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1D');
  1745. glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2D');
  1746. glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
  1747. end else begin
  1748. glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1DARB');
  1749. glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2DARB');
  1750. glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB');
  1751. end;
  1752. {$IFDEF GLB_DELPHI}
  1753. end;
  1754. {$ENDIF}
  1755. end;
  1756. {$ENDIF}
  1757. (* TODO GLB_DELPHI
  1758. {$IFDEF GLB_DELPHI}
  1759. function CreateGrayPalette: HPALETTE;
  1760. var
  1761. Idx: Integer;
  1762. Pal: PLogPalette;
  1763. begin
  1764. GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
  1765. Pal.palVersion := $300;
  1766. Pal.palNumEntries := 256;
  1767. {$IFOPT R+}
  1768. {$DEFINE GLB_TEMPRANGECHECK}
  1769. {$R-}
  1770. {$ENDIF}
  1771. for Idx := 0 to 256 - 1 do begin
  1772. Pal.palPalEntry[Idx].peRed := Idx;
  1773. Pal.palPalEntry[Idx].peGreen := Idx;
  1774. Pal.palPalEntry[Idx].peBlue := Idx;
  1775. Pal.palPalEntry[Idx].peFlags := 0;
  1776. end;
  1777. {$IFDEF GLB_TEMPRANGECHECK}
  1778. {$UNDEF GLB_TEMPRANGECHECK}
  1779. {$R+}
  1780. {$ENDIF}
  1781. result := CreatePalette(Pal^);
  1782. FreeMem(Pal);
  1783. end;
  1784. {$ENDIF}
  1785. *)
  1786. (* TODO GLB_SDL_IMAGE
  1787. {$IFDEF GLB_SDL_IMAGE}
  1788. function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
  1789. begin
  1790. result := TStream(context^.unknown.data1).Seek(offset, whence);
  1791. end;
  1792. function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
  1793. begin
  1794. result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
  1795. end;
  1796. function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
  1797. begin
  1798. result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
  1799. end;
  1800. function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
  1801. begin
  1802. result := 0;
  1803. end;
  1804. function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
  1805. begin
  1806. result := SDL_AllocRW;
  1807. if result = nil then
  1808. raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
  1809. result^.seek := glBitmapRWseek;
  1810. result^.read := glBitmapRWread;
  1811. result^.write := glBitmapRWwrite;
  1812. result^.close := glBitmapRWclose;
  1813. result^.unknown.data1 := Stream;
  1814. end;
  1815. {$ENDIF}
  1816. *)
  1817. (* TODO LoadFuncs
  1818. function LoadTexture(Filename: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal{$ENDIF}): Boolean;
  1819. var
  1820. glBitmap: TglBitmap2D;
  1821. begin
  1822. result := false;
  1823. Texture := 0;
  1824. {$IFDEF GLB_DELPHI}
  1825. if Instance = 0 then
  1826. Instance := HInstance;
  1827. if (LoadFromRes) then
  1828. glBitmap := TglBitmap2D.CreateFromResourceName(Instance, FileName)
  1829. else
  1830. {$ENDIF}
  1831. glBitmap := TglBitmap2D.Create(FileName);
  1832. try
  1833. glBitmap.DeleteTextureOnFree := false;
  1834. glBitmap.FreeDataAfterGenTexture := false;
  1835. glBitmap.GenTexture(true);
  1836. if (glBitmap.ID > 0) then begin
  1837. Texture := glBitmap.ID;
  1838. result := true;
  1839. end;
  1840. finally
  1841. glBitmap.Free;
  1842. end;
  1843. end;
  1844. function LoadCubeMap(PositiveX, NegativeX, PositiveY, NegativeY, PositiveZ, NegativeZ: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal{$ENDIF}): Boolean;
  1845. var
  1846. CM: TglBitmapCubeMap;
  1847. begin
  1848. Texture := 0;
  1849. {$IFDEF GLB_DELPHI}
  1850. if Instance = 0 then
  1851. Instance := HInstance;
  1852. {$ENDIF}
  1853. CM := TglBitmapCubeMap.Create;
  1854. try
  1855. CM.DeleteTextureOnFree := false;
  1856. // Maps
  1857. {$IFDEF GLB_DELPHI}
  1858. if (LoadFromRes) then
  1859. CM.LoadFromResource(Instance, PositiveX)
  1860. else
  1861. {$ENDIF}
  1862. CM.LoadFromFile(PositiveX);
  1863. CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X);
  1864. {$IFDEF GLB_DELPHI}
  1865. if (LoadFromRes) then
  1866. CM.LoadFromResource(Instance, NegativeX)
  1867. else
  1868. {$ENDIF}
  1869. CM.LoadFromFile(NegativeX);
  1870. CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X);
  1871. {$IFDEF GLB_DELPHI}
  1872. if (LoadFromRes) then
  1873. CM.LoadFromResource(Instance, PositiveY)
  1874. else
  1875. {$ENDIF}
  1876. CM.LoadFromFile(PositiveY);
  1877. CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y);
  1878. {$IFDEF GLB_DELPHI}
  1879. if (LoadFromRes) then
  1880. CM.LoadFromResource(Instance, NegativeY)
  1881. else
  1882. {$ENDIF}
  1883. CM.LoadFromFile(NegativeY);
  1884. CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y);
  1885. {$IFDEF GLB_DELPHI}
  1886. if (LoadFromRes) then
  1887. CM.LoadFromResource(Instance, PositiveZ)
  1888. else
  1889. {$ENDIF}
  1890. CM.LoadFromFile(PositiveZ);
  1891. CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z);
  1892. {$IFDEF GLB_DELPHI}
  1893. if (LoadFromRes) then
  1894. CM.LoadFromResource(Instance, NegativeZ)
  1895. else
  1896. {$ENDIF}
  1897. CM.LoadFromFile(NegativeZ);
  1898. CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z);
  1899. Texture := CM.ID;
  1900. result := true;
  1901. finally
  1902. CM.Free;
  1903. end;
  1904. end;
  1905. function LoadNormalMap(Size: Integer; var Texture: Cardinal): Boolean;
  1906. var
  1907. NM: TglBitmapNormalMap;
  1908. begin
  1909. Texture := 0;
  1910. NM := TglBitmapNormalMap.Create;
  1911. try
  1912. NM.DeleteTextureOnFree := false;
  1913. NM.GenerateNormalMap(Size);
  1914. Texture := NM.ID;
  1915. result := true;
  1916. finally
  1917. NM.Free;
  1918. end;
  1919. end;
  1920. *)
  1921. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1922. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1923. begin
  1924. glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
  1925. end;
  1926. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1927. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1928. begin
  1929. glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
  1930. end;
  1931. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1932. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1933. begin
  1934. glBitmapDefaultMipmap := aValue;
  1935. end;
  1936. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1937. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1938. begin
  1939. glBitmapDefaultFormat := aFormat;
  1940. end;
  1941. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1942. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1943. begin
  1944. glBitmapDefaultFilterMin := aMin;
  1945. glBitmapDefaultFilterMag := aMag;
  1946. end;
  1947. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1948. procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
  1949. begin
  1950. glBitmapDefaultWrapS := S;
  1951. glBitmapDefaultWrapT := T;
  1952. glBitmapDefaultWrapR := R;
  1953. end;
  1954. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1955. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1956. begin
  1957. result := glBitmapDefaultDeleteTextureOnFree;
  1958. end;
  1959. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1960. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1961. begin
  1962. result := glBitmapDefaultFreeDataAfterGenTextures;
  1963. end;
  1964. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1965. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1966. begin
  1967. result := glBitmapDefaultMipmap;
  1968. end;
  1969. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1970. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1971. begin
  1972. result := glBitmapDefaultFormat;
  1973. end;
  1974. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1975. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  1976. begin
  1977. aMin := glBitmapDefaultFilterMin;
  1978. aMag := glBitmapDefaultFilterMag;
  1979. end;
  1980. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1981. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  1982. begin
  1983. S := glBitmapDefaultWrapS;
  1984. T := glBitmapDefaultWrapT;
  1985. R := glBitmapDefaultWrapR;
  1986. end;
  1987. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1988. //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1989. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1990. function TFormatDescriptor.GetRedMask: UInt64;
  1991. begin
  1992. result := fRange.r shl fShift.r;
  1993. end;
  1994. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1995. function TFormatDescriptor.GetGreenMask: UInt64;
  1996. begin
  1997. result := fRange.g shl fShift.g;
  1998. end;
  1999. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2000. function TFormatDescriptor.GetBlueMask: UInt64;
  2001. begin
  2002. result := fRange.b shl fShift.b;
  2003. end;
  2004. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2005. function TFormatDescriptor.GetAlphaMask: UInt64;
  2006. begin
  2007. result := fRange.a shl fShift.a;
  2008. end;
  2009. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2010. function TFormatDescriptor.GetComponents: Integer;
  2011. var
  2012. i: Integer;
  2013. begin
  2014. result := 0;
  2015. for i := 0 to 3 do
  2016. if (fRange.arr[i] > 0) then
  2017. inc(result);
  2018. end;
  2019. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2020. function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
  2021. var
  2022. w, h: Integer;
  2023. begin
  2024. if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
  2025. w := Max(1, aSize.X);
  2026. h := Max(1, aSize.Y);
  2027. result := GetSize(w, h);
  2028. end else
  2029. result := 0;
  2030. end;
  2031. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2032. function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
  2033. begin
  2034. result := 0;
  2035. if (aWidth <= 0) or (aHeight <= 0) then
  2036. exit;
  2037. result := Ceil(aWidth * aHeight * fPixelSize);
  2038. end;
  2039. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2040. function TFormatDescriptor.CreateMappingData: Pointer;
  2041. begin
  2042. result := nil;
  2043. end;
  2044. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2045. procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
  2046. begin
  2047. //DUMMY
  2048. end;
  2049. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2050. function TFormatDescriptor.IsEmpty: Boolean;
  2051. begin
  2052. result := (fFormat = tfEmpty);
  2053. end;
  2054. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2055. function TFormatDescriptor.HasAlpha: Boolean;
  2056. begin
  2057. result := (fRange.a > 0);
  2058. end;
  2059. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2060. function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: UInt64): Boolean;
  2061. begin
  2062. result := false;
  2063. if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
  2064. raise EglBitmapException.Create('FormatCheckFormat - All Masks are 0');
  2065. if (aRedMask <> RedMask) then
  2066. exit;
  2067. if (aGreenMask <> GreenMask) then
  2068. exit;
  2069. if (aBlueMask <> BlueMask) then
  2070. exit;
  2071. if (aAlphaMask <> AlphaMask) then
  2072. exit;
  2073. result := true;
  2074. end;
  2075. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2076. procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
  2077. begin
  2078. FillChar(aPixel, SizeOf(aPixel), 0);
  2079. aPixel.Data := fRange;
  2080. aPixel.Range := fRange;
  2081. aPixel.Format := fFormat;
  2082. end;
  2083. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2084. constructor TFormatDescriptor.Create;
  2085. begin
  2086. inherited Create;
  2087. fFormat := tfEmpty;
  2088. fWithAlpha := tfEmpty;
  2089. fWithoutAlpha := tfEmpty;
  2090. fRGBInverted := tfEmpty;
  2091. fUncompressed := tfEmpty;
  2092. fPixelSize := 0.0;
  2093. fIsCompressed := false;
  2094. fglFormat := 0;
  2095. fglInternalFormat := 0;
  2096. fglDataFormat := 0;
  2097. FillChar(fRange, 0, SizeOf(fRange));
  2098. FillChar(fShift, 0, SizeOf(fShift));
  2099. end;
  2100. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2101. //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2102. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2103. procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2104. begin
  2105. aData^ := aPixel.Data.a;
  2106. inc(aData);
  2107. end;
  2108. procedure TfdAlpha_UB1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2109. begin
  2110. aPixel.Data.r := 0;
  2111. aPixel.Data.g := 0;
  2112. aPixel.Data.b := 0;
  2113. aPixel.Data.a := aData^;
  2114. inc(aData^);
  2115. end;
  2116. constructor TfdAlpha_UB1.Create;
  2117. begin
  2118. inherited Create;
  2119. fPixelSize := 1.0;
  2120. fRange.a := $FF;
  2121. fglFormat := GL_ALPHA;
  2122. fglDataFormat := GL_UNSIGNED_BYTE;
  2123. end;
  2124. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2125. //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2126. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2127. procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2128. begin
  2129. aData^ := LuminanceWeight(aPixel);
  2130. inc(aData);
  2131. end;
  2132. procedure TfdLuminance_UB1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2133. begin
  2134. aPixel.Data.r := aData^;
  2135. aPixel.Data.g := aData^;
  2136. aPixel.Data.b := aData^;
  2137. aPixel.Data.a := 0;
  2138. inc(aData);
  2139. end;
  2140. constructor TfdLuminance_UB1.Create;
  2141. begin
  2142. inherited Create;
  2143. fPixelSize := 1.0;
  2144. fRange.r := $FF;
  2145. fRange.g := $FF;
  2146. fRange.b := $FF;
  2147. fglFormat := GL_LUMINANCE;
  2148. fglDataFormat := GL_UNSIGNED_BYTE;
  2149. end;
  2150. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2151. //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2152. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2153. procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2154. var
  2155. i: Integer;
  2156. begin
  2157. aData^ := 0;
  2158. for i := 0 to 3 do
  2159. if (fRange.arr[i] > 0) then
  2160. aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2161. inc(aData);
  2162. end;
  2163. procedure TfdUniversal_UB1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2164. var
  2165. i: Integer;
  2166. begin
  2167. for i := 0 to 3 do
  2168. aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
  2169. inc(aData);
  2170. end;
  2171. constructor TfdUniversal_UB1.Create;
  2172. begin
  2173. inherited Create;
  2174. fPixelSize := 1.0;
  2175. end;
  2176. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2177. //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2178. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2179. procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2180. begin
  2181. inherited Map(aPixel, aData, aMapData);
  2182. aData^ := aPixel.Data.a;
  2183. inc(aData);
  2184. end;
  2185. procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2186. begin
  2187. inherited Unmap(aData, aPixel, aMapData);
  2188. aPixel.Data.a := aData^;
  2189. inc(aData);
  2190. end;
  2191. constructor TfdLuminanceAlpha_UB2.Create;
  2192. begin
  2193. inherited Create;
  2194. fPixelSize := 2.0;
  2195. fRange.a := $FF;
  2196. fShift.a := 8;
  2197. fglFormat := GL_LUMINANCE_ALPHA;
  2198. fglDataFormat := GL_UNSIGNED_BYTE;
  2199. end;
  2200. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2201. //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2202. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2203. procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2204. begin
  2205. aData^ := aPixel.Data.r;
  2206. inc(aData);
  2207. aData^ := aPixel.Data.g;
  2208. inc(aData);
  2209. aData^ := aPixel.Data.b;
  2210. inc(aData);
  2211. end;
  2212. procedure TfdRGB_UB3.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2213. begin
  2214. aPixel.Data.r := aData^;
  2215. inc(aData);
  2216. aPixel.Data.g := aData^;
  2217. inc(aData);
  2218. aPixel.Data.b := aData^;
  2219. inc(aData);
  2220. aPixel.Data.a := 0;
  2221. end;
  2222. constructor TfdRGB_UB3.Create;
  2223. begin
  2224. inherited Create;
  2225. fPixelSize := 3.0;
  2226. fRange.r := $FF;
  2227. fRange.g := $FF;
  2228. fRange.b := $FF;
  2229. fShift.r := 0;
  2230. fShift.g := 8;
  2231. fShift.b := 16;
  2232. fglFormat := GL_RGB;
  2233. fglDataFormat := GL_UNSIGNED_BYTE;
  2234. end;
  2235. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2236. //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2237. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2238. procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2239. begin
  2240. aData^ := aPixel.Data.b;
  2241. inc(aData);
  2242. aData^ := aPixel.Data.g;
  2243. inc(aData);
  2244. aData^ := aPixel.Data.r;
  2245. inc(aData);
  2246. end;
  2247. procedure TfdBGR_UB3.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2248. begin
  2249. aPixel.Data.b := aData^;
  2250. inc(aData);
  2251. aPixel.Data.g := aData^;
  2252. inc(aData);
  2253. aPixel.Data.r := aData^;
  2254. inc(aData);
  2255. aPixel.Data.a := 0;
  2256. end;
  2257. constructor TfdBGR_UB3.Create;
  2258. begin
  2259. fPixelSize := 3.0;
  2260. fRange.r := $FF;
  2261. fRange.g := $FF;
  2262. fRange.b := $FF;
  2263. fShift.r := 16;
  2264. fShift.g := 8;
  2265. fShift.b := 0;
  2266. fglFormat := GL_BGR;
  2267. fglDataFormat := GL_UNSIGNED_BYTE;
  2268. end;
  2269. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2270. //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2271. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2272. procedure TfdRGBA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2273. begin
  2274. inherited Map(aPixel, aData, aMapData);
  2275. aData^ := aPixel.Data.a;
  2276. inc(aData);
  2277. end;
  2278. procedure TfdRGBA_UB4.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2279. begin
  2280. inherited Unmap(aData, aPixel, aMapData);
  2281. aPixel.Data.a := aData^;
  2282. inc(aData);
  2283. end;
  2284. constructor TfdRGBA_UB4.Create;
  2285. begin
  2286. inherited Create;
  2287. fPixelSize := 4.0;
  2288. fRange.a := $FF;
  2289. fShift.a := 24;
  2290. fglFormat := GL_RGBA;
  2291. fglDataFormat := GL_UNSIGNED_BYTE;
  2292. end;
  2293. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2294. //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2295. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2296. procedure TfdBGRA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2297. begin
  2298. inherited Map(aPixel, aData, aMapData);
  2299. aData^ := aPixel.Data.a;
  2300. inc(aData);
  2301. end;
  2302. procedure TfdBGRA_UB4.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2303. begin
  2304. inherited Unmap(aData, aPixel, aMapData);
  2305. aPixel.Data.a := aData^;
  2306. inc(aData);
  2307. end;
  2308. constructor TfdBGRA_UB4.Create;
  2309. begin
  2310. inherited Create;
  2311. fPixelSize := 4.0;
  2312. fRange.a := $FF;
  2313. fShift.a := 24;
  2314. fglFormat := GL_BGRA;
  2315. fglDataFormat := GL_UNSIGNED_BYTE;
  2316. end;
  2317. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2318. //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2319. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2320. procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2321. begin
  2322. PWord(aData)^ := aPixel.Data.a;
  2323. inc(aData, 2);
  2324. end;
  2325. procedure TfdAlpha_US1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2326. begin
  2327. aPixel.Data.r := 0;
  2328. aPixel.Data.g := 0;
  2329. aPixel.Data.b := 0;
  2330. aPixel.Data.a := PWord(aData)^;
  2331. inc(aData, 2);
  2332. end;
  2333. constructor TfdAlpha_US1.Create;
  2334. begin
  2335. inherited Create;
  2336. fPixelSize := 2.0;
  2337. fRange.a := $FFFF;
  2338. fglFormat := GL_ALPHA;
  2339. fglDataFormat := GL_UNSIGNED_SHORT;
  2340. end;
  2341. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2342. //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2343. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2344. procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2345. begin
  2346. PWord(aData)^ := LuminanceWeight(aPixel);
  2347. inc(aData, 2);
  2348. end;
  2349. procedure TfdLuminance_US1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2350. begin
  2351. aPixel.Data.r := PWord(aData)^;
  2352. aPixel.Data.g := PWord(aData)^;
  2353. aPixel.Data.b := PWord(aData)^;
  2354. aPixel.Data.a := 0;
  2355. inc(aData, 2);
  2356. end;
  2357. constructor TfdLuminance_US1.Create;
  2358. begin
  2359. inherited Create;
  2360. fPixelSize := 2.0;
  2361. fRange.r := $FFFF;
  2362. fRange.g := $FFFF;
  2363. fRange.b := $FFFF;
  2364. fglFormat := GL_LUMINANCE;
  2365. fglDataFormat := GL_UNSIGNED_SHORT;
  2366. end;
  2367. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2368. //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2369. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2370. procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2371. var
  2372. i: Integer;
  2373. begin
  2374. PWord(aData)^ := 0;
  2375. for i := 0 to 3 do
  2376. if (fRange.arr[i] > 0) then
  2377. PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2378. inc(aData, 2);
  2379. end;
  2380. procedure TfdUniversal_US1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2381. var
  2382. i: Integer;
  2383. begin
  2384. for i := 0 to 3 do
  2385. aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
  2386. inc(aData, 2);
  2387. end;
  2388. constructor TfdUniversal_US1.Create;
  2389. begin
  2390. inherited Create;
  2391. fPixelSize := 2.0;
  2392. end;
  2393. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2394. //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2395. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2396. procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2397. begin
  2398. PWord(aData)^ := DepthWeight(aPixel);
  2399. inc(aData, 2);
  2400. end;
  2401. procedure TfdDepth_US1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2402. begin
  2403. aPixel.Data.r := PWord(aData)^;
  2404. aPixel.Data.g := PWord(aData)^;
  2405. aPixel.Data.b := PWord(aData)^;
  2406. aPixel.Data.a := 0;
  2407. inc(aData, 2);
  2408. end;
  2409. constructor TfdDepth_US1.Create;
  2410. begin
  2411. inherited Create;
  2412. fPixelSize := 2.0;
  2413. fRange.r := $FFFF;
  2414. fRange.g := $FFFF;
  2415. fRange.b := $FFFF;
  2416. fglFormat := GL_DEPTH_COMPONENT;
  2417. fglDataFormat := GL_UNSIGNED_SHORT;
  2418. end;
  2419. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2420. //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2421. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2422. procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2423. begin
  2424. inherited Map(aPixel, aData, aMapData);
  2425. PWord(aData)^ := aPixel.Data.a;
  2426. inc(aData, 2);
  2427. end;
  2428. procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2429. begin
  2430. inherited Unmap(aData, aPixel, aMapData);
  2431. aPixel.Data.a := PWord(aData)^;
  2432. inc(aData, 2);
  2433. end;
  2434. constructor TfdLuminanceAlpha_US2.Create;
  2435. begin
  2436. inherited Create;
  2437. fPixelSize := 4.0;
  2438. fRange.a := $FFFF;
  2439. fShift.a := 16;
  2440. fglFormat := GL_LUMINANCE_ALPHA;
  2441. fglDataFormat := GL_UNSIGNED_SHORT;
  2442. end;
  2443. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2444. //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2445. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2446. procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2447. begin
  2448. PWord(aData)^ := aPixel.Data.r;
  2449. inc(aData, 2);
  2450. PWord(aData)^ := aPixel.Data.g;
  2451. inc(aData, 2);
  2452. PWord(aData)^ := aPixel.Data.b;
  2453. inc(aData, 2);
  2454. end;
  2455. procedure TfdRGB_US3.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2456. begin
  2457. aPixel.Data.r := PWord(aData)^;
  2458. inc(aData, 2);
  2459. aPixel.Data.g := PWord(aData)^;
  2460. inc(aData, 2);
  2461. aPixel.Data.b := PWord(aData)^;
  2462. inc(aData, 2);
  2463. aPixel.Data.a := 0;
  2464. end;
  2465. constructor TfdRGB_US3.Create;
  2466. begin
  2467. inherited Create;
  2468. fPixelSize := 6.0;
  2469. fRange.r := $FFFF;
  2470. fRange.g := $FFFF;
  2471. fRange.b := $FFFF;
  2472. fShift.r := 0;
  2473. fShift.g := 16;
  2474. fShift.b := 32;
  2475. fglFormat := GL_RGB;
  2476. fglDataFormat := GL_UNSIGNED_SHORT;
  2477. end;
  2478. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2479. //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2480. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2481. procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2482. begin
  2483. PWord(aData)^ := aPixel.Data.b;
  2484. inc(aData, 2);
  2485. PWord(aData)^ := aPixel.Data.g;
  2486. inc(aData, 2);
  2487. PWord(aData)^ := aPixel.Data.r;
  2488. inc(aData, 2);
  2489. end;
  2490. procedure TfdBGR_US3.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2491. begin
  2492. aPixel.Data.b := PWord(aData)^;
  2493. inc(aData, 2);
  2494. aPixel.Data.g := PWord(aData)^;
  2495. inc(aData, 2);
  2496. aPixel.Data.r := PWord(aData)^;
  2497. inc(aData, 2);
  2498. aPixel.Data.a := 0;
  2499. end;
  2500. constructor TfdBGR_US3.Create;
  2501. begin
  2502. inherited Create;
  2503. fPixelSize := 6.0;
  2504. fRange.r := $FFFF;
  2505. fRange.g := $FFFF;
  2506. fRange.b := $FFFF;
  2507. fShift.r := 32;
  2508. fShift.g := 16;
  2509. fShift.b := 0;
  2510. fglFormat := GL_BGR;
  2511. fglDataFormat := GL_UNSIGNED_SHORT;
  2512. end;
  2513. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2514. //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2515. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2516. procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2517. begin
  2518. inherited Map(aPixel, aData, aMapData);
  2519. PWord(aData)^ := aPixel.Data.a;
  2520. inc(aData, 2);
  2521. end;
  2522. procedure TfdRGBA_US4.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2523. begin
  2524. inherited Unmap(aData, aPixel, aMapData);
  2525. aPixel.Data.a := PWord(aData)^;
  2526. inc(aData, 2);
  2527. end;
  2528. constructor TfdRGBA_US4.Create;
  2529. begin
  2530. inherited Create;
  2531. fPixelSize := 8.0;
  2532. fRange.a := $FFFF;
  2533. fShift.a := 48;
  2534. fglFormat := GL_RGBA;
  2535. fglDataFormat := GL_UNSIGNED_SHORT;
  2536. end;
  2537. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2538. //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2539. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2540. procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2541. begin
  2542. inherited Map(aPixel, aData, aMapData);
  2543. PWord(aData)^ := aPixel.Data.a;
  2544. inc(aData, 2);
  2545. end;
  2546. procedure TfdBGRA_US4.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2547. begin
  2548. inherited Unmap(aData, aPixel, aMapData);
  2549. aPixel.Data.a := PWord(aData)^;
  2550. inc(aData, 2);
  2551. end;
  2552. constructor TfdBGRA_US4.Create;
  2553. begin
  2554. inherited Create;
  2555. fPixelSize := 8.0;
  2556. fRange.a := $FFFF;
  2557. fShift.a := 48;
  2558. fglFormat := GL_BGRA;
  2559. fglDataFormat := GL_UNSIGNED_SHORT;
  2560. end;
  2561. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2562. //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2563. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2564. procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2565. var
  2566. i: Integer;
  2567. begin
  2568. PCardinal(aData)^ := 0;
  2569. for i := 0 to 3 do
  2570. if (fRange.arr[i] > 0) then
  2571. PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2572. inc(aData, 4);
  2573. end;
  2574. procedure TfdUniversal_UI1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2575. var
  2576. i: Integer;
  2577. begin
  2578. for i := 0 to 3 do
  2579. aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
  2580. inc(aData, 2);
  2581. end;
  2582. constructor TfdUniversal_UI1.Create;
  2583. begin
  2584. inherited Create;
  2585. fPixelSize := 4.0;
  2586. end;
  2587. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2588. //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2589. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2590. procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2591. begin
  2592. PCardinal(aData)^ := DepthWeight(aPixel);
  2593. inc(aData, 4);
  2594. end;
  2595. procedure TfdDepth_UI1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2596. begin
  2597. aPixel.Data.r := PCardinal(aData)^;
  2598. aPixel.Data.g := PCardinal(aData)^;
  2599. aPixel.Data.b := PCardinal(aData)^;
  2600. aPixel.Data.a := 0;
  2601. inc(aData, 4);
  2602. end;
  2603. constructor TfdDepth_UI1.Create;
  2604. begin
  2605. inherited Create;
  2606. fPixelSize := 4.0;
  2607. fRange.r := $FFFFFFFF;
  2608. fRange.g := $FFFFFFFF;
  2609. fRange.b := $FFFFFFFF;
  2610. fglFormat := GL_DEPTH_COMPONENT;
  2611. fglDataFormat := GL_UNSIGNED_INT;
  2612. end;
  2613. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2614. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2615. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2616. constructor TfdAlpha4.Create;
  2617. begin
  2618. inherited Create;
  2619. fFormat := tfAlpha4;
  2620. fWithAlpha := tfAlpha4;
  2621. fglInternalFormat := GL_ALPHA4;
  2622. end;
  2623. constructor TfdAlpha8.Create;
  2624. begin
  2625. inherited Create;
  2626. fFormat := tfAlpha8;
  2627. fWithAlpha := tfAlpha8;
  2628. fglInternalFormat := GL_ALPHA8;
  2629. end;
  2630. constructor TfdAlpha12.Create;
  2631. begin
  2632. inherited Create;
  2633. fFormat := tfAlpha12;
  2634. fWithAlpha := tfAlpha12;
  2635. fglInternalFormat := GL_ALPHA12;
  2636. end;
  2637. constructor TfdAlpha16.Create;
  2638. begin
  2639. inherited Create;
  2640. fFormat := tfAlpha16;
  2641. fWithAlpha := tfAlpha16;
  2642. fglInternalFormat := GL_ALPHA16;
  2643. end;
  2644. constructor TfdLuminance4.Create;
  2645. begin
  2646. inherited Create;
  2647. fFormat := tfLuminance4;
  2648. fWithAlpha := tfLuminance4Alpha4;
  2649. fWithoutAlpha := tfLuminance4;
  2650. fglInternalFormat := GL_LUMINANCE4;
  2651. end;
  2652. constructor TfdLuminance8.Create;
  2653. begin
  2654. inherited Create;
  2655. fFormat := tfLuminance8;
  2656. fWithAlpha := tfLuminance8Alpha8;
  2657. fWithoutAlpha := tfLuminance8;
  2658. fglInternalFormat := GL_LUMINANCE8;
  2659. end;
  2660. constructor TfdLuminance12.Create;
  2661. begin
  2662. inherited Create;
  2663. fFormat := tfLuminance12;
  2664. fWithAlpha := tfLuminance12Alpha12;
  2665. fWithoutAlpha := tfLuminance12;
  2666. fglInternalFormat := GL_LUMINANCE12;
  2667. end;
  2668. constructor TfdLuminance16.Create;
  2669. begin
  2670. inherited Create;
  2671. fFormat := tfLuminance16;
  2672. fWithAlpha := tfLuminance16Alpha16;
  2673. fWithoutAlpha := tfLuminance16;
  2674. fglInternalFormat := GL_LUMINANCE16;
  2675. end;
  2676. constructor TfdLuminance4Alpha4.Create;
  2677. begin
  2678. inherited Create;
  2679. fFormat := tfLuminance4Alpha4;
  2680. fWithAlpha := tfLuminance4Alpha4;
  2681. fWithoutAlpha := tfLuminance4;
  2682. fglInternalFormat := GL_LUMINANCE4_ALPHA4;
  2683. end;
  2684. constructor TfdLuminance6Alpha2.Create;
  2685. begin
  2686. inherited Create;
  2687. fFormat := tfLuminance6Alpha2;
  2688. fWithAlpha := tfLuminance6Alpha2;
  2689. fWithoutAlpha := tfLuminance8;
  2690. fglInternalFormat := GL_LUMINANCE6_ALPHA2;
  2691. end;
  2692. constructor TfdLuminance8Alpha8.Create;
  2693. begin
  2694. inherited Create;
  2695. fFormat := tfLuminance8Alpha8;
  2696. fWithAlpha := tfLuminance8Alpha8;
  2697. fWithoutAlpha := tfLuminance8;
  2698. fglInternalFormat := GL_LUMINANCE8_ALPHA8;
  2699. end;
  2700. constructor TfdLuminance12Alpha4.Create;
  2701. begin
  2702. inherited Create;
  2703. fFormat := tfLuminance12Alpha4;
  2704. fWithAlpha := tfLuminance12Alpha4;
  2705. fWithoutAlpha := tfLuminance12;
  2706. fglInternalFormat := GL_LUMINANCE12_ALPHA4;
  2707. end;
  2708. constructor TfdLuminance12Alpha12.Create;
  2709. begin
  2710. inherited Create;
  2711. fFormat := tfLuminance12Alpha12;
  2712. fWithAlpha := tfLuminance12Alpha12;
  2713. fWithoutAlpha := tfLuminance12;
  2714. fglInternalFormat := GL_LUMINANCE12_ALPHA12;
  2715. end;
  2716. constructor TfdLuminance16Alpha16.Create;
  2717. begin
  2718. inherited Create;
  2719. fFormat := tfLuminance16Alpha16;
  2720. fWithAlpha := tfLuminance16Alpha16;
  2721. fWithoutAlpha := tfLuminance16;
  2722. fglInternalFormat := GL_LUMINANCE16_ALPHA16;
  2723. end;
  2724. constructor TfdR3G3B2.Create;
  2725. begin
  2726. inherited Create;
  2727. fFormat := tfR3G3B2;
  2728. fWithAlpha := tfRGBA2;
  2729. fWithoutAlpha := tfR3G3B2;
  2730. fRange.r := $7;
  2731. fRange.g := $7;
  2732. fRange.b := $3;
  2733. fShift.r := 0;
  2734. fShift.g := 3;
  2735. fShift.b := 6;
  2736. fglFormat := GL_RGB;
  2737. fglInternalFormat := GL_R3_G3_B2;
  2738. fglDataFormat := GL_UNSIGNED_BYTE_2_3_3_REV;
  2739. end;
  2740. constructor TfdRGB4.Create;
  2741. begin
  2742. inherited Create;
  2743. fFormat := tfRGB4;
  2744. fWithAlpha := tfRGBA4;
  2745. fWithoutAlpha := tfRGB4;
  2746. fRGBInverted := tfBGR4;
  2747. fRange.r := $F;
  2748. fRange.g := $F;
  2749. fRange.b := $F;
  2750. fShift.r := 0;
  2751. fShift.g := 4;
  2752. fShift.b := 8;
  2753. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2754. fglInternalFormat := GL_RGB4;
  2755. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2756. end;
  2757. constructor TfdR5G6B5.Create;
  2758. begin
  2759. inherited Create;
  2760. fFormat := tfR5G6B5;
  2761. fWithAlpha := tfRGBA4;
  2762. fWithoutAlpha := tfR5G6B5;
  2763. fRGBInverted := tfB5G6R5;
  2764. fRange.r := $1F;
  2765. fRange.g := $3F;
  2766. fRange.b := $1F;
  2767. fShift.r := 0;
  2768. fShift.g := 5;
  2769. fShift.b := 11;
  2770. fglFormat := GL_RGB;
  2771. fglInternalFormat := GL_RGB565;
  2772. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5_REV;
  2773. end;
  2774. constructor TfdRGB5.Create;
  2775. begin
  2776. inherited Create;
  2777. fFormat := tfRGB5;
  2778. fWithAlpha := tfRGB5A1;
  2779. fWithoutAlpha := tfRGB5;
  2780. fRGBInverted := tfBGR5;
  2781. fRange.r := $1F;
  2782. fRange.g := $1F;
  2783. fRange.b := $1F;
  2784. fShift.r := 0;
  2785. fShift.g := 5;
  2786. fShift.b := 10;
  2787. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2788. fglInternalFormat := GL_RGB5;
  2789. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2790. end;
  2791. constructor TfdRGB8.Create;
  2792. begin
  2793. inherited Create;
  2794. fFormat := tfRGB8;
  2795. fWithAlpha := tfRGBA8;
  2796. fWithoutAlpha := tfRGB8;
  2797. fRGBInverted := tfBGR8;
  2798. fglInternalFormat := GL_RGB8;
  2799. end;
  2800. constructor TfdRGB10.Create;
  2801. begin
  2802. inherited Create;
  2803. fFormat := tfRGB10;
  2804. fWithAlpha := tfRGB10A2;
  2805. fWithoutAlpha := tfRGB10;
  2806. fRGBInverted := tfBGR10;
  2807. fRange.r := $3FF;
  2808. fRange.g := $3FF;
  2809. fRange.b := $3FF;
  2810. fShift.r := 0;
  2811. fShift.g := 10;
  2812. fShift.b := 20;
  2813. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2814. fglInternalFormat := GL_RGB10;
  2815. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2816. end;
  2817. constructor TfdRGB12.Create;
  2818. begin
  2819. inherited Create;
  2820. fFormat := tfRGB12;
  2821. fWithAlpha := tfRGBA12;
  2822. fWithoutAlpha := tfRGB12;
  2823. fRGBInverted := tfBGR12;
  2824. fglInternalFormat := GL_RGB12;
  2825. end;
  2826. constructor TfdRGB16.Create;
  2827. begin
  2828. inherited Create;
  2829. fFormat := tfRGB16;
  2830. fWithAlpha := tfRGBA16;
  2831. fWithoutAlpha := tfRGB16;
  2832. fRGBInverted := tfBGR16;
  2833. fglInternalFormat := GL_RGB16;
  2834. end;
  2835. constructor TfdRGBA2.Create;
  2836. begin
  2837. inherited Create;
  2838. fFormat := tfRGBA2;
  2839. fWithAlpha := tfRGBA2;
  2840. fWithoutAlpha := tfR3G3B2;
  2841. fRGBInverted := tfBGRA2;
  2842. fglInternalFormat := GL_RGBA2;
  2843. end;
  2844. constructor TfdRGBA4.Create;
  2845. begin
  2846. inherited Create;
  2847. fFormat := tfRGBA4;
  2848. fWithAlpha := tfRGBA4;
  2849. fWithoutAlpha := tfRGB4;
  2850. fRGBInverted := tfBGRA4;
  2851. fRange.r := $F;
  2852. fRange.g := $F;
  2853. fRange.b := $F;
  2854. fRange.a := $F;
  2855. fShift.r := 0;
  2856. fShift.g := 4;
  2857. fShift.b := 8;
  2858. fShift.a := 12;
  2859. fglFormat := GL_RGBA;
  2860. fglInternalFormat := GL_RGBA4;
  2861. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2862. end;
  2863. constructor TfdRGB5A1.Create;
  2864. begin
  2865. inherited Create;
  2866. fFormat := tfRGB5A1;
  2867. fWithAlpha := tfRGB5A1;
  2868. fWithoutAlpha := tfRGB5;
  2869. fRGBInverted := tfBGR5A1;
  2870. fRange.r := $1F;
  2871. fRange.g := $1F;
  2872. fRange.b := $1F;
  2873. fRange.a := $01;
  2874. fShift.r := 0;
  2875. fShift.g := 5;
  2876. fShift.b := 10;
  2877. fShift.a := 15;
  2878. fglFormat := GL_RGBA;
  2879. fglInternalFormat := GL_RGB5_A1;
  2880. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2881. end;
  2882. constructor TfdRGBA8.Create;
  2883. begin
  2884. inherited Create;
  2885. fFormat := tfRGBA8;
  2886. fWithAlpha := tfRGBA8;
  2887. fWithoutAlpha := tfRGB8;
  2888. fRGBInverted := tfBGRA8;
  2889. fglInternalFormat := GL_RGBA8;
  2890. end;
  2891. constructor TfdRGB10A2.Create;
  2892. begin
  2893. inherited Create;
  2894. fFormat := tfRGB10A2;
  2895. fWithAlpha := tfRGB10A2;
  2896. fWithoutAlpha := tfRGB10;
  2897. fRGBInverted := tfBGR10A2;
  2898. fRange.r := $3FF;
  2899. fRange.g := $3FF;
  2900. fRange.b := $3FF;
  2901. fRange.a := $003;
  2902. fShift.r := 0;
  2903. fShift.g := 10;
  2904. fShift.b := 20;
  2905. fShift.a := 30;
  2906. fglFormat := GL_RGBA;
  2907. fglInternalFormat := GL_RGB10_A2;
  2908. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2909. end;
  2910. constructor TfdRGBA12.Create;
  2911. begin
  2912. inherited Create;
  2913. fFormat := tfRGBA12;
  2914. fWithAlpha := tfRGBA12;
  2915. fWithoutAlpha := tfRGB12;
  2916. fRGBInverted := tfBGRA12;
  2917. fglInternalFormat := GL_RGBA12;
  2918. end;
  2919. constructor TfdRGBA16.Create;
  2920. begin
  2921. inherited Create;
  2922. fFormat := tfRGBA16;
  2923. fWithAlpha := tfRGBA16;
  2924. fWithoutAlpha := tfRGB16;
  2925. fRGBInverted := tfBGRA16;
  2926. fglInternalFormat := GL_RGBA16;
  2927. end;
  2928. constructor TfdBGR4.Create;
  2929. begin
  2930. inherited Create;
  2931. fPixelSize := 2.0;
  2932. fFormat := tfBGR4;
  2933. fWithAlpha := tfBGRA4;
  2934. fWithoutAlpha := tfBGR4;
  2935. fRGBInverted := tfRGB4;
  2936. fRange.r := $F;
  2937. fRange.g := $F;
  2938. fRange.b := $F;
  2939. fRange.a := $0;
  2940. fShift.r := 8;
  2941. fShift.g := 4;
  2942. fShift.b := 0;
  2943. fShift.a := 0;
  2944. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2945. fglInternalFormat := GL_RGB4;
  2946. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2947. end;
  2948. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2949. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2950. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2951. constructor TfdB5G6R5.Create;
  2952. begin
  2953. inherited Create;
  2954. fFormat := tfB5G6R5;
  2955. fWithAlpha := tfBGRA4;
  2956. fWithoutAlpha := tfB5G6R5;
  2957. fRGBInverted := tfR5G6B5;
  2958. fRange.r := $1F;
  2959. fRange.g := $3F;
  2960. fRange.b := $1F;
  2961. fShift.r := 11;
  2962. fShift.g := 5;
  2963. fShift.b := 0;
  2964. fglFormat := GL_RGB; //B5G6R5 is only possible as R5G6B5 -> use reverted dataformat
  2965. fglInternalFormat := GL_RGB8;
  2966. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5;
  2967. end;
  2968. constructor TfdBGR5.Create;
  2969. begin
  2970. inherited Create;
  2971. fPixelSize := 2.0;
  2972. fFormat := tfBGR5;
  2973. fWithAlpha := tfBGR5A1;
  2974. fWithoutAlpha := tfBGR5;
  2975. fRGBInverted := tfRGB5;
  2976. fRange.r := $1F;
  2977. fRange.g := $1F;
  2978. fRange.b := $1F;
  2979. fRange.a := $00;
  2980. fShift.r := 10;
  2981. fShift.g := 5;
  2982. fShift.b := 0;
  2983. fShift.a := 0;
  2984. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2985. fglInternalFormat := GL_RGB5;
  2986. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2987. end;
  2988. constructor TfdBGR8.Create;
  2989. begin
  2990. inherited Create;
  2991. fFormat := tfBGR8;
  2992. fWithAlpha := tfBGRA8;
  2993. fWithoutAlpha := tfBGR8;
  2994. fRGBInverted := tfRGB8;
  2995. fglInternalFormat := GL_RGB8;
  2996. end;
  2997. constructor TfdBGR10.Create;
  2998. begin
  2999. inherited Create;
  3000. fFormat := tfBGR10;
  3001. fWithAlpha := tfBGR10A2;
  3002. fWithoutAlpha := tfBGR10;
  3003. fRGBInverted := tfRGB10;
  3004. fRange.r := $3FF;
  3005. fRange.g := $3FF;
  3006. fRange.b := $3FF;
  3007. fRange.a := $000;
  3008. fShift.r := 20;
  3009. fShift.g := 10;
  3010. fShift.b := 0;
  3011. fShift.a := 0;
  3012. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3013. fglInternalFormat := GL_RGB10;
  3014. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3015. end;
  3016. constructor TfdBGR12.Create;
  3017. begin
  3018. inherited Create;
  3019. fFormat := tfBGR12;
  3020. fWithAlpha := tfBGRA12;
  3021. fWithoutAlpha := tfBGR12;
  3022. fRGBInverted := tfRGB12;
  3023. fglInternalFormat := GL_RGB12;
  3024. end;
  3025. constructor TfdBGR16.Create;
  3026. begin
  3027. inherited Create;
  3028. fFormat := tfBGR16;
  3029. fWithAlpha := tfBGRA16;
  3030. fWithoutAlpha := tfBGR16;
  3031. fRGBInverted := tfRGB16;
  3032. fglInternalFormat := GL_RGB16;
  3033. end;
  3034. constructor TfdBGRA2.Create;
  3035. begin
  3036. inherited Create;
  3037. fFormat := tfBGRA2;
  3038. fWithAlpha := tfBGRA4;
  3039. fWithoutAlpha := tfBGR4;
  3040. fRGBInverted := tfRGBA2;
  3041. fglInternalFormat := GL_RGBA2;
  3042. end;
  3043. constructor TfdBGRA4.Create;
  3044. begin
  3045. inherited Create;
  3046. fFormat := tfBGRA4;
  3047. fWithAlpha := tfBGRA4;
  3048. fWithoutAlpha := tfBGR4;
  3049. fRGBInverted := tfRGBA4;
  3050. fRange.r := $F;
  3051. fRange.g := $F;
  3052. fRange.b := $F;
  3053. fRange.a := $F;
  3054. fShift.r := 8;
  3055. fShift.g := 4;
  3056. fShift.b := 0;
  3057. fShift.a := 12;
  3058. fglFormat := GL_BGRA;
  3059. fglInternalFormat := GL_RGBA4;
  3060. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  3061. end;
  3062. constructor TfdBGR5A1.Create;
  3063. begin
  3064. inherited Create;
  3065. fFormat := tfBGR5A1;
  3066. fWithAlpha := tfBGR5A1;
  3067. fWithoutAlpha := tfBGR5;
  3068. fRGBInverted := tfRGB5A1;
  3069. fRange.r := $1F;
  3070. fRange.g := $1F;
  3071. fRange.b := $1F;
  3072. fRange.a := $01;
  3073. fShift.r := 10;
  3074. fShift.g := 5;
  3075. fShift.b := 0;
  3076. fShift.a := 15;
  3077. fglFormat := GL_BGRA;
  3078. fglInternalFormat := GL_RGB5_A1;
  3079. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  3080. end;
  3081. constructor TfdBGRA8.Create;
  3082. begin
  3083. inherited Create;
  3084. fFormat := tfBGRA8;
  3085. fWithAlpha := tfBGRA8;
  3086. fWithoutAlpha := tfBGR8;
  3087. fRGBInverted := tfRGBA8;
  3088. fglInternalFormat := GL_RGBA8;
  3089. end;
  3090. constructor TfdBGR10A2.Create;
  3091. begin
  3092. inherited Create;
  3093. fFormat := tfBGR10A2;
  3094. fWithAlpha := tfBGR10A2;
  3095. fWithoutAlpha := tfBGR10;
  3096. fRGBInverted := tfRGB10A2;
  3097. fRange.r := $3FF;
  3098. fRange.g := $3FF;
  3099. fRange.b := $3FF;
  3100. fRange.a := $003;
  3101. fShift.r := 20;
  3102. fShift.g := 10;
  3103. fShift.b := 0;
  3104. fShift.a := 30;
  3105. fglFormat := GL_BGRA;
  3106. fglInternalFormat := GL_RGB10_A2;
  3107. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3108. end;
  3109. constructor TfdBGRA12.Create;
  3110. begin
  3111. inherited Create;
  3112. fFormat := tfBGRA12;
  3113. fWithAlpha := tfBGRA12;
  3114. fWithoutAlpha := tfBGR12;
  3115. fRGBInverted := tfRGBA12;
  3116. fglInternalFormat := GL_RGBA12;
  3117. end;
  3118. constructor TfdBGRA16.Create;
  3119. begin
  3120. inherited Create;
  3121. fFormat := tfBGRA16;
  3122. fWithAlpha := tfBGRA16;
  3123. fWithoutAlpha := tfBGR16;
  3124. fRGBInverted := tfRGBA16;
  3125. fglInternalFormat := GL_RGBA16;
  3126. end;
  3127. constructor TfdDepth16.Create;
  3128. begin
  3129. inherited Create;
  3130. fFormat := tfDepth16;
  3131. fWithAlpha := tfEmpty;
  3132. fWithoutAlpha := tfDepth16;
  3133. fglInternalFormat := GL_DEPTH_COMPONENT16;
  3134. end;
  3135. constructor TfdDepth24.Create;
  3136. begin
  3137. inherited Create;
  3138. fFormat := tfDepth24;
  3139. fWithAlpha := tfEmpty;
  3140. fWithoutAlpha := tfDepth24;
  3141. fglInternalFormat := GL_DEPTH_COMPONENT24;
  3142. end;
  3143. constructor TfdDepth32.Create;
  3144. begin
  3145. inherited Create;
  3146. fFormat := tfDepth32;
  3147. fWithAlpha := tfEmpty;
  3148. fWithoutAlpha := tfDepth32;
  3149. fglInternalFormat := GL_DEPTH_COMPONENT32;
  3150. end;
  3151. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3152. //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3153. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3154. procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3155. begin
  3156. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  3157. end;
  3158. procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3159. begin
  3160. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  3161. end;
  3162. constructor TfdS3tcDtx1RGBA.Create;
  3163. begin
  3164. inherited Create;
  3165. fFormat := tfS3tcDtx1RGBA;
  3166. fWithAlpha := tfS3tcDtx1RGBA;
  3167. fUncompressed := tfRGB5A1;
  3168. fPixelSize := 0.5;
  3169. fIsCompressed := true;
  3170. fglFormat := GL_COMPRESSED_RGBA;
  3171. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
  3172. fglDataFormat := GL_UNSIGNED_BYTE;
  3173. end;
  3174. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3175. //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3176. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3177. procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3178. begin
  3179. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  3180. end;
  3181. procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3182. begin
  3183. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  3184. end;
  3185. constructor TfdS3tcDtx3RGBA.Create;
  3186. begin
  3187. inherited Create;
  3188. fFormat := tfS3tcDtx3RGBA;
  3189. fWithAlpha := tfS3tcDtx3RGBA;
  3190. fUncompressed := tfRGBA8;
  3191. fPixelSize := 1.0;
  3192. fIsCompressed := true;
  3193. fglFormat := GL_COMPRESSED_RGBA;
  3194. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
  3195. fglDataFormat := GL_UNSIGNED_BYTE;
  3196. end;
  3197. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3198. //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3199. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3200. procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3201. begin
  3202. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  3203. end;
  3204. procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3205. begin
  3206. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  3207. end;
  3208. constructor TfdS3tcDtx5RGBA.Create;
  3209. begin
  3210. inherited Create;
  3211. fFormat := tfS3tcDtx3RGBA;
  3212. fWithAlpha := tfS3tcDtx3RGBA;
  3213. fUncompressed := tfRGBA8;
  3214. fPixelSize := 1.0;
  3215. fIsCompressed := true;
  3216. fglFormat := GL_COMPRESSED_RGBA;
  3217. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
  3218. fglDataFormat := GL_UNSIGNED_BYTE;
  3219. end;
  3220. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3221. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3222. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3223. class procedure TFormatDescriptor.Init;
  3224. begin
  3225. if not Assigned(FormatDescriptorCS) then
  3226. FormatDescriptorCS := TCriticalSection.Create;
  3227. end;
  3228. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3229. class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3230. begin
  3231. FormatDescriptorCS.Enter;
  3232. try
  3233. result := FormatDescriptors[aFormat];
  3234. if not Assigned(result) then begin
  3235. result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
  3236. FormatDescriptors[aFormat] := result;
  3237. end;
  3238. finally
  3239. FormatDescriptorCS.Leave;
  3240. end;
  3241. end;
  3242. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3243. class function TFormatDescriptor.GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3244. begin
  3245. result := Get(Get(aFormat).WithAlpha);
  3246. end;
  3247. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3248. class procedure TFormatDescriptor.Clear;
  3249. var
  3250. f: TglBitmapFormat;
  3251. begin
  3252. FormatDescriptorCS.Enter;
  3253. try
  3254. for f := low(FormatDescriptors) to high(FormatDescriptors) do
  3255. FreeAndNil(FormatDescriptors[f]);
  3256. finally
  3257. FormatDescriptorCS.Leave;
  3258. end;
  3259. end;
  3260. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3261. class procedure TFormatDescriptor.Finalize;
  3262. begin
  3263. Clear;
  3264. FreeAndNil(FormatDescriptorCS);
  3265. end;
  3266. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3267. //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3268. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3269. procedure TbmpBitfieldFormat.SetRedMask(const aValue: UInt64);
  3270. begin
  3271. Update(aValue, fRange.r, fShift.r);
  3272. end;
  3273. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3274. procedure TbmpBitfieldFormat.SetGreenMask(const aValue: UInt64);
  3275. begin
  3276. Update(aValue, fRange.g, fShift.g);
  3277. end;
  3278. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3279. procedure TbmpBitfieldFormat.SetBlueMask(const aValue: UInt64);
  3280. begin
  3281. Update(aValue, fRange.b, fShift.b);
  3282. end;
  3283. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3284. procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: UInt64);
  3285. begin
  3286. Update(aValue, fRange.a, fShift.a);
  3287. end;
  3288. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3289. procedure TbmpBitfieldFormat.Update(aMask: UInt64; out aRange: Cardinal; out
  3290. aShift: Byte);
  3291. begin
  3292. aShift := 0;
  3293. aRange := 0;
  3294. if (aMask = 0) then
  3295. exit;
  3296. while (aMask > 0) and ((aMask and 1) = 0) do begin
  3297. inc(aShift);
  3298. aMask := aMask shr 1;
  3299. end;
  3300. aRange := 1;
  3301. while (aMask > 0) do begin
  3302. aRange := aRange shl 1;
  3303. aMask := aMask shr 1;
  3304. end;
  3305. dec(aRange);
  3306. fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
  3307. end;
  3308. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3309. procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3310. var
  3311. data: UInt64;
  3312. s: Integer;
  3313. type
  3314. PUInt64 = ^UInt64;
  3315. begin
  3316. data :=
  3317. ((aPixel.Data.r and fRange.r) shl fShift.r) or
  3318. ((aPixel.Data.g and fRange.g) shl fShift.g) or
  3319. ((aPixel.Data.b and fRange.b) shl fShift.b) or
  3320. ((aPixel.Data.a and fRange.a) shl fShift.a);
  3321. s := Round(fPixelSize);
  3322. case s of
  3323. 1: aData^ := data;
  3324. 2: PWord(aData)^ := data;
  3325. 4: PCardinal(aData)^ := data;
  3326. 8: PUInt64(aData)^ := data;
  3327. else
  3328. raise EglBitmapException.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
  3329. end;
  3330. inc(aData, s);
  3331. end;
  3332. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3333. procedure TbmpBitfieldFormat.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3334. var
  3335. data: UInt64;
  3336. s, i: Integer;
  3337. type
  3338. PUInt64 = ^UInt64;
  3339. begin
  3340. s := Round(fPixelSize);
  3341. case s of
  3342. 1: data := aData^;
  3343. 2: data := PWord(aData)^;
  3344. 4: data := PCardinal(aData)^;
  3345. 8: data := PUInt64(aData)^;
  3346. else
  3347. raise EglBitmapException.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
  3348. end;
  3349. for i := 0 to 3 do
  3350. aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
  3351. inc(aData, s);
  3352. end;
  3353. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3354. //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3355. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3356. procedure TbmpColorTableFormat.CreateColorTable;
  3357. var
  3358. bits: Byte;
  3359. len: Integer;
  3360. i: Integer;
  3361. begin
  3362. if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
  3363. raise EglBitmapException.Create(UNSUPPORTED_FORMAT);
  3364. if (Format = tfLuminance4) then
  3365. SetLength(fColorTable, 16)
  3366. else
  3367. SetLength(fColorTable, 256);
  3368. case Format of
  3369. tfLuminance4: begin
  3370. for i := 0 to High(fColorTable) do begin
  3371. fColorTable[i].r := 16 * i;
  3372. fColorTable[i].g := 16 * i;
  3373. fColorTable[i].b := 16 * i;
  3374. fColorTable[i].a := 0;
  3375. end;
  3376. end;
  3377. tfLuminance8: begin
  3378. for i := 0 to High(fColorTable) do begin
  3379. fColorTable[i].r := i;
  3380. fColorTable[i].g := i;
  3381. fColorTable[i].b := i;
  3382. fColorTable[i].a := 0;
  3383. end;
  3384. end;
  3385. tfR3G3B2: begin
  3386. for i := 0 to High(fColorTable) do begin
  3387. fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
  3388. fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
  3389. fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
  3390. fColorTable[i].a := 0;
  3391. end;
  3392. end;
  3393. end;
  3394. end;
  3395. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3396. procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3397. var
  3398. d: Byte;
  3399. begin
  3400. if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
  3401. raise EglBitmapException.Create(UNSUPPORTED_FORMAT);
  3402. case Format of
  3403. tfLuminance4: begin
  3404. if (aMapData = nil) then
  3405. aData^ := 0;
  3406. d := LuminanceWeight(aPixel) and Range.r;
  3407. aData^ := aData^ or (d shl (4 - PtrInt(aMapData)));
  3408. inc(aMapData, 4);
  3409. if (PtrInt(aMapData) >= 8) then begin
  3410. inc(aData);
  3411. aMapData := nil;
  3412. end;
  3413. end;
  3414. tfLuminance8: begin
  3415. aData^ := LuminanceWeight(aPixel) and Range.r;
  3416. inc(aData);
  3417. end;
  3418. tfR3G3B2: begin
  3419. aData^ := Round(
  3420. ((aPixel.Data.r and Range.r) shl Shift.r) or
  3421. ((aPixel.Data.g and Range.g) shl Shift.g) or
  3422. ((aPixel.Data.b and Range.b) shl Shift.b));
  3423. inc(aData);
  3424. end;
  3425. end;
  3426. end;
  3427. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3428. procedure TbmpColorTableFormat.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3429. type
  3430. PUInt64 = ^UInt64;
  3431. var
  3432. idx: UInt64;
  3433. s: Integer;
  3434. bits: Byte;
  3435. f: Single;
  3436. begin
  3437. s := Trunc(fPixelSize);
  3438. f := fPixelSize - s;
  3439. bits := Round(8 * f);
  3440. case s of
  3441. 0: idx := (aData^ shr (8 - bits - PtrInt(aMapData))) and ((1 shl bits) - 1);
  3442. 1: idx := aData^;
  3443. 2: idx := PWord(aData)^;
  3444. 4: idx := PCardinal(aData)^;
  3445. 8: idx := PUInt64(aData)^;
  3446. else
  3447. raise EglBitmapException.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
  3448. end;
  3449. if (idx >= Length(fColorTable)) then
  3450. raise EglBitmapException.CreateFmt('invalid color index: %d', [idx]);
  3451. with fColorTable[idx] do begin
  3452. aPixel.Data.r := r;
  3453. aPixel.Data.g := g;
  3454. aPixel.Data.b := b;
  3455. aPixel.Data.a := a;
  3456. end;
  3457. inc(aMapData, bits);
  3458. if (PtrInt(aMapData) >= 8) then begin
  3459. inc(aData, 1);
  3460. dec(aMapData, 8);
  3461. end;
  3462. inc(aData, s);
  3463. end;
  3464. destructor TbmpColorTableFormat.Destroy;
  3465. begin
  3466. SetLength(fColorTable, 0);
  3467. inherited Destroy;
  3468. end;
  3469. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3470. //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3471. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3472. procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
  3473. var
  3474. i: Integer;
  3475. begin
  3476. for i := 0 to 3 do begin
  3477. if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
  3478. if (aSourceFD.Range.arr[i] > 0) then
  3479. aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
  3480. else
  3481. aPixel.Data.arr[i] := aDestFD.Range.arr[i];
  3482. end;
  3483. end;
  3484. end;
  3485. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3486. procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
  3487. begin
  3488. with aFuncRec do begin
  3489. if (Source.Range.r > 0) then
  3490. Dest.Data.r := Source.Data.r;
  3491. if (Source.Range.g > 0) then
  3492. Dest.Data.g := Source.Data.g;
  3493. if (Source.Range.b > 0) then
  3494. Dest.Data.b := Source.Data.b;
  3495. if (Source.Range.a > 0) then
  3496. Dest.Data.a := Source.Data.a;
  3497. end;
  3498. end;
  3499. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3500. procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3501. var
  3502. i: Integer;
  3503. begin
  3504. with aFuncRec do begin
  3505. for i := 0 to 3 do
  3506. if (Source.Range.arr[i] > 0) then
  3507. Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
  3508. end;
  3509. end;
  3510. type
  3511. TShiftData = packed record
  3512. case Integer of
  3513. 0: (r, g, b, a: SmallInt);
  3514. 1: (arr: array[0..3] of SmallInt);
  3515. end;
  3516. PShiftData = ^TShiftData;
  3517. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3518. procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3519. var
  3520. i: Integer;
  3521. begin
  3522. with aFuncRec do
  3523. for i := 0 to 3 do
  3524. if (Source.Range.arr[i] > 0) then
  3525. Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
  3526. end;
  3527. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3528. procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
  3529. begin
  3530. with aFuncRec do begin
  3531. Dest.Data := Source.Data;
  3532. if (Args and $1 > 0) then begin
  3533. Dest.Data.r := Dest.Data.r xor Dest.Range.r;
  3534. Dest.Data.g := Dest.Data.g xor Dest.Range.g;
  3535. Dest.Data.b := Dest.Data.b xor Dest.Range.b;
  3536. end;
  3537. if (Args and $2 > 0) then begin
  3538. Dest.Data.a := Dest.Data.a xor Dest.Range.a;
  3539. end;
  3540. end;
  3541. end;
  3542. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3543. procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
  3544. var
  3545. i: Integer;
  3546. begin
  3547. with aFuncRec do begin
  3548. for i := 0 to 3 do
  3549. Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
  3550. end;
  3551. end;
  3552. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3553. procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3554. var
  3555. Temp: Single;
  3556. begin
  3557. with FuncRec do begin
  3558. if (FuncRec.Args = 0) then begin //source has no alpha
  3559. Temp :=
  3560. Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
  3561. Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
  3562. Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
  3563. Dest.Data.a := Round(Dest.Range.a * Temp);
  3564. end else
  3565. Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
  3566. end;
  3567. end;
  3568. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3569. procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3570. type
  3571. PglBitmapPixelData = ^TglBitmapPixelData;
  3572. begin
  3573. with FuncRec do begin
  3574. Dest.Data.r := Source.Data.r;
  3575. Dest.Data.g := Source.Data.g;
  3576. Dest.Data.b := Source.Data.b;
  3577. with PglBitmapPixelData(Args)^ do
  3578. if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
  3579. (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
  3580. (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
  3581. Dest.Data.a := 0
  3582. else
  3583. Dest.Data.a := Dest.Range.a;
  3584. end;
  3585. end;
  3586. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3587. procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3588. type
  3589. PglBitmapPixelData = ^TglBitmapPixelData;
  3590. begin
  3591. with FuncRec do begin
  3592. Dest.Data.r := Source.Data.r;
  3593. Dest.Data.g := Source.Data.g;
  3594. Dest.Data.b := Source.Data.b;
  3595. Dest.Data.a := PCardinal(Args)^;
  3596. end;
  3597. end;
  3598. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3599. procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
  3600. type
  3601. PRGBPix = ^TRGBPix;
  3602. TRGBPix = array [0..2] of byte;
  3603. var
  3604. Temp: Byte;
  3605. begin
  3606. while aWidth > 0 do begin
  3607. Temp := PRGBPix(aData)^[0];
  3608. PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
  3609. PRGBPix(aData)^[2] := Temp;
  3610. if aHasAlpha then
  3611. Inc(aData, 4)
  3612. else
  3613. Inc(aData, 3);
  3614. dec(aWidth);
  3615. end;
  3616. end;
  3617. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3618. //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3619. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3620. function TglBitmap.GetWidth: Integer;
  3621. begin
  3622. if (ffX in fDimension.Fields) then
  3623. result := fDimension.X
  3624. else
  3625. result := -1;
  3626. end;
  3627. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3628. function TglBitmap.GetHeight: Integer;
  3629. begin
  3630. if (ffY in fDimension.Fields) then
  3631. result := fDimension.Y
  3632. else
  3633. result := -1;
  3634. end;
  3635. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3636. function TglBitmap.GetFileWidth: Integer;
  3637. begin
  3638. result := Max(1, Width);
  3639. end;
  3640. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3641. function TglBitmap.GetFileHeight: Integer;
  3642. begin
  3643. result := Max(1, Height);
  3644. end;
  3645. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3646. procedure TglBitmap.SetCustomData(const aValue: Pointer);
  3647. begin
  3648. if fCustomData = aValue then
  3649. exit;
  3650. fCustomData := aValue;
  3651. end;
  3652. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3653. procedure TglBitmap.SetCustomName(const aValue: String);
  3654. begin
  3655. if fCustomName = aValue then
  3656. exit;
  3657. fCustomName := aValue;
  3658. end;
  3659. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3660. procedure TglBitmap.SetCustomNameW(const aValue: WideString);
  3661. begin
  3662. if fCustomNameW = aValue then
  3663. exit;
  3664. fCustomNameW := aValue;
  3665. end;
  3666. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3667. procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
  3668. begin
  3669. if fDeleteTextureOnFree = aValue then
  3670. exit;
  3671. fDeleteTextureOnFree := aValue;
  3672. end;
  3673. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3674. procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
  3675. begin
  3676. if fFormat = aValue then
  3677. exit;
  3678. if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
  3679. raise EglBitmapUnsupportedFormatFormat.Create('SetInternalFormat - ' + UNSUPPORTED_FORMAT);
  3680. SetDataPointer(Data, aValue, Width, Height);
  3681. end;
  3682. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3683. procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
  3684. begin
  3685. if fFreeDataAfterGenTexture = aValue then
  3686. exit;
  3687. fFreeDataAfterGenTexture := aValue;
  3688. end;
  3689. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3690. procedure TglBitmap.SetID(const aValue: Cardinal);
  3691. begin
  3692. if fID = aValue then
  3693. exit;
  3694. fID := aValue;
  3695. end;
  3696. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3697. procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
  3698. begin
  3699. if fMipMap = aValue then
  3700. exit;
  3701. fMipMap := aValue;
  3702. end;
  3703. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3704. procedure TglBitmap.SetTarget(const aValue: Cardinal);
  3705. begin
  3706. if fTarget = aValue then
  3707. exit;
  3708. fTarget := aValue;
  3709. end;
  3710. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3711. procedure TglBitmap.SetAnisotropic(const aValue: Integer);
  3712. var
  3713. MaxAnisotropic: Integer;
  3714. begin
  3715. fAnisotropic := aValue;
  3716. if (ID > 0) then begin
  3717. if GL_EXT_texture_filter_anisotropic then begin
  3718. if fAnisotropic > 0 then begin
  3719. Bind(false);
  3720. glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
  3721. if aValue > MaxAnisotropic then
  3722. fAnisotropic := MaxAnisotropic;
  3723. glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
  3724. end;
  3725. end else begin
  3726. fAnisotropic := 0;
  3727. end;
  3728. end;
  3729. end;
  3730. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3731. procedure TglBitmap.CreateID;
  3732. begin
  3733. if (ID <> 0) then
  3734. glDeleteTextures(1, @fID);
  3735. glGenTextures(1, @fID);
  3736. Bind(false);
  3737. end;
  3738. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3739. procedure TglBitmap.SetupParameters(var aBuildWithGlu: Boolean);
  3740. begin
  3741. // Set Up Parameters
  3742. SetWrap(fWrapS, fWrapT, fWrapR);
  3743. SetFilter(fFilterMin, fFilterMag);
  3744. SetAnisotropic(fAnisotropic);
  3745. SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
  3746. // Mip Maps Generation Mode
  3747. aBuildWithGlu := false;
  3748. if (MipMap = mmMipmap) then begin
  3749. if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
  3750. glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
  3751. else
  3752. aBuildWithGlu := true;
  3753. end else if (MipMap = mmMipmapGlu) then
  3754. aBuildWithGlu := true;
  3755. end;
  3756. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3757. procedure TglBitmap.SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
  3758. const aWidth: Integer; const aHeight: Integer);
  3759. var
  3760. s: Single;
  3761. begin
  3762. if (Data <> aData) then begin
  3763. if (Assigned(Data)) then
  3764. FreeMem(Data);
  3765. fData := aData;
  3766. end;
  3767. FillChar(fDimension, SizeOf(fDimension), 0);
  3768. if not Assigned(fData) then begin
  3769. fFormat := tfEmpty;
  3770. fPixelSize := 0;
  3771. fRowSize := 0;
  3772. end else begin
  3773. if aWidth <> -1 then begin
  3774. fDimension.Fields := fDimension.Fields + [ffX];
  3775. fDimension.X := aWidth;
  3776. end;
  3777. if aHeight <> -1 then begin
  3778. fDimension.Fields := fDimension.Fields + [ffY];
  3779. fDimension.Y := aHeight;
  3780. end;
  3781. s := TFormatDescriptor.Get(aFormat).PixelSize;
  3782. fFormat := aFormat;
  3783. fPixelSize := Ceil(s);
  3784. fRowSize := Ceil(s * aWidth);
  3785. end;
  3786. end;
  3787. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3788. function TglBitmap.FlipHorz: Boolean;
  3789. begin
  3790. result := false;
  3791. end;
  3792. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3793. function TglBitmap.FlipVert: Boolean;
  3794. begin
  3795. result := false;
  3796. end;
  3797. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3798. //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3799. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3800. procedure TglBitmap.AfterConstruction;
  3801. begin
  3802. inherited AfterConstruction;
  3803. fID := 0;
  3804. fTarget := 0;
  3805. fIsResident := false;
  3806. fFormat := glBitmapGetDefaultFormat;
  3807. fMipMap := glBitmapDefaultMipmap;
  3808. fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
  3809. fDeleteTextureOnFree := glBitmapGetDefaultDeleteTextureOnFree;
  3810. glBitmapGetDefaultFilter (fFilterMin, fFilterMag);
  3811. glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
  3812. end;
  3813. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3814. procedure TglBitmap.BeforeDestruction;
  3815. begin
  3816. SetDataPointer(nil, tfEmpty);
  3817. if (fID > 0) and fDeleteTextureOnFree then
  3818. glDeleteTextures(1, @fID);
  3819. inherited BeforeDestruction;
  3820. end;
  3821. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3822. procedure TglBitmap.LoadFromFile(const aFilename: String);
  3823. var
  3824. fs: TFileStream;
  3825. begin
  3826. if not FileExists(aFilename) then
  3827. raise EglBitmapException.Create('file does not exist: ' + aFilename);
  3828. fFilename := aFilename;
  3829. fs := TFileStream.Create(fFilename, fmOpenRead);
  3830. try
  3831. fs.Position := 0;
  3832. LoadFromStream(fs);
  3833. finally
  3834. fs.Free;
  3835. end;
  3836. end;
  3837. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3838. procedure TglBitmap.LoadFromStream(const aStream: TStream);
  3839. begin
  3840. {$IFDEF GLB_SUPPORT_PNG_READ}
  3841. if not LoadPNG(aStream) then
  3842. {$ENDIF}
  3843. {$IFDEF GLB_SUPPORT_JPEG_READ}
  3844. if not LoadJPEG(aStream) then
  3845. {$ENDIF}
  3846. if not LoadDDS(aStream) then
  3847. if not LoadTGA(aStream) then
  3848. if not LoadBMP(aStream) then
  3849. raise EglBitmapException.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
  3850. end;
  3851. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3852. procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  3853. const aFormat: TglBitmapFormat; const aArgs: PtrInt);
  3854. var
  3855. tmpData: PByte;
  3856. size: Integer;
  3857. begin
  3858. size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  3859. GetMem(tmpData, size);
  3860. try
  3861. FillChar(tmpData^, size, #$FF);
  3862. SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y);
  3863. except
  3864. FreeMem(tmpData);
  3865. raise;
  3866. end;
  3867. AddFunc(Self, aFunc, false, Format, aArgs);
  3868. end;
  3869. {$IFDEF GLB_DELPHI}
  3870. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3871. procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil);
  3872. var
  3873. rs: TResourceStream;
  3874. TempPos: Integer;
  3875. ResTypeStr: String;
  3876. TempResType: PChar;
  3877. begin
  3878. if not Assigned(ResType) then begin
  3879. TempPos := Pos('.', Resource);
  3880. ResTypeStr := UpperCase(Copy(Resource, TempPos + 1, Length(Resource) - TempPos));
  3881. Resource := UpperCase(Copy(Resource, 0, TempPos -1));
  3882. TempResType := PChar(ResTypeStr);
  3883. end else
  3884. TempResType := ResType
  3885. rs := TResourceStream.Create(Instance, Resource, TempResType);
  3886. try
  3887. LoadFromStream(rs);
  3888. finally
  3889. rs.Free;
  3890. end;
  3891. end;
  3892. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3893. procedure TglBitmap.LoadFromResourceID(const sInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  3894. var
  3895. rs: TResourceStream;
  3896. begin
  3897. rs := TResourceStream.CreateFromID(Instance, ResourceID, ResType);
  3898. try
  3899. LoadFromStream(rs);
  3900. finally
  3901. rs.Free;
  3902. end;
  3903. end;
  3904. {$ENDIF}
  3905. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3906. procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  3907. var
  3908. fs: TFileStream;
  3909. begin
  3910. fs := TFileStream.Create(aFileName, fmCreate);
  3911. try
  3912. fs.Position := 0;
  3913. SaveToStream(fs, aFileType);
  3914. finally
  3915. fs.Free;
  3916. end;
  3917. end;
  3918. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3919. procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
  3920. begin
  3921. case aFileType of
  3922. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  3923. ftPNG: SavePng(aStream);
  3924. {$ENDIF}
  3925. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  3926. ftJPEG: SaveJPEG(aStream);
  3927. {$ENDIF}
  3928. ftDDS: SaveDDS(aStream);
  3929. ftTGA: SaveTGA(aStream);
  3930. ftBMP: SaveBMP(aStream);
  3931. end;
  3932. end;
  3933. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3934. function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: PtrInt): Boolean;
  3935. begin
  3936. result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
  3937. end;
  3938. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3939. function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  3940. const aFormat: TglBitmapFormat; const aArgs: PtrInt): Boolean;
  3941. var
  3942. DestData, TmpData, SourceData: pByte;
  3943. TempHeight, TempWidth: Integer;
  3944. SourceFD, DestFD: TFormatDescriptor;
  3945. SourceMD, DestMD: Pointer;
  3946. FuncRec: TglBitmapFunctionRec;
  3947. begin
  3948. Assert(Assigned(Data));
  3949. Assert(Assigned(aSource));
  3950. Assert(Assigned(aSource.Data));
  3951. result := false;
  3952. if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
  3953. SourceFD := TFormatDescriptor.Get(aSource.Format);
  3954. DestFD := TFormatDescriptor.Get(aFormat);
  3955. // inkompatible Formats so CreateTemp
  3956. if (SourceFD.PixelSize <> DestFD.PixelSize) then
  3957. aCreateTemp := true;
  3958. // Values
  3959. TempHeight := Max(1, aSource.Height);
  3960. TempWidth := Max(1, aSource.Width);
  3961. FuncRec.Sender := Self;
  3962. FuncRec.Args := aArgs;
  3963. TmpData := nil;
  3964. if aCreateTemp then begin
  3965. GetMem(TmpData, TFormatDescriptor.Get(aFormat).GetSize(TempWidth, TempHeight));
  3966. DestData := TmpData;
  3967. end else
  3968. DestData := Data;
  3969. try
  3970. SourceFD.PreparePixel(FuncRec.Source);
  3971. DestFD.PreparePixel (FuncRec.Dest);
  3972. SourceMD := SourceFD.CreateMappingData;
  3973. DestMD := DestFD.CreateMappingData;
  3974. FuncRec.Size := aSource.Dimension;
  3975. FuncRec.Position.Fields := FuncRec.Size.Fields;
  3976. try
  3977. SourceData := aSource.Data;
  3978. FuncRec.Position.Y := 0;
  3979. while FuncRec.Position.Y < TempHeight do begin
  3980. FuncRec.Position.X := 0;
  3981. while FuncRec.Position.X < TempWidth do begin
  3982. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  3983. aFunc(FuncRec);
  3984. DestFD.Map(FuncRec.Dest, DestData, DestMD);
  3985. inc(FuncRec.Position.X);
  3986. end;
  3987. inc(FuncRec.Position.Y);
  3988. end;
  3989. // Updating Image or InternalFormat
  3990. if aCreateTemp then
  3991. SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height)
  3992. else if (aFormat <> fFormat) then
  3993. Format := aFormat;
  3994. result := true;
  3995. finally
  3996. SourceFD.FreeMappingData(SourceMD);
  3997. DestFD.FreeMappingData(DestMD);
  3998. end;
  3999. except
  4000. if aCreateTemp then
  4001. FreeMem(TmpData);
  4002. raise;
  4003. end;
  4004. end;
  4005. end;
  4006. {$IFDEF GLB_SDL}
  4007. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4008. function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  4009. var
  4010. Row, RowSize: Integer;
  4011. SourceData, TmpData: PByte;
  4012. TempDepth: Integer;
  4013. Pix: TglBitmapPixelData;
  4014. FormatDesc: TglBitmapFormatDescriptor;
  4015. function GetRowPointer(Row: Integer): pByte;
  4016. begin
  4017. result := Surface.pixels;
  4018. Inc(result, Row * RowSize);
  4019. end;
  4020. begin
  4021. result := false;
  4022. (* TODO
  4023. if not FormatIsUncompressed(InternalFormat) then
  4024. raise EglBitmapUnsupportedInternalFormat.Create('AssignToSurface - ' + UNSUPPORTED_INTERNAL_FORMAT);
  4025. *)
  4026. FormatDesc := FORMAT_DESCRIPTORS[Format];
  4027. if Assigned(Data) then begin
  4028. case Trunc(FormatDesc.GetSize) of
  4029. 1: TempDepth := 8;
  4030. 2: TempDepth := 16;
  4031. 3: TempDepth := 24;
  4032. 4: TempDepth := 32;
  4033. else
  4034. raise EglBitmapException.Create('AssignToSurface - ' + UNSUPPORTED_INTERNAL_FORMAT);
  4035. end;
  4036. FormatDesc.PreparePixel(Pix);
  4037. with Pix.PixelDesc do
  4038. Surface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
  4039. RedRange shl RedShift, GreenRange shl GreenShift, BlueRange shl BlueShift, AlphaRange shl AlphaShift);
  4040. SourceData := Data;
  4041. RowSize := Ceil(FileWidth * FormatDesc.GetSize);
  4042. for Row := 0 to FileHeight -1 do begin
  4043. TmpData := GetRowPointer(Row);
  4044. if Assigned(TmpData) then begin
  4045. Move(SourceData^, TmpData^, RowSize);
  4046. inc(SourceData, RowSize);
  4047. end;
  4048. end;
  4049. result := true;
  4050. end;
  4051. end;
  4052. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4053. function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  4054. var
  4055. pSource, pData, pTempData: PByte;
  4056. Row, RowSize, TempWidth, TempHeight: Integer;
  4057. IntFormat, f: TglBitmapInternalFormat;
  4058. FormatDesc: TglBitmapFormatDescriptor;
  4059. function GetRowPointer(Row: Integer): pByte;
  4060. begin
  4061. result := Surface^.pixels;
  4062. Inc(result, Row * RowSize);
  4063. end;
  4064. begin
  4065. result := false;
  4066. if (Assigned(Surface)) then begin
  4067. with Surface^.format^ do begin
  4068. IntFormat := tfEmpty;
  4069. for f := Low(f) to High(f) do begin
  4070. if FORMAT_DESCRIPTORS[f].MaskMatch(RMask, GMask, BMask, AMask) then begin
  4071. IntFormat := f;
  4072. break;
  4073. end;
  4074. end;
  4075. if (IntFormat = tfEmpty) then
  4076. raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
  4077. end;
  4078. FormatDesc := FORMAT_DESCRIPTORS[IntFormat];
  4079. TempWidth := Surface^.w;
  4080. TempHeight := Surface^.h;
  4081. RowSize := Trunc(TempWidth * FormatDesc.GetSize);
  4082. GetMem(pData, TempHeight * RowSize);
  4083. try
  4084. pTempData := pData;
  4085. for Row := 0 to TempHeight -1 do begin
  4086. pSource := GetRowPointer(Row);
  4087. if (Assigned(pSource)) then begin
  4088. Move(pSource^, pTempData^, RowSize);
  4089. Inc(pTempData, RowSize);
  4090. end;
  4091. end;
  4092. SetDataPointer(pData, IntFormat, TempWidth, TempHeight);
  4093. result := true;
  4094. except
  4095. FreeMem(pData);
  4096. raise;
  4097. end;
  4098. end;
  4099. end;
  4100. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4101. function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  4102. var
  4103. Row, Col, AlphaInterleave: Integer;
  4104. pSource, pDest: PByte;
  4105. function GetRowPointer(Row: Integer): pByte;
  4106. begin
  4107. result := aSurface.pixels;
  4108. Inc(result, Row * Width);
  4109. end;
  4110. begin
  4111. result := false;
  4112. if Assigned(Data) then begin
  4113. if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
  4114. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
  4115. AlphaInterleave := 0;
  4116. case Format of
  4117. ifLuminance8Alpha8:
  4118. AlphaInterleave := 1;
  4119. ifBGRA8, ifRGBA8:
  4120. AlphaInterleave := 3;
  4121. end;
  4122. pSource := Data;
  4123. for Row := 0 to Height -1 do begin
  4124. pDest := GetRowPointer(Row);
  4125. if Assigned(pDest) then begin
  4126. for Col := 0 to Width -1 do begin
  4127. Inc(pSource, AlphaInterleave);
  4128. pDest^ := pSource^;
  4129. Inc(pDest);
  4130. Inc(pSource);
  4131. end;
  4132. end;
  4133. end;
  4134. result := true;
  4135. end;
  4136. end;
  4137. end;
  4138. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4139. function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
  4140. var
  4141. bmp: TglBitmap2D;
  4142. begin
  4143. bmp := TglBitmap2D.Create;
  4144. try
  4145. bmp.AssignFromSurface(Surface);
  4146. result := AddAlphaFromGlBitmap(bmp, Func, CustomData);
  4147. finally
  4148. bmp.Free;
  4149. end;
  4150. end;
  4151. {$ENDIF}
  4152. {$IFDEF GLB_DELPHI}
  4153. //TODO rework & test
  4154. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4155. function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
  4156. var
  4157. Row: Integer;
  4158. pSource, pData: PByte;
  4159. begin
  4160. result := false;
  4161. if Assigned(Data) then begin
  4162. if Assigned(aBitmap) then begin
  4163. aBitmap.Width := Width;
  4164. aBitmap.Height := Height;
  4165. case Format of
  4166. tfAlpha8, ifLuminance, ifDepth8:
  4167. begin
  4168. Bitmap.PixelFormat := pf8bit;
  4169. Bitmap.Palette := CreateGrayPalette;
  4170. end;
  4171. ifRGB5A1:
  4172. Bitmap.PixelFormat := pf15bit;
  4173. ifR5G6B5:
  4174. Bitmap.PixelFormat := pf16bit;
  4175. ifRGB8, ifBGR8:
  4176. Bitmap.PixelFormat := pf24bit;
  4177. ifRGBA8, ifBGRA8:
  4178. Bitmap.PixelFormat := pf32bit;
  4179. else
  4180. raise EglBitmapException.Create('AssignToBitmap - Invalid Pixelformat.');
  4181. end;
  4182. pSource := Data;
  4183. for Row := 0 to FileHeight -1 do begin
  4184. pData := Bitmap.Scanline[Row];
  4185. Move(pSource^, pData^, fRowSize);
  4186. Inc(pSource, fRowSize);
  4187. // swap RGB(A) to BGR(A)
  4188. if InternalFormat in [ifRGB8, ifRGBA8] then
  4189. SwapRGB(pData, FileWidth, InternalFormat = ifRGBA8);
  4190. end;
  4191. result := true;
  4192. end;
  4193. end;
  4194. end;
  4195. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4196. function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  4197. var
  4198. pSource, pData, pTempData: PByte;
  4199. Row, RowSize, TempWidth, TempHeight: Integer;
  4200. IntFormat: TglBitmapInternalFormat;
  4201. begin
  4202. result := false;
  4203. if (Assigned(Bitmap)) then begin
  4204. case Bitmap.PixelFormat of
  4205. pf8bit:
  4206. IntFormat := ifLuminance;
  4207. pf15bit:
  4208. IntFormat := ifRGB5A1;
  4209. pf16bit:
  4210. IntFormat := ifR5G6B5;
  4211. pf24bit:
  4212. IntFormat := ifBGR8;
  4213. pf32bit:
  4214. IntFormat := ifBGRA8;
  4215. else
  4216. raise EglBitmapException.Create('AssignFromBitmap - Invalid Pixelformat.');
  4217. end;
  4218. TempWidth := Bitmap.Width;
  4219. TempHeight := Bitmap.Height;
  4220. RowSize := Trunc(TempWidth * FormatGetSize(IntFormat));
  4221. GetMem(pData, TempHeight * RowSize);
  4222. try
  4223. pTempData := pData;
  4224. for Row := 0 to TempHeight -1 do begin
  4225. pSource := Bitmap.Scanline[Row];
  4226. if (Assigned(pSource)) then begin
  4227. Move(pSource^, pTempData^, RowSize);
  4228. Inc(pTempData, RowSize);
  4229. end;
  4230. end;
  4231. SetDataPointer(pData, IntFormat, TempWidth, TempHeight);
  4232. result := true;
  4233. except
  4234. FreeMem(pData);
  4235. raise;
  4236. end;
  4237. end;
  4238. end;
  4239. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4240. function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  4241. var
  4242. Row, Col, AlphaInterleave: Integer;
  4243. pSource, pDest: PByte;
  4244. begin
  4245. result := false;
  4246. if Assigned(Data) then begin
  4247. if InternalFormat in [ifAlpha, ifLuminanceAlpha, ifRGBA8, ifBGRA8] then begin
  4248. if Assigned(Bitmap) then begin
  4249. Bitmap.PixelFormat := pf8bit;
  4250. Bitmap.Palette := CreateGrayPalette;
  4251. Bitmap.Width := Width;
  4252. Bitmap.Height := Height;
  4253. case InternalFormat of
  4254. ifLuminanceAlpha:
  4255. AlphaInterleave := 1;
  4256. ifRGBA8, ifBGRA8:
  4257. AlphaInterleave := 3;
  4258. else
  4259. AlphaInterleave := 0;
  4260. end;
  4261. // Copy Data
  4262. pSource := Data;
  4263. for Row := 0 to Height -1 do begin
  4264. pDest := Bitmap.Scanline[Row];
  4265. if Assigned(pDest) then begin
  4266. for Col := 0 to Width -1 do begin
  4267. Inc(pSource, AlphaInterleave);
  4268. pDest^ := pSource^;
  4269. Inc(pDest);
  4270. Inc(pSource);
  4271. end;
  4272. end;
  4273. end;
  4274. result := true;
  4275. end;
  4276. end;
  4277. end;
  4278. end;
  4279. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4280. function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
  4281. var
  4282. tex: TglBitmap2D;
  4283. begin
  4284. tex := TglBitmap2D.Create;
  4285. try
  4286. tex.AssignFromBitmap(Bitmap);
  4287. result := AddAlphaFromglBitmap(tex, Func, CustomData);
  4288. finally
  4289. tex.Free;
  4290. end;
  4291. end;
  4292. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4293. function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar;
  4294. const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
  4295. var
  4296. RS: TResourceStream;
  4297. TempPos: Integer;
  4298. ResTypeStr: String;
  4299. TempResType: PChar;
  4300. begin
  4301. if Assigned(ResType) then
  4302. TempResType := ResType
  4303. else
  4304. begin
  4305. TempPos := Pos('.', Resource);
  4306. ResTypeStr := UpperCase(Copy(Resource, TempPos + 1, Length(Resource) - TempPos));
  4307. Resource := UpperCase(Copy(Resource, 0, TempPos -1));
  4308. TempResType := PChar(ResTypeStr);
  4309. end;
  4310. RS := TResourceStream.Create(Instance, Resource, TempResType);
  4311. try
  4312. result := AddAlphaFromStream(RS, Func, CustomData);
  4313. finally
  4314. RS.Free;
  4315. end;
  4316. end;
  4317. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4318. function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  4319. const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
  4320. var
  4321. RS: TResourceStream;
  4322. begin
  4323. RS := TResourceStream.CreateFromID(Instance, ResourceID, ResType);
  4324. try
  4325. result := AddAlphaFromStream(RS, Func, CustomData);
  4326. finally
  4327. RS.Free;
  4328. end;
  4329. end;
  4330. {$ENDIF}
  4331. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4332. function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
  4333. begin
  4334. (* TODO
  4335. if not FormatIsUncompressed(InternalFormat) then
  4336. raise EglBitmapUnsupportedFormatFormat.Create('AddAlphaFromFunc - ' + UNSUPPORTED_FORMAT);
  4337. *)
  4338. result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
  4339. end;
  4340. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4341. function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
  4342. var
  4343. FS: TFileStream;
  4344. begin
  4345. FS := TFileStream.Create(FileName, fmOpenRead);
  4346. try
  4347. result := AddAlphaFromStream(FS, aFunc, aArgs);
  4348. finally
  4349. FS.Free;
  4350. end;
  4351. end;
  4352. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4353. function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
  4354. var
  4355. tex: TglBitmap2D;
  4356. begin
  4357. tex := TglBitmap2D.Create(aStream);
  4358. try
  4359. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4360. finally
  4361. tex.Free;
  4362. end;
  4363. end;
  4364. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4365. function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
  4366. var
  4367. DestData, DestData2, SourceData: pByte;
  4368. TempHeight, TempWidth: Integer;
  4369. SourceFD, DestFD: TFormatDescriptor;
  4370. SourceMD, DestMD, DestMD2: Pointer;
  4371. FuncRec: TglBitmapFunctionRec;
  4372. begin
  4373. result := false;
  4374. Assert(Assigned(Data));
  4375. Assert(Assigned(aBitmap));
  4376. Assert(Assigned(aBitmap.Data));
  4377. if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
  4378. result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
  4379. if not Assigned(aFunc) then
  4380. aFunc := glBitmapAlphaFunc;
  4381. SourceFD := TFormatDescriptor.Get(aBitmap.Format);
  4382. DestFD := TFormatDescriptor.Get(Format);
  4383. // Values
  4384. TempHeight := aBitmap.FileHeight;
  4385. TempWidth := aBitmap.FileWidth;
  4386. FuncRec.Sender := Self;
  4387. FuncRec.Args := aArgs;
  4388. FuncRec.Size := Dimension;
  4389. FuncRec.Position.Fields := FuncRec.Size.Fields;
  4390. FuncRec.Args := PtrInt(SourceFD.HasAlpha) and 1;
  4391. DestData := Data;
  4392. DestData2 := Data;
  4393. SourceData := aBitmap.Data;
  4394. // Mapping
  4395. SourceFD.PreparePixel(FuncRec.Source);
  4396. DestFD.PreparePixel (FuncRec.Dest);
  4397. SourceMD := SourceFD.CreateMappingData;
  4398. DestMD := DestFD.CreateMappingData;
  4399. DestMD2 := DestFD.CreateMappingData;
  4400. try
  4401. FuncRec.Position.Y := 0;
  4402. while FuncRec.Position.Y < TempHeight do begin
  4403. FuncRec.Position.X := 0;
  4404. while FuncRec.Position.X < TempWidth do begin
  4405. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  4406. DestFD.Unmap (DestData, FuncRec.Dest, DestMD);
  4407. aFunc(FuncRec);
  4408. DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
  4409. inc(FuncRec.Position.X);
  4410. end;
  4411. inc(FuncRec.Position.Y);
  4412. end;
  4413. finally
  4414. SourceFD.FreeMappingData(SourceMD);
  4415. DestFD.FreeMappingData(DestMD);
  4416. DestFD.FreeMappingData(DestMD2);
  4417. end;
  4418. end;
  4419. end;
  4420. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4421. function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
  4422. begin
  4423. result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
  4424. end;
  4425. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4426. function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
  4427. var
  4428. PixelData: TglBitmapPixelData;
  4429. begin
  4430. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4431. result := AddAlphaFromColorKeyFloat(
  4432. aRed / PixelData.Range.r,
  4433. aGreen / PixelData.Range.g,
  4434. aBlue / PixelData.Range.b,
  4435. aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
  4436. end;
  4437. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4438. function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
  4439. var
  4440. values: array[0..2] of Single;
  4441. tmp: Cardinal;
  4442. i: Integer;
  4443. PixelData: TglBitmapPixelData;
  4444. begin
  4445. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4446. with PixelData do begin
  4447. values[0] := aRed;
  4448. values[1] := aGreen;
  4449. values[2] := aBlue;
  4450. for i := 0 to 2 do begin
  4451. tmp := Trunc(Range.arr[i] * aDeviation);
  4452. Data.arr[i] := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
  4453. Range.arr[i] := Max(0, Trunc(Range.arr[i] * values[i] - tmp));
  4454. end;
  4455. Data.a := 0;
  4456. Range.a := 0;
  4457. end;
  4458. result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, PtrInt(@PixelData));
  4459. end;
  4460. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4461. function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
  4462. begin
  4463. result := AddAlphaFromValueFloat(aAlpha / $FF);
  4464. end;
  4465. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4466. function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  4467. var
  4468. PixelData: TglBitmapPixelData;
  4469. begin
  4470. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4471. result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
  4472. end;
  4473. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4474. function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  4475. var
  4476. PixelData: TglBitmapPixelData;
  4477. begin
  4478. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4479. with PixelData do
  4480. Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
  4481. result := AddAlphaFromFunc(glBitmapValueAlphaFunc, PtrInt(@PixelData.Data.a));
  4482. end;
  4483. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4484. function TglBitmap.RemoveAlpha: Boolean;
  4485. var
  4486. FormatDesc: TFormatDescriptor;
  4487. begin
  4488. result := false;
  4489. FormatDesc := TFormatDescriptor.Get(Format);
  4490. if Assigned(Data) then begin
  4491. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  4492. raise EglBitmapUnsupportedFormatFormat.Create('RemoveAlpha - ' + UNSUPPORTED_FORMAT);
  4493. result := ConvertTo(FormatDesc.WithoutAlpha);
  4494. end;
  4495. end;
  4496. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4497. function TglBitmap.Clone: TglBitmap;
  4498. var
  4499. Temp: TglBitmap;
  4500. TempPtr: PByte;
  4501. Size: Integer;
  4502. begin
  4503. result := nil;
  4504. Temp := (ClassType.Create as TglBitmap);
  4505. try
  4506. // copy texture data if assigned
  4507. if Assigned(Data) then begin
  4508. Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
  4509. GetMem(TempPtr, Size);
  4510. try
  4511. Move(Data^, TempPtr^, Size);
  4512. Temp.SetDataPointer(TempPtr, Format, Width, Height);
  4513. except
  4514. FreeMem(TempPtr);
  4515. raise;
  4516. end;
  4517. end else
  4518. Temp.SetDataPointer(nil, Format, Width, Height);
  4519. // copy properties
  4520. Temp.fID := ID;
  4521. Temp.fTarget := Target;
  4522. Temp.fFormat := Format;
  4523. Temp.fMipMap := MipMap;
  4524. Temp.fAnisotropic := Anisotropic;
  4525. Temp.fBorderColor := fBorderColor;
  4526. Temp.fDeleteTextureOnFree := DeleteTextureOnFree;
  4527. Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
  4528. Temp.fFilterMin := fFilterMin;
  4529. Temp.fFilterMag := fFilterMag;
  4530. Temp.fWrapS := fWrapS;
  4531. Temp.fWrapT := fWrapT;
  4532. Temp.fWrapR := fWrapR;
  4533. Temp.fFilename := fFilename;
  4534. Temp.fCustomName := fCustomName;
  4535. Temp.fCustomNameW := fCustomNameW;
  4536. Temp.fCustomData := fCustomData;
  4537. result := Temp;
  4538. except
  4539. FreeAndNil(Temp);
  4540. raise;
  4541. end;
  4542. end;
  4543. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4544. function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
  4545. var
  4546. SourceFD, DestFD: TFormatDescriptor;
  4547. SourcePD, DestPD: TglBitmapPixelData;
  4548. ShiftData: TShiftData;
  4549. function CanCopyDirect: Boolean;
  4550. begin
  4551. result :=
  4552. ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  4553. ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  4554. ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  4555. ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  4556. end;
  4557. function CanShift: Boolean;
  4558. begin
  4559. result :=
  4560. ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  4561. ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  4562. ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  4563. ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  4564. end;
  4565. function GetShift(aSource, aDest: Cardinal) : ShortInt;
  4566. begin
  4567. result := 0;
  4568. while (aSource > aDest) and (aSource > 0) do begin
  4569. inc(result);
  4570. aSource := aSource shr 1;
  4571. end;
  4572. end;
  4573. begin
  4574. if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
  4575. SourceFD := TFormatDescriptor.Get(Format);
  4576. DestFD := TFormatDescriptor.Get(aFormat);
  4577. SourceFD.PreparePixel(SourcePD);
  4578. DestFD.PreparePixel (DestPD);
  4579. if CanCopyDirect then
  4580. result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
  4581. else if CanShift then begin
  4582. ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
  4583. ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
  4584. ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
  4585. ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
  4586. result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, PtrInt(@ShiftData));
  4587. end else
  4588. result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
  4589. end else
  4590. result := true;
  4591. end;
  4592. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4593. procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
  4594. begin
  4595. if aUseRGB or aUseAlpha then
  4596. AddFunc(glBitmapInvertFunc, false, ((PtrInt(aUseAlpha) and 1) shl 1) or (PtrInt(aUseRGB) and 1));
  4597. end;
  4598. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4599. procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  4600. begin
  4601. fBorderColor[0] := aRed;
  4602. fBorderColor[1] := aGreen;
  4603. fBorderColor[2] := aBlue;
  4604. fBorderColor[3] := aAlpha;
  4605. if (ID > 0) then begin
  4606. Bind(false);
  4607. glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
  4608. end;
  4609. end;
  4610. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4611. procedure TglBitmap.FreeData;
  4612. begin
  4613. SetDataPointer(nil, tfEmpty);
  4614. end;
  4615. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4616. procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
  4617. const aAlpha: Byte);
  4618. begin
  4619. FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
  4620. end;
  4621. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4622. procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
  4623. var
  4624. PixelData: TglBitmapPixelData;
  4625. begin
  4626. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4627. FillWithColorFloat(
  4628. aRed / PixelData.Range.r,
  4629. aGreen / PixelData.Range.g,
  4630. aBlue / PixelData.Range.b,
  4631. aAlpha / PixelData.Range.a);
  4632. end;
  4633. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4634. procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
  4635. var
  4636. PixelData: TglBitmapPixelData;
  4637. begin
  4638. TFormatDescriptor.Get(Format).PreparePixel(PixelData);
  4639. with PixelData do begin
  4640. Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
  4641. Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
  4642. Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
  4643. Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
  4644. end;
  4645. AddFunc(glBitmapFillWithColorFunc, false, PtrInt(@PixelData));
  4646. end;
  4647. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4648. procedure TglBitmap.SetFilter(const aMin, aMag: Cardinal);
  4649. begin
  4650. //check MIN filter
  4651. case aMin of
  4652. GL_NEAREST:
  4653. fFilterMin := GL_NEAREST;
  4654. GL_LINEAR:
  4655. fFilterMin := GL_LINEAR;
  4656. GL_NEAREST_MIPMAP_NEAREST:
  4657. fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
  4658. GL_LINEAR_MIPMAP_NEAREST:
  4659. fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
  4660. GL_NEAREST_MIPMAP_LINEAR:
  4661. fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
  4662. GL_LINEAR_MIPMAP_LINEAR:
  4663. fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
  4664. else
  4665. raise EglBitmapException.Create('SetFilter - Unknow MIN filter.');
  4666. end;
  4667. //check MAG filter
  4668. case aMag of
  4669. GL_NEAREST:
  4670. fFilterMag := GL_NEAREST;
  4671. GL_LINEAR:
  4672. fFilterMag := GL_LINEAR;
  4673. else
  4674. raise EglBitmapException.Create('SetFilter - Unknow MAG filter.');
  4675. end;
  4676. //apply filter
  4677. if (ID > 0) then begin
  4678. Bind(false);
  4679. glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
  4680. if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
  4681. case fFilterMin of
  4682. GL_NEAREST, GL_LINEAR:
  4683. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  4684. GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
  4685. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
  4686. GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
  4687. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
  4688. end;
  4689. end else
  4690. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  4691. end;
  4692. end;
  4693. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4694. procedure TglBitmap.SetWrap(const S: Cardinal; const T: Cardinal; const R: Cardinal);
  4695. procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
  4696. begin
  4697. case aValue of
  4698. GL_CLAMP:
  4699. aTarget := GL_CLAMP;
  4700. GL_REPEAT:
  4701. aTarget := GL_REPEAT;
  4702. GL_CLAMP_TO_EDGE: begin
  4703. if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
  4704. aTarget := GL_CLAMP_TO_EDGE
  4705. else
  4706. aTarget := GL_CLAMP;
  4707. end;
  4708. GL_CLAMP_TO_BORDER: begin
  4709. if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
  4710. aTarget := GL_CLAMP_TO_BORDER
  4711. else
  4712. aTarget := GL_CLAMP;
  4713. end;
  4714. GL_MIRRORED_REPEAT: begin
  4715. if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
  4716. aTarget := GL_MIRRORED_REPEAT
  4717. else
  4718. raise EglBitmapException.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
  4719. end;
  4720. else
  4721. raise EglBitmapException.Create('SetWrap - Unknow Texturewrap (S).');
  4722. end;
  4723. end;
  4724. begin
  4725. CheckAndSetWrap(S, fWrapS);
  4726. CheckAndSetWrap(T, fWrapT);
  4727. CheckAndSetWrap(R, fWrapR);
  4728. if (ID > 0) then begin
  4729. Bind(false);
  4730. glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
  4731. glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
  4732. glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
  4733. end;
  4734. end;
  4735. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4736. procedure TglBitmap.GetPixel(const aPos: TglBitmapPixelPosition; var aPixel: TglBitmapPixelData);
  4737. begin
  4738. { TODO delete?
  4739. if Assigned (fGetPixelFunc) then
  4740. fGetPixelFunc(aPos, aPixel);
  4741. }
  4742. end;
  4743. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4744. procedure TglBitmap.SetPixel(const aPos: TglBitmapPixelPosition; const aPixel: TglBitmapPixelData);
  4745. begin
  4746. {TODO delete?
  4747. if Assigned (fSetPixelFunc) then
  4748. fSetPixelFuc(aPos, aPixel);
  4749. }
  4750. end;
  4751. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4752. procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
  4753. begin
  4754. if aEnableTextureUnit then
  4755. glEnable(Target);
  4756. if (ID > 0) then
  4757. glBindTexture(Target, ID);
  4758. end;
  4759. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4760. procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
  4761. begin
  4762. if aDisableTextureUnit then
  4763. glDisable(Target);
  4764. glBindTexture(Target, 0);
  4765. end;
  4766. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4767. constructor TglBitmap.Create;
  4768. begin
  4769. {$IFDEF GLB_NATIVE_OGL}
  4770. glbReadOpenGLExtensions;
  4771. {$ENDIF}
  4772. if (ClassType = TglBitmap) then
  4773. raise EglBitmapException.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
  4774. inherited Create;
  4775. end;
  4776. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4777. constructor TglBitmap.Create(const aFileName: String);
  4778. begin
  4779. Create;
  4780. LoadFromFile(FileName);
  4781. end;
  4782. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4783. constructor TglBitmap.Create(const aStream: TStream);
  4784. begin
  4785. Create;
  4786. LoadFromStream(aStream);
  4787. end;
  4788. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4789. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat);
  4790. var
  4791. Image: PByte;
  4792. ImageSize: Integer;
  4793. begin
  4794. Create;
  4795. TFormatDescriptor.Get(aFormat).GetSize(aSize);
  4796. GetMem(Image, ImageSize);
  4797. try
  4798. FillChar(Image^, ImageSize, #$FF);
  4799. SetDataPointer(Image, aFormat, aSize.X, aSize.Y);
  4800. except
  4801. FreeMem(Image);
  4802. raise;
  4803. end;
  4804. end;
  4805. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4806. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat;
  4807. const aFunc: TglBitmapFunction; const aArgs: PtrInt);
  4808. begin
  4809. Create;
  4810. LoadFromFunc(aSize, aFunc, aFormat, aArgs);
  4811. end;
  4812. {$IFDEF GLB_DELPHI}
  4813. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4814. constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
  4815. begin
  4816. Create;
  4817. LoadFromResource(aInstance, aResource, aResType);
  4818. end;
  4819. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4820. constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  4821. begin
  4822. Create;
  4823. LoadFromResourceID(aInstance, aResourceID, aResType);
  4824. end;
  4825. {$ENDIF}
  4826. {$IFDEF GLB_SUPPORT_PNG_READ}
  4827. {$IF DEFINED(GLB_SDL_IMAGE)}
  4828. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4829. //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4830. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4831. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  4832. var
  4833. Surface: PSDL_Surface;
  4834. RWops: PSDL_RWops;
  4835. begin
  4836. result := false;
  4837. RWops := glBitmapCreateRWops(aStream);
  4838. try
  4839. if IMG_isPNG(RWops) > 0 then begin
  4840. Surface := IMG_LoadPNG_RW(RWops);
  4841. try
  4842. AssignFromSurface(Surface);
  4843. Rresult := true;
  4844. finally
  4845. SDL_FreeSurface(Surface);
  4846. end;
  4847. end;
  4848. finally
  4849. SDL_FreeRW(RWops);
  4850. end;
  4851. end;
  4852. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  4853. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4854. procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  4855. begin
  4856. TStream(png_get_io_ptr(png)).Read(buffer^, size);
  4857. end;
  4858. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4859. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  4860. var
  4861. StreamPos: Int64;
  4862. signature: array [0..7] of byte;
  4863. png: png_structp;
  4864. png_info: png_infop;
  4865. TempHeight, TempWidth: Integer;
  4866. Format: TglBitmapInternalFormat;
  4867. png_data: pByte;
  4868. png_rows: array of pByte;
  4869. Row, LineSize: Integer;
  4870. begin
  4871. result := false;
  4872. if not init_libPNG then
  4873. raise Exception.Create('LoadPNG - unable to initialize libPNG.');
  4874. try
  4875. // signature
  4876. StreamPos := Stream.Position;
  4877. Stream.Read(signature, 8);
  4878. Stream.Position := StreamPos;
  4879. if png_check_sig(@signature, 8) <> 0 then begin
  4880. // png read struct
  4881. png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  4882. if png = nil then
  4883. raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
  4884. // png info
  4885. png_info := png_create_info_struct(png);
  4886. if png_info = nil then begin
  4887. png_destroy_read_struct(@png, nil, nil);
  4888. raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
  4889. end;
  4890. // set read callback
  4891. png_set_read_fn(png, stream, glBitmap_libPNG_read_func);
  4892. // read informations
  4893. png_read_info(png, png_info);
  4894. // size
  4895. TempHeight := png_get_image_height(png, png_info);
  4896. TempWidth := png_get_image_width(png, png_info);
  4897. // format
  4898. case png_get_color_type(png, png_info) of
  4899. PNG_COLOR_TYPE_GRAY:
  4900. Format := tfLuminance8;
  4901. PNG_COLOR_TYPE_GRAY_ALPHA:
  4902. Format := tfLuminance8Alpha8;
  4903. PNG_COLOR_TYPE_RGB:
  4904. Format := tfRGB8;
  4905. PNG_COLOR_TYPE_RGB_ALPHA:
  4906. Format := tfRGBA8;
  4907. else
  4908. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  4909. end;
  4910. // cut upper 8 bit from 16 bit formats
  4911. if png_get_bit_depth(png, png_info) > 8 then
  4912. png_set_strip_16(png);
  4913. // expand bitdepth smaller than 8
  4914. if png_get_bit_depth(png, png_info) < 8 then
  4915. png_set_expand(png);
  4916. // allocating mem for scanlines
  4917. LineSize := png_get_rowbytes(png, png_info);
  4918. GetMem(png_data, TempHeight * LineSize);
  4919. try
  4920. SetLength(png_rows, TempHeight);
  4921. for Row := Low(png_rows) to High(png_rows) do begin
  4922. png_rows[Row] := png_data;
  4923. Inc(png_rows[Row], Row * LineSize);
  4924. end;
  4925. // read complete image into scanlines
  4926. png_read_image(png, @png_rows[0]);
  4927. // read end
  4928. png_read_end(png, png_info);
  4929. // destroy read struct
  4930. png_destroy_read_struct(@png, @png_info, nil);
  4931. SetLength(png_rows, 0);
  4932. // set new data
  4933. SetDataPointer(png_data, Format, TempWidth, TempHeight);
  4934. result := true;
  4935. except
  4936. FreeMem(png_data);
  4937. raise;
  4938. end;
  4939. end;
  4940. finally
  4941. quit_libPNG;
  4942. end;
  4943. end;
  4944. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  4945. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4946. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  4947. var
  4948. StreamPos: Int64;
  4949. Png: TPNGObject;
  4950. Header: Array[0..7] of Byte;
  4951. Row, Col, PixSize, LineSize: Integer;
  4952. NewImage, pSource, pDest, pAlpha: pByte;
  4953. Format: TglBitmapInternalFormat;
  4954. const
  4955. PngHeader: Array[0..7] of Byte = (#137, #80, #78, #71, #13, #10, #26, #10);
  4956. begin
  4957. result := false;
  4958. StreamPos := Stream.Position;
  4959. Stream.Read(Header[0], SizeOf(Header));
  4960. Stream.Position := StreamPos;
  4961. {Test if the header matches}
  4962. if Header = PngHeader then begin
  4963. Png := TPNGObject.Create;
  4964. try
  4965. Png.LoadFromStream(Stream);
  4966. case Png.Header.ColorType of
  4967. COLOR_GRAYSCALE:
  4968. Format := ifLuminance;
  4969. COLOR_GRAYSCALEALPHA:
  4970. Format := ifLuminanceAlpha;
  4971. COLOR_RGB:
  4972. Format := ifBGR8;
  4973. COLOR_RGBALPHA:
  4974. Format := ifBGRA8;
  4975. else
  4976. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  4977. end;
  4978. PixSize := Trunc(FormatGetSize(Format));
  4979. LineSize := Integer(Png.Header.Width) * PixSize;
  4980. GetMem(NewImage, LineSize * Integer(Png.Header.Height));
  4981. try
  4982. pDest := NewImage;
  4983. case Png.Header.ColorType of
  4984. COLOR_RGB, COLOR_GRAYSCALE:
  4985. begin
  4986. for Row := 0 to Png.Height -1 do begin
  4987. Move (Png.Scanline[Row]^, pDest^, LineSize);
  4988. Inc(pDest, LineSize);
  4989. end;
  4990. end;
  4991. COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
  4992. begin
  4993. PixSize := PixSize -1;
  4994. for Row := 0 to Png.Height -1 do begin
  4995. pSource := Png.Scanline[Row];
  4996. pAlpha := pByte(Png.AlphaScanline[Row]);
  4997. for Col := 0 to Png.Width -1 do begin
  4998. Move (pSource^, pDest^, PixSize);
  4999. Inc(pSource, PixSize);
  5000. Inc(pDest, PixSize);
  5001. pDest^ := pAlpha^;
  5002. inc(pAlpha);
  5003. Inc(pDest);
  5004. end;
  5005. end;
  5006. end;
  5007. else
  5008. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  5009. end;
  5010. SetDataPointer(NewImage, Format, Png.Header.Width, Png.Header.Height);
  5011. result := true;
  5012. except
  5013. FreeMem(NewImage);
  5014. raise;
  5015. end;
  5016. finally
  5017. Png.Free;
  5018. end;
  5019. end;
  5020. end;
  5021. {$IFEND}
  5022. {$ENDIF}
  5023. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  5024. {$IFDEF GLB_LIB_PNG}
  5025. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5026. procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  5027. begin
  5028. TStream(png_get_io_ptr(png)).Write(buffer^, size);
  5029. end;
  5030. {$ENDIF}
  5031. {$IF DEFINED(GLB_LIB_PNG)}
  5032. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5033. procedure TglBitmap.SavePNG(const aStream: TStream);
  5034. var
  5035. png: png_structp;
  5036. png_info: png_infop;
  5037. png_rows: array of pByte;
  5038. LineSize: Integer;
  5039. ColorType: Integer;
  5040. Row: Integer;
  5041. begin
  5042. if not (ftPNG in FormatGetSupportedFiles (InternalFormat)) then
  5043. raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
  5044. if not init_libPNG then
  5045. raise Exception.Create('SavePNG - unable to initialize libPNG.');
  5046. try
  5047. case FInternalFormat of
  5048. ifAlpha, ifLuminance, ifDepth8:
  5049. ColorType := PNG_COLOR_TYPE_GRAY;
  5050. ifLuminanceAlpha:
  5051. ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
  5052. ifBGR8, ifRGB8:
  5053. ColorType := PNG_COLOR_TYPE_RGB;
  5054. ifBGRA8, ifRGBA8:
  5055. ColorType := PNG_COLOR_TYPE_RGBA;
  5056. else
  5057. raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
  5058. end;
  5059. LineSize := Trunc(FormatGetSize(FInternalFormat) * Width);
  5060. // creating array for scanline
  5061. SetLength(png_rows, Height);
  5062. try
  5063. for Row := 0 to Height - 1 do begin
  5064. png_rows[Row] := Data;
  5065. Inc(png_rows[Row], Row * LineSize)
  5066. end;
  5067. // write struct
  5068. png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  5069. if png = nil then
  5070. raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
  5071. // create png info
  5072. png_info := png_create_info_struct(png);
  5073. if png_info = nil then begin
  5074. png_destroy_write_struct(@png, nil);
  5075. raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
  5076. end;
  5077. // set read callback
  5078. png_set_write_fn(png, stream, glBitmap_libPNG_write_func, nil);
  5079. // set compression
  5080. png_set_compression_level(png, 6);
  5081. if InternalFormat in [ifBGR8, ifBGRA8] then
  5082. png_set_bgr(png);
  5083. png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
  5084. png_write_info(png, png_info);
  5085. png_write_image(png, @png_rows[0]);
  5086. png_write_end(png, png_info);
  5087. png_destroy_write_struct(@png, @png_info);
  5088. finally
  5089. SetLength(png_rows, 0);
  5090. end;
  5091. finally
  5092. quit_libPNG;
  5093. end;
  5094. end;
  5095. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  5096. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5097. procedure TglBitmap.SavePNG(const aStream: TStream);
  5098. var
  5099. Png: TPNGObject;
  5100. pSource, pDest: pByte;
  5101. X, Y, PixSize: Integer;
  5102. ColorType: Cardinal;
  5103. Alpha: Boolean;
  5104. pTemp: pByte;
  5105. Temp: Byte;
  5106. begin
  5107. if not (ftPNG in FormatGetSupportedFiles (InternalFormat)) then
  5108. raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
  5109. case FInternalFormat of
  5110. ifAlpha, ifLuminance, ifDepth8: begin
  5111. ColorType := COLOR_GRAYSCALE;
  5112. PixSize := 1;
  5113. Alpha := false;
  5114. end;
  5115. ifLuminanceAlpha: begin
  5116. ColorType := COLOR_GRAYSCALEALPHA;
  5117. PixSize := 1;
  5118. Alpha := true;
  5119. end;
  5120. ifBGR8, ifRGB8: begin
  5121. ColorType := COLOR_RGB;
  5122. PixSize := 3;
  5123. Alpha := false;
  5124. end;
  5125. ifBGRA8, ifRGBA8: begin
  5126. ColorType := COLOR_RGBALPHA;
  5127. PixSize := 3;
  5128. Alpha := true
  5129. end;
  5130. else
  5131. raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
  5132. end;
  5133. Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
  5134. try
  5135. // Copy ImageData
  5136. pSource := Data;
  5137. for Y := 0 to Height -1 do begin
  5138. pDest := png.ScanLine[Y];
  5139. for X := 0 to Width -1 do begin
  5140. Move(pSource^, pDest^, PixSize);
  5141. Inc(pDest, PixSize);
  5142. Inc(pSource, PixSize);
  5143. if Alpha then begin
  5144. png.AlphaScanline[Y]^[X] := pSource^;
  5145. Inc(pSource);
  5146. end;
  5147. end;
  5148. // convert RGB line to BGR
  5149. if InternalFormat in [ifRGB8, ifRGBA8] then begin
  5150. pTemp := png.ScanLine[Y];
  5151. for X := 0 to Width -1 do begin
  5152. Temp := pByteArray(pTemp)^[0];
  5153. pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
  5154. pByteArray(pTemp)^[2] := Temp;
  5155. Inc(pTemp, 3);
  5156. end;
  5157. end;
  5158. end;
  5159. // Save to Stream
  5160. Png.CompressionLevel := 6;
  5161. Png.SaveToStream(Stream);
  5162. finally
  5163. FreeAndNil(Png);
  5164. end;
  5165. end;
  5166. {$IFEND}
  5167. {$ENDIF}
  5168. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5169. //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5170. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5171. {$IFDEF GLB_LIB_JPEG}
  5172. type
  5173. glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
  5174. glBitmap_libJPEG_source_mgr = record
  5175. pub: jpeg_source_mgr;
  5176. SrcStream: TStream;
  5177. SrcBuffer: array [1..4096] of byte;
  5178. end;
  5179. glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
  5180. glBitmap_libJPEG_dest_mgr = record
  5181. pub: jpeg_destination_mgr;
  5182. DestStream: TStream;
  5183. DestBuffer: array [1..4096] of byte;
  5184. end;
  5185. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5186. {
  5187. procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
  5188. var
  5189. Msg: String;
  5190. begin
  5191. SetLength(Msg, 256);
  5192. cinfo^.err^.format_message(cinfo, pChar(Msg));
  5193. Writeln('ERROR [' + IntToStr(cinfo^.err^.msg_code) + '] ' + Msg);
  5194. cinfo^.global_state := 0;
  5195. jpeg_abort(cinfo);
  5196. end;
  5197. }
  5198. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5199. {
  5200. procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
  5201. var
  5202. Msg: String;
  5203. begin
  5204. SetLength(Msg, 256);
  5205. cinfo^.err^.format_message(cinfo, pChar(Msg));
  5206. Writeln('OUTPUT [' + IntToStr(cinfo^.err^.msg_code) + '] ' + Msg);
  5207. cinfo^.global_state := 0;
  5208. end;
  5209. }
  5210. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5211. {
  5212. procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
  5213. begin
  5214. end;
  5215. }
  5216. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5217. function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
  5218. var
  5219. src: glBitmap_libJPEG_source_mgr_ptr;
  5220. bytes: integer;
  5221. begin
  5222. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  5223. bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
  5224. if (bytes <= 0) then begin
  5225. src^.SrcBuffer[1] := $FF;
  5226. src^.SrcBuffer[2] := JPEG_EOI;
  5227. bytes := 2;
  5228. end;
  5229. src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
  5230. src^.pub.bytes_in_buffer := bytes;
  5231. result := true;
  5232. end;
  5233. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5234. procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
  5235. var
  5236. src: glBitmap_libJPEG_source_mgr_ptr;
  5237. begin
  5238. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  5239. if num_bytes > 0 then begin
  5240. // wanted byte isn't in buffer so set stream position and read buffer
  5241. if num_bytes > src^.pub.bytes_in_buffer then begin
  5242. src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
  5243. src^.pub.fill_input_buffer(cinfo);
  5244. end else begin
  5245. // wanted byte is in buffer so only skip
  5246. inc(src^.pub.next_input_byte, num_bytes);
  5247. dec(src^.pub.bytes_in_buffer, num_bytes);
  5248. end;
  5249. end;
  5250. end;
  5251. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5252. {
  5253. procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
  5254. begin
  5255. end;
  5256. }
  5257. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5258. {
  5259. procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
  5260. begin
  5261. end;
  5262. }
  5263. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5264. function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
  5265. var
  5266. dest: glBitmap_libJPEG_dest_mgr_ptr;
  5267. begin
  5268. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  5269. if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
  5270. // write complete buffer
  5271. dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
  5272. // reset buffer
  5273. dest^.pub.next_output_byte := @dest^.DestBuffer[1];
  5274. dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
  5275. end;
  5276. result := true;
  5277. end;
  5278. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5279. procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
  5280. var
  5281. Idx: Integer;
  5282. dest: glBitmap_libJPEG_dest_mgr_ptr;
  5283. begin
  5284. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  5285. for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
  5286. // check for endblock
  5287. if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
  5288. // write endblock
  5289. dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
  5290. // leave
  5291. break;
  5292. end else
  5293. dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
  5294. end;
  5295. end;
  5296. {$ENDIF}
  5297. {$IFDEF GLB_SUPPORT_JPEG_READ}
  5298. {$IF DEFINED(GLB_SDL_IMAGE)}
  5299. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5300. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5301. var
  5302. Surface: PSDL_Surface;
  5303. RWops: PSDL_RWops;
  5304. begin
  5305. result := false;
  5306. RWops := glBitmapCreateRWops(Stream);
  5307. try
  5308. if IMG_isJPG(RWops) > 0 then begin
  5309. Surface := IMG_LoadJPG_RW(RWops);
  5310. try
  5311. AssignFromSurface(Surface);
  5312. result := true;
  5313. finally
  5314. SDL_FreeSurface(Surface);
  5315. end;
  5316. end;
  5317. finally
  5318. SDL_FreeRW(RWops);
  5319. end;
  5320. end;
  5321. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  5322. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5323. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5324. var
  5325. StreamPos: Int64;
  5326. Temp: array[0..1]of Byte;
  5327. jpeg: jpeg_decompress_struct;
  5328. jpeg_err: jpeg_error_mgr;
  5329. IntFormat: TglBitmapInternalFormat;
  5330. pImage: pByte;
  5331. TempHeight, TempWidth: Integer;
  5332. pTemp: pByte;
  5333. Row: Integer;
  5334. begin
  5335. result := false;
  5336. if not init_libJPEG then
  5337. raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
  5338. try
  5339. // reading first two bytes to test file and set cursor back to begin
  5340. StreamPos := Stream.Position;
  5341. Stream.Read(Temp[0], 2);
  5342. Stream.Position := StreamPos;
  5343. // if Bitmap then read file.
  5344. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  5345. FillChar(jpeg, SizeOf(jpeg_decompress_struct), $00);
  5346. FillChar(jpeg_err, SizeOf(jpeg_error_mgr), $00);
  5347. // error managment
  5348. jpeg.err := jpeg_std_error(@jpeg_err);
  5349. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  5350. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  5351. // decompression struct
  5352. jpeg_create_decompress(@jpeg);
  5353. // allocation space for streaming methods
  5354. jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
  5355. // seeting up custom functions
  5356. with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
  5357. pub.init_source := glBitmap_libJPEG_init_source;
  5358. pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
  5359. pub.skip_input_data := glBitmap_libJPEG_skip_input_data;
  5360. pub.resync_to_restart := jpeg_resync_to_restart; // use default method
  5361. pub.term_source := glBitmap_libJPEG_term_source;
  5362. pub.bytes_in_buffer := 0; // forces fill_input_buffer on first read
  5363. pub.next_input_byte := nil; // until buffer loaded
  5364. SrcStream := Stream;
  5365. end;
  5366. // set global decoding state
  5367. jpeg.global_state := DSTATE_START;
  5368. // read header of jpeg
  5369. jpeg_read_header(@jpeg, false);
  5370. // setting output parameter
  5371. case jpeg.jpeg_color_space of
  5372. JCS_GRAYSCALE:
  5373. begin
  5374. jpeg.out_color_space := JCS_GRAYSCALE;
  5375. IntFormat := ifLuminance;
  5376. end;
  5377. else
  5378. jpeg.out_color_space := JCS_RGB;
  5379. IntFormat := ifRGB8;
  5380. end;
  5381. // reading image
  5382. jpeg_start_decompress(@jpeg);
  5383. TempHeight := jpeg.output_height;
  5384. TempWidth := jpeg.output_width;
  5385. // creating new image
  5386. GetMem(pImage, FormatGetImageSize(glBitmapPosition(TempWidth, TempHeight), IntFormat));
  5387. try
  5388. pTemp := pImage;
  5389. for Row := 0 to TempHeight -1 do begin
  5390. jpeg_read_scanlines(@jpeg, @pTemp, 1);
  5391. Inc(pTemp, Trunc(FormatGetSize(IntFormat) * TempWidth));
  5392. end;
  5393. // finish decompression
  5394. jpeg_finish_decompress(@jpeg);
  5395. // destroy decompression
  5396. jpeg_destroy_decompress(@jpeg);
  5397. SetDataPointer(pImage, IntFormat, TempWidth, TempHeight);
  5398. result := true;
  5399. except
  5400. FreeMem(pImage);
  5401. raise;
  5402. end;
  5403. end;
  5404. finally
  5405. quit_libJPEG;
  5406. end;
  5407. end;
  5408. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  5409. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5410. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5411. var
  5412. bmp: TBitmap;
  5413. jpg: TJPEGImage;
  5414. StreamPos: Int64;
  5415. Temp: array[0..1]of Byte;
  5416. begin
  5417. result := false;
  5418. // reading first two bytes to test file and set cursor back to begin
  5419. StreamPos := Stream.Position;
  5420. Stream.Read(Temp[0], 2);
  5421. Stream.Position := StreamPos;
  5422. // if Bitmap then read file.
  5423. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  5424. bmp := TBitmap.Create;
  5425. try
  5426. jpg := TJPEGImage.Create;
  5427. try
  5428. jpg.LoadFromStream(Stream);
  5429. bmp.Assign(jpg);
  5430. result := AssignFromBitmap(bmp);
  5431. finally
  5432. jpg.Free;
  5433. end;
  5434. finally
  5435. bmp.Free;
  5436. end;
  5437. end;
  5438. end;
  5439. {$IFEND}
  5440. {$ENDIF}
  5441. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  5442. {$IF DEFEFINED(GLB_LIB_JPEG)}
  5443. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5444. procedure TglBitmap.SaveJPEG(Stream: TStream);
  5445. var
  5446. jpeg: jpeg_compress_struct;
  5447. jpeg_err: jpeg_error_mgr;
  5448. Row: Integer;
  5449. pTemp, pTemp2: pByte;
  5450. procedure CopyRow(pDest, pSource: pByte);
  5451. var
  5452. X: Integer;
  5453. begin
  5454. for X := 0 to Width - 1 do begin
  5455. pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
  5456. pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
  5457. pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
  5458. Inc(pDest, 3);
  5459. Inc(pSource, 3);
  5460. end;
  5461. end;
  5462. begin
  5463. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  5464. raise EglBitmapUnsupportedInternalFormat.Create('SaveJpg - ' + UNSUPPORTED_INTERNAL_FORMAT);
  5465. if not init_libJPEG then
  5466. raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
  5467. try
  5468. FillChar(jpeg, SizeOf(jpeg_compress_struct), $00);
  5469. FillChar(jpeg_err, SizeOf(jpeg_error_mgr), $00);
  5470. // error managment
  5471. jpeg.err := jpeg_std_error(@jpeg_err);
  5472. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  5473. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  5474. // compression struct
  5475. jpeg_create_compress(@jpeg);
  5476. // allocation space for streaming methods
  5477. jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
  5478. // seeting up custom functions
  5479. with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
  5480. pub.init_destination := glBitmap_libJPEG_init_destination;
  5481. pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
  5482. pub.term_destination := glBitmap_libJPEG_term_destination;
  5483. pub.next_output_byte := @DestBuffer[1];
  5484. pub.free_in_buffer := Length(DestBuffer);
  5485. DestStream := Stream;
  5486. end;
  5487. // very important state
  5488. jpeg.global_state := CSTATE_START;
  5489. jpeg.image_width := Width;
  5490. jpeg.image_height := Height;
  5491. case InternalFormat of
  5492. ifAlpha, ifLuminance, ifDepth8: begin
  5493. jpeg.input_components := 1;
  5494. jpeg.in_color_space := JCS_GRAYSCALE;
  5495. end;
  5496. ifRGB8, ifBGR8: begin
  5497. jpeg.input_components := 3;
  5498. jpeg.in_color_space := JCS_RGB;
  5499. end;
  5500. end;
  5501. jpeg_set_defaults(@jpeg);
  5502. jpeg_set_quality(@jpeg, 95, true);
  5503. jpeg_start_compress(@jpeg, true);
  5504. pTemp := Data;
  5505. if InternalFormat = ifBGR8 then
  5506. GetMem(pTemp2, fRowSize)
  5507. else
  5508. pTemp2 := pTemp;
  5509. try
  5510. for Row := 0 to jpeg.image_height -1 do begin
  5511. // prepare row
  5512. if InternalFormat = ifBGR8 then
  5513. CopyRow(pTemp2, pTemp)
  5514. else
  5515. pTemp2 := pTemp;
  5516. // write row
  5517. jpeg_write_scanlines(@jpeg, @pTemp2, 1);
  5518. inc(pTemp, fRowSize);
  5519. end;
  5520. finally
  5521. // free memory
  5522. if InternalFormat = ifBGR8 then
  5523. FreeMem(pTemp2);
  5524. end;
  5525. jpeg_finish_compress(@jpeg);
  5526. jpeg_destroy_compress(@jpeg);
  5527. finally
  5528. quit_libJPEG;
  5529. end;
  5530. end;
  5531. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  5532. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5533. procedure TglBitmap.SaveJPEG(Stream: TStream);
  5534. var
  5535. Bmp: TBitmap;
  5536. Jpg: TJPEGImage;
  5537. begin
  5538. if not (ftJPEG in FormatGetSupportedFiles (InternalFormat)) then
  5539. raise EglBitmapUnsupportedInternalFormat.Create('SaveJpg - ' + UNSUPPORTED_INTERNAL_FORMAT);
  5540. Bmp := TBitmap.Create;
  5541. try
  5542. Jpg := TJPEGImage.Create;
  5543. try
  5544. AssignToBitmap(Bmp);
  5545. if FInternalFormat in [ifAlpha, ifLuminance, ifDepth8] then begin
  5546. Jpg.Grayscale := true;
  5547. Jpg.PixelFormat := jf8Bit;
  5548. end;
  5549. Jpg.Assign(Bmp);
  5550. Jpg.SaveToStream(Stream);
  5551. finally
  5552. FreeAndNil(Jpg);
  5553. end;
  5554. finally
  5555. FreeAndNil(Bmp);
  5556. end;
  5557. end;
  5558. {$ENDIF}
  5559. {$ENDIF}
  5560. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5561. //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5562. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5563. const
  5564. BMP_MAGIC = $4D42;
  5565. BMP_COMP_RGB = 0;
  5566. BMP_COMP_RLE8 = 1;
  5567. BMP_COMP_RLE4 = 2;
  5568. BMP_COMP_BITFIELDS = 3;
  5569. type
  5570. TBMPHeader = packed record
  5571. bfType: Word;
  5572. bfSize: Cardinal;
  5573. bfReserved1: Word;
  5574. bfReserved2: Word;
  5575. bfOffBits: Cardinal;
  5576. end;
  5577. TBMPInfo = packed record
  5578. biSize: Cardinal;
  5579. biWidth: Longint;
  5580. biHeight: Longint;
  5581. biPlanes: Word;
  5582. biBitCount: Word;
  5583. biCompression: Cardinal;
  5584. biSizeImage: Cardinal;
  5585. biXPelsPerMeter: Longint;
  5586. biYPelsPerMeter: Longint;
  5587. biClrUsed: Cardinal;
  5588. biClrImportant: Cardinal;
  5589. end;
  5590. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5591. function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
  5592. //////////////////////////////////////////////////////////////////////////////////////////////////
  5593. function ReadInfo(var aInfo: TBMPInfo; var aMask: TglBitmapColorRec): TglBitmapFormat;
  5594. begin
  5595. result := tfEmpty;
  5596. aStream.Read(aInfo, SizeOf(aInfo));
  5597. FillChar(aMask, SizeOf(aMask), 0);
  5598. //Read Compression
  5599. case aInfo.biCompression of
  5600. BMP_COMP_RLE4,
  5601. BMP_COMP_RLE8: begin
  5602. raise EglBitmapException.Create('RLE compression is not supported');
  5603. end;
  5604. BMP_COMP_BITFIELDS: begin
  5605. if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
  5606. aStream.Read(aMask.r, SizeOf(aMask.r));
  5607. aStream.Read(aMask.g, SizeOf(aMask.g));
  5608. aStream.Read(aMask.b, SizeOf(aMask.b));
  5609. aStream.Read(aMask.a, SizeOf(aMask.a));
  5610. end else
  5611. raise EglBitmapException.Create('Bitfields are only supported for 16bit and 32bit formats');
  5612. end;
  5613. end;
  5614. //get suitable format
  5615. case aInfo.biBitCount of
  5616. 8: result := tfLuminance8;
  5617. 16: result := tfBGR5;
  5618. 24: result := tfBGR8;
  5619. 32: result := tfBGRA8;
  5620. end;
  5621. end;
  5622. function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
  5623. var
  5624. i, c: Integer;
  5625. ColorTable: TbmpColorTable;
  5626. begin
  5627. result := nil;
  5628. if (aInfo.biBitCount >= 16) then
  5629. exit;
  5630. aFormat := tfLuminance8;
  5631. c := aInfo.biClrUsed;
  5632. if (c = 0) then
  5633. c := 1 shl aInfo.biBitCount;
  5634. SetLength(ColorTable, c);
  5635. for i := 0 to c-1 do begin
  5636. aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
  5637. if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
  5638. aFormat := tfRGB8;
  5639. end;
  5640. result := TbmpColorTableFormat.Create;
  5641. result.PixelSize := aInfo.biBitCount / 8;
  5642. result.ColorTable := ColorTable;
  5643. result.Range := glBitmapColorRec($FF, $FF, $FF, $00);
  5644. end;
  5645. //////////////////////////////////////////////////////////////////////////////////////////////////
  5646. function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
  5647. const aInfo: TBMPInfo): TbmpBitfieldFormat;
  5648. var
  5649. TmpFormat: TglBitmapFormat;
  5650. FormatDesc: TFormatDescriptor;
  5651. begin
  5652. result := nil;
  5653. if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
  5654. for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  5655. FormatDesc := TFormatDescriptor.Get(TmpFormat);
  5656. if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
  5657. aFormat := FormatDesc.Format;
  5658. exit;
  5659. end;
  5660. end;
  5661. if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
  5662. aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
  5663. if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
  5664. aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
  5665. result := TbmpBitfieldFormat.Create;
  5666. result.PixelSize := aInfo.biBitCount / 8;
  5667. result.RedMask := aMask.r;
  5668. result.GreenMask := aMask.g;
  5669. result.BlueMask := aMask.b;
  5670. result.AlphaMask := aMask.a;
  5671. end;
  5672. end;
  5673. var
  5674. //simple types
  5675. StartPos: Int64;
  5676. ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
  5677. PaddingBuff: Cardinal;
  5678. LineBuf, ImageData, TmpData: PByte;
  5679. SourceMD, DestMD: Pointer;
  5680. BmpFormat: TglBitmapFormat;
  5681. ColorTable: TbmpColorTable;
  5682. //records
  5683. Mask: TglBitmapColorRec;
  5684. Header: TBMPHeader;
  5685. Info: TBMPInfo;
  5686. //classes
  5687. SpecialFormat: TFormatDescriptor;
  5688. FormatDesc: TFormatDescriptor;
  5689. //////////////////////////////////////////////////////////////////////////////////////////////////
  5690. procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
  5691. var
  5692. i, j: Integer;
  5693. Pixel: TglBitmapPixelData;
  5694. begin
  5695. aStream.Read(aLineBuf^, rbLineSize);
  5696. SpecialFormat.PreparePixel(Pixel);
  5697. for i := 0 to Info.biWidth-1 do begin
  5698. SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
  5699. glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
  5700. FormatDesc.Map(Pixel, aData, DestMD);
  5701. end;
  5702. end;
  5703. begin
  5704. result := false;
  5705. BmpFormat := tfEmpty;
  5706. SpecialFormat := nil;
  5707. LineBuf := nil;
  5708. SourceMD := nil;
  5709. DestMD := nil;
  5710. // Header
  5711. StartPos := aStream.Position;
  5712. aStream.Read(Header, SizeOf(Header));
  5713. if Header.bfType = BMP_MAGIC then begin
  5714. try try
  5715. BmpFormat := ReadInfo(Info, Mask);
  5716. SpecialFormat := ReadColorTable(BmpFormat, Info);
  5717. if not Assigned(SpecialFormat) then
  5718. SpecialFormat := CheckBitfields(BmpFormat, Mask, Info);
  5719. aStream.Position := StartPos + Header.bfOffBits;
  5720. if (BmpFormat <> tfEmpty) then begin
  5721. FormatDesc := TFormatDescriptor.Get(BmpFormat);
  5722. rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
  5723. wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
  5724. Padding := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
  5725. //get Memory
  5726. DestMD := FormatDesc.CreateMappingData;
  5727. ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
  5728. GetMem(ImageData, ImageSize);
  5729. if Assigned(SpecialFormat) then begin
  5730. GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
  5731. SourceMD := SpecialFormat.CreateMappingData;
  5732. end;
  5733. //read Data
  5734. try try
  5735. FillChar(ImageData^, ImageSize, $FF);
  5736. TmpData := ImageData;
  5737. if (Info.biHeight > 0) then
  5738. Inc(TmpData, wbLineSize * (Info.biHeight-1));
  5739. for i := 0 to Abs(Info.biHeight)-1 do begin
  5740. if Assigned(SpecialFormat) then
  5741. SpecialFormatReadLine(TmpData, LineBuf) //if is special format read and convert data
  5742. else
  5743. aStream.Read(TmpData^, wbLineSize); //else only read data
  5744. if (Info.biHeight > 0) then
  5745. dec(TmpData, wbLineSize)
  5746. else
  5747. inc(TmpData, wbLineSize);
  5748. aStream.Read(PaddingBuff, Padding);
  5749. end;
  5750. SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight));
  5751. result := true;
  5752. finally
  5753. if Assigned(LineBuf) then
  5754. FreeMem(LineBuf);
  5755. if Assigned(SourceMD) then
  5756. SpecialFormat.FreeMappingData(SourceMD);
  5757. FormatDesc.FreeMappingData(DestMD);
  5758. end;
  5759. except
  5760. FreeMem(ImageData);
  5761. raise;
  5762. end;
  5763. end else
  5764. raise EglBitmapException.Create('LoadBMP - No suitable format found');
  5765. except
  5766. aStream.Position := StartPos;
  5767. raise;
  5768. end;
  5769. finally
  5770. FreeAndNil(SpecialFormat);
  5771. end;
  5772. end
  5773. else aStream.Position := StartPos;
  5774. end;
  5775. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5776. procedure TglBitmap.SaveBMP(const aStream: TStream);
  5777. var
  5778. Header: TBMPHeader;
  5779. Info: TBMPInfo;
  5780. Converter: TbmpColorTableFormat;
  5781. FormatDesc: TFormatDescriptor;
  5782. SourceFD, DestFD: Pointer;
  5783. pData, srcData, dstData, ConvertBuffer: pByte;
  5784. Pixel: TglBitmapPixelData;
  5785. PixelFormat: TglBitmapPixelData;
  5786. ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx, i: Integer;
  5787. RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
  5788. PaddingBuff: Cardinal;
  5789. function GetLineWidth : Integer;
  5790. begin
  5791. result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
  5792. end;
  5793. begin
  5794. if not (ftBMP in FormatGetSupportedFiles(Format)) then
  5795. raise EglBitmapUnsupportedFormatFormat.Create('SaveBMP - ' + UNSUPPORTED_FORMAT);
  5796. Converter := nil;
  5797. FormatDesc := TFormatDescriptor.Get(Format);
  5798. ImageSize := FormatDesc.GetSize(Dimension);
  5799. FillChar(Header, SizeOf(Header), 0);
  5800. Header.bfType := BMP_MAGIC;
  5801. Header.bfSize := SizeOf(Header) + SizeOf(Info) + ImageSize;
  5802. Header.bfReserved1 := 0;
  5803. Header.bfReserved2 := 0;
  5804. Header.bfOffBits := SizeOf(Header) + SizeOf(Info);
  5805. FillChar(Info, SizeOf(Info), 0);
  5806. Info.biSize := SizeOf(Info);
  5807. Info.biWidth := Width;
  5808. Info.biHeight := Height;
  5809. Info.biPlanes := 1;
  5810. Info.biCompression := BMP_COMP_RGB;
  5811. Info.biSizeImage := ImageSize;
  5812. try
  5813. case Format of
  5814. tfLuminance4: begin
  5815. Info.biBitCount := 4;
  5816. Header.bfSize := Header.bfSize + 16 * SizeOf(Cardinal);
  5817. Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
  5818. Converter := TbmpColorTableFormat.Create;
  5819. Converter.PixelSize := 0.5;
  5820. Converter.Format := Format;
  5821. Converter.Range := glBitmapColorRec($F, $F, $F, $0);
  5822. Converter.CreateColorTable;
  5823. end;
  5824. tfR3G3B2, tfLuminance8: begin
  5825. Info.biBitCount := 8;
  5826. Header.bfSize := Header.bfSize + 256 * SizeOf(Cardinal);
  5827. Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
  5828. Converter := TbmpColorTableFormat.Create;
  5829. Converter.PixelSize := 1;
  5830. Converter.Format := Format;
  5831. if (Format = tfR3G3B2) then begin
  5832. Converter.Range := glBitmapColorRec($7, $7, $3, $0);
  5833. Converter.Shift := glBitmapShiftRec(0, 3, 6, 0);
  5834. end else
  5835. Converter.Range := glBitmapColorRec($FF, $FF, $FF, $0);
  5836. Converter.CreateColorTable;
  5837. end;
  5838. tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
  5839. tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin
  5840. Info.biBitCount := 16;
  5841. Info.biCompression := BMP_COMP_BITFIELDS;
  5842. end;
  5843. tfBGR8, tfRGB8: begin
  5844. Info.biBitCount := 24;
  5845. end;
  5846. tfRGB10, tfRGB10A2, tfRGBA8,
  5847. tfBGR10, tfBGR10A2, tfBGRA8: begin
  5848. Info.biBitCount := 32;
  5849. Info.biCompression := BMP_COMP_BITFIELDS;
  5850. end;
  5851. else
  5852. raise EglBitmapUnsupportedFormatFormat.Create('SaveBMP - ' + UNSUPPORTED_FORMAT);
  5853. end;
  5854. Info.biXPelsPerMeter := 2835;
  5855. Info.biYPelsPerMeter := 2835;
  5856. // prepare bitmasks
  5857. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  5858. Header.bfSize := Header.bfSize + 4 * SizeOf(Cardinal);
  5859. Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
  5860. RedMask := FormatDesc.RedMask;
  5861. GreenMask := FormatDesc.GreenMask;
  5862. BlueMask := FormatDesc.BlueMask;
  5863. AlphaMask := FormatDesc.AlphaMask;
  5864. end;
  5865. // headers
  5866. aStream.Write(Header, SizeOf(Header));
  5867. aStream.Write(Info, SizeOf(Info));
  5868. // colortable
  5869. if Assigned(Converter) then
  5870. aStream.Write(Converter.ColorTable[0].b,
  5871. SizeOf(TbmpColorTableEnty) * Length(Converter.ColorTable));
  5872. // bitmasks
  5873. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  5874. aStream.Write(RedMask, SizeOf(Cardinal));
  5875. aStream.Write(GreenMask, SizeOf(Cardinal));
  5876. aStream.Write(BlueMask, SizeOf(Cardinal));
  5877. aStream.Write(AlphaMask, SizeOf(Cardinal));
  5878. end;
  5879. // image data
  5880. rbLineSize := Round(Info.biWidth * FormatDesc.PixelSize);
  5881. wbLineSize := Round(Info.biWidth * Info.biBitCount / 8);
  5882. Padding := GetLineWidth - wbLineSize;
  5883. PaddingBuff := 0;
  5884. pData := Data;
  5885. inc(pData, (Height-1) * rbLineSize);
  5886. // prepare row buffer. But only for RGB because RGBA supports color masks
  5887. // so it's possible to change color within the image.
  5888. if Assigned(Converter) then begin
  5889. FormatDesc.PreparePixel(Pixel);
  5890. GetMem(ConvertBuffer, wbLineSize);
  5891. SourceFD := FormatDesc.CreateMappingData;
  5892. DestFD := Converter.CreateMappingData;
  5893. end else
  5894. ConvertBuffer := nil;
  5895. try
  5896. for LineIdx := 0 to Height - 1 do begin
  5897. // preparing row
  5898. if Assigned(Converter) then begin
  5899. srcData := pData;
  5900. dstData := ConvertBuffer;
  5901. for PixelIdx := 0 to Info.biWidth-1 do begin
  5902. FormatDesc.Unmap(srcData, Pixel, SourceFD);
  5903. glBitmapConvertPixel(Pixel, FormatDesc, Converter);
  5904. Converter.Map(Pixel, dstData, DestFD);
  5905. end;
  5906. aStream.Write(ConvertBuffer^, wbLineSize);
  5907. end else begin
  5908. aStream.Write(pData^, rbLineSize);
  5909. end;
  5910. dec(pData, rbLineSize);
  5911. if (Padding > 0) then
  5912. aStream.Write(PaddingBuff, Padding);
  5913. end;
  5914. finally
  5915. // destroy row buffer
  5916. if Assigned(ConvertBuffer) then begin
  5917. FormatDesc.FreeMappingData(SourceFD);
  5918. Converter.FreeMappingData(DestFD);
  5919. FreeMem(ConvertBuffer);
  5920. end;
  5921. end;
  5922. finally
  5923. if Assigned(Converter) then
  5924. Converter.Free;
  5925. end;
  5926. end;
  5927. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5928. //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5929. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5930. type
  5931. TTGAHeader = packed record
  5932. ImageID: Byte;
  5933. ColorMapType: Byte;
  5934. ImageType: Byte;
  5935. //ColorMapSpec: Array[0..4] of Byte;
  5936. ColorMapStart: Word;
  5937. ColorMapLength: Word;
  5938. ColorMapEntrySize: Byte;
  5939. OrigX: Word;
  5940. OrigY: Word;
  5941. Width: Word;
  5942. Height: Word;
  5943. Bpp: Byte;
  5944. ImageDesc: Byte;
  5945. end;
  5946. const
  5947. TGA_UNCOMPRESSED_RGB = 2;
  5948. TGA_UNCOMPRESSED_GRAY = 3;
  5949. TGA_COMPRESSED_RGB = 10;
  5950. TGA_COMPRESSED_GRAY = 11;
  5951. TGA_NONE_COLOR_TABLE = 0;
  5952. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5953. function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
  5954. var
  5955. Header: TTGAHeader;
  5956. ImageData: PByte;
  5957. StartPosition: Int64;
  5958. PixelSize, LineSize: Integer;
  5959. tgaFormat: TglBitmapFormat;
  5960. FormatDesc: TFormatDescriptor;
  5961. Counter: packed record
  5962. X, Y: packed record
  5963. low, high, dir: Integer;
  5964. end;
  5965. end;
  5966. const
  5967. CACHE_SIZE = $4000;
  5968. ////////////////////////////////////////////////////////////////////////////////////////
  5969. procedure ReadUncompressed;
  5970. var
  5971. i, j: Integer;
  5972. buf, tmp1, tmp2: PByte;
  5973. begin
  5974. buf := nil;
  5975. if (Counter.X.dir < 0) then
  5976. buf := GetMem(LineSize);
  5977. try
  5978. while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
  5979. tmp1 := ImageData + (Counter.Y.low * LineSize); //pointer to LineStart
  5980. if (Counter.X.dir < 0) then begin //flip X
  5981. aStream.Read(buf^, LineSize);
  5982. tmp2 := buf + LineSize - PixelSize; //pointer to last pixel in line
  5983. for i := 0 to Header.Width-1 do begin //for all pixels in line
  5984. for j := 0 to PixelSize-1 do begin //for all bytes in pixel
  5985. tmp1^ := tmp2^;
  5986. inc(tmp1);
  5987. inc(tmp2);
  5988. end;
  5989. dec(tmp2, 2*PixelSize); //move 2 backwards, because j-loop moved 1 forward
  5990. end;
  5991. end else
  5992. aStream.Read(tmp1^, LineSize);
  5993. inc(Counter.Y.low, Counter.Y.dir); //move to next line index
  5994. end;
  5995. finally
  5996. if Assigned(buf) then
  5997. FreeMem(buf);
  5998. end;
  5999. end;
  6000. ////////////////////////////////////////////////////////////////////////////////////////
  6001. procedure ReadCompressed;
  6002. /////////////////////////////////////////////////////////////////
  6003. var
  6004. TmpData: PByte;
  6005. LinePixelsRead: Integer;
  6006. procedure CheckLine;
  6007. begin
  6008. if (LinePixelsRead >= Header.Width) then begin
  6009. LinePixelsRead := 0;
  6010. inc(Counter.Y.low, Counter.Y.dir); //next line index
  6011. TmpData := ImageData + Counter.Y.low * LineSize; //set line
  6012. if (Counter.X.dir < 0) then //if x flipped then
  6013. TmpData := TmpData + LineSize - PixelSize; //set last pixel
  6014. end;
  6015. end;
  6016. /////////////////////////////////////////////////////////////////
  6017. var
  6018. Cache: PByte;
  6019. CacheSize, CachePos: Integer;
  6020. procedure CachedRead(out Buffer; Count: Integer);
  6021. var
  6022. BytesRead: Integer;
  6023. begin
  6024. if (CachePos + Count > CacheSize) then begin
  6025. //if buffer overflow save non read bytes
  6026. BytesRead := 0;
  6027. if (CacheSize - CachePos > 0) then begin
  6028. BytesRead := CacheSize - CachePos;
  6029. Move(PByteArray(Cache)^[CachePos], Buffer, BytesRead);
  6030. inc(CachePos, BytesRead);
  6031. end;
  6032. //load cache from file
  6033. CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
  6034. aStream.Read(Cache^, CacheSize);
  6035. CachePos := 0;
  6036. //read rest of requested bytes
  6037. if (Count - BytesRead > 0) then begin
  6038. Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
  6039. inc(CachePos, Count - BytesRead);
  6040. end;
  6041. end else begin
  6042. //if no buffer overflow just read the data
  6043. Move(PByteArray(Cache)^[CachePos], Buffer, Count);
  6044. inc(CachePos, Count);
  6045. end;
  6046. end;
  6047. procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
  6048. begin
  6049. case PixelSize of
  6050. 1: begin
  6051. aBuffer^ := aData^;
  6052. inc(aBuffer, Counter.X.dir);
  6053. end;
  6054. 2: begin
  6055. PWord(aBuffer)^ := PWord(aData)^;
  6056. inc(aBuffer, 2 * Counter.X.dir);
  6057. end;
  6058. 3: begin
  6059. PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
  6060. PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
  6061. PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
  6062. inc(aBuffer, 3 * Counter.X.dir);
  6063. end;
  6064. 4: begin
  6065. PCardinal(aBuffer)^ := PCardinal(aData)^;
  6066. inc(aBuffer, 4 * Counter.X.dir);
  6067. end;
  6068. end;
  6069. end;
  6070. var
  6071. TotalPixelsToRead, TotalPixelsRead: Integer;
  6072. Temp: Byte;
  6073. buf: array [0..3] of Byte; //1 pixel is max 32bit long
  6074. PixelRepeat: Boolean;
  6075. PixelsToRead, PixelCount: Integer;
  6076. begin
  6077. CacheSize := 0;
  6078. CachePos := 0;
  6079. TotalPixelsToRead := Header.Width * Header.Height;
  6080. TotalPixelsRead := 0;
  6081. LinePixelsRead := 0;
  6082. GetMem(Cache, CACHE_SIZE);
  6083. try
  6084. TmpData := ImageData + Counter.Y.low * LineSize; //set line
  6085. if (Counter.X.dir < 0) then //if x flipped then
  6086. TmpData := TmpData + LineSize - PixelSize; //set last pixel
  6087. repeat
  6088. //read CommandByte
  6089. CachedRead(Temp, 1);
  6090. PixelRepeat := (Temp and $80) > 0;
  6091. PixelsToRead := (Temp and $7F) + 1;
  6092. inc(TotalPixelsRead, PixelsToRead);
  6093. if PixelRepeat then
  6094. CachedRead(buf[0], PixelSize);
  6095. while (PixelsToRead > 0) do begin
  6096. CheckLine;
  6097. PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
  6098. while (PixelCount > 0) do begin
  6099. if not PixelRepeat then
  6100. CachedRead(buf[0], PixelSize);
  6101. PixelToBuffer(@buf[0], TmpData);
  6102. inc(LinePixelsRead);
  6103. dec(PixelsToRead);
  6104. dec(PixelCount);
  6105. end;
  6106. end;
  6107. until (TotalPixelsRead >= TotalPixelsToRead);
  6108. finally
  6109. FreeMem(Cache);
  6110. end;
  6111. end;
  6112. function IsGrayFormat: Boolean;
  6113. begin
  6114. result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
  6115. end;
  6116. begin
  6117. result := false;
  6118. // reading header to test file and set cursor back to begin
  6119. StartPosition := aStream.Position;
  6120. aStream.Read(Header, SizeOf(Header));
  6121. // no colormapped files
  6122. if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
  6123. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
  6124. begin
  6125. try
  6126. if Header.ImageID <> 0 then // skip image ID
  6127. aStream.Position := aStream.Position + Header.ImageID;
  6128. case Header.Bpp of
  6129. 8: if IsGrayFormat then case (Header.ImageDesc and $F) of
  6130. 0: tgaFormat := tfLuminance8;
  6131. 8: tgaFormat := tfAlpha8;
  6132. end;
  6133. 16: if IsGrayFormat then case (Header.ImageDesc and $F) of
  6134. 0: tgaFormat := tfLuminance16;
  6135. 8: tgaFormat := tfLuminance8Alpha8;
  6136. end else case (Header.ImageDesc and $F) of
  6137. 0: tgaFormat := tfBGR5;
  6138. 1: tgaFormat := tfBGR5A1;
  6139. 4: tgaFormat := tfBGRA4;
  6140. end;
  6141. 24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  6142. 0: tgaFormat := tfBGR8;
  6143. end;
  6144. 32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  6145. 2: tgaFormat := tfBGR10A2;
  6146. 8: tgaFormat := tfBGRA8;
  6147. end;
  6148. end;
  6149. if (tgaFormat = tfEmpty) then
  6150. raise EglBitmapException.Create('LoadTga - unsupported format');
  6151. FormatDesc := TFormatDescriptor.Get(tgaFormat);
  6152. PixelSize := FormatDesc.GetSize(1, 1);
  6153. LineSize := FormatDesc.GetSize(Header.Width, 1);
  6154. GetMem(ImageData, LineSize * Header.Height);
  6155. try
  6156. //column direction
  6157. if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
  6158. Counter.X.low := Header.Height-1;;
  6159. Counter.X.high := 0;
  6160. Counter.X.dir := -1;
  6161. end else begin
  6162. Counter.X.low := 0;
  6163. Counter.X.high := Header.Height-1;
  6164. Counter.X.dir := 1;
  6165. end;
  6166. // Row direction
  6167. if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
  6168. Counter.Y.low := 0;
  6169. Counter.Y.high := Header.Height-1;
  6170. Counter.Y.dir := 1;
  6171. end else begin
  6172. Counter.Y.low := Header.Height-1;;
  6173. Counter.Y.high := 0;
  6174. Counter.Y.dir := -1;
  6175. end;
  6176. // Read Image
  6177. case Header.ImageType of
  6178. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
  6179. ReadUncompressed;
  6180. TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
  6181. ReadCompressed;
  6182. end;
  6183. SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height);
  6184. result := true;
  6185. except
  6186. FreeMem(ImageData);
  6187. raise;
  6188. end;
  6189. finally
  6190. aStream.Position := StartPosition;
  6191. end;
  6192. end
  6193. else aStream.Position := StartPosition;
  6194. end;
  6195. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6196. procedure TglBitmap.SaveTGA(const aStream: TStream);
  6197. var
  6198. Header: TTGAHeader;
  6199. LineSize, Size, x, y: Integer;
  6200. Pixel: TglBitmapPixelData;
  6201. LineBuf, SourceData, DestData: PByte;
  6202. SourceMD, DestMD: Pointer;
  6203. FormatDesc: TFormatDescriptor;
  6204. Converter: TFormatDescriptor;
  6205. begin
  6206. if not (ftTGA in FormatGetSupportedFiles(Format)) then
  6207. raise EglBitmapUnsupportedFormatFormat.Create('SaveTGA - ' + UNSUPPORTED_FORMAT);
  6208. //prepare header
  6209. FillChar(Header, SizeOf(Header), 0);
  6210. //set ImageType
  6211. if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
  6212. tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
  6213. Header.ImageType := TGA_UNCOMPRESSED_GRAY
  6214. else
  6215. Header.ImageType := TGA_UNCOMPRESSED_RGB;
  6216. //set BitsPerPixel
  6217. if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
  6218. Header.Bpp := 8
  6219. else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
  6220. tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
  6221. Header.Bpp := 16
  6222. else if (Format in [tfBGR8, tfRGB8]) then
  6223. Header.Bpp := 24
  6224. else
  6225. Header.Bpp := 32;
  6226. //set AlphaBitCount
  6227. case Format of
  6228. tfRGB5A1, tfBGR5A1:
  6229. Header.ImageDesc := 1 and $F;
  6230. tfRGB10A2, tfBGR10A2:
  6231. Header.ImageDesc := 2 and $F;
  6232. tfRGBA4, tfBGRA4:
  6233. Header.ImageDesc := 4 and $F;
  6234. tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
  6235. Header.ImageDesc := 8 and $F;
  6236. end;
  6237. Header.Width := Width;
  6238. Header.Height := Height;
  6239. Header.ImageDesc := Header.ImageDesc or $20; //flip y
  6240. aStream.Write(Header, SizeOf(Header));
  6241. // convert RGB(A) to BGR(A)
  6242. Converter := nil;
  6243. FormatDesc := TFormatDescriptor.Get(Format);
  6244. Size := FormatDesc.GetSize(Dimension);
  6245. if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
  6246. if (FormatDesc.RGBInverted = tfEmpty) then
  6247. raise EglBitmapException.Create('inverted RGB format is empty');
  6248. Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
  6249. if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
  6250. (Converter.PixelSize <> FormatDesc.PixelSize) then
  6251. raise EglBitmapException.Create('invalid inverted RGB format');
  6252. end;
  6253. if Assigned(Converter) then begin
  6254. LineSize := FormatDesc.GetSize(Width, 1);
  6255. LineBuf := GetMem(LineSize);
  6256. SourceMD := FormatDesc.CreateMappingData;
  6257. DestMD := Converter.CreateMappingData;
  6258. try
  6259. SourceData := Data;
  6260. for y := 0 to Height-1 do begin
  6261. DestData := LineBuf;
  6262. for x := 0 to Width-1 do begin
  6263. FormatDesc.Unmap(SourceData, Pixel, SourceMD);
  6264. Converter.Map(Pixel, DestData, DestMD);
  6265. end;
  6266. aStream.Write(LineBuf^, LineSize);
  6267. end;
  6268. finally
  6269. FreeMem(LineBuf);
  6270. FormatDesc.FreeMappingData(SourceMD);
  6271. FormatDesc.FreeMappingData(DestMD);
  6272. end;
  6273. end else
  6274. aStream.Write(Data^, Size);
  6275. end;
  6276. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6277. //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6278. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6279. const
  6280. DDS_MAGIC: Cardinal = $20534444;
  6281. // DDS_header.dwFlags
  6282. DDSD_CAPS = $00000001;
  6283. DDSD_HEIGHT = $00000002;
  6284. DDSD_WIDTH = $00000004;
  6285. DDSD_PIXELFORMAT = $00001000;
  6286. // DDS_header.sPixelFormat.dwFlags
  6287. DDPF_ALPHAPIXELS = $00000001;
  6288. DDPF_ALPHA = $00000002;
  6289. DDPF_FOURCC = $00000004;
  6290. DDPF_RGB = $00000040;
  6291. DDPF_LUMINANCE = $00020000;
  6292. // DDS_header.sCaps.dwCaps1
  6293. DDSCAPS_TEXTURE = $00001000;
  6294. // DDS_header.sCaps.dwCaps2
  6295. DDSCAPS2_CUBEMAP = $00000200;
  6296. D3DFMT_DXT1 = $31545844;
  6297. D3DFMT_DXT3 = $33545844;
  6298. D3DFMT_DXT5 = $35545844;
  6299. type
  6300. TDDSPixelFormat = packed record
  6301. dwSize: Cardinal;
  6302. dwFlags: Cardinal;
  6303. dwFourCC: Cardinal;
  6304. dwRGBBitCount: Cardinal;
  6305. dwRBitMask: Cardinal;
  6306. dwGBitMask: Cardinal;
  6307. dwBBitMask: Cardinal;
  6308. dwABitMask: Cardinal;
  6309. end;
  6310. TDDSCaps = packed record
  6311. dwCaps1: Cardinal;
  6312. dwCaps2: Cardinal;
  6313. dwDDSX: Cardinal;
  6314. dwReserved: Cardinal;
  6315. end;
  6316. TDDSHeader = packed record
  6317. dwSize: Cardinal;
  6318. dwFlags: Cardinal;
  6319. dwHeight: Cardinal;
  6320. dwWidth: Cardinal;
  6321. dwPitchOrLinearSize: Cardinal;
  6322. dwDepth: Cardinal;
  6323. dwMipMapCount: Cardinal;
  6324. dwReserved: array[0..10] of Cardinal;
  6325. PixelFormat: TDDSPixelFormat;
  6326. Caps: TDDSCaps;
  6327. dwReserved2: Cardinal;
  6328. end;
  6329. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6330. function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
  6331. var
  6332. Header: TDDSHeader;
  6333. Converter: TbmpBitfieldFormat;
  6334. function GetDDSFormat: TglBitmapFormat;
  6335. var
  6336. fd: TFormatDescriptor;
  6337. i: Integer;
  6338. Range: TglBitmapColorRec;
  6339. match: Boolean;
  6340. begin
  6341. result := tfEmpty;
  6342. with Header.PixelFormat do begin
  6343. // Compresses
  6344. if ((dwFlags and DDPF_FOURCC) > 0) then begin
  6345. case Header.PixelFormat.dwFourCC of
  6346. D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
  6347. D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
  6348. D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
  6349. end;
  6350. end else if ((Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin
  6351. //find matching format
  6352. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  6353. fd := TFormatDescriptor.Get(result);
  6354. if fd.MaskMatch(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask) and
  6355. (8 * fd.PixelSize = dwRGBBitCount) then
  6356. exit;
  6357. end;
  6358. //find format with same Range
  6359. Range.r := dwRBitMask;
  6360. Range.g := dwGBitMask;
  6361. Range.b := dwBBitMask;
  6362. Range.a := dwABitMask;
  6363. for i := 0 to 3 do begin
  6364. while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do
  6365. Range.arr[i] := Range.arr[i] shr 1;
  6366. end;
  6367. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  6368. fd := TFormatDescriptor.Get(result);
  6369. match := true;
  6370. for i := 0 to 3 do
  6371. if (fd.Range.arr[i] <> Range.arr[i]) then begin
  6372. match := false;
  6373. break;
  6374. end;
  6375. if match then
  6376. break;
  6377. end;
  6378. //no format with same range found -> use default
  6379. if (result = tfEmpty) then begin
  6380. if (dwABitMask > 0) then
  6381. result := tfBGRA8
  6382. else
  6383. result := tfBGR8;
  6384. end;
  6385. Converter := TbmpBitfieldFormat.Create;
  6386. Converter.RedMask := dwRBitMask;
  6387. Converter.GreenMask := dwGBitMask;
  6388. Converter.BlueMask := dwBBitMask;
  6389. Converter.AlphaMask := dwABitMask;
  6390. Converter.PixelSize := dwRGBBitCount / 8;
  6391. end;
  6392. end;
  6393. end;
  6394. var
  6395. StreamPos: Int64;
  6396. x, y, j, LineSize, RowSize, Magic: Cardinal;
  6397. NewImage, TmpData, RowData, SrcData: PByte;
  6398. SourceMD, DestMD: Pointer;
  6399. Pixel: TglBitmapPixelData;
  6400. ddsFormat: TglBitmapFormat;
  6401. FormatDesc: TFormatDescriptor;
  6402. begin
  6403. result := false;
  6404. Converter := nil;
  6405. StreamPos := aStream.Position;
  6406. // Magic
  6407. aStream.Read(Magic, sizeof(Magic));
  6408. if (Magic <> DDS_MAGIC) then begin
  6409. aStream.Position := StreamPos;
  6410. exit;
  6411. end;
  6412. //Header
  6413. aStream.Read(Header, sizeof(Header));
  6414. if (Header.dwSize <> SizeOf(Header)) or
  6415. ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
  6416. (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
  6417. begin
  6418. aStream.Position := StreamPos;
  6419. exit;
  6420. end;
  6421. if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
  6422. raise EglBitmapException.Create('LoadDDS - CubeMaps are not supported');
  6423. ddsFormat := GetDDSFormat;
  6424. try
  6425. if (ddsFormat = tfEmpty) then
  6426. raise EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');
  6427. FormatDesc := TFormatDescriptor.Get(ddsFormat);
  6428. LineSize := Trunc(Header.dwWidth * FormatDesc.PixelSize);
  6429. GetMem(NewImage, Header.dwHeight * LineSize);
  6430. try
  6431. TmpData := NewImage;
  6432. //Converter needed
  6433. if Assigned(Converter) then begin
  6434. RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
  6435. GetMem(RowData, RowSize);
  6436. SourceMD := Converter.CreateMappingData;
  6437. DestMD := FormatDesc.CreateMappingData;
  6438. try
  6439. for y := 0 to Header.dwHeight-1 do begin
  6440. TmpData := NewImage + y * LineSize;
  6441. SrcData := RowData;
  6442. aStream.Read(SrcData^, RowSize);
  6443. for x := 0 to Header.dwWidth-1 do begin
  6444. Converter.Unmap(SrcData, Pixel, SourceMD);
  6445. glBitmapConvertPixel(Pixel, Converter, FormatDesc);
  6446. FormatDesc.Map(Pixel, TmpData, DestMD);
  6447. end;
  6448. end;
  6449. finally
  6450. Converter.FreeMappingData(SourceMD);
  6451. FormatDesc.FreeMappingData(DestMD);
  6452. FreeMem(RowData);
  6453. end;
  6454. end else
  6455. // Compressed
  6456. if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
  6457. RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
  6458. for Y := 0 to Header.dwHeight-1 do begin
  6459. aStream.Read(TmpData^, RowSize);
  6460. Inc(TmpData, LineSize);
  6461. end;
  6462. end else
  6463. // Uncompressed
  6464. if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
  6465. RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
  6466. for Y := 0 to Header.dwHeight-1 do begin
  6467. aStream.Read(TmpData^, RowSize);
  6468. Inc(TmpData, LineSize);
  6469. end;
  6470. end else
  6471. raise EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');
  6472. SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight);
  6473. result := true;
  6474. except
  6475. FreeMem(NewImage);
  6476. raise;
  6477. end;
  6478. finally
  6479. FreeAndNil(Converter);
  6480. end;
  6481. end;
  6482. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6483. procedure TglBitmap.SaveDDS(const aStream: TStream);
  6484. var
  6485. Header: TDDSHeader;
  6486. FormatDesc: TFormatDescriptor;
  6487. begin
  6488. if not (ftDDS in FormatGetSupportedFiles(Format)) then
  6489. raise EglBitmapUnsupportedFormatFormat.Create('SaveDDS - ' + UNSUPPORTED_FORMAT);
  6490. FormatDesc := TFormatDescriptor.Get(Format);
  6491. // Generell
  6492. FillChar(Header, SizeOf(Header), 0);
  6493. Header.dwSize := SizeOf(Header);
  6494. Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
  6495. Header.dwWidth := Max(1, Width);
  6496. Header.dwHeight := Max(1, Height);
  6497. // Caps
  6498. Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
  6499. // Pixelformat
  6500. Header.PixelFormat.dwSize := sizeof(Header);
  6501. if (FormatDesc.IsCompressed) then begin
  6502. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
  6503. case Format of
  6504. tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
  6505. tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
  6506. tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
  6507. end;
  6508. end else if (Format in [tfAlpha8, tfAlpha16]) then begin
  6509. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHA;
  6510. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6511. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6512. end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
  6513. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
  6514. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6515. Header.PixelFormat.dwRBitMask := FormatDesc.RedMask;
  6516. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6517. end else begin
  6518. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
  6519. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6520. Header.PixelFormat.dwRBitMask := FormatDesc.RedMask;
  6521. Header.PixelFormat.dwGBitMask := FormatDesc.GreenMask;
  6522. Header.PixelFormat.dwBBitMask := FormatDesc.BlueMask;
  6523. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6524. end;
  6525. if (FormatDesc.HasAlpha) then
  6526. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
  6527. aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
  6528. aStream.Write(Header, SizeOf(Header));
  6529. aStream.Write(Data^, FormatDesc.GetSize(Dimension));
  6530. end;
  6531. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6532. //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6533. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6534. function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
  6535. begin
  6536. if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
  6537. result := fLines[aIndex]
  6538. else
  6539. result := nil;
  6540. end;
  6541. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6542. procedure TglBitmap2D.SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
  6543. const aWidth: Integer; const aHeight: Integer);
  6544. var
  6545. Idx, LineWidth: Integer;
  6546. begin
  6547. inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
  6548. if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
  6549. (* TODO PixelFuncs
  6550. fGetPixelFunc := GetPixel2DUnmap;
  6551. fSetPixelFunc := SetPixel2DUnmap;
  6552. *)
  6553. // Assigning Data
  6554. if Assigned(Data) then begin
  6555. SetLength(fLines, GetHeight);
  6556. LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
  6557. for Idx := 0 to GetHeight -1 do begin
  6558. fLines[Idx] := Data;
  6559. Inc(fLines[Idx], Idx * LineWidth);
  6560. end;
  6561. end
  6562. else SetLength(fLines, 0);
  6563. end else begin
  6564. SetLength(fLines, 0);
  6565. (*
  6566. fSetPixelFunc := nil;
  6567. case Format of
  6568. ifDXT1:
  6569. fGetPixelFunc := GetPixel2DDXT1;
  6570. ifDXT3:
  6571. fGetPixelFunc := GetPixel2DDXT3;
  6572. ifDXT5:
  6573. fGetPixelFunc := GetPixel2DDXT5;
  6574. else
  6575. fGetPixelFunc := nil;
  6576. end;
  6577. *)
  6578. end;
  6579. end;
  6580. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6581. procedure TglBitmap2D.UploadData(const aTarget: Cardinal; const aBuildWithGlu: Boolean);
  6582. var
  6583. FormatDesc: TFormatDescriptor;
  6584. begin
  6585. glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
  6586. FormatDesc := TFormatDescriptor.Get(Format);
  6587. if FormatDesc.IsCompressed then begin
  6588. glCompressedTexImage2D(Target, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
  6589. end else if aBuildWithGlu then begin
  6590. gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
  6591. FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  6592. end else begin
  6593. glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
  6594. FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  6595. end;
  6596. // Freigeben
  6597. if (FreeDataAfterGenTexture) then
  6598. FreeData;
  6599. end;
  6600. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6601. procedure TglBitmap2D.AfterConstruction;
  6602. begin
  6603. inherited;
  6604. Target := GL_TEXTURE_2D;
  6605. end;
  6606. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6607. procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  6608. var
  6609. Temp: pByte;
  6610. Size, w, h: Integer;
  6611. FormatDesc: TFormatDescriptor;
  6612. begin
  6613. FormatDesc := TFormatDescriptor.Get(Format);
  6614. if FormatDesc.IsCompressed then
  6615. raise EglBitmapUnsupportedFormatFormat.Create('TglBitmap2D.GrabScreen - ' + UNSUPPORTED_FORMAT);
  6616. w := aRight - aLeft;
  6617. h := aBottom - aTop;
  6618. Size := FormatDesc.GetSize(w, h);
  6619. GetMem(Temp, Size);
  6620. try
  6621. glPixelStorei(GL_PACK_ALIGNMENT, 1);
  6622. glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  6623. SetDataPointer(Temp, Format, w, h);
  6624. FlipVert;
  6625. except
  6626. FreeMem(Temp);
  6627. raise;
  6628. end;
  6629. end;
  6630. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6631. procedure TglBitmap2D.GetDataFromTexture;
  6632. var
  6633. Temp: PByte;
  6634. TempWidth, TempHeight: Integer;
  6635. TempType, TempIntFormat: Cardinal;
  6636. IntFormat, f: TglBitmapFormat;
  6637. FormatDesc: TFormatDescriptor;
  6638. begin
  6639. Bind;
  6640. // Request Data
  6641. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH, @TempWidth);
  6642. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT, @TempHeight);
  6643. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
  6644. IntFormat := tfEmpty;
  6645. for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do
  6646. if (TFormatDescriptor.Get(f).glInternalFormat = TempIntFormat) then begin
  6647. IntFormat := FormatDesc.Format;
  6648. break;
  6649. end;
  6650. // Getting data from OpenGL
  6651. FormatDesc := TFormatDescriptor.Get(IntFormat);
  6652. GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
  6653. try
  6654. if FormatDesc.IsCompressed then
  6655. glGetCompressedTexImage(Target, 0, Temp)
  6656. else
  6657. glGetTexImage(Target, 0, FormatDesc.glInternalFormat, FormatDesc.glDataFormat, Temp);
  6658. SetDataPointer(Temp, IntFormat, TempWidth, TempHeight);
  6659. except
  6660. FreeMem(Temp);
  6661. raise;
  6662. end;
  6663. end;
  6664. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6665. procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
  6666. var
  6667. BuildWithGlu, PotTex, TexRec: Boolean;
  6668. TexSize: Integer;
  6669. begin
  6670. if Assigned(Data) then begin
  6671. // Check Texture Size
  6672. if (aTestTextureSize) then begin
  6673. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  6674. if ((Height > TexSize) or (Width > TexSize)) then
  6675. raise EglBitmapSizeToLargeException.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  6676. PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
  6677. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
  6678. if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  6679. raise EglBitmapNonPowerOfTwoException.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  6680. end;
  6681. CreateId;
  6682. SetupParameters(BuildWithGlu);
  6683. UploadData(Target, BuildWithGlu);
  6684. glAreTexturesResident(1, @fID, @fIsResident);
  6685. end;
  6686. end;
  6687. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6688. function TglBitmap2D.FlipHorz: Boolean;
  6689. var
  6690. Col, Row: Integer;
  6691. TempDestData, DestData, SourceData: PByte;
  6692. ImgSize: Integer;
  6693. begin
  6694. result := inherited FlipHorz;
  6695. if Assigned(Data) then begin
  6696. SourceData := Data;
  6697. ImgSize := Height * fRowSize;
  6698. GetMem(DestData, ImgSize);
  6699. try
  6700. TempDestData := DestData;
  6701. Dec(TempDestData, fRowSize + fPixelSize);
  6702. for Row := 0 to Height -1 do begin
  6703. Inc(TempDestData, fRowSize * 2);
  6704. for Col := 0 to Width -1 do begin
  6705. Move(SourceData^, TempDestData^, fPixelSize);
  6706. Inc(SourceData, fPixelSize);
  6707. Dec(TempDestData, fPixelSize);
  6708. end;
  6709. end;
  6710. SetDataPointer(DestData, Format);
  6711. result := true;
  6712. except
  6713. FreeMem(DestData);
  6714. raise;
  6715. end;
  6716. end;
  6717. end;
  6718. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6719. function TglBitmap2D.FlipVert: Boolean;
  6720. var
  6721. Row: Integer;
  6722. TempDestData, DestData, SourceData: PByte;
  6723. begin
  6724. result := inherited FlipVert;
  6725. if Assigned(Data) then begin
  6726. SourceData := Data;
  6727. GetMem(DestData, Height * fRowSize);
  6728. try
  6729. TempDestData := DestData;
  6730. Inc(TempDestData, Width * (Height -1) * fPixelSize);
  6731. for Row := 0 to Height -1 do begin
  6732. Move(SourceData^, TempDestData^, fRowSize);
  6733. Dec(TempDestData, fRowSize);
  6734. Inc(SourceData, fRowSize);
  6735. end;
  6736. SetDataPointer(DestData, Format);
  6737. result := true;
  6738. except
  6739. FreeMem(DestData);
  6740. raise;
  6741. end;
  6742. end;
  6743. end;
  6744. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6745. //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6746. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6747. type
  6748. TMatrixItem = record
  6749. X, Y: Integer;
  6750. W: Single;
  6751. end;
  6752. PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
  6753. TglBitmapToNormalMapRec = Record
  6754. Scale: Single;
  6755. Heights: array of Single;
  6756. MatrixU : array of TMatrixItem;
  6757. MatrixV : array of TMatrixItem;
  6758. end;
  6759. const
  6760. ONE_OVER_255 = 1 / 255;
  6761. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6762. procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
  6763. var
  6764. Val: Single;
  6765. begin
  6766. with FuncRec do begin
  6767. Val :=
  6768. Source.Data.r * LUMINANCE_WEIGHT_R +
  6769. Source.Data.g * LUMINANCE_WEIGHT_G +
  6770. Source.Data.b * LUMINANCE_WEIGHT_B;
  6771. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
  6772. end;
  6773. end;
  6774. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6775. procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  6776. begin
  6777. with FuncRec do
  6778. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
  6779. end;
  6780. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6781. procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
  6782. type
  6783. TVec = Array[0..2] of Single;
  6784. var
  6785. Idx: Integer;
  6786. du, dv: Double;
  6787. Len: Single;
  6788. Vec: TVec;
  6789. function GetHeight(X, Y: Integer): Single;
  6790. begin
  6791. with FuncRec do begin
  6792. X := Max(0, Min(Size.X -1, X));
  6793. Y := Max(0, Min(Size.Y -1, Y));
  6794. result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
  6795. end;
  6796. end;
  6797. begin
  6798. with FuncRec do begin
  6799. with PglBitmapToNormalMapRec(Args)^ do begin
  6800. du := 0;
  6801. for Idx := Low(MatrixU) to High(MatrixU) do
  6802. du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
  6803. dv := 0;
  6804. for Idx := Low(MatrixU) to High(MatrixU) do
  6805. dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
  6806. Vec[0] := -du * Scale;
  6807. Vec[1] := -dv * Scale;
  6808. Vec[2] := 1;
  6809. end;
  6810. // Normalize
  6811. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  6812. if Len <> 0 then begin
  6813. Vec[0] := Vec[0] * Len;
  6814. Vec[1] := Vec[1] * Len;
  6815. Vec[2] := Vec[2] * Len;
  6816. end;
  6817. // Farbe zuweisem
  6818. Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
  6819. Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
  6820. Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
  6821. end;
  6822. end;
  6823. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6824. procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
  6825. var
  6826. Rec: TglBitmapToNormalMapRec;
  6827. procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
  6828. begin
  6829. if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
  6830. Matrix[Index].X := X;
  6831. Matrix[Index].Y := Y;
  6832. Matrix[Index].W := W;
  6833. end;
  6834. end;
  6835. begin
  6836. (* TODO Compression
  6837. if not FormatIsUncompressed(InternalFormat) then
  6838. raise EglBitmapUnsupportedFormatFormat.Create('TglBitmap2D.ToNormalMap - ' + UNSUPPORTED_FORMAT);
  6839. *)
  6840. if aScale > 100 then
  6841. Rec.Scale := 100
  6842. else if aScale < -100 then
  6843. Rec.Scale := -100
  6844. else
  6845. Rec.Scale := aScale;
  6846. SetLength(Rec.Heights, Width * Height);
  6847. try
  6848. case aFunc of
  6849. nm4Samples: begin
  6850. SetLength(Rec.MatrixU, 2);
  6851. SetEntry(Rec.MatrixU, 0, -1, 0, -0.5);
  6852. SetEntry(Rec.MatrixU, 1, 1, 0, 0.5);
  6853. SetLength(Rec.MatrixV, 2);
  6854. SetEntry(Rec.MatrixV, 0, 0, 1, 0.5);
  6855. SetEntry(Rec.MatrixV, 1, 0, -1, -0.5);
  6856. end;
  6857. nmSobel: begin
  6858. SetLength(Rec.MatrixU, 6);
  6859. SetEntry(Rec.MatrixU, 0, -1, 1, -1.0);
  6860. SetEntry(Rec.MatrixU, 1, -1, 0, -2.0);
  6861. SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
  6862. SetEntry(Rec.MatrixU, 3, 1, 1, 1.0);
  6863. SetEntry(Rec.MatrixU, 4, 1, 0, 2.0);
  6864. SetEntry(Rec.MatrixU, 5, 1, -1, 1.0);
  6865. SetLength(Rec.MatrixV, 6);
  6866. SetEntry(Rec.MatrixV, 0, -1, 1, 1.0);
  6867. SetEntry(Rec.MatrixV, 1, 0, 1, 2.0);
  6868. SetEntry(Rec.MatrixV, 2, 1, 1, 1.0);
  6869. SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
  6870. SetEntry(Rec.MatrixV, 4, 0, -1, -2.0);
  6871. SetEntry(Rec.MatrixV, 5, 1, -1, -1.0);
  6872. end;
  6873. nm3x3: begin
  6874. SetLength(Rec.MatrixU, 6);
  6875. SetEntry(Rec.MatrixU, 0, -1, 1, -1/6);
  6876. SetEntry(Rec.MatrixU, 1, -1, 0, -1/6);
  6877. SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
  6878. SetEntry(Rec.MatrixU, 3, 1, 1, 1/6);
  6879. SetEntry(Rec.MatrixU, 4, 1, 0, 1/6);
  6880. SetEntry(Rec.MatrixU, 5, 1, -1, 1/6);
  6881. SetLength(Rec.MatrixV, 6);
  6882. SetEntry(Rec.MatrixV, 0, -1, 1, 1/6);
  6883. SetEntry(Rec.MatrixV, 1, 0, 1, 1/6);
  6884. SetEntry(Rec.MatrixV, 2, 1, 1, 1/6);
  6885. SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
  6886. SetEntry(Rec.MatrixV, 4, 0, -1, -1/6);
  6887. SetEntry(Rec.MatrixV, 5, 1, -1, -1/6);
  6888. end;
  6889. nm5x5: begin
  6890. SetLength(Rec.MatrixU, 20);
  6891. SetEntry(Rec.MatrixU, 0, -2, 2, -1 / 16);
  6892. SetEntry(Rec.MatrixU, 1, -1, 2, -1 / 10);
  6893. SetEntry(Rec.MatrixU, 2, 1, 2, 1 / 10);
  6894. SetEntry(Rec.MatrixU, 3, 2, 2, 1 / 16);
  6895. SetEntry(Rec.MatrixU, 4, -2, 1, -1 / 10);
  6896. SetEntry(Rec.MatrixU, 5, -1, 1, -1 / 8);
  6897. SetEntry(Rec.MatrixU, 6, 1, 1, 1 / 8);
  6898. SetEntry(Rec.MatrixU, 7, 2, 1, 1 / 10);
  6899. SetEntry(Rec.MatrixU, 8, -2, 0, -1 / 2.8);
  6900. SetEntry(Rec.MatrixU, 9, -1, 0, -0.5);
  6901. SetEntry(Rec.MatrixU, 10, 1, 0, 0.5);
  6902. SetEntry(Rec.MatrixU, 11, 2, 0, 1 / 2.8);
  6903. SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
  6904. SetEntry(Rec.MatrixU, 13, -1, -1, -1 / 8);
  6905. SetEntry(Rec.MatrixU, 14, 1, -1, 1 / 8);
  6906. SetEntry(Rec.MatrixU, 15, 2, -1, 1 / 10);
  6907. SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
  6908. SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
  6909. SetEntry(Rec.MatrixU, 18, 1, -2, 1 / 10);
  6910. SetEntry(Rec.MatrixU, 19, 2, -2, 1 / 16);
  6911. SetLength(Rec.MatrixV, 20);
  6912. SetEntry(Rec.MatrixV, 0, -2, 2, 1 / 16);
  6913. SetEntry(Rec.MatrixV, 1, -1, 2, 1 / 10);
  6914. SetEntry(Rec.MatrixV, 2, 0, 2, 0.25);
  6915. SetEntry(Rec.MatrixV, 3, 1, 2, 1 / 10);
  6916. SetEntry(Rec.MatrixV, 4, 2, 2, 1 / 16);
  6917. SetEntry(Rec.MatrixV, 5, -2, 1, 1 / 10);
  6918. SetEntry(Rec.MatrixV, 6, -1, 1, 1 / 8);
  6919. SetEntry(Rec.MatrixV, 7, 0, 1, 0.5);
  6920. SetEntry(Rec.MatrixV, 8, 1, 1, 1 / 8);
  6921. SetEntry(Rec.MatrixV, 9, 2, 1, 1 / 16);
  6922. SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
  6923. SetEntry(Rec.MatrixV, 11, -1, -1, -1 / 8);
  6924. SetEntry(Rec.MatrixV, 12, 0, -1, -0.5);
  6925. SetEntry(Rec.MatrixV, 13, 1, -1, -1 / 8);
  6926. SetEntry(Rec.MatrixV, 14, 2, -1, -1 / 10);
  6927. SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
  6928. SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
  6929. SetEntry(Rec.MatrixV, 17, 0, -2, -0.25);
  6930. SetEntry(Rec.MatrixV, 18, 1, -2, -1 / 10);
  6931. SetEntry(Rec.MatrixV, 19, 2, -2, -1 / 16);
  6932. end;
  6933. end;
  6934. // Daten Sammeln
  6935. if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
  6936. AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, PtrInt(@Rec))
  6937. else
  6938. AddFunc(glBitmapToNormalMapPrepareFunc, false, PtrInt(@Rec));
  6939. AddFunc(glBitmapToNormalMapFunc, false, PtrInt(@Rec));
  6940. finally
  6941. SetLength(Rec.Heights, 0);
  6942. end;
  6943. end;
  6944. (*
  6945. procedure TglBitmap1D.SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width, Height: Integer);
  6946. var
  6947. pTemp: pByte;
  6948. Size: Integer;
  6949. begin
  6950. if Height > 1 then begin
  6951. // extract first line of the data
  6952. Size := FormatGetImageSize(glBitmapPosition(Width), Format);
  6953. GetMem(pTemp, Size);
  6954. Move(Data^, pTemp^, Size);
  6955. FreeMem(Data);
  6956. end else
  6957. pTemp := Data;
  6958. // set data pointer
  6959. inherited SetDataPointer(pTemp, Format, Width);
  6960. if FormatIsUncompressed(Format) then begin
  6961. fUnmapFunc := FormatGetUnMapFunc(Format);
  6962. fGetPixelFunc := GetPixel1DUnmap;
  6963. end;
  6964. end;
  6965. procedure TglBitmap1D.GetPixel1DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
  6966. var
  6967. pTemp: pByte;
  6968. begin
  6969. pTemp := Data;
  6970. Inc(pTemp, Pos.X * fPixelSize);
  6971. fUnmapFunc(pTemp, Pixel);
  6972. end;
  6973. function TglBitmap1D.FlipHorz: Boolean;
  6974. var
  6975. Col: Integer;
  6976. pTempDest, pDest, pSource: pByte;
  6977. begin
  6978. result := inherited FlipHorz;
  6979. if Assigned(Data) and FormatIsUncompressed(InternalFormat) then begin
  6980. pSource := Data;
  6981. GetMem(pDest, fRowSize);
  6982. try
  6983. pTempDest := pDest;
  6984. Inc(pTempDest, fRowSize);
  6985. for Col := 0 to Width -1 do begin
  6986. Move(pSource^, pTempDest^, fPixelSize);
  6987. Inc(pSource, fPixelSize);
  6988. Dec(pTempDest, fPixelSize);
  6989. end;
  6990. SetDataPointer(pDest, InternalFormat);
  6991. result := true;
  6992. finally
  6993. FreeMem(pDest);
  6994. end;
  6995. end;
  6996. end;
  6997. procedure TglBitmap1D.UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
  6998. begin
  6999. // Upload data
  7000. if Self.InternalFormat in [ifDXT1, ifDXT3, ifDXT5] then
  7001. glCompressedTexImage1D(Target, 0, InternalFormat, Width, 0, Trunc(Width * FormatGetSize(Self.InternalFormat)), Data)
  7002. else
  7003. // Upload data
  7004. if BuildWithGlu then
  7005. gluBuild1DMipmaps(Target, InternalFormat, Width, Format, Typ, Data)
  7006. else
  7007. glTexImage1D(Target, 0, InternalFormat, Width, 0, Format, Typ, Data);
  7008. // Freigeben
  7009. if (FreeDataAfterGenTexture) then
  7010. FreeData;
  7011. end;
  7012. procedure TglBitmap1D.GenTexture(TestTextureSize: Boolean);
  7013. var
  7014. BuildWithGlu, TexRec: Boolean;
  7015. glFormat, glInternalFormat, glType: Cardinal;
  7016. TexSize: Integer;
  7017. begin
  7018. if Assigned(Data) then begin
  7019. // Check Texture Size
  7020. if (TestTextureSize) then begin
  7021. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  7022. if (Width > TexSize) then
  7023. raise EglBitmapSizeToLargeException.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  7024. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
  7025. (Target = GL_TEXTURE_RECTANGLE_ARB);
  7026. if not (IsPowerOfTwo (Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  7027. raise EglBitmapNonPowerOfTwoException.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7028. end;
  7029. CreateId;
  7030. SetupParameters(BuildWithGlu);
  7031. SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
  7032. UploadData(Target, glFormat, glInternalFormat, glType, BuildWithGlu);
  7033. // Infos sammeln
  7034. glAreTexturesResident(1, @fID, @fIsResident);
  7035. end;
  7036. end;
  7037. procedure TglBitmap1D.AfterConstruction;
  7038. begin
  7039. inherited;
  7040. Target := GL_TEXTURE_1D;
  7041. end;
  7042. { TglBitmapCubeMap }
  7043. procedure TglBitmapCubeMap.AfterConstruction;
  7044. begin
  7045. inherited;
  7046. if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
  7047. raise EglBitmapException.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
  7048. SetWrap; // set all to GL_CLAMP_TO_EDGE
  7049. Target := GL_TEXTURE_CUBE_MAP;
  7050. fGenMode := GL_REFLECTION_MAP;
  7051. end;
  7052. procedure TglBitmapCubeMap.Bind(EnableTexCoordsGen, EnableTextureUnit: Boolean);
  7053. begin
  7054. inherited Bind (EnableTextureUnit);
  7055. if EnableTexCoordsGen then begin
  7056. glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
  7057. glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
  7058. glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
  7059. glEnable(GL_TEXTURE_GEN_S);
  7060. glEnable(GL_TEXTURE_GEN_T);
  7061. glEnable(GL_TEXTURE_GEN_R);
  7062. end;
  7063. end;
  7064. procedure TglBitmapCubeMap.GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean);
  7065. var
  7066. glFormat, glInternalFormat, glType: Cardinal;
  7067. BuildWithGlu: Boolean;
  7068. TexSize: Integer;
  7069. begin
  7070. // Check Texture Size
  7071. if (TestTextureSize) then begin
  7072. glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
  7073. if ((Height > TexSize) or (Width > TexSize)) then
  7074. raise EglBitmapSizeToLargeException.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
  7075. if not ((IsPowerOfTwo (Height) and IsPowerOfTwo (Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
  7076. raise EglBitmapNonPowerOfTwoException.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
  7077. end;
  7078. // create Texture
  7079. if ID = 0 then begin
  7080. CreateID;
  7081. SetupParameters(BuildWithGlu);
  7082. end;
  7083. SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
  7084. UploadData (CubeTarget, glFormat, glInternalFormat, glType, BuildWithGlu);
  7085. end;
  7086. procedure TglBitmapCubeMap.GenTexture(TestTextureSize: Boolean);
  7087. begin
  7088. Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
  7089. end;
  7090. procedure TglBitmapCubeMap.Unbind(DisableTexCoordsGen,
  7091. DisableTextureUnit: Boolean);
  7092. begin
  7093. inherited Unbind (DisableTextureUnit);
  7094. if DisableTexCoordsGen then begin
  7095. glDisable(GL_TEXTURE_GEN_S);
  7096. glDisable(GL_TEXTURE_GEN_T);
  7097. glDisable(GL_TEXTURE_GEN_R);
  7098. end;
  7099. end;
  7100. { TglBitmapNormalMap }
  7101. type
  7102. TVec = Array[0..2] of Single;
  7103. TglBitmapNormalMapGetVectorFunc = procedure (var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  7104. PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
  7105. TglBitmapNormalMapRec = record
  7106. HalfSize : Integer;
  7107. Func: TglBitmapNormalMapGetVectorFunc;
  7108. end;
  7109. procedure glBitmapNormalMapPosX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  7110. begin
  7111. Vec[0] := HalfSize;
  7112. Vec[1] := - (Position.Y + 0.5 - HalfSize);
  7113. Vec[2] := - (Position.X + 0.5 - HalfSize);
  7114. end;
  7115. procedure glBitmapNormalMapNegX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  7116. begin
  7117. Vec[0] := - HalfSize;
  7118. Vec[1] := - (Position.Y + 0.5 - HalfSize);
  7119. Vec[2] := Position.X + 0.5 - HalfSize;
  7120. end;
  7121. procedure glBitmapNormalMapPosY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  7122. begin
  7123. Vec[0] := Position.X + 0.5 - HalfSize;
  7124. Vec[1] := HalfSize;
  7125. Vec[2] := Position.Y + 0.5 - HalfSize;
  7126. end;
  7127. procedure glBitmapNormalMapNegY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  7128. begin
  7129. Vec[0] := Position.X + 0.5 - HalfSize;
  7130. Vec[1] := - HalfSize;
  7131. Vec[2] := - (Position.Y + 0.5 - HalfSize);
  7132. end;
  7133. procedure glBitmapNormalMapPosZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  7134. begin
  7135. Vec[0] := Position.X + 0.5 - HalfSize;
  7136. Vec[1] := - (Position.Y + 0.5 - HalfSize);
  7137. Vec[2] := HalfSize;
  7138. end;
  7139. procedure glBitmapNormalMapNegZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  7140. begin
  7141. Vec[0] := - (Position.X + 0.5 - HalfSize);
  7142. Vec[1] := - (Position.Y + 0.5 - HalfSize);
  7143. Vec[2] := - HalfSize;
  7144. end;
  7145. procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
  7146. var
  7147. Vec : TVec;
  7148. Len: Single;
  7149. begin
  7150. with FuncRec do begin
  7151. with PglBitmapNormalMapRec (CustomData)^ do begin
  7152. Func(Vec, Position, HalfSize);
  7153. // Normalize
  7154. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  7155. if Len <> 0 then begin
  7156. Vec[0] := Vec[0] * Len;
  7157. Vec[1] := Vec[1] * Len;
  7158. Vec[2] := Vec[2] * Len;
  7159. end;
  7160. // Scale Vector and AddVectro
  7161. Vec[0] := Vec[0] * 0.5 + 0.5;
  7162. Vec[1] := Vec[1] * 0.5 + 0.5;
  7163. Vec[2] := Vec[2] * 0.5 + 0.5;
  7164. end;
  7165. // Set Color
  7166. Dest.Red := Round(Vec[0] * 255);
  7167. Dest.Green := Round(Vec[1] * 255);
  7168. Dest.Blue := Round(Vec[2] * 255);
  7169. end;
  7170. end;
  7171. procedure TglBitmapNormalMap.AfterConstruction;
  7172. begin
  7173. inherited;
  7174. fGenMode := GL_NORMAL_MAP;
  7175. end;
  7176. procedure TglBitmapNormalMap.GenerateNormalMap(Size: Integer;
  7177. TestTextureSize: Boolean);
  7178. var
  7179. Rec: TglBitmapNormalMapRec;
  7180. SizeRec: TglBitmapPixelPosition;
  7181. begin
  7182. Rec.HalfSize := Size div 2;
  7183. FreeDataAfterGenTexture := false;
  7184. SizeRec.Fields := [ffX, ffY];
  7185. SizeRec.X := Size;
  7186. SizeRec.Y := Size;
  7187. // Positive X
  7188. Rec.Func := glBitmapNormalMapPosX;
  7189. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  7190. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, TestTextureSize);
  7191. // Negative X
  7192. Rec.Func := glBitmapNormalMapNegX;
  7193. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  7194. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, TestTextureSize);
  7195. // Positive Y
  7196. Rec.Func := glBitmapNormalMapPosY;
  7197. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  7198. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, TestTextureSize);
  7199. // Negative Y
  7200. Rec.Func := glBitmapNormalMapNegY;
  7201. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  7202. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, TestTextureSize);
  7203. // Positive Z
  7204. Rec.Func := glBitmapNormalMapPosZ;
  7205. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  7206. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, TestTextureSize);
  7207. // Negative Z
  7208. Rec.Func := glBitmapNormalMapNegZ;
  7209. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  7210. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, TestTextureSize);
  7211. end;
  7212. *)
  7213. initialization
  7214. glBitmapSetDefaultFormat(tfEmpty);
  7215. glBitmapSetDefaultMipmap(mmMipmap);
  7216. glBitmapSetDefaultFilter(GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
  7217. glBitmapSetDefaultWrap (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
  7218. glBitmapSetDefaultFreeDataAfterGenTexture(true);
  7219. glBitmapSetDefaultDeleteTextureOnFree (true);
  7220. TFormatDescriptor.Init;
  7221. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  7222. OpenGLInitialized := false;
  7223. InitOpenGLCS := TCriticalSection.Create;
  7224. {$ENDIF}
  7225. finalization
  7226. TFormatDescriptor.Finalize;
  7227. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  7228. FreeAndNil(InitOpenGLCS);
  7229. {$ENDIF}
  7230. end.