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.

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