Du kan inte välja fler än 25 ämnen Ämnen måste starta med en bokstav eller siffra, kan innehålla bindestreck ('-') och vara max 35 tecken långa.

8236 rader
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. modified by Delphi OpenGL Community (http://delphigl.com/)
  5. ------------------------------------------------------------
  6. The contents of this file are used with permission, subject to
  7. the Mozilla Public License Version 1.1 (the "License"); you may
  8. not use this file except in compliance with the License. You may
  9. obtain a copy of the License at
  10. http://www.mozilla.org/MPL/MPL-1.1.html
  11. ------------------------------------------------------------
  12. Version 2.0.3
  13. ------------------------------------------------------------
  14. History
  15. 21-03-2010
  16. - The define GLB_DELPHI dosn't check versions anymore. If you say you are using delphi
  17. then it's your problem if that isn't true. This prevents the unit for incompatibility
  18. with newer versions of Delphi.
  19. - Problems with D2009+ resolved (Thanks noeska and all i forgot)
  20. - GetPixel isn't set if you are loading textures inside the constructor (Thanks Wilson)
  21. 10-08-2008
  22. - AddAlphaFromglBitmap used the custom pointer instead the imagedatapointer (Thanks Wilson)
  23. - Additional Datapointer for functioninterface now has the name CustomData
  24. 24-07-2008
  25. - AssigneAlphaToBitmap overwrites his own palette (Thanks Wilson)
  26. - If you load an texture from an file the property Filename will be set to the name of the file
  27. - Three new properties to attach custom data to the Texture objects
  28. - CustomName (free for use string)
  29. - CustomNameW (free for use widestring)
  30. - CustomDataPointer (free for use pointer to attach other objects or complex structures)
  31. 27-05-2008
  32. - RLE TGAs loaded much faster
  33. 26-05-2008
  34. - fixed some problem with reading RLE TGAs.
  35. 21-05-2008
  36. - function clone now only copys data if it's assigned and now it also copies the ID
  37. - it seems that lazarus dont like comments in comments.
  38. 01-05-2008
  39. - It's possible to set the id of the texture
  40. - define GLB_NO_NATIVE_GL deactivated by default
  41. 27-04-2008
  42. - Now supports the following libraries
  43. - SDL and SDL_image
  44. - libPNG
  45. - libJPEG
  46. - Linux compatibillity via free pascal compatibility (delphi sources optional)
  47. - BMPs now loaded manuel
  48. - Large restructuring
  49. - Property DataPtr now has the name Data
  50. - Functions are more flexible between RGB(A) and BGR(A). RGB can be saved as Bitmap and will be saved as BGR
  51. - Unused Depth removed
  52. - Function FreeData to freeing image data added
  53. 24-10-2007
  54. - ImageID flag of TGAs was ignored. (Thanks Zwoetzen)
  55. 15-11-2006
  56. - Function SetBorderColor implemented (only used by opengl if wrap is set to GL_CLAMP_TO_BORDER)
  57. - Function AddAlphaFromValue implemented to use an fixed Value as Alphachannel
  58. - Function ReadOpenGLExtension is now only intern
  59. 29-06-2006
  60. - pngimage now disabled by default like all other versions.
  61. 26-06-2006
  62. - Setting up an anisotropic filter of 0 isnt allowed by nvidia (Thanks Ogridi)
  63. 22-06-2006
  64. - Fixed some Problem with Delphi 5
  65. - Now uses the newest version of pngimage. Makes saving pngs much easier.
  66. 22-03-2006
  67. - Property IsCompressed and Size removed. Not really supported by Spec (Thanks Ogridi)
  68. 09-03-2006
  69. - Internal Format ifDepth8 added
  70. - function GrabScreen now supports all uncompressed formats
  71. 31-01-2006
  72. - AddAlphaFromglBitmap implemented
  73. 29-12-2005
  74. - LoadFromResource and LoadFromResourceId now needs an Instance and an ResourceType (for ID)
  75. 28-12-2005
  76. - Width, Height and Depth internal changed to TglBitmapPixelPosition.
  77. property Width, Height, Depth are still existing and new property Dimension are avail
  78. 11-12-2005
  79. - Added native OpenGL Support. Breaking the dglOpenGL "barrier".
  80. 19-10-2005
  81. - Added function GrabScreen to class TglBitmap2D
  82. 18-10-2005
  83. - Added support to Save images
  84. - Added function Clone to Clone Instance
  85. 11-10-2005
  86. - Functions now works with Cardinals for each channel. Up to 32 Bits per channel.
  87. Usefull for Future
  88. - Several speed optimizations
  89. 09-10-2005
  90. - Internal structure change. Loading of TGA, PNG and DDS improved.
  91. Data, format and size will now set directly with SetDataPtr.
  92. - AddFunc now works with all Types of Images and Formats
  93. - Some Funtions moved to Baseclass TglBitmap
  94. 06-10-2005
  95. - Added Support to decompress DXT3 and DXT5 compressed Images.
  96. - Added Mapping to convert data from one format into an other.
  97. 05-10-2005
  98. - Added method ConvertTo in Class TglBitmap2D. Method allows to convert every
  99. supported Input format (supported by GetPixel) into any uncompresed Format
  100. - Added Support to decompress DXT1 compressed Images.
  101. - SwapColors replaced by ConvertTo
  102. 04-10-2005
  103. - Added Support for compressed DDSs
  104. - Added new internal formats (DXT1, DXT3, DXT5)
  105. 29-09-2005
  106. - Parameter Components renamed to InternalFormat
  107. 23-09-2005
  108. - Some AllocMem replaced with GetMem (little speed change)
  109. - better exception handling. Better protection from memory leaks.
  110. 22-09-2005
  111. - Added support for Direct Draw Surfaces (.DDS) (uncompressed images only)
  112. - Added new internal formats (RGB8, RGBA8, RGBA4, RGB5A1, RGB10A2, R5G6B5)
  113. 07-09-2005
  114. - Added support for Grayscale textures
  115. - Added internal formats (Alpha, Luminance, LuminanceAlpha, BGR8, BGRA8)
  116. 10-07-2005
  117. - Added support for GL_VERSION_2_0
  118. - Added support for GL_EXT_texture_filter_anisotropic
  119. 04-07-2005
  120. - Function FillWithColor fills the Image with one Color
  121. - Function LoadNormalMap added
  122. 30-06-2005
  123. - ToNormalMap allows to Create an NormalMap from the Alphachannel
  124. - ToNormalMap now supports Sobel (nmSobel) function.
  125. 29-06-2005
  126. - support for RLE Compressed RGB TGAs added
  127. 28-06-2005
  128. - Class TglBitmapNormalMap added to support Normalmap generation
  129. - Added function ToNormalMap in class TglBitmap2D to genereate normal maps from textures.
  130. 3 Filters are supported. (4 Samples, 3x3 and 5x5)
  131. 16-06-2005
  132. - Method LoadCubeMapClass removed
  133. - LoadCubeMap returnvalue is now the Texture paramter. Such as LoadTextures
  134. - virtual abstract method GenTexture in class TglBitmap now is protected
  135. 12-06-2005
  136. - now support DescriptionFlag in LoadTga. Allows vertical flipped images to be loaded as normal
  137. 10-06-2005
  138. - little enhancement for IsPowerOfTwo
  139. - TglBitmap1D.GenTexture now tests NPOT Textures
  140. 06-06-2005
  141. - some little name changes. All properties or function with Texture in name are
  142. now without texture in name. We have allways texture so we dosn't name it.
  143. 03-06-2005
  144. - GenTexture now tests if texture is NPOT and NPOT-Texture are supported or
  145. TextureTarget is GL_TEXTURE_RECTANGLE. Else it raised an exception.
  146. 02-06-2005
  147. - added support for GL_ARB_texture_rectangle, GL_EXT_texture_rectangle and GL_NV_texture_rectangle
  148. 25-04-2005
  149. - Function Unbind added
  150. - call of SetFilter or SetTextureWrap if TextureID exists results in setting properties to opengl texture.
  151. 21-04-2005
  152. - class TglBitmapCubeMap added (allows to Create Cubemaps)
  153. 29-03-2005
  154. - Added Support for PNG Images. (http://pngdelphi.sourceforge.net/)
  155. To Enable png's use the define pngimage
  156. 22-03-2005
  157. - New Functioninterface added
  158. - Function GetPixel added
  159. 27-11-2004
  160. - Property BuildMipMaps renamed to MipMap
  161. 21-11-2004
  162. - property Name removed.
  163. - BuildMipMaps is now a set of 3 values. None, GluBuildMipmaps and SGIS_generate_mipmap
  164. 22-05-2004
  165. - property name added. Only used in glForms!
  166. 26-11-2003
  167. - property FreeDataAfterGenTexture is now available as default (default = true)
  168. - BuildMipmaps now implemented in TglBitmap1D (i've forgotten it)
  169. - function MoveMemory replaced with function Move (little speed change)
  170. - several calculations stored in variables (little speed change)
  171. 29-09-2003
  172. - property BuildMipsMaps added (default = true)
  173. if BuildMipMaps isn't set GenTextures uses glTexImage[12]D else it use gluBuild[12]dMipmaps
  174. - property FreeDataAfterGenTexture added (default = true)
  175. if FreeDataAfterGenTexture is set the texturedata were deleted after the texture was generated.
  176. - parameter DisableOtherTextureUnits of Bind removed
  177. - parameter FreeDataAfterGeneration of GenTextures removed
  178. 12-09-2003
  179. - TglBitmap dosn't delete data if class was destroyed (fixed)
  180. 09-09-2003
  181. - Bind now enables TextureUnits (by params)
  182. - GenTextures can leave data (by param)
  183. - LoadTextures now optimal
  184. 03-09-2003
  185. - Performance optimization in AddFunc
  186. - procedure Bind moved to subclasses
  187. - Added new Class TglBitmap1D to support real OpenGL 1D Textures
  188. 19-08-2003
  189. - Texturefilter and texturewrap now also as defaults
  190. Minfilter = GL_LINEAR_MIPMAP_LINEAR
  191. Magfilter = GL_LINEAR
  192. Wrap(str) = GL_CLAMP_TO_EDGE
  193. - Added new format tfCompressed to create a compressed texture.
  194. - propertys IsCompressed, TextureSize and IsResident added
  195. IsCompressed and TextureSize only contains data from level 0
  196. 18-08-2003
  197. - Added function AddFunc to add PerPixelEffects to Image
  198. - LoadFromFunc now based on AddFunc
  199. - Invert now based on AddFunc
  200. - SwapColors now based on AddFunc
  201. 16-08-2003
  202. - Added function FlipHorz
  203. 15-08-2003
  204. - Added function LaodFromFunc to create images with function
  205. - Added function FlipVert
  206. - Added internal format RGB(A) if GL_EXT_bgra or OpenGL 1.2 isn't supported
  207. 29-07-2003
  208. - Added Alphafunctions to calculate alpha per function
  209. - Added Alpha from ColorKey using alphafunctions
  210. 28-07-2003
  211. - First full functionally Version of glBitmap
  212. - Support for 24Bit and 32Bit TGA Pictures added
  213. 25-07-2003
  214. - begin of programming
  215. ***********************************************************}
  216. unit glBitmap;
  217. {.$MESSAGE warn 'Hey. I''m the glBitmap.pas and i need to be configured. My master tell me your preferences! ;)'}
  218. // Please uncomment the defines below to configure the glBitmap to your preferences.
  219. // If you have configured the unit you can uncomment the warning above.
  220. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  221. // Preferences ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  222. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  223. // activate to enable build-in OpenGL support with statically linked methods
  224. // use dglOpenGL.pas if not enabled
  225. {.$DEFINE GLB_NATIVE_OGL_STATIC}
  226. // activate to enable build-in OpenGL support with dynamically linked methods
  227. // use dglOpenGL.pas if not enabled
  228. {.$DEFINE GLB_NATIVE_OGL_DYNAMIC}
  229. // activate to enable the support for SDL_surfaces
  230. {.$DEFINE GLB_SDL}
  231. // activate to enable the support for TBitmap from Delphi (not lazarus)
  232. {.$DEFINE GLB_DELPHI}
  233. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  234. // activate to enable the support of SDL_image to load files. (READ ONLY)
  235. // If you enable SDL_image all other libraries will be ignored!
  236. {.$DEFINE GLB_SDL_IMAGE}
  237. // activate to enable png support with the unit pngimage. You can download it from http://pngdelphi.sourceforge.net/
  238. // if you enable pngimage the libPNG will be ignored
  239. {.$DEFINE GLB_PNGIMAGE}
  240. // activate to use the libPNG http://www.libpng.org/
  241. // You will need an aditional header.
  242. // http://www.opengl24.de/index.php?cat=header&file=libpng
  243. {$DEFINE GLB_LIB_PNG}
  244. // if you enable delphi jpegs the libJPEG will be ignored
  245. {.$DEFINE GLB_DELPHI_JPEG}
  246. // activateto use the libJPEG http://www.ijg.org/
  247. // You will need an aditional header.
  248. // http://www.opengl24.de/index.php?cat=header&file=libjpeg
  249. {.$DEFINE GLB_LIB_JPEG}
  250. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  251. // PRIVATE: do not change anything! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  252. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  253. // Delphi Versions
  254. {$IFDEF fpc}
  255. {$MODE Delphi}
  256. {$IFDEF CPUI386}
  257. {$DEFINE CPU386}
  258. {$ASMMODE INTEL}
  259. {$ENDIF}
  260. {$IFNDEF WINDOWS}
  261. {$linklib c}
  262. {$ENDIF}
  263. {$ENDIF}
  264. // Operation System
  265. {$IF DEFINED(WIN32) or DEFINED(WIN64)}
  266. {$DEFINE GLB_WIN}
  267. {$ELSEIF DEFINED(LINUX)}
  268. {$DEFINE GLB_LINUX}
  269. {$IFEND}
  270. // native OpenGL Support
  271. {$IF DEFINED(GLB_NATIVE_OGL_STATIC) OR DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
  272. {$DEFINE GLB_NATIVE_OGL}
  273. {$IFEND}
  274. // checking define combinations
  275. //SDL Image
  276. {$IFDEF GLB_SDL_IMAGE}
  277. {$IFNDEF GLB_SDL}
  278. {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
  279. {$DEFINE GLB_SDL}
  280. {$ENDIF}
  281. {$IFDEF GLB_PNGIMAGE}
  282. {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
  283. {$undef GLB_PNGIMAGE}
  284. {$ENDIF}
  285. {$IFDEF GLB_DELPHI_JPEG}
  286. {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
  287. {$undef GLB_DELPHI_JPEG}
  288. {$ENDIF}
  289. {$IFDEF GLB_LIB_PNG}
  290. {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
  291. {$undef GLB_LIB_PNG}
  292. {$ENDIF}
  293. {$IFDEF GLB_LIB_JPEG}
  294. {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
  295. {$undef GLB_LIB_JPEG}
  296. {$ENDIF}
  297. {$DEFINE GLB_SUPPORT_PNG_READ}
  298. {$DEFINE GLB_SUPPORT_JPEG_READ}
  299. {$ENDIF}
  300. // PNG Image
  301. {$IFDEF GLB_PNGIMAGE}
  302. {$IFDEF GLB_LIB_PNG}
  303. {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
  304. {$undef GLB_LIB_PNG}
  305. {$ENDIF}
  306. {$DEFINE GLB_SUPPORT_PNG_READ}
  307. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  308. {$ENDIF}
  309. // libPNG
  310. {$IFDEF GLB_LIB_PNG}
  311. {$DEFINE GLB_SUPPORT_PNG_READ}
  312. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  313. {$ENDIF}
  314. // JPEG Image
  315. {$IFDEF GLB_DELPHI_JPEG}
  316. {$IFDEF GLB_LIB_JPEG}
  317. {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
  318. {$undef GLB_LIB_JPEG}
  319. {$ENDIF}
  320. {$DEFINE GLB_SUPPORT_JPEG_READ}
  321. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  322. {$ENDIF}
  323. // libJPEG
  324. {$IFDEF GLB_LIB_JPEG}
  325. {$DEFINE GLB_SUPPORT_JPEG_READ}
  326. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  327. {$ENDIF}
  328. // native OpenGL
  329. {$IF DEFINED(GLB_NATIVE_OGL_STATIC) AND DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
  330. {$MESSAGE warn 'GLB_NATIVE_OGL_STATIC will be ignored because you enabled GLB_NATIVE_OGL_DYNAMIC'}
  331. {$ENDIF}
  332. // general options
  333. {$EXTENDEDSYNTAX ON}
  334. {$LONGSTRINGS ON}
  335. {$ALIGN ON}
  336. {$IFNDEF FPC}
  337. {$OPTIMIZATION ON}
  338. {$ENDIF}
  339. interface
  340. uses
  341. {$IFNDEF GLB_NATIVE_OGL} dglOpenGL, {$ENDIF}
  342. {$IF DEFINED(GLB_WIN) AND
  343. DEFINED(GLB_NATIVE_OGL)} windows, {$IFEND}
  344. {$IFDEF GLB_SDL} SDL, {$ENDIF}
  345. {$IFDEF GLB_DELPHI} Dialogs, Graphics, {$ENDIF}
  346. {$IFDEF GLB_SDL_IMAGE} SDL_image, {$ENDIF}
  347. {$IFDEF GLB_PNGIMAGE} pngimage, {$ENDIF}
  348. {$IFDEF GLB_LIB_PNG} libPNG, {$ENDIF}
  349. {$IFDEF GLB_DELPHI_JPEG} JPEG, {$ENDIF}
  350. {$IFDEF GLB_LIB_JPEG} libJPEG, {$ENDIF}
  351. Classes, SysUtils;
  352. {$IFNDEF GLB_DELPHI}
  353. type
  354. HGLRC = Cardinal;
  355. DWORD = Cardinal;
  356. PDWORD = ^DWORD;
  357. TRGBQuad = packed record
  358. rgbBlue: Byte;
  359. rgbGreen: Byte;
  360. rgbRed: Byte;
  361. rgbReserved: Byte;
  362. end;
  363. {$ENDIF}
  364. {$IFDEF GLB_NATIVE_OGL}
  365. const
  366. GL_TRUE = 1;
  367. GL_FALSE = 0;
  368. GL_VERSION = $1F02;
  369. GL_EXTENSIONS = $1F03;
  370. GL_TEXTURE_1D = $0DE0;
  371. GL_TEXTURE_2D = $0DE1;
  372. GL_TEXTURE_RECTANGLE = $84F5;
  373. GL_TEXTURE_WIDTH = $1000;
  374. GL_TEXTURE_HEIGHT = $1001;
  375. GL_TEXTURE_INTERNAL_FORMAT = $1003;
  376. GL_ALPHA = $1906;
  377. GL_ALPHA4 = $803B;
  378. GL_ALPHA8 = $803C;
  379. GL_ALPHA12 = $803D;
  380. GL_ALPHA16 = $803E;
  381. GL_LUMINANCE = $1909;
  382. GL_LUMINANCE4 = $803F;
  383. GL_LUMINANCE8 = $8040;
  384. GL_LUMINANCE12 = $8041;
  385. GL_LUMINANCE16 = $8042;
  386. GL_LUMINANCE_ALPHA = $190A;
  387. GL_LUMINANCE4_ALPHA4 = $8043;
  388. GL_LUMINANCE6_ALPHA2 = $8044;
  389. GL_LUMINANCE8_ALPHA8 = $8045;
  390. GL_LUMINANCE12_ALPHA4 = $8046;
  391. GL_LUMINANCE12_ALPHA12 = $8047;
  392. GL_LUMINANCE16_ALPHA16 = $8048;
  393. GL_RGB = $1907;
  394. GL_BGR = $80E0;
  395. GL_R3_G3_B2 = $2A10;
  396. GL_RGB4 = $804F;
  397. GL_RGB5 = $8050;
  398. GL_RGB565 = $8D62;
  399. GL_RGB8 = $8051;
  400. GL_RGB10 = $8052;
  401. GL_RGB12 = $8053;
  402. GL_RGB16 = $8054;
  403. GL_RGBA = $1908;
  404. GL_BGRA = $80E1;
  405. GL_RGBA2 = $8055;
  406. GL_RGBA4 = $8056;
  407. GL_RGB5_A1 = $8057;
  408. GL_RGBA8 = $8058;
  409. GL_RGB10_A2 = $8059;
  410. GL_RGBA12 = $805A;
  411. GL_RGBA16 = $805B;
  412. GL_DEPTH_COMPONENT = $1902;
  413. GL_DEPTH_COMPONENT16 = $81A5;
  414. GL_DEPTH_COMPONENT24 = $81A6;
  415. GL_DEPTH_COMPONENT32 = $81A7;
  416. GL_COMPRESSED_RGB = $84ED;
  417. GL_COMPRESSED_RGBA = $84EE;
  418. GL_COMPRESSED_RGB_S3TC_DXT1_EXT = $83F0;
  419. GL_COMPRESSED_RGBA_S3TC_DXT1_EXT = $83F1;
  420. GL_COMPRESSED_RGBA_S3TC_DXT3_EXT = $83F2;
  421. GL_COMPRESSED_RGBA_S3TC_DXT5_EXT = $83F3;
  422. GL_UNSIGNED_BYTE = $1401;
  423. GL_UNSIGNED_BYTE_3_3_2 = $8032;
  424. GL_UNSIGNED_BYTE_2_3_3_REV = $8362;
  425. GL_UNSIGNED_SHORT = $1403;
  426. GL_UNSIGNED_SHORT_5_6_5 = $8363;
  427. GL_UNSIGNED_SHORT_4_4_4_4 = $8033;
  428. GL_UNSIGNED_SHORT_5_5_5_1 = $8034;
  429. GL_UNSIGNED_SHORT_5_6_5_REV = $8364;
  430. GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;
  431. GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;
  432. GL_UNSIGNED_INT = $1405;
  433. GL_UNSIGNED_INT_8_8_8_8 = $8035;
  434. GL_UNSIGNED_INT_10_10_10_2 = $8036;
  435. GL_UNSIGNED_INT_8_8_8_8_REV = $8367;
  436. GL_UNSIGNED_INT_2_10_10_10_REV = $8368;
  437. { Texture Filter }
  438. GL_TEXTURE_MAG_FILTER = $2800;
  439. GL_TEXTURE_MIN_FILTER = $2801;
  440. GL_NEAREST = $2600;
  441. GL_NEAREST_MIPMAP_NEAREST = $2700;
  442. GL_NEAREST_MIPMAP_LINEAR = $2702;
  443. GL_LINEAR = $2601;
  444. GL_LINEAR_MIPMAP_NEAREST = $2701;
  445. GL_LINEAR_MIPMAP_LINEAR = $2703;
  446. { Texture Wrap }
  447. GL_TEXTURE_WRAP_S = $2802;
  448. GL_TEXTURE_WRAP_T = $2803;
  449. GL_TEXTURE_WRAP_R = $8072;
  450. GL_CLAMP = $2900;
  451. GL_REPEAT = $2901;
  452. GL_CLAMP_TO_EDGE = $812F;
  453. GL_CLAMP_TO_BORDER = $812D;
  454. GL_MIRRORED_REPEAT = $8370;
  455. { Other }
  456. GL_GENERATE_MIPMAP = $8191;
  457. GL_TEXTURE_BORDER_COLOR = $1004;
  458. GL_MAX_TEXTURE_SIZE = $0D33;
  459. GL_PACK_ALIGNMENT = $0D05;
  460. GL_UNPACK_ALIGNMENT = $0CF5;
  461. GL_TEXTURE_MAX_ANISOTROPY_EXT = $84FE;
  462. GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;
  463. {$ifdef LINUX}
  464. libglu = 'libGLU.so.1';
  465. libopengl = 'libGL.so.1';
  466. {$else}
  467. libglu = 'glu32.dll';
  468. libopengl = 'opengl32.dll';
  469. {$endif}
  470. type
  471. GLboolean = BYTEBOOL;
  472. GLint = Integer;
  473. GLsizei = Integer;
  474. GLuint = Cardinal;
  475. GLfloat = Single;
  476. GLenum = Cardinal;
  477. PGLvoid = Pointer;
  478. PGLboolean = ^GLboolean;
  479. PGLint = ^GLint;
  480. PGLuint = ^GLuint;
  481. PGLfloat = ^GLfloat;
  482. TglCompressedTexImage1D = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  483. 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}
  484. TglGetCompressedTexImage = procedure(target: GLenum; level: GLint; img: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  485. {$IF DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
  486. TglEnable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  487. TglDisable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  488. TglGetString = function(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  489. TglGetIntegerv = procedure(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  490. TglTexParameteri = procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  491. TglTexParameterfv = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  492. TglGetTexParameteriv = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  493. TglGetTexParameterfv = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  494. TglGetTexLevelParameteriv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  495. TglGetTexLevelParameterfv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  496. TglGenTextures = procedure(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  497. TglBindTexture = procedure(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  498. TglDeleteTextures = procedure(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  499. TglAreTexturesResident = function(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  500. TglReadPixels = procedure(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  501. TglPixelStorei = procedure(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  502. 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}
  503. 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}
  504. TglGetTexImage = procedure(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  505. TgluBuild1DMipmaps = function(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  506. TgluBuild2DMipmaps = function(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}
  507. {$IFDEF GLB_LINUX}
  508. TglXGetProcAddress = function(ProcName: PAnsiChar): Pointer; cdecl;
  509. {$ELSE}
  510. TwglGetProcAddress = function (ProcName: PAnsiChar): Pointer; stdcall;
  511. {$ENDIF}
  512. {$ELSEIF DEFINED(GLB_NATIVE_OGL_STATIC)}
  513. procedure glEnable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  514. procedure glDisable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  515. function glGetString(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  516. procedure glGetIntegerv(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  517. procedure glTexParameteri(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  518. procedure glTexParameterfv(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  519. procedure glGetTexParameteriv(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  520. procedure glGetTexParameterfv(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  521. procedure glGetTexLevelParameteriv(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  522. procedure glGetTexLevelParameterfv(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  523. procedure glGenTextures(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  524. procedure glBindTexture(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  525. procedure glDeleteTextures(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  526. function glAreTexturesResident(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  527. 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;
  528. procedure glPixelStorei(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  529. 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;
  530. 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;
  531. procedure glGetTexImage(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;
  532. function gluBuild1DMipmaps(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
  533. function gluBuild2DMipmaps(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;
  534. {$ENDIF}
  535. var
  536. GL_VERSION_1_2,
  537. GL_VERSION_1_3,
  538. GL_VERSION_1_4,
  539. GL_VERSION_2_0,
  540. GL_SGIS_generate_mipmap,
  541. GL_ARB_texture_border_clamp,
  542. GL_ARB_texture_mirrored_repeat,
  543. GL_ARB_texture_rectangle,
  544. GL_ARB_texture_non_power_of_two,
  545. GL_IBM_texture_mirrored_repeat,
  546. GL_NV_texture_rectangle,
  547. GL_EXT_texture_edge_clamp,
  548. GL_EXT_texture_rectangle,
  549. GL_EXT_texture_filter_anisotropic: Boolean;
  550. glCompressedTexImage1D: TglCompressedTexImage1D;
  551. glCompressedTexImage2D: TglCompressedTexImage2D;
  552. glGetCompressedTexImage: TglGetCompressedTexImage;
  553. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  554. glEnable: TglEnable;
  555. glDisable: TglDisable;
  556. glGetString: TglGetString;
  557. glGetIntegerv: TglGetIntegerv;
  558. glTexParameteri: TglTexParameteri;
  559. glTexParameterfv: TglTexParameterfv;
  560. glGetTexParameteriv: TglGetTexParameteriv;
  561. glGetTexParameterfv: TglGetTexParameterfv;
  562. glGetTexLevelParameteriv: TglGetTexLevelParameteriv;
  563. glGetTexLevelParameterfv: TglGetTexLevelParameterfv;
  564. glGenTextures: TglGenTextures;
  565. glBindTexture: TglBindTexture;
  566. glDeleteTextures: TglDeleteTextures;
  567. glAreTexturesResident: TglAreTexturesResident;
  568. glReadPixels: TglReadPixels;
  569. glPixelStorei: TglPixelStorei;
  570. glTexImage1D: TglTexImage1D;
  571. glTexImage2D: TglTexImage2D;
  572. glGetTexImage: TglGetTexImage;
  573. gluBuild1DMipmaps: TgluBuild1DMipmaps;
  574. gluBuild2DMipmaps: TgluBuild2DMipmaps;
  575. {$IF DEFINED(GLB_WIN)}
  576. wglGetProcAddress: TwglGetProcAddress;
  577. {$ELSEIF DEFINED(GLB_LINUX)}
  578. glXGetProcAddress: TglXGetProcAddress;
  579. glXGetProcAddressARB: TglXGetProcAddressARB;
  580. {$ENDIF}
  581. {$ENDIF}
  582. (*
  583. {$IFDEF GLB_DELPHI}
  584. var
  585. gLastContext: HGLRC;
  586. {$ENDIF}
  587. *)
  588. {$ENDIF}
  589. type
  590. ////////////////////////////////////////////////////////////////////////////////////////////////////
  591. TglBitmapFormat = (
  592. tfEmpty = 0, //must be smallest value!
  593. tfAlpha4,
  594. tfAlpha8,
  595. tfAlpha12,
  596. tfAlpha16,
  597. tfLuminance4,
  598. tfLuminance8,
  599. tfLuminance12,
  600. tfLuminance16,
  601. tfLuminance4Alpha4,
  602. tfLuminance6Alpha2,
  603. tfLuminance8Alpha8,
  604. tfLuminance12Alpha4,
  605. tfLuminance12Alpha12,
  606. tfLuminance16Alpha16,
  607. tfR3G3B2,
  608. tfRGB4,
  609. tfR5G6B5,
  610. tfRGB5,
  611. tfRGB8,
  612. tfRGB10,
  613. tfRGB12,
  614. tfRGB16,
  615. tfRGBA2,
  616. tfRGBA4,
  617. tfRGB5A1,
  618. tfRGBA8,
  619. tfRGB10A2,
  620. tfRGBA12,
  621. tfRGBA16,
  622. tfBGR4,
  623. tfB5G6R5,
  624. tfBGR5,
  625. tfBGR8,
  626. tfBGR10,
  627. tfBGR12,
  628. tfBGR16,
  629. tfBGRA2,
  630. tfBGRA4,
  631. tfBGR5A1,
  632. tfBGRA8,
  633. tfBGR10A2,
  634. tfBGRA12,
  635. tfBGRA16,
  636. tfDepth16,
  637. tfDepth24,
  638. tfDepth32,
  639. tfS3tcDtx1RGBA,
  640. tfS3tcDtx3RGBA,
  641. tfS3tcDtx5RGBA
  642. );
  643. TglBitmapFileType = (
  644. {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG, {$ENDIF}
  645. {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
  646. ftDDS,
  647. ftTGA,
  648. ftBMP);
  649. TglBitmapFileTypes = set of TglBitmapFileType;
  650. TglBitmapMipMap = (
  651. mmNone,
  652. mmMipmap,
  653. mmMipmapGlu);
  654. TglBitmapNormalMapFunc = (
  655. nm4Samples,
  656. nmSobel,
  657. nm3x3,
  658. nm5x5);
  659. ////////////////////////////////////////////////////////////////////////////////////////////////////
  660. EglBitmapException = class(Exception);
  661. EglBitmapSizeToLargeException = class(EglBitmapException);
  662. EglBitmapNonPowerOfTwoException = class(EglBitmapException);
  663. EglBitmapUnsupportedFormat = class(EglBitmapException)
  664. constructor Create(const aFormat: TglBitmapFormat);
  665. end;
  666. ////////////////////////////////////////////////////////////////////////////////////////////////////
  667. TglBitmapColorRec = packed record
  668. case Integer of
  669. 0: (r, g, b, a: Cardinal);
  670. 1: (arr: array[0..3] of Cardinal);
  671. end;
  672. TglBitmapPixelData = packed record
  673. Data, Range: TglBitmapColorRec;
  674. Format: TglBitmapFormat;
  675. end;
  676. PglBitmapPixelData = ^TglBitmapPixelData;
  677. ////////////////////////////////////////////////////////////////////////////////////////////////////
  678. TglBitmapPixelPositionFields = set of (ffX, ffY);
  679. TglBitmapPixelPosition = record
  680. Fields : TglBitmapPixelPositionFields;
  681. X : Word;
  682. Y : Word;
  683. end;
  684. ////////////////////////////////////////////////////////////////////////////////////////////////////
  685. TglBitmap = class;
  686. TglBitmapFunctionRec = record
  687. Sender: TglBitmap;
  688. Size: TglBitmapPixelPosition;
  689. Position: TglBitmapPixelPosition;
  690. Source: TglBitmapPixelData;
  691. Dest: TglBitmapPixelData;
  692. Args: Pointer;
  693. end;
  694. TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
  695. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  696. TglBitmap = class
  697. protected
  698. fID: GLuint;
  699. fTarget: GLuint;
  700. fAnisotropic: Integer;
  701. fDeleteTextureOnFree: Boolean;
  702. fFreeDataAfterGenTexture: Boolean;
  703. fData: PByte;
  704. fIsResident: Boolean;
  705. fBorderColor: array[0..3] of Single;
  706. fDimension: TglBitmapPixelPosition;
  707. fMipMap: TglBitmapMipMap;
  708. fFormat: TglBitmapFormat;
  709. // Mapping
  710. fPixelSize: Integer;
  711. fRowSize: Integer;
  712. // Filtering
  713. fFilterMin: Cardinal;
  714. fFilterMag: Cardinal;
  715. // TexturWarp
  716. fWrapS: Cardinal;
  717. fWrapT: Cardinal;
  718. fWrapR: Cardinal;
  719. // CustomData
  720. fFilename: String;
  721. fCustomName: String;
  722. fCustomNameW: WideString;
  723. fCustomData: Pointer;
  724. //Getter
  725. function GetWidth: Integer; virtual;
  726. function GetHeight: Integer; virtual;
  727. function GetFileWidth: Integer; virtual;
  728. function GetFileHeight: Integer; virtual;
  729. //Setter
  730. procedure SetCustomData(const aValue: Pointer);
  731. procedure SetCustomName(const aValue: String);
  732. procedure SetCustomNameW(const aValue: WideString);
  733. procedure SetDeleteTextureOnFree(const aValue: Boolean);
  734. procedure SetFormat(const aValue: TglBitmapFormat);
  735. procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
  736. procedure SetID(const aValue: Cardinal);
  737. procedure SetMipMap(const aValue: TglBitmapMipMap);
  738. procedure SetTarget(const aValue: Cardinal);
  739. procedure SetAnisotropic(const aValue: Integer);
  740. procedure CreateID;
  741. procedure SetupParameters(out aBuildWithGlu: Boolean);
  742. procedure SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
  743. const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;
  744. procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
  745. function FlipHorz: Boolean; virtual;
  746. function FlipVert: Boolean; virtual;
  747. property Width: Integer read GetWidth;
  748. property Height: Integer read GetHeight;
  749. property FileWidth: Integer read GetFileWidth;
  750. property FileHeight: Integer read GetFileHeight;
  751. public
  752. //Properties
  753. property ID: Cardinal read fID write SetID;
  754. property Target: Cardinal read fTarget write SetTarget;
  755. property Format: TglBitmapFormat read fFormat write SetFormat;
  756. property MipMap: TglBitmapMipMap read fMipMap write SetMipMap;
  757. property Anisotropic: Integer read fAnisotropic write SetAnisotropic;
  758. property Filename: String read fFilename;
  759. property CustomName: String read fCustomName write SetCustomName;
  760. property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
  761. property CustomData: Pointer read fCustomData write SetCustomData;
  762. property DeleteTextureOnFree: Boolean read fDeleteTextureOnFree write SetDeleteTextureOnFree;
  763. property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
  764. property Dimension: TglBitmapPixelPosition read fDimension;
  765. property Data: PByte read fData;
  766. property IsResident: Boolean read fIsResident;
  767. procedure AfterConstruction; override;
  768. procedure BeforeDestruction; override;
  769. //Load
  770. procedure LoadFromFile(const aFilename: String);
  771. procedure LoadFromStream(const aStream: TStream); virtual;
  772. procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  773. const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
  774. {$IFDEF GLB_DELPHI}
  775. procedure LoadFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil);
  776. procedure LoadFromResourceID(const sInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  777. {$ENDIF}
  778. //Save
  779. procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  780. procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
  781. //Convert
  782. function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
  783. function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  784. const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
  785. public
  786. //Alpha & Co
  787. {$IFDEF GLB_SDL}
  788. function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  789. function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  790. function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  791. function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
  792. const aArgs: Pointer = nil): Boolean;
  793. {$ENDIF}
  794. {$IFDEF GLB_DELPHI}
  795. function AssignToBitmap(const aBitmap: TBitmap): Boolean;
  796. function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  797. function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  798. function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
  799. const aArgs: Pointer = nil): Boolean;
  800. function AddAlphaFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil;
  801. const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  802. function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  803. const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  804. {$ENDIF}
  805. function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
  806. function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  807. function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  808. function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  809. function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
  810. function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
  811. function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
  812. function AddAlphaFromValue(const aAlpha: Byte): Boolean;
  813. function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  814. function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  815. function RemoveAlpha: Boolean; virtual;
  816. public
  817. //Common
  818. function Clone: TglBitmap;
  819. function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
  820. procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
  821. procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  822. procedure FreeData;
  823. //ColorFill
  824. procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
  825. procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
  826. procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
  827. //TexParameters
  828. procedure SetFilter(const aMin, aMag: Cardinal);
  829. procedure SetWrap(
  830. const S: Cardinal = GL_CLAMP_TO_EDGE;
  831. const T: Cardinal = GL_CLAMP_TO_EDGE;
  832. const R: Cardinal = GL_CLAMP_TO_EDGE);
  833. procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
  834. procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
  835. //Constructors
  836. constructor Create; overload;
  837. constructor Create(const aFileName: String); overload;
  838. constructor Create(const aStream: TStream); overload;
  839. constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat); overload;
  840. constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
  841. {$IFDEF GLB_DELPHI}
  842. constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
  843. constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
  844. {$ENDIF}
  845. private
  846. {$IFDEF GLB_SUPPORT_PNG_READ} function LoadPNG(const aStream: TStream): Boolean; virtual; {$ENDIF}
  847. {$ifdef GLB_SUPPORT_PNG_WRITE} procedure SavePNG(const aStream: TStream); virtual; {$ENDIF}
  848. {$IFDEF GLB_SUPPORT_JPEG_READ} function LoadJPEG(const aStream: TStream): Boolean; virtual; {$ENDIF}
  849. {$IFDEF GLB_SUPPORT_JPEG_WRITE} procedure SaveJPEG(const aStream: TStream); virtual; {$ENDIF}
  850. function LoadBMP(const aStream: TStream): Boolean; virtual;
  851. procedure SaveBMP(const aStream: TStream); virtual;
  852. function LoadTGA(const aStream: TStream): Boolean; virtual;
  853. procedure SaveTGA(const aStream: TStream); virtual;
  854. function LoadDDS(const aStream: TStream): Boolean; virtual;
  855. procedure SaveDDS(const aStream: TStream); virtual;
  856. end;
  857. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  858. TglBitmap2D = class(TglBitmap)
  859. protected
  860. // Bildeinstellungen
  861. fLines: array of PByte;
  862. (* TODO
  863. procedure GetDXTColorBlock(pData: pByte; relX, relY: Integer; var Pixel: TglBitmapPixelData);
  864. procedure GetPixel2DDXT1(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
  865. procedure GetPixel2DDXT3(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
  866. procedure GetPixel2DDXT5(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
  867. procedure GetPixel2DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
  868. procedure SetPixel2DUnmap(const Pos: TglBitmapPixelPosition; const Pixel: TglBitmapPixelData);
  869. *)
  870. function GetScanline(const aIndex: Integer): Pointer;
  871. procedure SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
  872. const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
  873. procedure UploadData(const aTarget: Cardinal; const aBuildWithGlu: Boolean);
  874. public
  875. property Width;
  876. property Height;
  877. property Scanline[const aIndex: Integer]: Pointer read GetScanline;
  878. procedure AfterConstruction; override;
  879. procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  880. procedure GetDataFromTexture;
  881. procedure GenTexture(const aTestTextureSize: Boolean = true); override;
  882. function FlipHorz: Boolean; override;
  883. function FlipVert: Boolean; override;
  884. procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
  885. const aScale: Single = 2; const aUseAlpha: Boolean = false);
  886. end;
  887. (* TODO
  888. TglBitmapCubeMap = class(TglBitmap2D)
  889. protected
  890. fGenMode: Integer;
  891. // Hide GenTexture
  892. procedure GenTexture(TestTextureSize: Boolean = true); reintroduce;
  893. public
  894. procedure AfterConstruction; override;
  895. procedure GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean = true);
  896. procedure Unbind(DisableTexCoordsGen: Boolean = true; DisableTextureUnit: Boolean = true); reintroduce; virtual;
  897. procedure Bind(EnableTexCoordsGen: Boolean = true; EnableTextureUnit: Boolean = true); reintroduce; virtual;
  898. end;
  899. TglBitmapNormalMap = class(TglBitmapCubeMap)
  900. public
  901. procedure AfterConstruction; override;
  902. procedure GenerateNormalMap(Size: Integer = 32; TestTextureSize: Boolean = true);
  903. end;
  904. TglBitmap1D = class(TglBitmap)
  905. protected
  906. procedure GetPixel1DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
  907. procedure SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width: Integer = -1; Height: Integer = -1); override;
  908. procedure UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
  909. public
  910. // propertys
  911. property Width;
  912. procedure AfterConstruction; override;
  913. // Other
  914. function FlipHorz: Boolean; override;
  915. // Generation
  916. procedure GenTexture(TestTextureSize: Boolean = true); override;
  917. end;
  918. *)
  919. const
  920. NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
  921. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  922. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  923. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  924. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  925. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  926. procedure glBitmapSetDefaultWrap(
  927. const S: Cardinal = GL_CLAMP_TO_EDGE;
  928. const T: Cardinal = GL_CLAMP_TO_EDGE;
  929. const R: Cardinal = GL_CLAMP_TO_EDGE);
  930. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  931. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  932. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  933. function glBitmapGetDefaultFormat: TglBitmapFormat;
  934. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  935. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  936. function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
  937. function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
  938. function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
  939. var
  940. glBitmapDefaultDeleteTextureOnFree: Boolean;
  941. glBitmapDefaultFreeDataAfterGenTextures: Boolean;
  942. glBitmapDefaultFormat: TglBitmapFormat;
  943. glBitmapDefaultMipmap: TglBitmapMipMap;
  944. glBitmapDefaultFilterMin: Cardinal;
  945. glBitmapDefaultFilterMag: Cardinal;
  946. glBitmapDefaultWrapS: Cardinal;
  947. glBitmapDefaultWrapT: Cardinal;
  948. glBitmapDefaultWrapR: Cardinal;
  949. {$IFDEF GLB_DELPHI}
  950. function CreateGrayPalette: HPALETTE;
  951. {$ENDIF}
  952. implementation
  953. (* TODO
  954. function FormatIsCompressed(Format: TglBitmapInternalFormat): boolean;
  955. function FormatIsUncompressed(Format: TglBitmapInternalFormat): boolean;
  956. function LoadTexture(Filename: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal = 0{$ENDIF}): Boolean;
  957. function LoadCubeMap(PositiveX, NegativeX, PositiveY, NegativeY, PositiveZ, NegativeZ: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal = 0{$ENDIF}): Boolean;
  958. function LoadNormalMap(Size: Integer; var Texture: Cardinal): Boolean;
  959. *)
  960. uses
  961. Math, syncobjs, typinfo;
  962. type
  963. ////////////////////////////////////////////////////////////////////////////////////////////////////
  964. TShiftRec = packed record
  965. case Integer of
  966. 0: (r, g, b, a: Byte);
  967. 1: (arr: array[0..3] of Byte);
  968. end;
  969. TFormatDescriptor = class(TObject)
  970. private
  971. function GetRedMask: QWord;
  972. function GetGreenMask: QWord;
  973. function GetBlueMask: QWord;
  974. function GetAlphaMask: QWord;
  975. protected
  976. fFormat: TglBitmapFormat;
  977. fWithAlpha: TglBitmapFormat;
  978. fWithoutAlpha: TglBitmapFormat;
  979. fRGBInverted: TglBitmapFormat;
  980. fUncompressed: TglBitmapFormat;
  981. fPixelSize: Single;
  982. fIsCompressed: Boolean;
  983. fRange: TglBitmapColorRec;
  984. fShift: TShiftRec;
  985. fglFormat: Cardinal;
  986. fglInternalFormat: Cardinal;
  987. fglDataFormat: Cardinal;
  988. function GetComponents: Integer; virtual;
  989. public
  990. property Format: TglBitmapFormat read fFormat;
  991. property WithAlpha: TglBitmapFormat read fWithAlpha;
  992. property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;
  993. property RGBInverted: TglBitmapFormat read fRGBInverted;
  994. property Components: Integer read GetComponents;
  995. property PixelSize: Single read fPixelSize;
  996. property IsCompressed: Boolean read fIsCompressed;
  997. property glFormat: Cardinal read fglFormat;
  998. property glInternalFormat: Cardinal read fglInternalFormat;
  999. property glDataFormat: Cardinal read fglDataFormat;
  1000. property Range: TglBitmapColorRec read fRange;
  1001. property Shift: TShiftRec read fShift;
  1002. property RedMask: QWord read GetRedMask;
  1003. property GreenMask: QWord read GetGreenMask;
  1004. property BlueMask: QWord read GetBlueMask;
  1005. property AlphaMask: QWord read GetAlphaMask;
  1006. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
  1007. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
  1008. function GetSize(const aSize: TglBitmapPixelPosition): Integer; virtual; overload;
  1009. function GetSize(const aWidth, aHeight: Integer): Integer; virtual; overload;
  1010. function CreateMappingData: Pointer; virtual;
  1011. procedure FreeMappingData(var aMappingData: Pointer); virtual;
  1012. function IsEmpty: Boolean; virtual;
  1013. function HasAlpha: Boolean; virtual;
  1014. function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean; virtual;
  1015. procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
  1016. constructor Create; virtual;
  1017. public
  1018. class procedure Init;
  1019. class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1020. class function GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1021. class procedure Clear;
  1022. class procedure Finalize;
  1023. end;
  1024. TFormatDescriptorClass = class of TFormatDescriptor;
  1025. TfdEmpty = class(TFormatDescriptor);
  1026. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1027. TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1028. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1029. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1030. constructor Create; override;
  1031. end;
  1032. TfdLuminance_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1033. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1034. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1035. constructor Create; override;
  1036. end;
  1037. TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte
  1038. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1039. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1040. constructor Create; override;
  1041. end;
  1042. TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte
  1043. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1044. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1045. constructor Create; override;
  1046. end;
  1047. TfdRGB_UB3 = class(TFormatDescriptor) //3* unsigned byte
  1048. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1049. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1050. constructor Create; override;
  1051. end;
  1052. TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
  1053. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1054. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1055. constructor Create; override;
  1056. end;
  1057. TfdRGBA_UB4 = class(TfdRGB_UB3) //4* unsigned byte
  1058. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1059. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1060. constructor Create; override;
  1061. end;
  1062. TfdBGRA_UB4 = class(TfdBGR_UB3) //4* unsigned byte (inverse)
  1063. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1064. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1065. constructor Create; override;
  1066. end;
  1067. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1068. TfdAlpha_US1 = class(TFormatDescriptor) //1* unsigned short
  1069. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1070. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1071. constructor Create; override;
  1072. end;
  1073. TfdLuminance_US1 = class(TFormatDescriptor) //1* unsigned short
  1074. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1075. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1076. constructor Create; override;
  1077. end;
  1078. TfdUniversal_US1 = class(TFormatDescriptor) //1* unsigned short
  1079. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1080. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1081. constructor Create; override;
  1082. end;
  1083. TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short
  1084. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1085. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1086. constructor Create; override;
  1087. end;
  1088. TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short
  1089. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1090. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1091. constructor Create; override;
  1092. end;
  1093. TfdRGB_US3 = class(TFormatDescriptor) //3* unsigned short
  1094. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1095. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1096. constructor Create; override;
  1097. end;
  1098. TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)
  1099. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1100. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1101. constructor Create; override;
  1102. end;
  1103. TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short
  1104. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1105. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1106. constructor Create; override;
  1107. end;
  1108. TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)
  1109. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1110. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1111. constructor Create; override;
  1112. end;
  1113. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1114. TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int
  1115. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1116. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1117. constructor Create; override;
  1118. end;
  1119. TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int
  1120. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1121. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1122. constructor Create; override;
  1123. end;
  1124. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1125. TfdAlpha4 = class(TfdAlpha_UB1)
  1126. constructor Create; override;
  1127. end;
  1128. TfdAlpha8 = class(TfdAlpha_UB1)
  1129. constructor Create; override;
  1130. end;
  1131. TfdAlpha12 = class(TfdAlpha_US1)
  1132. constructor Create; override;
  1133. end;
  1134. TfdAlpha16 = class(TfdAlpha_US1)
  1135. constructor Create; override;
  1136. end;
  1137. TfdLuminance4 = class(TfdLuminance_UB1)
  1138. constructor Create; override;
  1139. end;
  1140. TfdLuminance8 = class(TfdLuminance_UB1)
  1141. constructor Create; override;
  1142. end;
  1143. TfdLuminance12 = class(TfdLuminance_US1)
  1144. constructor Create; override;
  1145. end;
  1146. TfdLuminance16 = class(TfdLuminance_US1)
  1147. constructor Create; override;
  1148. end;
  1149. TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)
  1150. constructor Create; override;
  1151. end;
  1152. TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)
  1153. constructor Create; override;
  1154. end;
  1155. TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)
  1156. constructor Create; override;
  1157. end;
  1158. TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)
  1159. constructor Create; override;
  1160. end;
  1161. TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)
  1162. constructor Create; override;
  1163. end;
  1164. TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)
  1165. constructor Create; override;
  1166. end;
  1167. TfdR3G3B2 = class(TfdUniversal_UB1)
  1168. constructor Create; override;
  1169. end;
  1170. TfdRGB4 = class(TfdUniversal_US1)
  1171. constructor Create; override;
  1172. end;
  1173. TfdR5G6B5 = class(TfdUniversal_US1)
  1174. constructor Create; override;
  1175. end;
  1176. TfdRGB5 = class(TfdUniversal_US1)
  1177. constructor Create; override;
  1178. end;
  1179. TfdRGB8 = class(TfdRGB_UB3)
  1180. constructor Create; override;
  1181. end;
  1182. TfdRGB10 = class(TfdUniversal_UI1)
  1183. constructor Create; override;
  1184. end;
  1185. TfdRGB12 = class(TfdRGB_US3)
  1186. constructor Create; override;
  1187. end;
  1188. TfdRGB16 = class(TfdRGB_US3)
  1189. constructor Create; override;
  1190. end;
  1191. TfdRGBA2 = class(TfdRGBA_UB4)
  1192. constructor Create; override;
  1193. end;
  1194. TfdRGBA4 = class(TfdUniversal_US1)
  1195. constructor Create; override;
  1196. end;
  1197. TfdRGB5A1 = class(TfdUniversal_US1)
  1198. constructor Create; override;
  1199. end;
  1200. TfdRGBA8 = class(TfdRGBA_UB4)
  1201. constructor Create; override;
  1202. end;
  1203. TfdRGB10A2 = class(TfdUniversal_UI1)
  1204. constructor Create; override;
  1205. end;
  1206. TfdRGBA12 = class(TfdRGBA_US4)
  1207. constructor Create; override;
  1208. end;
  1209. TfdRGBA16 = class(TfdRGBA_US4)
  1210. constructor Create; override;
  1211. end;
  1212. TfdBGR4 = class(TfdUniversal_US1)
  1213. constructor Create; override;
  1214. end;
  1215. TfdB5G6R5 = class(TfdUniversal_US1)
  1216. constructor Create; override;
  1217. end;
  1218. TfdBGR5 = class(TfdUniversal_US1)
  1219. constructor Create; override;
  1220. end;
  1221. TfdBGR8 = class(TfdBGR_UB3)
  1222. constructor Create; override;
  1223. end;
  1224. TfdBGR10 = class(TfdUniversal_UI1)
  1225. constructor Create; override;
  1226. end;
  1227. TfdBGR12 = class(TfdBGR_US3)
  1228. constructor Create; override;
  1229. end;
  1230. TfdBGR16 = class(TfdBGR_US3)
  1231. constructor Create; override;
  1232. end;
  1233. TfdBGRA2 = class(TfdBGRA_UB4)
  1234. constructor Create; override;
  1235. end;
  1236. TfdBGRA4 = class(TfdUniversal_US1)
  1237. constructor Create; override;
  1238. end;
  1239. TfdBGR5A1 = class(TfdUniversal_US1)
  1240. constructor Create; override;
  1241. end;
  1242. TfdBGRA8 = class(TfdBGRA_UB4)
  1243. constructor Create; override;
  1244. end;
  1245. TfdBGR10A2 = class(TfdUniversal_UI1)
  1246. constructor Create; override;
  1247. end;
  1248. TfdBGRA12 = class(TfdBGRA_US4)
  1249. constructor Create; override;
  1250. end;
  1251. TfdBGRA16 = class(TfdBGRA_US4)
  1252. constructor Create; override;
  1253. end;
  1254. TfdDepth16 = class(TfdDepth_US1)
  1255. constructor Create; override;
  1256. end;
  1257. TfdDepth24 = class(TfdDepth_UI1)
  1258. constructor Create; override;
  1259. end;
  1260. TfdDepth32 = class(TfdDepth_UI1)
  1261. constructor Create; override;
  1262. end;
  1263. TfdS3tcDtx1RGBA = class(TFormatDescriptor)
  1264. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1265. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1266. constructor Create; override;
  1267. end;
  1268. TfdS3tcDtx3RGBA = class(TFormatDescriptor)
  1269. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1270. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1271. constructor Create; override;
  1272. end;
  1273. TfdS3tcDtx5RGBA = class(TFormatDescriptor)
  1274. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1275. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1276. constructor Create; override;
  1277. end;
  1278. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1279. TbmpBitfieldFormat = class(TFormatDescriptor)
  1280. private
  1281. procedure SetRedMask (const aValue: QWord);
  1282. procedure SetGreenMask(const aValue: QWord);
  1283. procedure SetBlueMask (const aValue: QWord);
  1284. procedure SetAlphaMask(const aValue: QWord);
  1285. procedure Update(aMask: QWord; out aRange: Cardinal; out aShift: Byte);
  1286. public
  1287. property RedMask: QWord read GetRedMask write SetRedMask;
  1288. property GreenMask: QWord read GetGreenMask write SetGreenMask;
  1289. property BlueMask: QWord read GetBlueMask write SetBlueMask;
  1290. property AlphaMask: QWord read GetAlphaMask write SetAlphaMask;
  1291. property PixelSize: Single read fPixelSize write fPixelSize;
  1292. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1293. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1294. end;
  1295. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1296. TbmpColorTableEnty = packed record
  1297. b, g, r, a: Byte;
  1298. end;
  1299. TbmpColorTable = array of TbmpColorTableEnty;
  1300. TbmpColorTableFormat = class(TFormatDescriptor)
  1301. private
  1302. fColorTable: TbmpColorTable;
  1303. public
  1304. property PixelSize: Single read fPixelSize write fPixelSize;
  1305. property ColorTable: TbmpColorTable read fColorTable write fColorTable;
  1306. property Range: TglBitmapColorRec read fRange write fRange;
  1307. property Shift: TShiftRec read fShift write fShift;
  1308. property Format: TglBitmapFormat read fFormat write fFormat;
  1309. procedure CreateColorTable;
  1310. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1311. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1312. destructor Destroy; override;
  1313. end;
  1314. const
  1315. LUMINANCE_WEIGHT_R = 0.30;
  1316. LUMINANCE_WEIGHT_G = 0.59;
  1317. LUMINANCE_WEIGHT_B = 0.11;
  1318. ALPHA_WEIGHT_R = 0.30;
  1319. ALPHA_WEIGHT_G = 0.59;
  1320. ALPHA_WEIGHT_B = 0.11;
  1321. DEPTH_WEIGHT_R = 0.333333333;
  1322. DEPTH_WEIGHT_G = 0.333333333;
  1323. DEPTH_WEIGHT_B = 0.333333333;
  1324. UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
  1325. FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
  1326. TfdEmpty,
  1327. TfdAlpha4,
  1328. TfdAlpha8,
  1329. TfdAlpha12,
  1330. TfdAlpha16,
  1331. TfdLuminance4,
  1332. TfdLuminance8,
  1333. TfdLuminance12,
  1334. TfdLuminance16,
  1335. TfdLuminance4Alpha4,
  1336. TfdLuminance6Alpha2,
  1337. TfdLuminance8Alpha8,
  1338. TfdLuminance12Alpha4,
  1339. TfdLuminance12Alpha12,
  1340. TfdLuminance16Alpha16,
  1341. TfdR3G3B2,
  1342. TfdRGB4,
  1343. TfdR5G6B5,
  1344. TfdRGB5,
  1345. TfdRGB8,
  1346. TfdRGB10,
  1347. TfdRGB12,
  1348. TfdRGB16,
  1349. TfdRGBA2,
  1350. TfdRGBA4,
  1351. TfdRGB5A1,
  1352. TfdRGBA8,
  1353. TfdRGB10A2,
  1354. TfdRGBA12,
  1355. TfdRGBA16,
  1356. TfdBGR4,
  1357. TfdB5G6R5,
  1358. TfdBGR5,
  1359. TfdBGR8,
  1360. TfdBGR10,
  1361. TfdBGR12,
  1362. TfdBGR16,
  1363. TfdBGRA2,
  1364. TfdBGRA4,
  1365. TfdBGR5A1,
  1366. TfdBGRA8,
  1367. TfdBGR10A2,
  1368. TfdBGRA12,
  1369. TfdBGRA16,
  1370. TfdDepth16,
  1371. TfdDepth24,
  1372. TfdDepth32,
  1373. TfdS3tcDtx1RGBA,
  1374. TfdS3tcDtx3RGBA,
  1375. TfdS3tcDtx5RGBA
  1376. );
  1377. var
  1378. FormatDescriptorCS: TCriticalSection;
  1379. FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
  1380. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1381. constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
  1382. begin
  1383. inherited Create(GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1384. end;
  1385. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1386. function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
  1387. begin
  1388. result.Fields := [];
  1389. if X >= 0 then
  1390. result.Fields := result.Fields + [ffX];
  1391. if Y >= 0 then
  1392. result.Fields := result.Fields + [ffY];
  1393. result.X := Max(0, X);
  1394. result.Y := Max(0, Y);
  1395. end;
  1396. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1397. function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;
  1398. begin
  1399. result.r := r;
  1400. result.g := g;
  1401. result.b := b;
  1402. result.a := a;
  1403. end;
  1404. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1405. function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;
  1406. var
  1407. i: Integer;
  1408. begin
  1409. result := false;
  1410. for i := 0 to high(r1.arr) do
  1411. if (r1.arr[i] <> r2.arr[i]) then
  1412. exit;
  1413. result := true;
  1414. end;
  1415. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1416. function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
  1417. begin
  1418. result.r := r;
  1419. result.g := g;
  1420. result.b := b;
  1421. result.a := a;
  1422. end;
  1423. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1424. function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
  1425. begin
  1426. result := [];
  1427. if (aFormat in [
  1428. //4 bbp
  1429. tfLuminance4,
  1430. //8bpp
  1431. tfR3G3B2, tfLuminance8,
  1432. //16bpp
  1433. tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
  1434. tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,
  1435. //24bpp
  1436. tfBGR8, tfRGB8,
  1437. //32bpp
  1438. tfRGB10, tfRGB10A2, tfRGBA8,
  1439. tfBGR10, tfBGR10A2, tfBGRA8]) then
  1440. result := result + [ftBMP];
  1441. if (aFormat in [
  1442. //8 bpp
  1443. tfLuminance8, tfAlpha8,
  1444. //16 bpp
  1445. tfLuminance16, tfLuminance8Alpha8,
  1446. tfRGB5, tfRGB5A1, tfRGBA4,
  1447. tfBGR5, tfBGR5A1, tfBGRA4,
  1448. //24 bpp
  1449. tfRGB8, tfBGR8,
  1450. //32 bpp
  1451. tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then
  1452. result := result + [ftTGA];
  1453. if (aFormat in [
  1454. //8 bpp
  1455. tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,
  1456. tfR3G3B2, tfRGBA2, tfBGRA2,
  1457. //16 bpp
  1458. tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,
  1459. tfRGB4, tfR5G6B5, tfRGB5, tfRGBA4, tfRGB5A1,
  1460. tfBGR4, tfB5G6R5, tfBGR5, tfBGRA4, tfBGR5A1,
  1461. //24 bpp
  1462. tfRGB8, tfBGR8,
  1463. //32 bbp
  1464. tfLuminance16Alpha16,
  1465. tfRGBA8, tfRGB10A2,
  1466. tfBGRA8, tfBGR10A2,
  1467. //compressed
  1468. tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then
  1469. result := result + [ftDDS];
  1470. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  1471. if aFormat in [
  1472. tfAlpha8, tfLuminance8, tfLuminance8Alpha8,
  1473. tfRGB8, tfRGBA8,
  1474. tfBGR8, tfBGRA8] then
  1475. result := result + [ftPNG];
  1476. {$ENDIF}
  1477. (* TODO
  1478. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  1479. if Format in [
  1480. tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
  1481. tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
  1482. tfR3G3B2, tfRGB4, tfRGB5, tfRGB8, tfRGB10, tfRGB12, tfRGB16,
  1483. tfDepth16, tfDepth24, tfDepth32]
  1484. then
  1485. result := result + [ftJPEG];
  1486. {$ENDIF}
  1487. *)
  1488. end;
  1489. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1490. function IsPowerOfTwo(aNumber: Integer): Boolean;
  1491. begin
  1492. while (aNumber and 1) = 0 do
  1493. aNumber := aNumber shr 1;
  1494. result := aNumber = 1;
  1495. end;
  1496. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1497. function GetTopMostBit(aBitSet: QWord): Integer;
  1498. begin
  1499. result := 0;
  1500. while aBitSet > 0 do begin
  1501. inc(result);
  1502. aBitSet := aBitSet shr 1;
  1503. end;
  1504. end;
  1505. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1506. function CountSetBits(aBitSet: QWord): Integer;
  1507. begin
  1508. result := 0;
  1509. while aBitSet > 0 do begin
  1510. if (aBitSet and 1) = 1 then
  1511. inc(result);
  1512. aBitSet := aBitSet shr 1;
  1513. end;
  1514. end;
  1515. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1516. function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1517. begin
  1518. result := Trunc(
  1519. LUMINANCE_WEIGHT_R * aPixel.Data.r +
  1520. LUMINANCE_WEIGHT_G * aPixel.Data.g +
  1521. LUMINANCE_WEIGHT_B * aPixel.Data.b);
  1522. end;
  1523. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1524. function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1525. begin
  1526. result := Trunc(
  1527. DEPTH_WEIGHT_R * aPixel.Data.r +
  1528. DEPTH_WEIGHT_G * aPixel.Data.g +
  1529. DEPTH_WEIGHT_B * aPixel.Data.b);
  1530. end;
  1531. {$IFDEF GLB_NATIVE_OGL}
  1532. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1533. //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1534. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1535. var
  1536. GL_LibHandle: Pointer = nil;
  1537. function glbGetProcAddress(aProcName: PChar; aLibHandle: Pointer = nil): Pointer;
  1538. begin
  1539. result := nil;
  1540. if not Assigned(aLibHandle) then
  1541. aLibHandle := GL_LibHandle;
  1542. {$IF DEFINED(GLB_WIN)}
  1543. result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);
  1544. if Assigned(result) then
  1545. exit;
  1546. if Assigned(wglGetProcAddress) then
  1547. result := wglGetProcAddress(aProcName);
  1548. {$ELSEIF DEFINED(GLB_LINUX)}
  1549. if Assigned(glXGetProcAddress) then begin
  1550. result := glXGetProcAddress(aProcName);
  1551. if Assigned(result) then
  1552. exit;
  1553. end;
  1554. if Assigned(glXGetProcAddressARB) then begin
  1555. result := glXGetProcAddressARB(aProcName);
  1556. if Assigned(result) then
  1557. exit;
  1558. end;
  1559. result := dlsym(aLibHandle, aProcName);
  1560. {$ENDIF}
  1561. if not Assigned(result) then
  1562. raise EglBitmapException.Create('unable to load procedure form library: ' + aProcName);
  1563. end;
  1564. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  1565. var
  1566. GLU_LibHandle: Pointer = nil;
  1567. OpenGLInitialized: Boolean;
  1568. InitOpenGLCS: TCriticalSection;
  1569. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1570. procedure glbInitOpenGL;
  1571. ////////////////////////////////////////////////////////////////////////////////
  1572. function glbLoadLibrary(const aName: PChar): Pointer;
  1573. begin
  1574. {$IF DEFINED(GLB_WIN)}
  1575. result := {%H-}Pointer(LoadLibrary(aName));
  1576. {$ELSEIF DEFINED(GLB_LINUX)}
  1577. result := dlopen(Name, RTLD_LAZY);
  1578. {$ELSE}
  1579. result := nil;
  1580. {$ENDIF}
  1581. end;
  1582. ////////////////////////////////////////////////////////////////////////////////
  1583. function glbFreeLibrary(const aLibHandle: Pointer): Boolean;
  1584. begin
  1585. result := false;
  1586. if not Assigned(aLibHandle) then
  1587. exit;
  1588. {$IF DEFINED(GLB_WIN)}
  1589. Result := FreeLibrary({%H-}HINST(aLibHandle));
  1590. {$ELSEIF DEFINED(GLB_LINUX)}
  1591. Result := dlclose(aLibHandle) = 0;
  1592. {$ENDIF}
  1593. end;
  1594. begin
  1595. if Assigned(GL_LibHandle) then
  1596. glbFreeLibrary(GL_LibHandle);
  1597. if Assigned(GLU_LibHandle) then
  1598. glbFreeLibrary(GLU_LibHandle);
  1599. GL_LibHandle := glbLoadLibrary(libopengl);
  1600. if not Assigned(GL_LibHandle) then
  1601. raise EglBitmapException.Create('unable to load library: ' + libopengl);
  1602. GLU_LibHandle := glbLoadLibrary(libglu);
  1603. if not Assigned(GLU_LibHandle) then
  1604. raise EglBitmapException.Create('unable to load library: ' + libglu);
  1605. try
  1606. {$IF DEFINED(GLB_WIN)}
  1607. wglGetProcAddress := glbGetProcAddress('wglGetProcAddress');
  1608. {$ELSEIF DEFINED(GLB_LINUX)}
  1609. glXGetProcAddress := glbGetProcAddress('glXGetProcAddress');
  1610. glXGetProcAddressARB := dglGetProcAddress('glXGetProcAddressARB');
  1611. {$ENDIF}
  1612. glEnable := glbGetProcAddress('glEnable');
  1613. glDisable := glbGetProcAddress('glDisable');
  1614. glGetString := glbGetProcAddress('glGetString');
  1615. glGetIntegerv := glbGetProcAddress('glGetIntegerv');
  1616. glTexParameteri := glbGetProcAddress('glTexParameteri');
  1617. glTexParameterfv := glbGetProcAddress('glTexParameterfv');
  1618. glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');
  1619. glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');
  1620. glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');
  1621. glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');
  1622. glGenTextures := glbGetProcAddress('glGenTextures');
  1623. glBindTexture := glbGetProcAddress('glBindTexture');
  1624. glDeleteTextures := glbGetProcAddress('glDeleteTextures');
  1625. glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');
  1626. glReadPixels := glbGetProcAddress('glReadPixels');
  1627. glPixelStorei := glbGetProcAddress('glPixelStorei');
  1628. glTexImage1D := glbGetProcAddress('glTexImage1D');
  1629. glTexImage2D := glbGetProcAddress('glTexImage2D');
  1630. glGetTexImage := glbGetProcAddress('glGetTexImage');
  1631. gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);
  1632. gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);
  1633. finally
  1634. glbFreeLibrary(GL_LibHandle);
  1635. glbFreeLibrary(GLU_LibHandle);
  1636. end;
  1637. end;
  1638. {$ENDIF}
  1639. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1640. procedure glbReadOpenGLExtensions;
  1641. var
  1642. {$IFDEF GLB_DELPHI}
  1643. Context: HGLRC;
  1644. {$ENDIF}
  1645. Buffer: AnsiString;
  1646. MajorVersion, MinorVersion: Integer;
  1647. ///////////////////////////////////////////////////////////////////////////////////////////
  1648. procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);
  1649. var
  1650. Separator: Integer;
  1651. begin
  1652. aMinor := 0;
  1653. aMajor := 0;
  1654. Separator := Pos(AnsiString('.'), aBuffer);
  1655. if (Separator > 1) and (Separator < Length(aBuffer)) and
  1656. (aBuffer[Separator - 1] in ['0'..'9']) and
  1657. (aBuffer[Separator + 1] in ['0'..'9']) then begin
  1658. Dec(Separator);
  1659. while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do
  1660. Dec(Separator);
  1661. Delete(aBuffer, 1, Separator);
  1662. Separator := Pos(AnsiString('.'), aBuffer) + 1;
  1663. while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do
  1664. Inc(Separator);
  1665. Delete(aBuffer, Separator, 255);
  1666. Separator := Pos(AnsiString('.'), aBuffer);
  1667. aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));
  1668. aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));
  1669. end;
  1670. end;
  1671. ///////////////////////////////////////////////////////////////////////////////////////////
  1672. function CheckExtension(const Extension: AnsiString): Boolean;
  1673. var
  1674. ExtPos: Integer;
  1675. begin
  1676. ExtPos := Pos(Extension, Buffer);
  1677. result := ExtPos > 0;
  1678. if result then
  1679. result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
  1680. end;
  1681. begin
  1682. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  1683. InitOpenGLCS.Enter;
  1684. try
  1685. if not OpenGLInitialized then begin
  1686. glbInitOpenGL;
  1687. OpenGLInitialized := true;
  1688. end;
  1689. finally
  1690. InitOpenGLCS.Leave;
  1691. end;
  1692. {$ENDIF}
  1693. {$IFDEF GLB_DELPHI}
  1694. Context := wglGetCurrentContext;
  1695. if (Context <> gLastContext) then begin
  1696. gLastContext := Context;
  1697. {$ENDIF}
  1698. // Version
  1699. Buffer := glGetString(GL_VERSION);
  1700. TrimVersionString(Buffer, MajorVersion, MinorVersion);
  1701. GL_VERSION_1_2 := false;
  1702. GL_VERSION_1_3 := false;
  1703. GL_VERSION_1_4 := false;
  1704. GL_VERSION_2_0 := false;
  1705. if MajorVersion = 1 then begin
  1706. if MinorVersion >= 2 then
  1707. GL_VERSION_1_2 := true;
  1708. if MinorVersion >= 3 then
  1709. GL_VERSION_1_3 := true;
  1710. if MinorVersion >= 4 then
  1711. GL_VERSION_1_4 := true;
  1712. end else if MajorVersion >= 2 then begin
  1713. GL_VERSION_1_2 := true;
  1714. GL_VERSION_1_3 := true;
  1715. GL_VERSION_1_4 := true;
  1716. GL_VERSION_2_0 := true;
  1717. end;
  1718. // Extensions
  1719. Buffer := glGetString(GL_EXTENSIONS);
  1720. GL_ARB_texture_border_clamp := CheckExtension('GL_ARB_texture_border_clamp');
  1721. GL_ARB_texture_non_power_of_two := CheckExtension('GL_ARB_texture_non_power_of_two');
  1722. GL_ARB_texture_rectangle := CheckExtension('GL_ARB_texture_rectangle');
  1723. GL_ARB_texture_mirrored_repeat := CheckExtension('GL_ARB_texture_mirrored_repeat');
  1724. GL_EXT_texture_edge_clamp := CheckExtension('GL_EXT_texture_edge_clamp');
  1725. GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
  1726. GL_EXT_texture_rectangle := CheckExtension('GL_EXT_texture_rectangle');
  1727. GL_NV_texture_rectangle := CheckExtension('GL_NV_texture_rectangle');
  1728. GL_IBM_texture_mirrored_repeat := CheckExtension('GL_IBM_texture_mirrored_repeat');
  1729. GL_SGIS_generate_mipmap := CheckExtension('GL_SGIS_generate_mipmap');
  1730. if GL_VERSION_1_3 then begin
  1731. glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1D');
  1732. glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2D');
  1733. glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');
  1734. end else begin
  1735. glCompressedTexImage1D := glbGetProcAddress('glCompressedTexImage1DARB');
  1736. glCompressedTexImage2D := glbGetProcAddress('glCompressedTexImage2DARB');
  1737. glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB');
  1738. end;
  1739. {$IFDEF GLB_DELPHI}
  1740. end;
  1741. {$ENDIF}
  1742. end;
  1743. {$ENDIF}
  1744. (* TODO GLB_DELPHI
  1745. {$IFDEF GLB_DELPHI}
  1746. function CreateGrayPalette: HPALETTE;
  1747. var
  1748. Idx: Integer;
  1749. Pal: PLogPalette;
  1750. begin
  1751. GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
  1752. Pal.palVersion := $300;
  1753. Pal.palNumEntries := 256;
  1754. {$IFOPT R+}
  1755. {$DEFINE GLB_TEMPRANGECHECK}
  1756. {$R-}
  1757. {$ENDIF}
  1758. for Idx := 0 to 256 - 1 do begin
  1759. Pal.palPalEntry[Idx].peRed := Idx;
  1760. Pal.palPalEntry[Idx].peGreen := Idx;
  1761. Pal.palPalEntry[Idx].peBlue := Idx;
  1762. Pal.palPalEntry[Idx].peFlags := 0;
  1763. end;
  1764. {$IFDEF GLB_TEMPRANGECHECK}
  1765. {$UNDEF GLB_TEMPRANGECHECK}
  1766. {$R+}
  1767. {$ENDIF}
  1768. result := CreatePalette(Pal^);
  1769. FreeMem(Pal);
  1770. end;
  1771. {$ENDIF}
  1772. *)
  1773. {$IFDEF GLB_SDL_IMAGE}
  1774. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1775. // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1776. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1777. function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
  1778. begin
  1779. result := TStream(context^.unknown.data1).Seek(offset, whence);
  1780. end;
  1781. function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
  1782. begin
  1783. result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
  1784. end;
  1785. function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
  1786. begin
  1787. result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
  1788. end;
  1789. function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
  1790. begin
  1791. result := 0;
  1792. end;
  1793. function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
  1794. begin
  1795. result := SDL_AllocRW;
  1796. if result = nil then
  1797. raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
  1798. result^.seek := glBitmapRWseek;
  1799. result^.read := glBitmapRWread;
  1800. result^.write := glBitmapRWwrite;
  1801. result^.close := glBitmapRWclose;
  1802. result^.unknown.data1 := Stream;
  1803. end;
  1804. {$ENDIF}
  1805. (* TODO LoadFuncs
  1806. function LoadTexture(Filename: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal{$ENDIF}): Boolean;
  1807. var
  1808. glBitmap: TglBitmap2D;
  1809. begin
  1810. result := false;
  1811. Texture := 0;
  1812. {$IFDEF GLB_DELPHI}
  1813. if Instance = 0 then
  1814. Instance := HInstance;
  1815. if (LoadFromRes) then
  1816. glBitmap := TglBitmap2D.CreateFromResourceName(Instance, FileName)
  1817. else
  1818. {$ENDIF}
  1819. glBitmap := TglBitmap2D.Create(FileName);
  1820. try
  1821. glBitmap.DeleteTextureOnFree := false;
  1822. glBitmap.FreeDataAfterGenTexture := false;
  1823. glBitmap.GenTexture(true);
  1824. if (glBitmap.ID > 0) then begin
  1825. Texture := glBitmap.ID;
  1826. result := true;
  1827. end;
  1828. finally
  1829. glBitmap.Free;
  1830. end;
  1831. end;
  1832. function LoadCubeMap(PositiveX, NegativeX, PositiveY, NegativeY, PositiveZ, NegativeZ: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal{$ENDIF}): Boolean;
  1833. var
  1834. CM: TglBitmapCubeMap;
  1835. begin
  1836. Texture := 0;
  1837. {$IFDEF GLB_DELPHI}
  1838. if Instance = 0 then
  1839. Instance := HInstance;
  1840. {$ENDIF}
  1841. CM := TglBitmapCubeMap.Create;
  1842. try
  1843. CM.DeleteTextureOnFree := false;
  1844. // Maps
  1845. {$IFDEF GLB_DELPHI}
  1846. if (LoadFromRes) then
  1847. CM.LoadFromResource(Instance, PositiveX)
  1848. else
  1849. {$ENDIF}
  1850. CM.LoadFromFile(PositiveX);
  1851. CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X);
  1852. {$IFDEF GLB_DELPHI}
  1853. if (LoadFromRes) then
  1854. CM.LoadFromResource(Instance, NegativeX)
  1855. else
  1856. {$ENDIF}
  1857. CM.LoadFromFile(NegativeX);
  1858. CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X);
  1859. {$IFDEF GLB_DELPHI}
  1860. if (LoadFromRes) then
  1861. CM.LoadFromResource(Instance, PositiveY)
  1862. else
  1863. {$ENDIF}
  1864. CM.LoadFromFile(PositiveY);
  1865. CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y);
  1866. {$IFDEF GLB_DELPHI}
  1867. if (LoadFromRes) then
  1868. CM.LoadFromResource(Instance, NegativeY)
  1869. else
  1870. {$ENDIF}
  1871. CM.LoadFromFile(NegativeY);
  1872. CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y);
  1873. {$IFDEF GLB_DELPHI}
  1874. if (LoadFromRes) then
  1875. CM.LoadFromResource(Instance, PositiveZ)
  1876. else
  1877. {$ENDIF}
  1878. CM.LoadFromFile(PositiveZ);
  1879. CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z);
  1880. {$IFDEF GLB_DELPHI}
  1881. if (LoadFromRes) then
  1882. CM.LoadFromResource(Instance, NegativeZ)
  1883. else
  1884. {$ENDIF}
  1885. CM.LoadFromFile(NegativeZ);
  1886. CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z);
  1887. Texture := CM.ID;
  1888. result := true;
  1889. finally
  1890. CM.Free;
  1891. end;
  1892. end;
  1893. function LoadNormalMap(Size: Integer; var Texture: Cardinal): Boolean;
  1894. var
  1895. NM: TglBitmapNormalMap;
  1896. begin
  1897. Texture := 0;
  1898. NM := TglBitmapNormalMap.Create;
  1899. try
  1900. NM.DeleteTextureOnFree := false;
  1901. NM.GenerateNormalMap(Size);
  1902. Texture := NM.ID;
  1903. result := true;
  1904. finally
  1905. NM.Free;
  1906. end;
  1907. end;
  1908. *)
  1909. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1910. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1911. begin
  1912. glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
  1913. end;
  1914. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1915. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1916. begin
  1917. glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
  1918. end;
  1919. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1920. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1921. begin
  1922. glBitmapDefaultMipmap := aValue;
  1923. end;
  1924. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1925. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1926. begin
  1927. glBitmapDefaultFormat := aFormat;
  1928. end;
  1929. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1930. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1931. begin
  1932. glBitmapDefaultFilterMin := aMin;
  1933. glBitmapDefaultFilterMag := aMag;
  1934. end;
  1935. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1936. procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
  1937. begin
  1938. glBitmapDefaultWrapS := S;
  1939. glBitmapDefaultWrapT := T;
  1940. glBitmapDefaultWrapR := R;
  1941. end;
  1942. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1943. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1944. begin
  1945. result := glBitmapDefaultDeleteTextureOnFree;
  1946. end;
  1947. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1948. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1949. begin
  1950. result := glBitmapDefaultFreeDataAfterGenTextures;
  1951. end;
  1952. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1953. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1954. begin
  1955. result := glBitmapDefaultMipmap;
  1956. end;
  1957. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1958. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1959. begin
  1960. result := glBitmapDefaultFormat;
  1961. end;
  1962. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1963. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  1964. begin
  1965. aMin := glBitmapDefaultFilterMin;
  1966. aMag := glBitmapDefaultFilterMag;
  1967. end;
  1968. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1969. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  1970. begin
  1971. S := glBitmapDefaultWrapS;
  1972. T := glBitmapDefaultWrapT;
  1973. R := glBitmapDefaultWrapR;
  1974. end;
  1975. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1976. //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1977. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1978. function TFormatDescriptor.GetRedMask: QWord;
  1979. begin
  1980. result := fRange.r shl fShift.r;
  1981. end;
  1982. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1983. function TFormatDescriptor.GetGreenMask: QWord;
  1984. begin
  1985. result := fRange.g shl fShift.g;
  1986. end;
  1987. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1988. function TFormatDescriptor.GetBlueMask: QWord;
  1989. begin
  1990. result := fRange.b shl fShift.b;
  1991. end;
  1992. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1993. function TFormatDescriptor.GetAlphaMask: QWord;
  1994. begin
  1995. result := fRange.a shl fShift.a;
  1996. end;
  1997. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1998. function TFormatDescriptor.GetComponents: Integer;
  1999. var
  2000. i: Integer;
  2001. begin
  2002. result := 0;
  2003. for i := 0 to 3 do
  2004. if (fRange.arr[i] > 0) then
  2005. inc(result);
  2006. end;
  2007. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2008. function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
  2009. var
  2010. w, h: Integer;
  2011. begin
  2012. if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
  2013. w := Max(1, aSize.X);
  2014. h := Max(1, aSize.Y);
  2015. result := GetSize(w, h);
  2016. end else
  2017. result := 0;
  2018. end;
  2019. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2020. function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
  2021. begin
  2022. result := 0;
  2023. if (aWidth <= 0) or (aHeight <= 0) then
  2024. exit;
  2025. result := Ceil(aWidth * aHeight * fPixelSize);
  2026. end;
  2027. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2028. function TFormatDescriptor.CreateMappingData: Pointer;
  2029. begin
  2030. result := nil;
  2031. end;
  2032. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2033. procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
  2034. begin
  2035. //DUMMY
  2036. end;
  2037. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2038. function TFormatDescriptor.IsEmpty: Boolean;
  2039. begin
  2040. result := (fFormat = tfEmpty);
  2041. end;
  2042. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2043. function TFormatDescriptor.HasAlpha: Boolean;
  2044. begin
  2045. result := (fRange.a > 0);
  2046. end;
  2047. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2048. function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean;
  2049. begin
  2050. result := false;
  2051. if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
  2052. raise EglBitmapException.Create('FormatCheckFormat - All Masks are 0');
  2053. if (aRedMask <> RedMask) then
  2054. exit;
  2055. if (aGreenMask <> GreenMask) then
  2056. exit;
  2057. if (aBlueMask <> BlueMask) then
  2058. exit;
  2059. if (aAlphaMask <> AlphaMask) then
  2060. exit;
  2061. result := true;
  2062. end;
  2063. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2064. procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
  2065. begin
  2066. FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
  2067. aPixel.Data := fRange;
  2068. aPixel.Range := fRange;
  2069. aPixel.Format := fFormat;
  2070. end;
  2071. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2072. constructor TFormatDescriptor.Create;
  2073. begin
  2074. inherited Create;
  2075. fFormat := tfEmpty;
  2076. fWithAlpha := tfEmpty;
  2077. fWithoutAlpha := tfEmpty;
  2078. fRGBInverted := tfEmpty;
  2079. fUncompressed := tfEmpty;
  2080. fPixelSize := 0.0;
  2081. fIsCompressed := false;
  2082. fglFormat := 0;
  2083. fglInternalFormat := 0;
  2084. fglDataFormat := 0;
  2085. FillChar(fRange, 0, SizeOf(fRange));
  2086. FillChar(fShift, 0, SizeOf(fShift));
  2087. end;
  2088. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2089. //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2090. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2091. procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2092. begin
  2093. aData^ := aPixel.Data.a;
  2094. inc(aData);
  2095. end;
  2096. procedure TfdAlpha_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2097. begin
  2098. aPixel.Data.r := 0;
  2099. aPixel.Data.g := 0;
  2100. aPixel.Data.b := 0;
  2101. aPixel.Data.a := aData^;
  2102. inc(aData^);
  2103. end;
  2104. constructor TfdAlpha_UB1.Create;
  2105. begin
  2106. inherited Create;
  2107. fPixelSize := 1.0;
  2108. fRange.a := $FF;
  2109. fglFormat := GL_ALPHA;
  2110. fglDataFormat := GL_UNSIGNED_BYTE;
  2111. end;
  2112. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2113. //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2114. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2115. procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2116. begin
  2117. aData^ := LuminanceWeight(aPixel);
  2118. inc(aData);
  2119. end;
  2120. procedure TfdLuminance_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2121. begin
  2122. aPixel.Data.r := aData^;
  2123. aPixel.Data.g := aData^;
  2124. aPixel.Data.b := aData^;
  2125. aPixel.Data.a := 0;
  2126. inc(aData);
  2127. end;
  2128. constructor TfdLuminance_UB1.Create;
  2129. begin
  2130. inherited Create;
  2131. fPixelSize := 1.0;
  2132. fRange.r := $FF;
  2133. fRange.g := $FF;
  2134. fRange.b := $FF;
  2135. fglFormat := GL_LUMINANCE;
  2136. fglDataFormat := GL_UNSIGNED_BYTE;
  2137. end;
  2138. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2139. //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2140. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2141. procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2142. var
  2143. i: Integer;
  2144. begin
  2145. aData^ := 0;
  2146. for i := 0 to 3 do
  2147. if (fRange.arr[i] > 0) then
  2148. aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2149. inc(aData);
  2150. end;
  2151. procedure TfdUniversal_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2152. var
  2153. i: Integer;
  2154. begin
  2155. for i := 0 to 3 do
  2156. aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];
  2157. inc(aData);
  2158. end;
  2159. constructor TfdUniversal_UB1.Create;
  2160. begin
  2161. inherited Create;
  2162. fPixelSize := 1.0;
  2163. end;
  2164. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2165. //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2166. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2167. procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2168. begin
  2169. inherited Map(aPixel, aData, aMapData);
  2170. aData^ := aPixel.Data.a;
  2171. inc(aData);
  2172. end;
  2173. procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2174. begin
  2175. inherited Unmap(aData, aPixel, aMapData);
  2176. aPixel.Data.a := aData^;
  2177. inc(aData);
  2178. end;
  2179. constructor TfdLuminanceAlpha_UB2.Create;
  2180. begin
  2181. inherited Create;
  2182. fPixelSize := 2.0;
  2183. fRange.a := $FF;
  2184. fShift.a := 8;
  2185. fglFormat := GL_LUMINANCE_ALPHA;
  2186. fglDataFormat := GL_UNSIGNED_BYTE;
  2187. end;
  2188. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2189. //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2190. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2191. procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2192. begin
  2193. aData^ := aPixel.Data.r;
  2194. inc(aData);
  2195. aData^ := aPixel.Data.g;
  2196. inc(aData);
  2197. aData^ := aPixel.Data.b;
  2198. inc(aData);
  2199. end;
  2200. procedure TfdRGB_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2201. begin
  2202. aPixel.Data.r := aData^;
  2203. inc(aData);
  2204. aPixel.Data.g := aData^;
  2205. inc(aData);
  2206. aPixel.Data.b := aData^;
  2207. inc(aData);
  2208. aPixel.Data.a := 0;
  2209. end;
  2210. constructor TfdRGB_UB3.Create;
  2211. begin
  2212. inherited Create;
  2213. fPixelSize := 3.0;
  2214. fRange.r := $FF;
  2215. fRange.g := $FF;
  2216. fRange.b := $FF;
  2217. fShift.r := 0;
  2218. fShift.g := 8;
  2219. fShift.b := 16;
  2220. fglFormat := GL_RGB;
  2221. fglDataFormat := GL_UNSIGNED_BYTE;
  2222. end;
  2223. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2224. //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2225. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2226. procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2227. begin
  2228. aData^ := aPixel.Data.b;
  2229. inc(aData);
  2230. aData^ := aPixel.Data.g;
  2231. inc(aData);
  2232. aData^ := aPixel.Data.r;
  2233. inc(aData);
  2234. end;
  2235. procedure TfdBGR_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2236. begin
  2237. aPixel.Data.b := aData^;
  2238. inc(aData);
  2239. aPixel.Data.g := aData^;
  2240. inc(aData);
  2241. aPixel.Data.r := aData^;
  2242. inc(aData);
  2243. aPixel.Data.a := 0;
  2244. end;
  2245. constructor TfdBGR_UB3.Create;
  2246. begin
  2247. fPixelSize := 3.0;
  2248. fRange.r := $FF;
  2249. fRange.g := $FF;
  2250. fRange.b := $FF;
  2251. fShift.r := 16;
  2252. fShift.g := 8;
  2253. fShift.b := 0;
  2254. fglFormat := GL_BGR;
  2255. fglDataFormat := GL_UNSIGNED_BYTE;
  2256. end;
  2257. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2258. //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2259. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2260. procedure TfdRGBA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2261. begin
  2262. inherited Map(aPixel, aData, aMapData);
  2263. aData^ := aPixel.Data.a;
  2264. inc(aData);
  2265. end;
  2266. procedure TfdRGBA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2267. begin
  2268. inherited Unmap(aData, aPixel, aMapData);
  2269. aPixel.Data.a := aData^;
  2270. inc(aData);
  2271. end;
  2272. constructor TfdRGBA_UB4.Create;
  2273. begin
  2274. inherited Create;
  2275. fPixelSize := 4.0;
  2276. fRange.a := $FF;
  2277. fShift.a := 24;
  2278. fglFormat := GL_RGBA;
  2279. fglDataFormat := GL_UNSIGNED_BYTE;
  2280. end;
  2281. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2282. //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2283. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2284. procedure TfdBGRA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2285. begin
  2286. inherited Map(aPixel, aData, aMapData);
  2287. aData^ := aPixel.Data.a;
  2288. inc(aData);
  2289. end;
  2290. procedure TfdBGRA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2291. begin
  2292. inherited Unmap(aData, aPixel, aMapData);
  2293. aPixel.Data.a := aData^;
  2294. inc(aData);
  2295. end;
  2296. constructor TfdBGRA_UB4.Create;
  2297. begin
  2298. inherited Create;
  2299. fPixelSize := 4.0;
  2300. fRange.a := $FF;
  2301. fShift.a := 24;
  2302. fglFormat := GL_BGRA;
  2303. fglDataFormat := GL_UNSIGNED_BYTE;
  2304. end;
  2305. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2306. //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2307. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2308. procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2309. begin
  2310. PWord(aData)^ := aPixel.Data.a;
  2311. inc(aData, 2);
  2312. end;
  2313. procedure TfdAlpha_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2314. begin
  2315. aPixel.Data.r := 0;
  2316. aPixel.Data.g := 0;
  2317. aPixel.Data.b := 0;
  2318. aPixel.Data.a := PWord(aData)^;
  2319. inc(aData, 2);
  2320. end;
  2321. constructor TfdAlpha_US1.Create;
  2322. begin
  2323. inherited Create;
  2324. fPixelSize := 2.0;
  2325. fRange.a := $FFFF;
  2326. fglFormat := GL_ALPHA;
  2327. fglDataFormat := GL_UNSIGNED_SHORT;
  2328. end;
  2329. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2330. //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2331. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2332. procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2333. begin
  2334. PWord(aData)^ := LuminanceWeight(aPixel);
  2335. inc(aData, 2);
  2336. end;
  2337. procedure TfdLuminance_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2338. begin
  2339. aPixel.Data.r := PWord(aData)^;
  2340. aPixel.Data.g := PWord(aData)^;
  2341. aPixel.Data.b := PWord(aData)^;
  2342. aPixel.Data.a := 0;
  2343. inc(aData, 2);
  2344. end;
  2345. constructor TfdLuminance_US1.Create;
  2346. begin
  2347. inherited Create;
  2348. fPixelSize := 2.0;
  2349. fRange.r := $FFFF;
  2350. fRange.g := $FFFF;
  2351. fRange.b := $FFFF;
  2352. fglFormat := GL_LUMINANCE;
  2353. fglDataFormat := GL_UNSIGNED_SHORT;
  2354. end;
  2355. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2356. //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2357. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2358. procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2359. var
  2360. i: Integer;
  2361. begin
  2362. PWord(aData)^ := 0;
  2363. for i := 0 to 3 do
  2364. if (fRange.arr[i] > 0) then
  2365. PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2366. inc(aData, 2);
  2367. end;
  2368. procedure TfdUniversal_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2369. var
  2370. i: Integer;
  2371. begin
  2372. for i := 0 to 3 do
  2373. aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];
  2374. inc(aData, 2);
  2375. end;
  2376. constructor TfdUniversal_US1.Create;
  2377. begin
  2378. inherited Create;
  2379. fPixelSize := 2.0;
  2380. end;
  2381. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2382. //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2383. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2384. procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2385. begin
  2386. PWord(aData)^ := DepthWeight(aPixel);
  2387. inc(aData, 2);
  2388. end;
  2389. procedure TfdDepth_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2390. begin
  2391. aPixel.Data.r := PWord(aData)^;
  2392. aPixel.Data.g := PWord(aData)^;
  2393. aPixel.Data.b := PWord(aData)^;
  2394. aPixel.Data.a := 0;
  2395. inc(aData, 2);
  2396. end;
  2397. constructor TfdDepth_US1.Create;
  2398. begin
  2399. inherited Create;
  2400. fPixelSize := 2.0;
  2401. fRange.r := $FFFF;
  2402. fRange.g := $FFFF;
  2403. fRange.b := $FFFF;
  2404. fglFormat := GL_DEPTH_COMPONENT;
  2405. fglDataFormat := GL_UNSIGNED_SHORT;
  2406. end;
  2407. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2408. //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2409. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2410. procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2411. begin
  2412. inherited Map(aPixel, aData, aMapData);
  2413. PWord(aData)^ := aPixel.Data.a;
  2414. inc(aData, 2);
  2415. end;
  2416. procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2417. begin
  2418. inherited Unmap(aData, aPixel, aMapData);
  2419. aPixel.Data.a := PWord(aData)^;
  2420. inc(aData, 2);
  2421. end;
  2422. constructor TfdLuminanceAlpha_US2.Create;
  2423. begin
  2424. inherited Create;
  2425. fPixelSize := 4.0;
  2426. fRange.a := $FFFF;
  2427. fShift.a := 16;
  2428. fglFormat := GL_LUMINANCE_ALPHA;
  2429. fglDataFormat := GL_UNSIGNED_SHORT;
  2430. end;
  2431. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2432. //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2433. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2434. procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2435. begin
  2436. PWord(aData)^ := aPixel.Data.r;
  2437. inc(aData, 2);
  2438. PWord(aData)^ := aPixel.Data.g;
  2439. inc(aData, 2);
  2440. PWord(aData)^ := aPixel.Data.b;
  2441. inc(aData, 2);
  2442. end;
  2443. procedure TfdRGB_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2444. begin
  2445. aPixel.Data.r := PWord(aData)^;
  2446. inc(aData, 2);
  2447. aPixel.Data.g := PWord(aData)^;
  2448. inc(aData, 2);
  2449. aPixel.Data.b := PWord(aData)^;
  2450. inc(aData, 2);
  2451. aPixel.Data.a := 0;
  2452. end;
  2453. constructor TfdRGB_US3.Create;
  2454. begin
  2455. inherited Create;
  2456. fPixelSize := 6.0;
  2457. fRange.r := $FFFF;
  2458. fRange.g := $FFFF;
  2459. fRange.b := $FFFF;
  2460. fShift.r := 0;
  2461. fShift.g := 16;
  2462. fShift.b := 32;
  2463. fglFormat := GL_RGB;
  2464. fglDataFormat := GL_UNSIGNED_SHORT;
  2465. end;
  2466. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2467. //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2468. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2469. procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2470. begin
  2471. PWord(aData)^ := aPixel.Data.b;
  2472. inc(aData, 2);
  2473. PWord(aData)^ := aPixel.Data.g;
  2474. inc(aData, 2);
  2475. PWord(aData)^ := aPixel.Data.r;
  2476. inc(aData, 2);
  2477. end;
  2478. procedure TfdBGR_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2479. begin
  2480. aPixel.Data.b := PWord(aData)^;
  2481. inc(aData, 2);
  2482. aPixel.Data.g := PWord(aData)^;
  2483. inc(aData, 2);
  2484. aPixel.Data.r := PWord(aData)^;
  2485. inc(aData, 2);
  2486. aPixel.Data.a := 0;
  2487. end;
  2488. constructor TfdBGR_US3.Create;
  2489. begin
  2490. inherited Create;
  2491. fPixelSize := 6.0;
  2492. fRange.r := $FFFF;
  2493. fRange.g := $FFFF;
  2494. fRange.b := $FFFF;
  2495. fShift.r := 32;
  2496. fShift.g := 16;
  2497. fShift.b := 0;
  2498. fglFormat := GL_BGR;
  2499. fglDataFormat := GL_UNSIGNED_SHORT;
  2500. end;
  2501. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2502. //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2503. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2504. procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2505. begin
  2506. inherited Map(aPixel, aData, aMapData);
  2507. PWord(aData)^ := aPixel.Data.a;
  2508. inc(aData, 2);
  2509. end;
  2510. procedure TfdRGBA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2511. begin
  2512. inherited Unmap(aData, aPixel, aMapData);
  2513. aPixel.Data.a := PWord(aData)^;
  2514. inc(aData, 2);
  2515. end;
  2516. constructor TfdRGBA_US4.Create;
  2517. begin
  2518. inherited Create;
  2519. fPixelSize := 8.0;
  2520. fRange.a := $FFFF;
  2521. fShift.a := 48;
  2522. fglFormat := GL_RGBA;
  2523. fglDataFormat := GL_UNSIGNED_SHORT;
  2524. end;
  2525. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2526. //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2527. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2528. procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2529. begin
  2530. inherited Map(aPixel, aData, aMapData);
  2531. PWord(aData)^ := aPixel.Data.a;
  2532. inc(aData, 2);
  2533. end;
  2534. procedure TfdBGRA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2535. begin
  2536. inherited Unmap(aData, aPixel, aMapData);
  2537. aPixel.Data.a := PWord(aData)^;
  2538. inc(aData, 2);
  2539. end;
  2540. constructor TfdBGRA_US4.Create;
  2541. begin
  2542. inherited Create;
  2543. fPixelSize := 8.0;
  2544. fRange.a := $FFFF;
  2545. fShift.a := 48;
  2546. fglFormat := GL_BGRA;
  2547. fglDataFormat := GL_UNSIGNED_SHORT;
  2548. end;
  2549. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2550. //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2551. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2552. procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2553. var
  2554. i: Integer;
  2555. begin
  2556. PCardinal(aData)^ := 0;
  2557. for i := 0 to 3 do
  2558. if (fRange.arr[i] > 0) then
  2559. PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);
  2560. inc(aData, 4);
  2561. end;
  2562. procedure TfdUniversal_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2563. var
  2564. i: Integer;
  2565. begin
  2566. for i := 0 to 3 do
  2567. aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];
  2568. inc(aData, 2);
  2569. end;
  2570. constructor TfdUniversal_UI1.Create;
  2571. begin
  2572. inherited Create;
  2573. fPixelSize := 4.0;
  2574. end;
  2575. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2576. //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2577. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2578. procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2579. begin
  2580. PCardinal(aData)^ := DepthWeight(aPixel);
  2581. inc(aData, 4);
  2582. end;
  2583. procedure TfdDepth_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2584. begin
  2585. aPixel.Data.r := PCardinal(aData)^;
  2586. aPixel.Data.g := PCardinal(aData)^;
  2587. aPixel.Data.b := PCardinal(aData)^;
  2588. aPixel.Data.a := 0;
  2589. inc(aData, 4);
  2590. end;
  2591. constructor TfdDepth_UI1.Create;
  2592. begin
  2593. inherited Create;
  2594. fPixelSize := 4.0;
  2595. fRange.r := $FFFFFFFF;
  2596. fRange.g := $FFFFFFFF;
  2597. fRange.b := $FFFFFFFF;
  2598. fglFormat := GL_DEPTH_COMPONENT;
  2599. fglDataFormat := GL_UNSIGNED_INT;
  2600. end;
  2601. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2602. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2603. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2604. constructor TfdAlpha4.Create;
  2605. begin
  2606. inherited Create;
  2607. fFormat := tfAlpha4;
  2608. fWithAlpha := tfAlpha4;
  2609. fglInternalFormat := GL_ALPHA4;
  2610. end;
  2611. constructor TfdAlpha8.Create;
  2612. begin
  2613. inherited Create;
  2614. fFormat := tfAlpha8;
  2615. fWithAlpha := tfAlpha8;
  2616. fglInternalFormat := GL_ALPHA8;
  2617. end;
  2618. constructor TfdAlpha12.Create;
  2619. begin
  2620. inherited Create;
  2621. fFormat := tfAlpha12;
  2622. fWithAlpha := tfAlpha12;
  2623. fglInternalFormat := GL_ALPHA12;
  2624. end;
  2625. constructor TfdAlpha16.Create;
  2626. begin
  2627. inherited Create;
  2628. fFormat := tfAlpha16;
  2629. fWithAlpha := tfAlpha16;
  2630. fglInternalFormat := GL_ALPHA16;
  2631. end;
  2632. constructor TfdLuminance4.Create;
  2633. begin
  2634. inherited Create;
  2635. fFormat := tfLuminance4;
  2636. fWithAlpha := tfLuminance4Alpha4;
  2637. fWithoutAlpha := tfLuminance4;
  2638. fglInternalFormat := GL_LUMINANCE4;
  2639. end;
  2640. constructor TfdLuminance8.Create;
  2641. begin
  2642. inherited Create;
  2643. fFormat := tfLuminance8;
  2644. fWithAlpha := tfLuminance8Alpha8;
  2645. fWithoutAlpha := tfLuminance8;
  2646. fglInternalFormat := GL_LUMINANCE8;
  2647. end;
  2648. constructor TfdLuminance12.Create;
  2649. begin
  2650. inherited Create;
  2651. fFormat := tfLuminance12;
  2652. fWithAlpha := tfLuminance12Alpha12;
  2653. fWithoutAlpha := tfLuminance12;
  2654. fglInternalFormat := GL_LUMINANCE12;
  2655. end;
  2656. constructor TfdLuminance16.Create;
  2657. begin
  2658. inherited Create;
  2659. fFormat := tfLuminance16;
  2660. fWithAlpha := tfLuminance16Alpha16;
  2661. fWithoutAlpha := tfLuminance16;
  2662. fglInternalFormat := GL_LUMINANCE16;
  2663. end;
  2664. constructor TfdLuminance4Alpha4.Create;
  2665. begin
  2666. inherited Create;
  2667. fFormat := tfLuminance4Alpha4;
  2668. fWithAlpha := tfLuminance4Alpha4;
  2669. fWithoutAlpha := tfLuminance4;
  2670. fglInternalFormat := GL_LUMINANCE4_ALPHA4;
  2671. end;
  2672. constructor TfdLuminance6Alpha2.Create;
  2673. begin
  2674. inherited Create;
  2675. fFormat := tfLuminance6Alpha2;
  2676. fWithAlpha := tfLuminance6Alpha2;
  2677. fWithoutAlpha := tfLuminance8;
  2678. fglInternalFormat := GL_LUMINANCE6_ALPHA2;
  2679. end;
  2680. constructor TfdLuminance8Alpha8.Create;
  2681. begin
  2682. inherited Create;
  2683. fFormat := tfLuminance8Alpha8;
  2684. fWithAlpha := tfLuminance8Alpha8;
  2685. fWithoutAlpha := tfLuminance8;
  2686. fglInternalFormat := GL_LUMINANCE8_ALPHA8;
  2687. end;
  2688. constructor TfdLuminance12Alpha4.Create;
  2689. begin
  2690. inherited Create;
  2691. fFormat := tfLuminance12Alpha4;
  2692. fWithAlpha := tfLuminance12Alpha4;
  2693. fWithoutAlpha := tfLuminance12;
  2694. fglInternalFormat := GL_LUMINANCE12_ALPHA4;
  2695. end;
  2696. constructor TfdLuminance12Alpha12.Create;
  2697. begin
  2698. inherited Create;
  2699. fFormat := tfLuminance12Alpha12;
  2700. fWithAlpha := tfLuminance12Alpha12;
  2701. fWithoutAlpha := tfLuminance12;
  2702. fglInternalFormat := GL_LUMINANCE12_ALPHA12;
  2703. end;
  2704. constructor TfdLuminance16Alpha16.Create;
  2705. begin
  2706. inherited Create;
  2707. fFormat := tfLuminance16Alpha16;
  2708. fWithAlpha := tfLuminance16Alpha16;
  2709. fWithoutAlpha := tfLuminance16;
  2710. fglInternalFormat := GL_LUMINANCE16_ALPHA16;
  2711. end;
  2712. constructor TfdR3G3B2.Create;
  2713. begin
  2714. inherited Create;
  2715. fFormat := tfR3G3B2;
  2716. fWithAlpha := tfRGBA2;
  2717. fWithoutAlpha := tfR3G3B2;
  2718. fRange.r := $7;
  2719. fRange.g := $7;
  2720. fRange.b := $3;
  2721. fShift.r := 0;
  2722. fShift.g := 3;
  2723. fShift.b := 6;
  2724. fglFormat := GL_RGB;
  2725. fglInternalFormat := GL_R3_G3_B2;
  2726. fglDataFormat := GL_UNSIGNED_BYTE_2_3_3_REV;
  2727. end;
  2728. constructor TfdRGB4.Create;
  2729. begin
  2730. inherited Create;
  2731. fFormat := tfRGB4;
  2732. fWithAlpha := tfRGBA4;
  2733. fWithoutAlpha := tfRGB4;
  2734. fRGBInverted := tfBGR4;
  2735. fRange.r := $F;
  2736. fRange.g := $F;
  2737. fRange.b := $F;
  2738. fShift.r := 0;
  2739. fShift.g := 4;
  2740. fShift.b := 8;
  2741. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2742. fglInternalFormat := GL_RGB4;
  2743. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2744. end;
  2745. constructor TfdR5G6B5.Create;
  2746. begin
  2747. inherited Create;
  2748. fFormat := tfR5G6B5;
  2749. fWithAlpha := tfRGBA4;
  2750. fWithoutAlpha := tfR5G6B5;
  2751. fRGBInverted := tfB5G6R5;
  2752. fRange.r := $1F;
  2753. fRange.g := $3F;
  2754. fRange.b := $1F;
  2755. fShift.r := 0;
  2756. fShift.g := 5;
  2757. fShift.b := 11;
  2758. fglFormat := GL_RGB;
  2759. fglInternalFormat := GL_RGB565;
  2760. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5_REV;
  2761. end;
  2762. constructor TfdRGB5.Create;
  2763. begin
  2764. inherited Create;
  2765. fFormat := tfRGB5;
  2766. fWithAlpha := tfRGB5A1;
  2767. fWithoutAlpha := tfRGB5;
  2768. fRGBInverted := tfBGR5;
  2769. fRange.r := $1F;
  2770. fRange.g := $1F;
  2771. fRange.b := $1F;
  2772. fShift.r := 0;
  2773. fShift.g := 5;
  2774. fShift.b := 10;
  2775. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2776. fglInternalFormat := GL_RGB5;
  2777. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2778. end;
  2779. constructor TfdRGB8.Create;
  2780. begin
  2781. inherited Create;
  2782. fFormat := tfRGB8;
  2783. fWithAlpha := tfRGBA8;
  2784. fWithoutAlpha := tfRGB8;
  2785. fRGBInverted := tfBGR8;
  2786. fglInternalFormat := GL_RGB8;
  2787. end;
  2788. constructor TfdRGB10.Create;
  2789. begin
  2790. inherited Create;
  2791. fFormat := tfRGB10;
  2792. fWithAlpha := tfRGB10A2;
  2793. fWithoutAlpha := tfRGB10;
  2794. fRGBInverted := tfBGR10;
  2795. fRange.r := $3FF;
  2796. fRange.g := $3FF;
  2797. fRange.b := $3FF;
  2798. fShift.r := 0;
  2799. fShift.g := 10;
  2800. fShift.b := 20;
  2801. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2802. fglInternalFormat := GL_RGB10;
  2803. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2804. end;
  2805. constructor TfdRGB12.Create;
  2806. begin
  2807. inherited Create;
  2808. fFormat := tfRGB12;
  2809. fWithAlpha := tfRGBA12;
  2810. fWithoutAlpha := tfRGB12;
  2811. fRGBInverted := tfBGR12;
  2812. fglInternalFormat := GL_RGB12;
  2813. end;
  2814. constructor TfdRGB16.Create;
  2815. begin
  2816. inherited Create;
  2817. fFormat := tfRGB16;
  2818. fWithAlpha := tfRGBA16;
  2819. fWithoutAlpha := tfRGB16;
  2820. fRGBInverted := tfBGR16;
  2821. fglInternalFormat := GL_RGB16;
  2822. end;
  2823. constructor TfdRGBA2.Create;
  2824. begin
  2825. inherited Create;
  2826. fFormat := tfRGBA2;
  2827. fWithAlpha := tfRGBA2;
  2828. fWithoutAlpha := tfR3G3B2;
  2829. fRGBInverted := tfBGRA2;
  2830. fglInternalFormat := GL_RGBA2;
  2831. end;
  2832. constructor TfdRGBA4.Create;
  2833. begin
  2834. inherited Create;
  2835. fFormat := tfRGBA4;
  2836. fWithAlpha := tfRGBA4;
  2837. fWithoutAlpha := tfRGB4;
  2838. fRGBInverted := tfBGRA4;
  2839. fRange.r := $F;
  2840. fRange.g := $F;
  2841. fRange.b := $F;
  2842. fRange.a := $F;
  2843. fShift.r := 0;
  2844. fShift.g := 4;
  2845. fShift.b := 8;
  2846. fShift.a := 12;
  2847. fglFormat := GL_RGBA;
  2848. fglInternalFormat := GL_RGBA4;
  2849. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2850. end;
  2851. constructor TfdRGB5A1.Create;
  2852. begin
  2853. inherited Create;
  2854. fFormat := tfRGB5A1;
  2855. fWithAlpha := tfRGB5A1;
  2856. fWithoutAlpha := tfRGB5;
  2857. fRGBInverted := tfBGR5A1;
  2858. fRange.r := $1F;
  2859. fRange.g := $1F;
  2860. fRange.b := $1F;
  2861. fRange.a := $01;
  2862. fShift.r := 0;
  2863. fShift.g := 5;
  2864. fShift.b := 10;
  2865. fShift.a := 15;
  2866. fglFormat := GL_RGBA;
  2867. fglInternalFormat := GL_RGB5_A1;
  2868. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2869. end;
  2870. constructor TfdRGBA8.Create;
  2871. begin
  2872. inherited Create;
  2873. fFormat := tfRGBA8;
  2874. fWithAlpha := tfRGBA8;
  2875. fWithoutAlpha := tfRGB8;
  2876. fRGBInverted := tfBGRA8;
  2877. fglInternalFormat := GL_RGBA8;
  2878. end;
  2879. constructor TfdRGB10A2.Create;
  2880. begin
  2881. inherited Create;
  2882. fFormat := tfRGB10A2;
  2883. fWithAlpha := tfRGB10A2;
  2884. fWithoutAlpha := tfRGB10;
  2885. fRGBInverted := tfBGR10A2;
  2886. fRange.r := $3FF;
  2887. fRange.g := $3FF;
  2888. fRange.b := $3FF;
  2889. fRange.a := $003;
  2890. fShift.r := 0;
  2891. fShift.g := 10;
  2892. fShift.b := 20;
  2893. fShift.a := 30;
  2894. fglFormat := GL_RGBA;
  2895. fglInternalFormat := GL_RGB10_A2;
  2896. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2897. end;
  2898. constructor TfdRGBA12.Create;
  2899. begin
  2900. inherited Create;
  2901. fFormat := tfRGBA12;
  2902. fWithAlpha := tfRGBA12;
  2903. fWithoutAlpha := tfRGB12;
  2904. fRGBInverted := tfBGRA12;
  2905. fglInternalFormat := GL_RGBA12;
  2906. end;
  2907. constructor TfdRGBA16.Create;
  2908. begin
  2909. inherited Create;
  2910. fFormat := tfRGBA16;
  2911. fWithAlpha := tfRGBA16;
  2912. fWithoutAlpha := tfRGB16;
  2913. fRGBInverted := tfBGRA16;
  2914. fglInternalFormat := GL_RGBA16;
  2915. end;
  2916. constructor TfdBGR4.Create;
  2917. begin
  2918. inherited Create;
  2919. fPixelSize := 2.0;
  2920. fFormat := tfBGR4;
  2921. fWithAlpha := tfBGRA4;
  2922. fWithoutAlpha := tfBGR4;
  2923. fRGBInverted := tfRGB4;
  2924. fRange.r := $F;
  2925. fRange.g := $F;
  2926. fRange.b := $F;
  2927. fRange.a := $0;
  2928. fShift.r := 8;
  2929. fShift.g := 4;
  2930. fShift.b := 0;
  2931. fShift.a := 0;
  2932. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2933. fglInternalFormat := GL_RGB4;
  2934. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2935. end;
  2936. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2937. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2938. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2939. constructor TfdB5G6R5.Create;
  2940. begin
  2941. inherited Create;
  2942. fFormat := tfB5G6R5;
  2943. fWithAlpha := tfBGRA4;
  2944. fWithoutAlpha := tfB5G6R5;
  2945. fRGBInverted := tfR5G6B5;
  2946. fRange.r := $1F;
  2947. fRange.g := $3F;
  2948. fRange.b := $1F;
  2949. fShift.r := 11;
  2950. fShift.g := 5;
  2951. fShift.b := 0;
  2952. fglFormat := GL_RGB; //B5G6R5 is only possible as R5G6B5 -> use reverted dataformat
  2953. fglInternalFormat := GL_RGB8;
  2954. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5;
  2955. end;
  2956. constructor TfdBGR5.Create;
  2957. begin
  2958. inherited Create;
  2959. fPixelSize := 2.0;
  2960. fFormat := tfBGR5;
  2961. fWithAlpha := tfBGR5A1;
  2962. fWithoutAlpha := tfBGR5;
  2963. fRGBInverted := tfRGB5;
  2964. fRange.r := $1F;
  2965. fRange.g := $1F;
  2966. fRange.b := $1F;
  2967. fRange.a := $00;
  2968. fShift.r := 10;
  2969. fShift.g := 5;
  2970. fShift.b := 0;
  2971. fShift.a := 0;
  2972. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2973. fglInternalFormat := GL_RGB5;
  2974. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2975. end;
  2976. constructor TfdBGR8.Create;
  2977. begin
  2978. inherited Create;
  2979. fFormat := tfBGR8;
  2980. fWithAlpha := tfBGRA8;
  2981. fWithoutAlpha := tfBGR8;
  2982. fRGBInverted := tfRGB8;
  2983. fglInternalFormat := GL_RGB8;
  2984. end;
  2985. constructor TfdBGR10.Create;
  2986. begin
  2987. inherited Create;
  2988. fFormat := tfBGR10;
  2989. fWithAlpha := tfBGR10A2;
  2990. fWithoutAlpha := tfBGR10;
  2991. fRGBInverted := tfRGB10;
  2992. fRange.r := $3FF;
  2993. fRange.g := $3FF;
  2994. fRange.b := $3FF;
  2995. fRange.a := $000;
  2996. fShift.r := 20;
  2997. fShift.g := 10;
  2998. fShift.b := 0;
  2999. fShift.a := 0;
  3000. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  3001. fglInternalFormat := GL_RGB10;
  3002. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3003. end;
  3004. constructor TfdBGR12.Create;
  3005. begin
  3006. inherited Create;
  3007. fFormat := tfBGR12;
  3008. fWithAlpha := tfBGRA12;
  3009. fWithoutAlpha := tfBGR12;
  3010. fRGBInverted := tfRGB12;
  3011. fglInternalFormat := GL_RGB12;
  3012. end;
  3013. constructor TfdBGR16.Create;
  3014. begin
  3015. inherited Create;
  3016. fFormat := tfBGR16;
  3017. fWithAlpha := tfBGRA16;
  3018. fWithoutAlpha := tfBGR16;
  3019. fRGBInverted := tfRGB16;
  3020. fglInternalFormat := GL_RGB16;
  3021. end;
  3022. constructor TfdBGRA2.Create;
  3023. begin
  3024. inherited Create;
  3025. fFormat := tfBGRA2;
  3026. fWithAlpha := tfBGRA4;
  3027. fWithoutAlpha := tfBGR4;
  3028. fRGBInverted := tfRGBA2;
  3029. fglInternalFormat := GL_RGBA2;
  3030. end;
  3031. constructor TfdBGRA4.Create;
  3032. begin
  3033. inherited Create;
  3034. fFormat := tfBGRA4;
  3035. fWithAlpha := tfBGRA4;
  3036. fWithoutAlpha := tfBGR4;
  3037. fRGBInverted := tfRGBA4;
  3038. fRange.r := $F;
  3039. fRange.g := $F;
  3040. fRange.b := $F;
  3041. fRange.a := $F;
  3042. fShift.r := 8;
  3043. fShift.g := 4;
  3044. fShift.b := 0;
  3045. fShift.a := 12;
  3046. fglFormat := GL_BGRA;
  3047. fglInternalFormat := GL_RGBA4;
  3048. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  3049. end;
  3050. constructor TfdBGR5A1.Create;
  3051. begin
  3052. inherited Create;
  3053. fFormat := tfBGR5A1;
  3054. fWithAlpha := tfBGR5A1;
  3055. fWithoutAlpha := tfBGR5;
  3056. fRGBInverted := tfRGB5A1;
  3057. fRange.r := $1F;
  3058. fRange.g := $1F;
  3059. fRange.b := $1F;
  3060. fRange.a := $01;
  3061. fShift.r := 10;
  3062. fShift.g := 5;
  3063. fShift.b := 0;
  3064. fShift.a := 15;
  3065. fglFormat := GL_BGRA;
  3066. fglInternalFormat := GL_RGB5_A1;
  3067. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  3068. end;
  3069. constructor TfdBGRA8.Create;
  3070. begin
  3071. inherited Create;
  3072. fFormat := tfBGRA8;
  3073. fWithAlpha := tfBGRA8;
  3074. fWithoutAlpha := tfBGR8;
  3075. fRGBInverted := tfRGBA8;
  3076. fglInternalFormat := GL_RGBA8;
  3077. end;
  3078. constructor TfdBGR10A2.Create;
  3079. begin
  3080. inherited Create;
  3081. fFormat := tfBGR10A2;
  3082. fWithAlpha := tfBGR10A2;
  3083. fWithoutAlpha := tfBGR10;
  3084. fRGBInverted := tfRGB10A2;
  3085. fRange.r := $3FF;
  3086. fRange.g := $3FF;
  3087. fRange.b := $3FF;
  3088. fRange.a := $003;
  3089. fShift.r := 20;
  3090. fShift.g := 10;
  3091. fShift.b := 0;
  3092. fShift.a := 30;
  3093. fglFormat := GL_BGRA;
  3094. fglInternalFormat := GL_RGB10_A2;
  3095. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3096. end;
  3097. constructor TfdBGRA12.Create;
  3098. begin
  3099. inherited Create;
  3100. fFormat := tfBGRA12;
  3101. fWithAlpha := tfBGRA12;
  3102. fWithoutAlpha := tfBGR12;
  3103. fRGBInverted := tfRGBA12;
  3104. fglInternalFormat := GL_RGBA12;
  3105. end;
  3106. constructor TfdBGRA16.Create;
  3107. begin
  3108. inherited Create;
  3109. fFormat := tfBGRA16;
  3110. fWithAlpha := tfBGRA16;
  3111. fWithoutAlpha := tfBGR16;
  3112. fRGBInverted := tfRGBA16;
  3113. fglInternalFormat := GL_RGBA16;
  3114. end;
  3115. constructor TfdDepth16.Create;
  3116. begin
  3117. inherited Create;
  3118. fFormat := tfDepth16;
  3119. fWithAlpha := tfEmpty;
  3120. fWithoutAlpha := tfDepth16;
  3121. fglInternalFormat := GL_DEPTH_COMPONENT16;
  3122. end;
  3123. constructor TfdDepth24.Create;
  3124. begin
  3125. inherited Create;
  3126. fFormat := tfDepth24;
  3127. fWithAlpha := tfEmpty;
  3128. fWithoutAlpha := tfDepth24;
  3129. fglInternalFormat := GL_DEPTH_COMPONENT24;
  3130. end;
  3131. constructor TfdDepth32.Create;
  3132. begin
  3133. inherited Create;
  3134. fFormat := tfDepth32;
  3135. fWithAlpha := tfEmpty;
  3136. fWithoutAlpha := tfDepth32;
  3137. fglInternalFormat := GL_DEPTH_COMPONENT32;
  3138. end;
  3139. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3140. //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3141. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3142. procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3143. begin
  3144. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  3145. end;
  3146. procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3147. begin
  3148. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  3149. end;
  3150. constructor TfdS3tcDtx1RGBA.Create;
  3151. begin
  3152. inherited Create;
  3153. fFormat := tfS3tcDtx1RGBA;
  3154. fWithAlpha := tfS3tcDtx1RGBA;
  3155. fUncompressed := tfRGB5A1;
  3156. fPixelSize := 0.5;
  3157. fIsCompressed := true;
  3158. fglFormat := GL_COMPRESSED_RGBA;
  3159. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
  3160. fglDataFormat := GL_UNSIGNED_BYTE;
  3161. end;
  3162. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3163. //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3164. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3165. procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3166. begin
  3167. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  3168. end;
  3169. procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3170. begin
  3171. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  3172. end;
  3173. constructor TfdS3tcDtx3RGBA.Create;
  3174. begin
  3175. inherited Create;
  3176. fFormat := tfS3tcDtx3RGBA;
  3177. fWithAlpha := tfS3tcDtx3RGBA;
  3178. fUncompressed := tfRGBA8;
  3179. fPixelSize := 1.0;
  3180. fIsCompressed := true;
  3181. fglFormat := GL_COMPRESSED_RGBA;
  3182. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
  3183. fglDataFormat := GL_UNSIGNED_BYTE;
  3184. end;
  3185. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3186. //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3187. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3188. procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3189. begin
  3190. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  3191. end;
  3192. procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3193. begin
  3194. raise EglBitmapException.Create('mapping for compressed formats is not supported');
  3195. end;
  3196. constructor TfdS3tcDtx5RGBA.Create;
  3197. begin
  3198. inherited Create;
  3199. fFormat := tfS3tcDtx3RGBA;
  3200. fWithAlpha := tfS3tcDtx3RGBA;
  3201. fUncompressed := tfRGBA8;
  3202. fPixelSize := 1.0;
  3203. fIsCompressed := true;
  3204. fglFormat := GL_COMPRESSED_RGBA;
  3205. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
  3206. fglDataFormat := GL_UNSIGNED_BYTE;
  3207. end;
  3208. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3209. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3210. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3211. class procedure TFormatDescriptor.Init;
  3212. begin
  3213. if not Assigned(FormatDescriptorCS) then
  3214. FormatDescriptorCS := TCriticalSection.Create;
  3215. end;
  3216. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3217. class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3218. begin
  3219. FormatDescriptorCS.Enter;
  3220. try
  3221. result := FormatDescriptors[aFormat];
  3222. if not Assigned(result) then begin
  3223. result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
  3224. FormatDescriptors[aFormat] := result;
  3225. end;
  3226. finally
  3227. FormatDescriptorCS.Leave;
  3228. end;
  3229. end;
  3230. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3231. class function TFormatDescriptor.GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3232. begin
  3233. result := Get(Get(aFormat).WithAlpha);
  3234. end;
  3235. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3236. class procedure TFormatDescriptor.Clear;
  3237. var
  3238. f: TglBitmapFormat;
  3239. begin
  3240. FormatDescriptorCS.Enter;
  3241. try
  3242. for f := low(FormatDescriptors) to high(FormatDescriptors) do
  3243. FreeAndNil(FormatDescriptors[f]);
  3244. finally
  3245. FormatDescriptorCS.Leave;
  3246. end;
  3247. end;
  3248. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3249. class procedure TFormatDescriptor.Finalize;
  3250. begin
  3251. Clear;
  3252. FreeAndNil(FormatDescriptorCS);
  3253. end;
  3254. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3255. //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3256. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3257. procedure TbmpBitfieldFormat.SetRedMask(const aValue: QWord);
  3258. begin
  3259. Update(aValue, fRange.r, fShift.r);
  3260. end;
  3261. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3262. procedure TbmpBitfieldFormat.SetGreenMask(const aValue: QWord);
  3263. begin
  3264. Update(aValue, fRange.g, fShift.g);
  3265. end;
  3266. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3267. procedure TbmpBitfieldFormat.SetBlueMask(const aValue: QWord);
  3268. begin
  3269. Update(aValue, fRange.b, fShift.b);
  3270. end;
  3271. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3272. procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: QWord);
  3273. begin
  3274. Update(aValue, fRange.a, fShift.a);
  3275. end;
  3276. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3277. procedure TbmpBitfieldFormat.Update(aMask: QWord; out aRange: Cardinal; out
  3278. aShift: Byte);
  3279. begin
  3280. aShift := 0;
  3281. aRange := 0;
  3282. if (aMask = 0) then
  3283. exit;
  3284. while (aMask > 0) and ((aMask and 1) = 0) do begin
  3285. inc(aShift);
  3286. aMask := aMask shr 1;
  3287. end;
  3288. aRange := 1;
  3289. while (aMask > 0) do begin
  3290. aRange := aRange shl 1;
  3291. aMask := aMask shr 1;
  3292. end;
  3293. dec(aRange);
  3294. fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);
  3295. end;
  3296. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3297. procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3298. var
  3299. data: QWord;
  3300. s: Integer;
  3301. begin
  3302. data :=
  3303. ((aPixel.Data.r and fRange.r) shl fShift.r) or
  3304. ((aPixel.Data.g and fRange.g) shl fShift.g) or
  3305. ((aPixel.Data.b and fRange.b) shl fShift.b) or
  3306. ((aPixel.Data.a and fRange.a) shl fShift.a);
  3307. s := Round(fPixelSize);
  3308. case s of
  3309. 1: aData^ := data;
  3310. 2: PWord(aData)^ := data;
  3311. 4: PCardinal(aData)^ := data;
  3312. 8: PQWord(aData)^ := data;
  3313. else
  3314. raise EglBitmapException.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
  3315. end;
  3316. inc(aData, s);
  3317. end;
  3318. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3319. procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3320. var
  3321. data: QWord;
  3322. s, i: Integer;
  3323. begin
  3324. s := Round(fPixelSize);
  3325. case s of
  3326. 1: data := aData^;
  3327. 2: data := PWord(aData)^;
  3328. 4: data := PCardinal(aData)^;
  3329. 8: data := PQWord(aData)^;
  3330. else
  3331. raise EglBitmapException.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);
  3332. end;
  3333. for i := 0 to 3 do
  3334. aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];
  3335. inc(aData, s);
  3336. end;
  3337. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3338. //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3339. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3340. procedure TbmpColorTableFormat.CreateColorTable;
  3341. var
  3342. i: Integer;
  3343. begin
  3344. if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
  3345. raise EglBitmapException.Create(UNSUPPORTED_FORMAT);
  3346. if (Format = tfLuminance4) then
  3347. SetLength(fColorTable, 16)
  3348. else
  3349. SetLength(fColorTable, 256);
  3350. case Format of
  3351. tfLuminance4: begin
  3352. for i := 0 to High(fColorTable) do begin
  3353. fColorTable[i].r := 16 * i;
  3354. fColorTable[i].g := 16 * i;
  3355. fColorTable[i].b := 16 * i;
  3356. fColorTable[i].a := 0;
  3357. end;
  3358. end;
  3359. tfLuminance8: begin
  3360. for i := 0 to High(fColorTable) do begin
  3361. fColorTable[i].r := i;
  3362. fColorTable[i].g := i;
  3363. fColorTable[i].b := i;
  3364. fColorTable[i].a := 0;
  3365. end;
  3366. end;
  3367. tfR3G3B2: begin
  3368. for i := 0 to High(fColorTable) do begin
  3369. fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
  3370. fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
  3371. fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
  3372. fColorTable[i].a := 0;
  3373. end;
  3374. end;
  3375. end;
  3376. end;
  3377. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3378. procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3379. var
  3380. d: Byte;
  3381. begin
  3382. if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
  3383. raise EglBitmapException.Create(UNSUPPORTED_FORMAT);
  3384. case Format of
  3385. tfLuminance4: begin
  3386. if (aMapData = nil) then
  3387. aData^ := 0;
  3388. d := LuminanceWeight(aPixel) and Range.r;
  3389. aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData)));
  3390. inc(aMapData, 4);
  3391. if ({%H-}PtrUInt(aMapData) >= 8) then begin
  3392. inc(aData);
  3393. aMapData := nil;
  3394. end;
  3395. end;
  3396. tfLuminance8: begin
  3397. aData^ := LuminanceWeight(aPixel) and Range.r;
  3398. inc(aData);
  3399. end;
  3400. tfR3G3B2: begin
  3401. aData^ := Round(
  3402. ((aPixel.Data.r and Range.r) shl Shift.r) or
  3403. ((aPixel.Data.g and Range.g) shl Shift.g) or
  3404. ((aPixel.Data.b and Range.b) shl Shift.b));
  3405. inc(aData);
  3406. end;
  3407. end;
  3408. end;
  3409. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3410. procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3411. var
  3412. idx: QWord;
  3413. s: Integer;
  3414. bits: Byte;
  3415. f: Single;
  3416. begin
  3417. s := Trunc(fPixelSize);
  3418. f := fPixelSize - s;
  3419. bits := Round(8 * f);
  3420. case s of
  3421. 0: idx := (aData^ shr (8 - bits - {%H-}PtrUInt(aMapData))) and ((1 shl bits) - 1);
  3422. 1: idx := aData^;
  3423. 2: idx := PWord(aData)^;
  3424. 4: idx := PCardinal(aData)^;
  3425. 8: idx := PQWord(aData)^;
  3426. else
  3427. raise EglBitmapException.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);
  3428. end;
  3429. if (idx >= Length(fColorTable)) then
  3430. raise EglBitmapException.CreateFmt('invalid color index: %d', [idx]);
  3431. with fColorTable[idx] do begin
  3432. aPixel.Data.r := r;
  3433. aPixel.Data.g := g;
  3434. aPixel.Data.b := b;
  3435. aPixel.Data.a := a;
  3436. end;
  3437. inc(aMapData, bits);
  3438. if ({%H-}PtrUInt(aMapData) >= 8) then begin
  3439. inc(aData, 1);
  3440. dec(aMapData, 8);
  3441. end;
  3442. inc(aData, s);
  3443. end;
  3444. destructor TbmpColorTableFormat.Destroy;
  3445. begin
  3446. SetLength(fColorTable, 0);
  3447. inherited Destroy;
  3448. end;
  3449. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3450. //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3451. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3452. procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
  3453. var
  3454. i: Integer;
  3455. begin
  3456. for i := 0 to 3 do begin
  3457. if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
  3458. if (aSourceFD.Range.arr[i] > 0) then
  3459. aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
  3460. else
  3461. aPixel.Data.arr[i] := aDestFD.Range.arr[i];
  3462. end;
  3463. end;
  3464. end;
  3465. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3466. procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
  3467. begin
  3468. with aFuncRec do begin
  3469. if (Source.Range.r > 0) then
  3470. Dest.Data.r := Source.Data.r;
  3471. if (Source.Range.g > 0) then
  3472. Dest.Data.g := Source.Data.g;
  3473. if (Source.Range.b > 0) then
  3474. Dest.Data.b := Source.Data.b;
  3475. if (Source.Range.a > 0) then
  3476. Dest.Data.a := Source.Data.a;
  3477. end;
  3478. end;
  3479. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3480. procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3481. var
  3482. i: Integer;
  3483. begin
  3484. with aFuncRec do begin
  3485. for i := 0 to 3 do
  3486. if (Source.Range.arr[i] > 0) then
  3487. Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
  3488. end;
  3489. end;
  3490. type
  3491. TShiftData = packed record
  3492. case Integer of
  3493. 0: (r, g, b, a: SmallInt);
  3494. 1: (arr: array[0..3] of SmallInt);
  3495. end;
  3496. PShiftData = ^TShiftData;
  3497. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3498. procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3499. var
  3500. i: Integer;
  3501. begin
  3502. with aFuncRec do
  3503. for i := 0 to 3 do
  3504. if (Source.Range.arr[i] > 0) then
  3505. Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
  3506. end;
  3507. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3508. procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
  3509. begin
  3510. with aFuncRec do begin
  3511. Dest.Data := Source.Data;
  3512. if ({%H-}PtrUInt(Args) and $1 > 0) then begin
  3513. Dest.Data.r := Dest.Data.r xor Dest.Range.r;
  3514. Dest.Data.g := Dest.Data.g xor Dest.Range.g;
  3515. Dest.Data.b := Dest.Data.b xor Dest.Range.b;
  3516. end;
  3517. if ({%H-}PtrUInt(Args) and $2 > 0) then begin
  3518. Dest.Data.a := Dest.Data.a xor Dest.Range.a;
  3519. end;
  3520. end;
  3521. end;
  3522. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3523. procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
  3524. var
  3525. i: Integer;
  3526. begin
  3527. with aFuncRec do begin
  3528. for i := 0 to 3 do
  3529. Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
  3530. end;
  3531. end;
  3532. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3533. procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3534. var
  3535. Temp: Single;
  3536. begin
  3537. with FuncRec do begin
  3538. if (FuncRec.Args = nil) then begin //source has no alpha
  3539. Temp :=
  3540. Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
  3541. Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
  3542. Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
  3543. Dest.Data.a := Round(Dest.Range.a * Temp);
  3544. end else
  3545. Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
  3546. end;
  3547. end;
  3548. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3549. procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3550. type
  3551. PglBitmapPixelData = ^TglBitmapPixelData;
  3552. begin
  3553. with FuncRec do begin
  3554. Dest.Data.r := Source.Data.r;
  3555. Dest.Data.g := Source.Data.g;
  3556. Dest.Data.b := Source.Data.b;
  3557. with PglBitmapPixelData(Args)^ do
  3558. if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
  3559. (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
  3560. (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
  3561. Dest.Data.a := 0
  3562. else
  3563. Dest.Data.a := Dest.Range.a;
  3564. end;
  3565. end;
  3566. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3567. procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3568. begin
  3569. with FuncRec do begin
  3570. Dest.Data.r := Source.Data.r;
  3571. Dest.Data.g := Source.Data.g;
  3572. Dest.Data.b := Source.Data.b;
  3573. Dest.Data.a := PCardinal(Args)^;
  3574. end;
  3575. end;
  3576. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3577. procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
  3578. type
  3579. PRGBPix = ^TRGBPix;
  3580. TRGBPix = array [0..2] of byte;
  3581. var
  3582. Temp: Byte;
  3583. begin
  3584. while aWidth > 0 do begin
  3585. Temp := PRGBPix(aData)^[0];
  3586. PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
  3587. PRGBPix(aData)^[2] := Temp;
  3588. if aHasAlpha then
  3589. Inc(aData, 4)
  3590. else
  3591. Inc(aData, 3);
  3592. dec(aWidth);
  3593. end;
  3594. end;
  3595. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3596. //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3597. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3598. function TglBitmap.GetWidth: Integer;
  3599. begin
  3600. if (ffX in fDimension.Fields) then
  3601. result := fDimension.X
  3602. else
  3603. result := -1;
  3604. end;
  3605. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3606. function TglBitmap.GetHeight: Integer;
  3607. begin
  3608. if (ffY in fDimension.Fields) then
  3609. result := fDimension.Y
  3610. else
  3611. result := -1;
  3612. end;
  3613. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3614. function TglBitmap.GetFileWidth: Integer;
  3615. begin
  3616. result := Max(1, Width);
  3617. end;
  3618. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3619. function TglBitmap.GetFileHeight: Integer;
  3620. begin
  3621. result := Max(1, Height);
  3622. end;
  3623. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3624. procedure TglBitmap.SetCustomData(const aValue: Pointer);
  3625. begin
  3626. if fCustomData = aValue then
  3627. exit;
  3628. fCustomData := aValue;
  3629. end;
  3630. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3631. procedure TglBitmap.SetCustomName(const aValue: String);
  3632. begin
  3633. if fCustomName = aValue then
  3634. exit;
  3635. fCustomName := aValue;
  3636. end;
  3637. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3638. procedure TglBitmap.SetCustomNameW(const aValue: WideString);
  3639. begin
  3640. if fCustomNameW = aValue then
  3641. exit;
  3642. fCustomNameW := aValue;
  3643. end;
  3644. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3645. procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
  3646. begin
  3647. if fDeleteTextureOnFree = aValue then
  3648. exit;
  3649. fDeleteTextureOnFree := aValue;
  3650. end;
  3651. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3652. procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
  3653. begin
  3654. if fFormat = aValue then
  3655. exit;
  3656. if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then
  3657. raise EglBitmapUnsupportedFormat.Create(Format);
  3658. SetDataPointer(Data, aValue, Width, Height);
  3659. end;
  3660. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3661. procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
  3662. begin
  3663. if fFreeDataAfterGenTexture = aValue then
  3664. exit;
  3665. fFreeDataAfterGenTexture := aValue;
  3666. end;
  3667. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3668. procedure TglBitmap.SetID(const aValue: Cardinal);
  3669. begin
  3670. if fID = aValue then
  3671. exit;
  3672. fID := aValue;
  3673. end;
  3674. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3675. procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
  3676. begin
  3677. if fMipMap = aValue then
  3678. exit;
  3679. fMipMap := aValue;
  3680. end;
  3681. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3682. procedure TglBitmap.SetTarget(const aValue: Cardinal);
  3683. begin
  3684. if fTarget = aValue then
  3685. exit;
  3686. fTarget := aValue;
  3687. end;
  3688. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3689. procedure TglBitmap.SetAnisotropic(const aValue: Integer);
  3690. var
  3691. MaxAnisotropic: Integer;
  3692. begin
  3693. fAnisotropic := aValue;
  3694. if (ID > 0) then begin
  3695. if GL_EXT_texture_filter_anisotropic then begin
  3696. if fAnisotropic > 0 then begin
  3697. Bind(false);
  3698. glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
  3699. if aValue > MaxAnisotropic then
  3700. fAnisotropic := MaxAnisotropic;
  3701. glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
  3702. end;
  3703. end else begin
  3704. fAnisotropic := 0;
  3705. end;
  3706. end;
  3707. end;
  3708. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3709. procedure TglBitmap.CreateID;
  3710. begin
  3711. if (ID <> 0) then
  3712. glDeleteTextures(1, @fID);
  3713. glGenTextures(1, @fID);
  3714. Bind(false);
  3715. end;
  3716. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3717. procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);
  3718. begin
  3719. // Set Up Parameters
  3720. SetWrap(fWrapS, fWrapT, fWrapR);
  3721. SetFilter(fFilterMin, fFilterMag);
  3722. SetAnisotropic(fAnisotropic);
  3723. SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
  3724. // Mip Maps Generation Mode
  3725. aBuildWithGlu := false;
  3726. if (MipMap = mmMipmap) then begin
  3727. if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
  3728. glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
  3729. else
  3730. aBuildWithGlu := true;
  3731. end else if (MipMap = mmMipmapGlu) then
  3732. aBuildWithGlu := true;
  3733. end;
  3734. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3735. procedure TglBitmap.SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
  3736. const aWidth: Integer; const aHeight: Integer);
  3737. var
  3738. s: Single;
  3739. begin
  3740. if (Data <> aData) then begin
  3741. if (Assigned(Data)) then
  3742. FreeMem(Data);
  3743. fData := aData;
  3744. end;
  3745. FillChar(fDimension, SizeOf(fDimension), 0);
  3746. if not Assigned(fData) then begin
  3747. fFormat := tfEmpty;
  3748. fPixelSize := 0;
  3749. fRowSize := 0;
  3750. end else begin
  3751. if aWidth <> -1 then begin
  3752. fDimension.Fields := fDimension.Fields + [ffX];
  3753. fDimension.X := aWidth;
  3754. end;
  3755. if aHeight <> -1 then begin
  3756. fDimension.Fields := fDimension.Fields + [ffY];
  3757. fDimension.Y := aHeight;
  3758. end;
  3759. s := TFormatDescriptor.Get(aFormat).PixelSize;
  3760. fFormat := aFormat;
  3761. fPixelSize := Ceil(s);
  3762. fRowSize := Ceil(s * aWidth);
  3763. end;
  3764. end;
  3765. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3766. function TglBitmap.FlipHorz: Boolean;
  3767. begin
  3768. result := false;
  3769. end;
  3770. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3771. function TglBitmap.FlipVert: Boolean;
  3772. begin
  3773. result := false;
  3774. end;
  3775. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3776. //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3777. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3778. procedure TglBitmap.AfterConstruction;
  3779. begin
  3780. inherited AfterConstruction;
  3781. fID := 0;
  3782. fTarget := 0;
  3783. fIsResident := false;
  3784. fFormat := glBitmapGetDefaultFormat;
  3785. fMipMap := glBitmapDefaultMipmap;
  3786. fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
  3787. fDeleteTextureOnFree := glBitmapGetDefaultDeleteTextureOnFree;
  3788. glBitmapGetDefaultFilter (fFilterMin, fFilterMag);
  3789. glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
  3790. end;
  3791. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3792. procedure TglBitmap.BeforeDestruction;
  3793. begin
  3794. SetDataPointer(nil, tfEmpty);
  3795. if (fID > 0) and fDeleteTextureOnFree then
  3796. glDeleteTextures(1, @fID);
  3797. inherited BeforeDestruction;
  3798. end;
  3799. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3800. procedure TglBitmap.LoadFromFile(const aFilename: String);
  3801. var
  3802. fs: TFileStream;
  3803. begin
  3804. if not FileExists(aFilename) then
  3805. raise EglBitmapException.Create('file does not exist: ' + aFilename);
  3806. fFilename := aFilename;
  3807. fs := TFileStream.Create(fFilename, fmOpenRead);
  3808. try
  3809. fs.Position := 0;
  3810. LoadFromStream(fs);
  3811. finally
  3812. fs.Free;
  3813. end;
  3814. end;
  3815. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3816. procedure TglBitmap.LoadFromStream(const aStream: TStream);
  3817. begin
  3818. {$IFDEF GLB_SUPPORT_PNG_READ}
  3819. if not LoadPNG(aStream) then
  3820. {$ENDIF}
  3821. {$IFDEF GLB_SUPPORT_JPEG_READ}
  3822. if not LoadJPEG(aStream) then
  3823. {$ENDIF}
  3824. if not LoadDDS(aStream) then
  3825. if not LoadTGA(aStream) then
  3826. if not LoadBMP(aStream) then
  3827. raise EglBitmapException.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
  3828. end;
  3829. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3830. procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  3831. const aFormat: TglBitmapFormat; const aArgs: Pointer);
  3832. var
  3833. tmpData: PByte;
  3834. size: Integer;
  3835. begin
  3836. size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  3837. GetMem(tmpData, size);
  3838. try
  3839. FillChar(tmpData^, size, #$FF);
  3840. SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y);
  3841. except
  3842. FreeMem(tmpData);
  3843. raise;
  3844. end;
  3845. AddFunc(Self, aFunc, false, Format, aArgs);
  3846. end;
  3847. {$IFDEF GLB_DELPHI}
  3848. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3849. procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil);
  3850. var
  3851. rs: TResourceStream;
  3852. TempPos: Integer;
  3853. ResTypeStr: String;
  3854. TempResType: PChar;
  3855. begin
  3856. if not Assigned(ResType) then begin
  3857. TempPos := Pos('.', Resource);
  3858. ResTypeStr := UpperCase(Copy(Resource, TempPos + 1, Length(Resource) - TempPos));
  3859. Resource := UpperCase(Copy(Resource, 0, TempPos -1));
  3860. TempResType := PChar(ResTypeStr);
  3861. end else
  3862. TempResType := ResType
  3863. rs := TResourceStream.Create(Instance, Resource, TempResType);
  3864. try
  3865. LoadFromStream(rs);
  3866. finally
  3867. rs.Free;
  3868. end;
  3869. end;
  3870. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3871. procedure TglBitmap.LoadFromResourceID(const sInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  3872. var
  3873. rs: TResourceStream;
  3874. begin
  3875. rs := TResourceStream.CreateFromID(Instance, ResourceID, ResType);
  3876. try
  3877. LoadFromStream(rs);
  3878. finally
  3879. rs.Free;
  3880. end;
  3881. end;
  3882. {$ENDIF}
  3883. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3884. procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  3885. var
  3886. fs: TFileStream;
  3887. begin
  3888. fs := TFileStream.Create(aFileName, fmCreate);
  3889. try
  3890. fs.Position := 0;
  3891. SaveToStream(fs, aFileType);
  3892. finally
  3893. fs.Free;
  3894. end;
  3895. end;
  3896. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3897. procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
  3898. begin
  3899. case aFileType of
  3900. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  3901. ftPNG: SavePNG(aStream);
  3902. {$ENDIF}
  3903. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  3904. ftJPEG: SaveJPEG(aStream);
  3905. {$ENDIF}
  3906. ftDDS: SaveDDS(aStream);
  3907. ftTGA: SaveTGA(aStream);
  3908. ftBMP: SaveBMP(aStream);
  3909. end;
  3910. end;
  3911. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3912. function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
  3913. begin
  3914. result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
  3915. end;
  3916. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3917. function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  3918. const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
  3919. var
  3920. DestData, TmpData, SourceData: pByte;
  3921. TempHeight, TempWidth: Integer;
  3922. SourceFD, DestFD: TFormatDescriptor;
  3923. SourceMD, DestMD: Pointer;
  3924. FuncRec: TglBitmapFunctionRec;
  3925. begin
  3926. Assert(Assigned(Data));
  3927. Assert(Assigned(aSource));
  3928. Assert(Assigned(aSource.Data));
  3929. result := false;
  3930. if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
  3931. SourceFD := TFormatDescriptor.Get(aSource.Format);
  3932. DestFD := TFormatDescriptor.Get(aFormat);
  3933. // inkompatible Formats so CreateTemp
  3934. if (SourceFD.PixelSize <> DestFD.PixelSize) then
  3935. aCreateTemp := true;
  3936. // Values
  3937. TempHeight := Max(1, aSource.Height);
  3938. TempWidth := Max(1, aSource.Width);
  3939. FuncRec.Sender := Self;
  3940. FuncRec.Args := aArgs;
  3941. TmpData := nil;
  3942. if aCreateTemp then begin
  3943. GetMem(TmpData, TFormatDescriptor.Get(aFormat).GetSize(TempWidth, TempHeight));
  3944. DestData := TmpData;
  3945. end else
  3946. DestData := Data;
  3947. try
  3948. SourceFD.PreparePixel(FuncRec.Source);
  3949. DestFD.PreparePixel (FuncRec.Dest);
  3950. SourceMD := SourceFD.CreateMappingData;
  3951. DestMD := DestFD.CreateMappingData;
  3952. FuncRec.Size := aSource.Dimension;
  3953. FuncRec.Position.Fields := FuncRec.Size.Fields;
  3954. try
  3955. SourceData := aSource.Data;
  3956. FuncRec.Position.Y := 0;
  3957. while FuncRec.Position.Y < TempHeight do begin
  3958. FuncRec.Position.X := 0;
  3959. while FuncRec.Position.X < TempWidth do begin
  3960. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  3961. aFunc(FuncRec);
  3962. DestFD.Map(FuncRec.Dest, DestData, DestMD);
  3963. inc(FuncRec.Position.X);
  3964. end;
  3965. inc(FuncRec.Position.Y);
  3966. end;
  3967. // Updating Image or InternalFormat
  3968. if aCreateTemp then
  3969. SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height)
  3970. else if (aFormat <> fFormat) then
  3971. Format := aFormat;
  3972. result := true;
  3973. finally
  3974. SourceFD.FreeMappingData(SourceMD);
  3975. DestFD.FreeMappingData(DestMD);
  3976. end;
  3977. except
  3978. if aCreateTemp then
  3979. FreeMem(TmpData);
  3980. raise;
  3981. end;
  3982. end;
  3983. end;
  3984. {$IFDEF GLB_SDL}
  3985. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3986. function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  3987. var
  3988. Row, RowSize: Integer;
  3989. SourceData, TmpData: PByte;
  3990. TempDepth: Integer;
  3991. FormatDesc: TFormatDescriptor;
  3992. function GetRowPointer(Row: Integer): pByte;
  3993. begin
  3994. result := aSurface.pixels;
  3995. Inc(result, Row * RowSize);
  3996. end;
  3997. begin
  3998. result := false;
  3999. FormatDesc := TFormatDescriptor.Get(Format);
  4000. if FormatDesc.IsCompressed then
  4001. raise EglBitmapUnsupportedFormat.Create(Format);
  4002. if Assigned(Data) then begin
  4003. case Trunc(FormatDesc.PixelSize) of
  4004. 1: TempDepth := 8;
  4005. 2: TempDepth := 16;
  4006. 3: TempDepth := 24;
  4007. 4: TempDepth := 32;
  4008. else
  4009. raise EglBitmapUnsupportedFormat.Create(Format);
  4010. end;
  4011. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
  4012. FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
  4013. SourceData := Data;
  4014. RowSize := FormatDesc.GetSize(FileWidth, 1);
  4015. for Row := 0 to FileHeight-1 do begin
  4016. TmpData := GetRowPointer(Row);
  4017. if Assigned(TmpData) then begin
  4018. Move(SourceData^, TmpData^, RowSize);
  4019. inc(SourceData, RowSize);
  4020. end;
  4021. end;
  4022. result := true;
  4023. end;
  4024. end;
  4025. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4026. function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  4027. var
  4028. pSource, pData, pTempData: PByte;
  4029. Row, RowSize, TempWidth, TempHeight: Integer;
  4030. IntFormat: TglBitmapFormat;
  4031. FormatDesc: TFormatDescriptor;
  4032. function GetRowPointer(Row: Integer): pByte;
  4033. begin
  4034. result := aSurface^.pixels;
  4035. Inc(result, Row * RowSize);
  4036. end;
  4037. begin
  4038. result := false;
  4039. if (Assigned(aSurface)) then begin
  4040. with aSurface^.format^ do begin
  4041. for IntFormat := High(TglBitmapFormat) to Low(TglBitmapFormat) do begin
  4042. FormatDesc := TFormatDescriptor.Get(IntFormat);
  4043. if (FormatDesc.MaskMatch(RMask, GMask, BMask, AMask)) then
  4044. break;
  4045. end;
  4046. if (IntFormat = tfEmpty) then
  4047. raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
  4048. end;
  4049. TempWidth := aSurface^.w;
  4050. TempHeight := aSurface^.h;
  4051. RowSize := FormatDesc.GetSize(TempWidth, 1);
  4052. GetMem(pData, TempHeight * RowSize);
  4053. try
  4054. pTempData := pData;
  4055. for Row := 0 to TempHeight -1 do begin
  4056. pSource := GetRowPointer(Row);
  4057. if (Assigned(pSource)) then begin
  4058. Move(pSource^, pTempData^, RowSize);
  4059. Inc(pTempData, RowSize);
  4060. end;
  4061. end;
  4062. SetDataPointer(pData, IntFormat, TempWidth, TempHeight);
  4063. result := true;
  4064. except
  4065. FreeMem(pData);
  4066. raise;
  4067. end;
  4068. end;
  4069. end;
  4070. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4071. function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  4072. var
  4073. Row, Col, AlphaInterleave: Integer;
  4074. pSource, pDest: PByte;
  4075. function GetRowPointer(Row: Integer): pByte;
  4076. begin
  4077. result := aSurface.pixels;
  4078. Inc(result, Row * Width);
  4079. end;
  4080. begin
  4081. result := false;
  4082. if Assigned(Data) then begin
  4083. if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
  4084. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
  4085. AlphaInterleave := 0;
  4086. case Format of
  4087. tfLuminance8Alpha8:
  4088. AlphaInterleave := 1;
  4089. tfBGRA8, tfRGBA8:
  4090. AlphaInterleave := 3;
  4091. end;
  4092. pSource := Data;
  4093. for Row := 0 to Height -1 do begin
  4094. pDest := GetRowPointer(Row);
  4095. if Assigned(pDest) then begin
  4096. for Col := 0 to Width -1 do begin
  4097. Inc(pSource, AlphaInterleave);
  4098. pDest^ := pSource^;
  4099. Inc(pDest);
  4100. Inc(pSource);
  4101. end;
  4102. end;
  4103. end;
  4104. result := true;
  4105. end;
  4106. end;
  4107. end;
  4108. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4109. function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  4110. var
  4111. bmp: TglBitmap2D;
  4112. begin
  4113. bmp := TglBitmap2D.Create;
  4114. try
  4115. bmp.AssignFromSurface(aSurface);
  4116. result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
  4117. finally
  4118. bmp.Free;
  4119. end;
  4120. end;
  4121. {$ENDIF}
  4122. {$IFDEF GLB_DELPHI}
  4123. //TODO rework & test
  4124. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4125. function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
  4126. var
  4127. Row: Integer;
  4128. pSource, pData: PByte;
  4129. begin
  4130. result := false;
  4131. if Assigned(Data) then begin
  4132. if Assigned(aBitmap) then begin
  4133. aBitmap.Width := Width;
  4134. aBitmap.Height := Height;
  4135. case Format of
  4136. tfAlpha8, ifLuminance, ifDepth8:
  4137. begin
  4138. Bitmap.PixelFormat := pf8bit;
  4139. Bitmap.Palette := CreateGrayPalette;
  4140. end;
  4141. ifRGB5A1:
  4142. Bitmap.PixelFormat := pf15bit;
  4143. ifR5G6B5:
  4144. Bitmap.PixelFormat := pf16bit;
  4145. ifRGB8, ifBGR8:
  4146. Bitmap.PixelFormat := pf24bit;
  4147. ifRGBA8, ifBGRA8:
  4148. Bitmap.PixelFormat := pf32bit;
  4149. else
  4150. raise EglBitmapException.Create('AssignToBitmap - Invalid Pixelformat.');
  4151. end;
  4152. pSource := Data;
  4153. for Row := 0 to FileHeight -1 do begin
  4154. pData := Bitmap.Scanline[Row];
  4155. Move(pSource^, pData^, fRowSize);
  4156. Inc(pSource, fRowSize);
  4157. // swap RGB(A) to BGR(A)
  4158. if InternalFormat in [ifRGB8, ifRGBA8] then
  4159. SwapRGB(pData, FileWidth, InternalFormat = ifRGBA8);
  4160. end;
  4161. result := true;
  4162. end;
  4163. end;
  4164. end;
  4165. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4166. function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  4167. var
  4168. pSource, pData, pTempData: PByte;
  4169. Row, RowSize, TempWidth, TempHeight: Integer;
  4170. IntFormat: TglBitmapInternalFormat;
  4171. begin
  4172. result := false;
  4173. if (Assigned(Bitmap)) then begin
  4174. case Bitmap.PixelFormat of
  4175. pf8bit:
  4176. IntFormat := ifLuminance;
  4177. pf15bit:
  4178. IntFormat := ifRGB5A1;
  4179. pf16bit:
  4180. IntFormat := ifR5G6B5;
  4181. pf24bit:
  4182. IntFormat := ifBGR8;
  4183. pf32bit:
  4184. IntFormat := ifBGRA8;
  4185. else
  4186. raise EglBitmapException.Create('AssignFromBitmap - Invalid Pixelformat.');
  4187. end;
  4188. TempWidth := Bitmap.Width;
  4189. TempHeight := Bitmap.Height;
  4190. RowSize := Trunc(TempWidth * FormatGetSize(IntFormat));
  4191. GetMem(pData, TempHeight * RowSize);
  4192. try
  4193. pTempData := pData;
  4194. for Row := 0 to TempHeight -1 do begin
  4195. pSource := Bitmap.Scanline[Row];
  4196. if (Assigned(pSource)) then begin
  4197. Move(pSource^, pTempData^, RowSize);
  4198. Inc(pTempData, RowSize);
  4199. end;
  4200. end;
  4201. SetDataPointer(pData, IntFormat, TempWidth, TempHeight);
  4202. result := true;
  4203. except
  4204. FreeMem(pData);
  4205. raise;
  4206. end;
  4207. end;
  4208. end;
  4209. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4210. function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  4211. var
  4212. Row, Col, AlphaInterleave: Integer;
  4213. pSource, pDest: PByte;
  4214. begin
  4215. result := false;
  4216. if Assigned(Data) then begin
  4217. if InternalFormat in [ifAlpha, ifLuminanceAlpha, ifRGBA8, ifBGRA8] then begin
  4218. if Assigned(Bitmap) then begin
  4219. Bitmap.PixelFormat := pf8bit;
  4220. Bitmap.Palette := CreateGrayPalette;
  4221. Bitmap.Width := Width;
  4222. Bitmap.Height := Height;
  4223. case InternalFormat of
  4224. ifLuminanceAlpha:
  4225. AlphaInterleave := 1;
  4226. ifRGBA8, ifBGRA8:
  4227. AlphaInterleave := 3;
  4228. else
  4229. AlphaInterleave := 0;
  4230. end;
  4231. // Copy Data
  4232. pSource := Data;
  4233. for Row := 0 to Height -1 do begin
  4234. pDest := Bitmap.Scanline[Row];
  4235. if Assigned(pDest) then begin
  4236. for Col := 0 to Width -1 do begin
  4237. Inc(pSource, AlphaInterleave);
  4238. pDest^ := pSource^;
  4239. Inc(pDest);
  4240. Inc(pSource);
  4241. end;
  4242. end;
  4243. end;
  4244. result := true;
  4245. end;
  4246. end;
  4247. end;
  4248. end;
  4249. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4250. function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
  4251. var
  4252. tex: TglBitmap2D;
  4253. begin
  4254. tex := TglBitmap2D.Create;
  4255. try
  4256. tex.AssignFromBitmap(Bitmap);
  4257. result := AddAlphaFromglBitmap(tex, Func, CustomData);
  4258. finally
  4259. tex.Free;
  4260. end;
  4261. end;
  4262. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4263. function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar;
  4264. const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
  4265. var
  4266. RS: TResourceStream;
  4267. TempPos: Integer;
  4268. ResTypeStr: String;
  4269. TempResType: PChar;
  4270. begin
  4271. if Assigned(ResType) then
  4272. TempResType := ResType
  4273. else
  4274. begin
  4275. TempPos := Pos('.', Resource);
  4276. ResTypeStr := UpperCase(Copy(Resource, TempPos + 1, Length(Resource) - TempPos));
  4277. Resource := UpperCase(Copy(Resource, 0, TempPos -1));
  4278. TempResType := PChar(ResTypeStr);
  4279. end;
  4280. RS := TResourceStream.Create(Instance, Resource, TempResType);
  4281. try
  4282. result := AddAlphaFromStream(RS, Func, CustomData);
  4283. finally
  4284. RS.Free;
  4285. end;
  4286. end;
  4287. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4288. function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  4289. const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
  4290. var
  4291. RS: TResourceStream;
  4292. begin
  4293. RS := TResourceStream.CreateFromID(Instance, ResourceID, ResType);
  4294. try
  4295. result := AddAlphaFromStream(RS, Func, CustomData);
  4296. finally
  4297. RS.Free;
  4298. end;
  4299. end;
  4300. {$ENDIF}
  4301. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4302. function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4303. begin
  4304. if TFormatDescriptor.Get(Format).IsCompressed then
  4305. raise EglBitmapUnsupportedFormat.Create(Format);
  4306. result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
  4307. end;
  4308. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4309. function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4310. var
  4311. FS: TFileStream;
  4312. begin
  4313. FS := TFileStream.Create(FileName, fmOpenRead);
  4314. try
  4315. result := AddAlphaFromStream(FS, aFunc, aArgs);
  4316. finally
  4317. FS.Free;
  4318. end;
  4319. end;
  4320. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4321. function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4322. var
  4323. tex: TglBitmap2D;
  4324. begin
  4325. tex := TglBitmap2D.Create(aStream);
  4326. try
  4327. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  4328. finally
  4329. tex.Free;
  4330. end;
  4331. end;
  4332. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4333. function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  4334. var
  4335. DestData, DestData2, SourceData: pByte;
  4336. TempHeight, TempWidth: Integer;
  4337. SourceFD, DestFD: TFormatDescriptor;
  4338. SourceMD, DestMD, DestMD2: Pointer;
  4339. FuncRec: TglBitmapFunctionRec;
  4340. begin
  4341. result := false;
  4342. Assert(Assigned(Data));
  4343. Assert(Assigned(aBitmap));
  4344. Assert(Assigned(aBitmap.Data));
  4345. if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
  4346. result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
  4347. SourceFD := TFormatDescriptor.Get(aBitmap.Format);
  4348. DestFD := TFormatDescriptor.Get(Format);
  4349. if not Assigned(aFunc) then begin
  4350. aFunc := glBitmapAlphaFunc;
  4351. FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
  4352. end else
  4353. FuncRec.Args := aArgs;
  4354. // Values
  4355. TempHeight := aBitmap.FileHeight;
  4356. TempWidth := aBitmap.FileWidth;
  4357. FuncRec.Sender := Self;
  4358. FuncRec.Size := Dimension;
  4359. FuncRec.Position.Fields := FuncRec.Size.Fields;
  4360. DestData := Data;
  4361. DestData2 := Data;
  4362. SourceData := aBitmap.Data;
  4363. // Mapping
  4364. SourceFD.PreparePixel(FuncRec.Source);
  4365. DestFD.PreparePixel (FuncRec.Dest);
  4366. SourceMD := SourceFD.CreateMappingData;
  4367. DestMD := DestFD.CreateMappingData;
  4368. DestMD2 := DestFD.CreateMappingData;
  4369. try
  4370. FuncRec.Position.Y := 0;
  4371. while FuncRec.Position.Y < TempHeight do begin
  4372. FuncRec.Position.X := 0;
  4373. while FuncRec.Position.X < TempWidth do begin
  4374. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  4375. DestFD.Unmap (DestData, FuncRec.Dest, DestMD);
  4376. aFunc(FuncRec);
  4377. DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
  4378. inc(FuncRec.Position.X);
  4379. end;
  4380. inc(FuncRec.Position.Y);
  4381. end;
  4382. finally
  4383. SourceFD.FreeMappingData(SourceMD);
  4384. DestFD.FreeMappingData(DestMD);
  4385. DestFD.FreeMappingData(DestMD2);
  4386. end;
  4387. end;
  4388. end;
  4389. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4390. function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
  4391. begin
  4392. result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
  4393. end;
  4394. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4395. function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
  4396. var
  4397. PixelData: TglBitmapPixelData;
  4398. begin
  4399. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4400. result := AddAlphaFromColorKeyFloat(
  4401. aRed / PixelData.Range.r,
  4402. aGreen / PixelData.Range.g,
  4403. aBlue / PixelData.Range.b,
  4404. aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
  4405. end;
  4406. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4407. function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
  4408. var
  4409. values: array[0..2] of Single;
  4410. tmp: Cardinal;
  4411. i: Integer;
  4412. PixelData: TglBitmapPixelData;
  4413. begin
  4414. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4415. with PixelData do begin
  4416. values[0] := aRed;
  4417. values[1] := aGreen;
  4418. values[2] := aBlue;
  4419. for i := 0 to 2 do begin
  4420. tmp := Trunc(Range.arr[i] * aDeviation);
  4421. Data.arr[i] := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
  4422. Range.arr[i] := Max(0, Trunc(Range.arr[i] * values[i] - tmp));
  4423. end;
  4424. Data.a := 0;
  4425. Range.a := 0;
  4426. end;
  4427. result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
  4428. end;
  4429. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4430. function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
  4431. begin
  4432. result := AddAlphaFromValueFloat(aAlpha / $FF);
  4433. end;
  4434. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4435. function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  4436. var
  4437. PixelData: TglBitmapPixelData;
  4438. begin
  4439. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4440. result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
  4441. end;
  4442. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4443. function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  4444. var
  4445. PixelData: TglBitmapPixelData;
  4446. begin
  4447. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4448. with PixelData do
  4449. Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
  4450. result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
  4451. end;
  4452. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4453. function TglBitmap.RemoveAlpha: Boolean;
  4454. var
  4455. FormatDesc: TFormatDescriptor;
  4456. begin
  4457. result := false;
  4458. FormatDesc := TFormatDescriptor.Get(Format);
  4459. if Assigned(Data) then begin
  4460. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  4461. raise EglBitmapUnsupportedFormat.Create(Format);
  4462. result := ConvertTo(FormatDesc.WithoutAlpha);
  4463. end;
  4464. end;
  4465. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4466. function TglBitmap.Clone: TglBitmap;
  4467. var
  4468. Temp: TglBitmap;
  4469. TempPtr: PByte;
  4470. Size: Integer;
  4471. begin
  4472. result := nil;
  4473. Temp := (ClassType.Create as TglBitmap);
  4474. try
  4475. // copy texture data if assigned
  4476. if Assigned(Data) then begin
  4477. Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
  4478. GetMem(TempPtr, Size);
  4479. try
  4480. Move(Data^, TempPtr^, Size);
  4481. Temp.SetDataPointer(TempPtr, Format, Width, Height);
  4482. except
  4483. FreeMem(TempPtr);
  4484. raise;
  4485. end;
  4486. end else
  4487. Temp.SetDataPointer(nil, Format, Width, Height);
  4488. // copy properties
  4489. Temp.fID := ID;
  4490. Temp.fTarget := Target;
  4491. Temp.fFormat := Format;
  4492. Temp.fMipMap := MipMap;
  4493. Temp.fAnisotropic := Anisotropic;
  4494. Temp.fBorderColor := fBorderColor;
  4495. Temp.fDeleteTextureOnFree := DeleteTextureOnFree;
  4496. Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
  4497. Temp.fFilterMin := fFilterMin;
  4498. Temp.fFilterMag := fFilterMag;
  4499. Temp.fWrapS := fWrapS;
  4500. Temp.fWrapT := fWrapT;
  4501. Temp.fWrapR := fWrapR;
  4502. Temp.fFilename := fFilename;
  4503. Temp.fCustomName := fCustomName;
  4504. Temp.fCustomNameW := fCustomNameW;
  4505. Temp.fCustomData := fCustomData;
  4506. result := Temp;
  4507. except
  4508. FreeAndNil(Temp);
  4509. raise;
  4510. end;
  4511. end;
  4512. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4513. function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
  4514. var
  4515. SourceFD, DestFD: TFormatDescriptor;
  4516. SourcePD, DestPD: TglBitmapPixelData;
  4517. ShiftData: TShiftData;
  4518. function CanCopyDirect: Boolean;
  4519. begin
  4520. result :=
  4521. ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  4522. ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  4523. ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  4524. ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  4525. end;
  4526. function CanShift: Boolean;
  4527. begin
  4528. result :=
  4529. ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  4530. ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  4531. ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  4532. ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  4533. end;
  4534. function GetShift(aSource, aDest: Cardinal) : ShortInt;
  4535. begin
  4536. result := 0;
  4537. while (aSource > aDest) and (aSource > 0) do begin
  4538. inc(result);
  4539. aSource := aSource shr 1;
  4540. end;
  4541. end;
  4542. begin
  4543. if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
  4544. SourceFD := TFormatDescriptor.Get(Format);
  4545. DestFD := TFormatDescriptor.Get(aFormat);
  4546. SourceFD.PreparePixel(SourcePD);
  4547. DestFD.PreparePixel (DestPD);
  4548. if CanCopyDirect then
  4549. result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
  4550. else if CanShift then begin
  4551. ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
  4552. ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
  4553. ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
  4554. ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
  4555. result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
  4556. end else
  4557. result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
  4558. end else
  4559. result := true;
  4560. end;
  4561. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4562. procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
  4563. begin
  4564. if aUseRGB or aUseAlpha then
  4565. AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(
  4566. ((PtrInt(aUseAlpha) and 1) shl 1) or
  4567. (PtrInt(aUseRGB) and 1) ));
  4568. end;
  4569. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4570. procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  4571. begin
  4572. fBorderColor[0] := aRed;
  4573. fBorderColor[1] := aGreen;
  4574. fBorderColor[2] := aBlue;
  4575. fBorderColor[3] := aAlpha;
  4576. if (ID > 0) then begin
  4577. Bind(false);
  4578. glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
  4579. end;
  4580. end;
  4581. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4582. procedure TglBitmap.FreeData;
  4583. begin
  4584. SetDataPointer(nil, tfEmpty);
  4585. end;
  4586. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4587. procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
  4588. const aAlpha: Byte);
  4589. begin
  4590. FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
  4591. end;
  4592. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4593. procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
  4594. var
  4595. PixelData: TglBitmapPixelData;
  4596. begin
  4597. TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);
  4598. FillWithColorFloat(
  4599. aRed / PixelData.Range.r,
  4600. aGreen / PixelData.Range.g,
  4601. aBlue / PixelData.Range.b,
  4602. aAlpha / PixelData.Range.a);
  4603. end;
  4604. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4605. procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
  4606. var
  4607. PixelData: TglBitmapPixelData;
  4608. begin
  4609. TFormatDescriptor.Get(Format).PreparePixel(PixelData);
  4610. with PixelData do begin
  4611. Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
  4612. Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
  4613. Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
  4614. Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
  4615. end;
  4616. AddFunc(glBitmapFillWithColorFunc, false, @PixelData);
  4617. end;
  4618. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4619. procedure TglBitmap.SetFilter(const aMin, aMag: Cardinal);
  4620. begin
  4621. //check MIN filter
  4622. case aMin of
  4623. GL_NEAREST:
  4624. fFilterMin := GL_NEAREST;
  4625. GL_LINEAR:
  4626. fFilterMin := GL_LINEAR;
  4627. GL_NEAREST_MIPMAP_NEAREST:
  4628. fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
  4629. GL_LINEAR_MIPMAP_NEAREST:
  4630. fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
  4631. GL_NEAREST_MIPMAP_LINEAR:
  4632. fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
  4633. GL_LINEAR_MIPMAP_LINEAR:
  4634. fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
  4635. else
  4636. raise EglBitmapException.Create('SetFilter - Unknow MIN filter.');
  4637. end;
  4638. //check MAG filter
  4639. case aMag of
  4640. GL_NEAREST:
  4641. fFilterMag := GL_NEAREST;
  4642. GL_LINEAR:
  4643. fFilterMag := GL_LINEAR;
  4644. else
  4645. raise EglBitmapException.Create('SetFilter - Unknow MAG filter.');
  4646. end;
  4647. //apply filter
  4648. if (ID > 0) then begin
  4649. Bind(false);
  4650. glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
  4651. if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
  4652. case fFilterMin of
  4653. GL_NEAREST, GL_LINEAR:
  4654. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  4655. GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
  4656. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
  4657. GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
  4658. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
  4659. end;
  4660. end else
  4661. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  4662. end;
  4663. end;
  4664. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4665. procedure TglBitmap.SetWrap(const S: Cardinal; const T: Cardinal; const R: Cardinal);
  4666. procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
  4667. begin
  4668. case aValue of
  4669. GL_CLAMP:
  4670. aTarget := GL_CLAMP;
  4671. GL_REPEAT:
  4672. aTarget := GL_REPEAT;
  4673. GL_CLAMP_TO_EDGE: begin
  4674. if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
  4675. aTarget := GL_CLAMP_TO_EDGE
  4676. else
  4677. aTarget := GL_CLAMP;
  4678. end;
  4679. GL_CLAMP_TO_BORDER: begin
  4680. if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
  4681. aTarget := GL_CLAMP_TO_BORDER
  4682. else
  4683. aTarget := GL_CLAMP;
  4684. end;
  4685. GL_MIRRORED_REPEAT: begin
  4686. if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
  4687. aTarget := GL_MIRRORED_REPEAT
  4688. else
  4689. raise EglBitmapException.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
  4690. end;
  4691. else
  4692. raise EglBitmapException.Create('SetWrap - Unknow Texturewrap (S).');
  4693. end;
  4694. end;
  4695. begin
  4696. CheckAndSetWrap(S, fWrapS);
  4697. CheckAndSetWrap(T, fWrapT);
  4698. CheckAndSetWrap(R, fWrapR);
  4699. if (ID > 0) then begin
  4700. Bind(false);
  4701. glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
  4702. glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
  4703. glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
  4704. end;
  4705. end;
  4706. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4707. procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
  4708. begin
  4709. if aEnableTextureUnit then
  4710. glEnable(Target);
  4711. if (ID > 0) then
  4712. glBindTexture(Target, ID);
  4713. end;
  4714. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4715. procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
  4716. begin
  4717. if aDisableTextureUnit then
  4718. glDisable(Target);
  4719. glBindTexture(Target, 0);
  4720. end;
  4721. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4722. constructor TglBitmap.Create;
  4723. begin
  4724. {$IFDEF GLB_NATIVE_OGL}
  4725. glbReadOpenGLExtensions;
  4726. {$ENDIF}
  4727. if (ClassType = TglBitmap) then
  4728. raise EglBitmapException.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
  4729. inherited Create;
  4730. end;
  4731. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4732. constructor TglBitmap.Create(const aFileName: String);
  4733. begin
  4734. Create;
  4735. LoadFromFile(FileName);
  4736. end;
  4737. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4738. constructor TglBitmap.Create(const aStream: TStream);
  4739. begin
  4740. Create;
  4741. LoadFromStream(aStream);
  4742. end;
  4743. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4744. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat);
  4745. var
  4746. Image: PByte;
  4747. ImageSize: Integer;
  4748. begin
  4749. Create;
  4750. ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  4751. GetMem(Image, ImageSize);
  4752. try
  4753. FillChar(Image^, ImageSize, #$FF);
  4754. SetDataPointer(Image, aFormat, aSize.X, aSize.Y);
  4755. except
  4756. FreeMem(Image);
  4757. raise;
  4758. end;
  4759. end;
  4760. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4761. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat;
  4762. const aFunc: TglBitmapFunction; const aArgs: Pointer);
  4763. begin
  4764. Create;
  4765. LoadFromFunc(aSize, aFunc, aFormat, aArgs);
  4766. end;
  4767. {$IFDEF GLB_DELPHI}
  4768. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4769. constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
  4770. begin
  4771. Create;
  4772. LoadFromResource(aInstance, aResource, aResType);
  4773. end;
  4774. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4775. constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  4776. begin
  4777. Create;
  4778. LoadFromResourceID(aInstance, aResourceID, aResType);
  4779. end;
  4780. {$ENDIF}
  4781. {$IFDEF GLB_SUPPORT_PNG_READ}
  4782. {$IF DEFINED(GLB_SDL_IMAGE)}
  4783. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4784. //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4785. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4786. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  4787. var
  4788. Surface: PSDL_Surface;
  4789. RWops: PSDL_RWops;
  4790. begin
  4791. result := false;
  4792. RWops := glBitmapCreateRWops(aStream);
  4793. try
  4794. if IMG_isPNG(RWops) > 0 then begin
  4795. Surface := IMG_LoadPNG_RW(RWops);
  4796. try
  4797. AssignFromSurface(Surface);
  4798. result := true;
  4799. finally
  4800. SDL_FreeSurface(Surface);
  4801. end;
  4802. end;
  4803. finally
  4804. SDL_FreeRW(RWops);
  4805. end;
  4806. end;
  4807. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  4808. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4809. procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  4810. begin
  4811. TStream(png_get_io_ptr(png)).Read(buffer^, size);
  4812. end;
  4813. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4814. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  4815. var
  4816. StreamPos: Int64;
  4817. signature: array [0..7] of byte;
  4818. png: png_structp;
  4819. png_info: png_infop;
  4820. TempHeight, TempWidth: Integer;
  4821. Format: TglBitmapFormat;
  4822. png_data: pByte;
  4823. png_rows: array of pByte;
  4824. Row, LineSize: Integer;
  4825. begin
  4826. result := false;
  4827. if not init_libPNG then
  4828. raise Exception.Create('LoadPNG - unable to initialize libPNG.');
  4829. try
  4830. // signature
  4831. StreamPos := aStream.Position;
  4832. aStream.Read(signature, 8);
  4833. aStream.Position := StreamPos;
  4834. if png_check_sig(@signature, 8) <> 0 then begin
  4835. // png read struct
  4836. png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  4837. if png = nil then
  4838. raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
  4839. // png info
  4840. png_info := png_create_info_struct(png);
  4841. if png_info = nil then begin
  4842. png_destroy_read_struct(@png, nil, nil);
  4843. raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
  4844. end;
  4845. // set read callback
  4846. png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
  4847. // read informations
  4848. png_read_info(png, png_info);
  4849. // size
  4850. TempHeight := png_get_image_height(png, png_info);
  4851. TempWidth := png_get_image_width(png, png_info);
  4852. // format
  4853. case png_get_color_type(png, png_info) of
  4854. PNG_COLOR_TYPE_GRAY:
  4855. Format := tfLuminance8;
  4856. PNG_COLOR_TYPE_GRAY_ALPHA:
  4857. Format := tfLuminance8Alpha8;
  4858. PNG_COLOR_TYPE_RGB:
  4859. Format := tfRGB8;
  4860. PNG_COLOR_TYPE_RGB_ALPHA:
  4861. Format := tfRGBA8;
  4862. else
  4863. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  4864. end;
  4865. // cut upper 8 bit from 16 bit formats
  4866. if png_get_bit_depth(png, png_info) > 8 then
  4867. png_set_strip_16(png);
  4868. // expand bitdepth smaller than 8
  4869. if png_get_bit_depth(png, png_info) < 8 then
  4870. png_set_expand(png);
  4871. // allocating mem for scanlines
  4872. LineSize := png_get_rowbytes(png, png_info);
  4873. GetMem(png_data, TempHeight * LineSize);
  4874. try
  4875. SetLength(png_rows, TempHeight);
  4876. for Row := Low(png_rows) to High(png_rows) do begin
  4877. png_rows[Row] := png_data;
  4878. Inc(png_rows[Row], Row * LineSize);
  4879. end;
  4880. // read complete image into scanlines
  4881. png_read_image(png, @png_rows[0]);
  4882. // read end
  4883. png_read_end(png, png_info);
  4884. // destroy read struct
  4885. png_destroy_read_struct(@png, @png_info, nil);
  4886. SetLength(png_rows, 0);
  4887. // set new data
  4888. SetDataPointer(png_data, Format, TempWidth, TempHeight);
  4889. result := true;
  4890. except
  4891. FreeMem(png_data);
  4892. raise;
  4893. end;
  4894. end;
  4895. finally
  4896. quit_libPNG;
  4897. end;
  4898. end;
  4899. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  4900. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4901. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  4902. var
  4903. StreamPos: Int64;
  4904. Png: TPNGObject;
  4905. Header: Array[0..7] of Byte;
  4906. Row, Col, PixSize, LineSize: Integer;
  4907. NewImage, pSource, pDest, pAlpha: pByte;
  4908. Format: TglBitmapInternalFormat;
  4909. const
  4910. PngHeader: Array[0..7] of Byte = (#137, #80, #78, #71, #13, #10, #26, #10);
  4911. begin
  4912. result := false;
  4913. StreamPos := Stream.Position;
  4914. Stream.Read(Header[0], SizeOf(Header));
  4915. Stream.Position := StreamPos;
  4916. {Test if the header matches}
  4917. if Header = PngHeader then begin
  4918. Png := TPNGObject.Create;
  4919. try
  4920. Png.LoadFromStream(Stream);
  4921. case Png.Header.ColorType of
  4922. COLOR_GRAYSCALE:
  4923. Format := ifLuminance;
  4924. COLOR_GRAYSCALEALPHA:
  4925. Format := ifLuminanceAlpha;
  4926. COLOR_RGB:
  4927. Format := ifBGR8;
  4928. COLOR_RGBALPHA:
  4929. Format := ifBGRA8;
  4930. else
  4931. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  4932. end;
  4933. PixSize := Trunc(FormatGetSize(Format));
  4934. LineSize := Integer(Png.Header.Width) * PixSize;
  4935. GetMem(NewImage, LineSize * Integer(Png.Header.Height));
  4936. try
  4937. pDest := NewImage;
  4938. case Png.Header.ColorType of
  4939. COLOR_RGB, COLOR_GRAYSCALE:
  4940. begin
  4941. for Row := 0 to Png.Height -1 do begin
  4942. Move (Png.Scanline[Row]^, pDest^, LineSize);
  4943. Inc(pDest, LineSize);
  4944. end;
  4945. end;
  4946. COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
  4947. begin
  4948. PixSize := PixSize -1;
  4949. for Row := 0 to Png.Height -1 do begin
  4950. pSource := Png.Scanline[Row];
  4951. pAlpha := pByte(Png.AlphaScanline[Row]);
  4952. for Col := 0 to Png.Width -1 do begin
  4953. Move (pSource^, pDest^, PixSize);
  4954. Inc(pSource, PixSize);
  4955. Inc(pDest, PixSize);
  4956. pDest^ := pAlpha^;
  4957. inc(pAlpha);
  4958. Inc(pDest);
  4959. end;
  4960. end;
  4961. end;
  4962. else
  4963. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  4964. end;
  4965. SetDataPointer(NewImage, Format, Png.Header.Width, Png.Header.Height);
  4966. result := true;
  4967. except
  4968. FreeMem(NewImage);
  4969. raise;
  4970. end;
  4971. finally
  4972. Png.Free;
  4973. end;
  4974. end;
  4975. end;
  4976. {$IFEND}
  4977. {$ENDIF}
  4978. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  4979. {$IFDEF GLB_LIB_PNG}
  4980. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4981. procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  4982. begin
  4983. TStream(png_get_io_ptr(png)).Write(buffer^, size);
  4984. end;
  4985. {$ENDIF}
  4986. {$IF DEFINED(GLB_LIB_PNG)}
  4987. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4988. procedure TglBitmap.SavePNG(const aStream: TStream);
  4989. var
  4990. png: png_structp;
  4991. png_info: png_infop;
  4992. png_rows: array of pByte;
  4993. LineSize: Integer;
  4994. ColorType: Integer;
  4995. Row: Integer;
  4996. FormatDesc: TFormatDescriptor;
  4997. begin
  4998. if not (ftPNG in FormatGetSupportedFiles(Format)) then
  4999. raise EglBitmapUnsupportedFormat.Create(Format);
  5000. if not init_libPNG then
  5001. raise Exception.Create('unable to initialize libPNG.');
  5002. try
  5003. case Format of
  5004. tfAlpha8, tfLuminance8:
  5005. ColorType := PNG_COLOR_TYPE_GRAY;
  5006. tfLuminance8Alpha8:
  5007. ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
  5008. tfBGR8, tfRGB8:
  5009. ColorType := PNG_COLOR_TYPE_RGB;
  5010. tfBGRA8, tfRGBA8:
  5011. ColorType := PNG_COLOR_TYPE_RGBA;
  5012. else
  5013. raise EglBitmapUnsupportedFormat.Create(Format);
  5014. end;
  5015. FormatDesc := TFormatDescriptor.Get(Format);
  5016. LineSize := FormatDesc.GetSize(Width, 1);
  5017. // creating array for scanline
  5018. SetLength(png_rows, Height);
  5019. try
  5020. for Row := 0 to Height - 1 do begin
  5021. png_rows[Row] := Data;
  5022. Inc(png_rows[Row], Row * LineSize)
  5023. end;
  5024. // write struct
  5025. png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  5026. if png = nil then
  5027. raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
  5028. // create png info
  5029. png_info := png_create_info_struct(png);
  5030. if png_info = nil then begin
  5031. png_destroy_write_struct(@png, nil);
  5032. raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
  5033. end;
  5034. // set read callback
  5035. png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
  5036. // set compression
  5037. png_set_compression_level(png, 6);
  5038. if Format in [tfBGR8, tfBGRA8] then
  5039. png_set_bgr(png);
  5040. png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
  5041. png_write_info(png, png_info);
  5042. png_write_image(png, @png_rows[0]);
  5043. png_write_end(png, png_info);
  5044. png_destroy_write_struct(@png, @png_info);
  5045. finally
  5046. SetLength(png_rows, 0);
  5047. end;
  5048. finally
  5049. quit_libPNG;
  5050. end;
  5051. end;
  5052. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  5053. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5054. procedure TglBitmap.SavePNG(const aStream: TStream);
  5055. var
  5056. Png: TPNGObject;
  5057. pSource, pDest: pByte;
  5058. X, Y, PixSize: Integer;
  5059. ColorType: Cardinal;
  5060. Alpha: Boolean;
  5061. pTemp: pByte;
  5062. Temp: Byte;
  5063. begin
  5064. if not (ftPNG in FormatGetSupportedFiles (InternalFormat)) then
  5065. raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
  5066. case FInternalFormat of
  5067. ifAlpha, ifLuminance, ifDepth8: begin
  5068. ColorType := COLOR_GRAYSCALE;
  5069. PixSize := 1;
  5070. Alpha := false;
  5071. end;
  5072. ifLuminanceAlpha: begin
  5073. ColorType := COLOR_GRAYSCALEALPHA;
  5074. PixSize := 1;
  5075. Alpha := true;
  5076. end;
  5077. ifBGR8, ifRGB8: begin
  5078. ColorType := COLOR_RGB;
  5079. PixSize := 3;
  5080. Alpha := false;
  5081. end;
  5082. ifBGRA8, ifRGBA8: begin
  5083. ColorType := COLOR_RGBALPHA;
  5084. PixSize := 3;
  5085. Alpha := true
  5086. end;
  5087. else
  5088. raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
  5089. end;
  5090. Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
  5091. try
  5092. // Copy ImageData
  5093. pSource := Data;
  5094. for Y := 0 to Height -1 do begin
  5095. pDest := png.ScanLine[Y];
  5096. for X := 0 to Width -1 do begin
  5097. Move(pSource^, pDest^, PixSize);
  5098. Inc(pDest, PixSize);
  5099. Inc(pSource, PixSize);
  5100. if Alpha then begin
  5101. png.AlphaScanline[Y]^[X] := pSource^;
  5102. Inc(pSource);
  5103. end;
  5104. end;
  5105. // convert RGB line to BGR
  5106. if InternalFormat in [ifRGB8, ifRGBA8] then begin
  5107. pTemp := png.ScanLine[Y];
  5108. for X := 0 to Width -1 do begin
  5109. Temp := pByteArray(pTemp)^[0];
  5110. pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
  5111. pByteArray(pTemp)^[2] := Temp;
  5112. Inc(pTemp, 3);
  5113. end;
  5114. end;
  5115. end;
  5116. // Save to Stream
  5117. Png.CompressionLevel := 6;
  5118. Png.SaveToStream(Stream);
  5119. finally
  5120. FreeAndNil(Png);
  5121. end;
  5122. end;
  5123. {$IFEND}
  5124. {$ENDIF}
  5125. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5126. //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5127. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5128. {$IFDEF GLB_LIB_JPEG}
  5129. type
  5130. glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
  5131. glBitmap_libJPEG_source_mgr = record
  5132. pub: jpeg_source_mgr;
  5133. SrcStream: TStream;
  5134. SrcBuffer: array [1..4096] of byte;
  5135. end;
  5136. glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
  5137. glBitmap_libJPEG_dest_mgr = record
  5138. pub: jpeg_destination_mgr;
  5139. DestStream: TStream;
  5140. DestBuffer: array [1..4096] of byte;
  5141. end;
  5142. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5143. function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
  5144. var
  5145. src: glBitmap_libJPEG_source_mgr_ptr;
  5146. bytes: integer;
  5147. begin
  5148. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  5149. bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
  5150. if (bytes <= 0) then begin
  5151. src^.SrcBuffer[1] := $FF;
  5152. src^.SrcBuffer[2] := JPEG_EOI;
  5153. bytes := 2;
  5154. end;
  5155. src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
  5156. src^.pub.bytes_in_buffer := bytes;
  5157. result := true;
  5158. end;
  5159. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5160. procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
  5161. var
  5162. src: glBitmap_libJPEG_source_mgr_ptr;
  5163. begin
  5164. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  5165. if num_bytes > 0 then begin
  5166. // wanted byte isn't in buffer so set stream position and read buffer
  5167. if num_bytes > src^.pub.bytes_in_buffer then begin
  5168. src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
  5169. src^.pub.fill_input_buffer(cinfo);
  5170. end else begin
  5171. // wanted byte is in buffer so only skip
  5172. inc(src^.pub.next_input_byte, num_bytes);
  5173. dec(src^.pub.bytes_in_buffer, num_bytes);
  5174. end;
  5175. end;
  5176. end;
  5177. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5178. function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
  5179. var
  5180. dest: glBitmap_libJPEG_dest_mgr_ptr;
  5181. begin
  5182. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  5183. if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
  5184. // write complete buffer
  5185. dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
  5186. // reset buffer
  5187. dest^.pub.next_output_byte := @dest^.DestBuffer[1];
  5188. dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
  5189. end;
  5190. result := true;
  5191. end;
  5192. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5193. procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
  5194. var
  5195. Idx: Integer;
  5196. dest: glBitmap_libJPEG_dest_mgr_ptr;
  5197. begin
  5198. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  5199. for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
  5200. // check for endblock
  5201. if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
  5202. // write endblock
  5203. dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
  5204. // leave
  5205. break;
  5206. end else
  5207. dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
  5208. end;
  5209. end;
  5210. {$ENDIF}
  5211. {$IFDEF GLB_SUPPORT_JPEG_READ}
  5212. {$IF DEFINED(GLB_SDL_IMAGE)}
  5213. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5214. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5215. var
  5216. Surface: PSDL_Surface;
  5217. RWops: PSDL_RWops;
  5218. begin
  5219. result := false;
  5220. RWops := glBitmapCreateRWops(aStream);
  5221. try
  5222. if IMG_isJPG(RWops) > 0 then begin
  5223. Surface := IMG_LoadJPG_RW(RWops);
  5224. try
  5225. AssignFromSurface(Surface);
  5226. result := true;
  5227. finally
  5228. SDL_FreeSurface(Surface);
  5229. end;
  5230. end;
  5231. finally
  5232. SDL_FreeRW(RWops);
  5233. end;
  5234. end;
  5235. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  5236. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5237. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5238. var
  5239. StreamPos: Int64;
  5240. Temp: array[0..1]of Byte;
  5241. jpeg: jpeg_decompress_struct;
  5242. jpeg_err: jpeg_error_mgr;
  5243. IntFormat: TglBitmapInternalFormat;
  5244. pImage: pByte;
  5245. TempHeight, TempWidth: Integer;
  5246. pTemp: pByte;
  5247. Row: Integer;
  5248. begin
  5249. result := false;
  5250. if not init_libJPEG then
  5251. raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
  5252. try
  5253. // reading first two bytes to test file and set cursor back to begin
  5254. StreamPos := Stream.Position;
  5255. Stream.Read(Temp[0], 2);
  5256. Stream.Position := StreamPos;
  5257. // if Bitmap then read file.
  5258. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  5259. FillChar(jpeg, SizeOf(jpeg_decompress_struct), $00);
  5260. FillChar(jpeg_err, SizeOf(jpeg_error_mgr), $00);
  5261. // error managment
  5262. jpeg.err := jpeg_std_error(@jpeg_err);
  5263. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  5264. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  5265. // decompression struct
  5266. jpeg_create_decompress(@jpeg);
  5267. // allocation space for streaming methods
  5268. jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
  5269. // seeting up custom functions
  5270. with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
  5271. pub.init_source := glBitmap_libJPEG_init_source;
  5272. pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
  5273. pub.skip_input_data := glBitmap_libJPEG_skip_input_data;
  5274. pub.resync_to_restart := jpeg_resync_to_restart; // use default method
  5275. pub.term_source := glBitmap_libJPEG_term_source;
  5276. pub.bytes_in_buffer := 0; // forces fill_input_buffer on first read
  5277. pub.next_input_byte := nil; // until buffer loaded
  5278. SrcStream := Stream;
  5279. end;
  5280. // set global decoding state
  5281. jpeg.global_state := DSTATE_START;
  5282. // read header of jpeg
  5283. jpeg_read_header(@jpeg, false);
  5284. // setting output parameter
  5285. case jpeg.jpeg_color_space of
  5286. JCS_GRAYSCALE:
  5287. begin
  5288. jpeg.out_color_space := JCS_GRAYSCALE;
  5289. IntFormat := ifLuminance;
  5290. end;
  5291. else
  5292. jpeg.out_color_space := JCS_RGB;
  5293. IntFormat := ifRGB8;
  5294. end;
  5295. // reading image
  5296. jpeg_start_decompress(@jpeg);
  5297. TempHeight := jpeg.output_height;
  5298. TempWidth := jpeg.output_width;
  5299. // creating new image
  5300. GetMem(pImage, FormatGetImageSize(glBitmapPosition(TempWidth, TempHeight), IntFormat));
  5301. try
  5302. pTemp := pImage;
  5303. for Row := 0 to TempHeight -1 do begin
  5304. jpeg_read_scanlines(@jpeg, @pTemp, 1);
  5305. Inc(pTemp, Trunc(FormatGetSize(IntFormat) * TempWidth));
  5306. end;
  5307. // finish decompression
  5308. jpeg_finish_decompress(@jpeg);
  5309. // destroy decompression
  5310. jpeg_destroy_decompress(@jpeg);
  5311. SetDataPointer(pImage, IntFormat, TempWidth, TempHeight);
  5312. result := true;
  5313. except
  5314. FreeMem(pImage);
  5315. raise;
  5316. end;
  5317. end;
  5318. finally
  5319. quit_libJPEG;
  5320. end;
  5321. end;
  5322. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  5323. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5324. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  5325. var
  5326. bmp: TBitmap;
  5327. jpg: TJPEGImage;
  5328. StreamPos: Int64;
  5329. Temp: array[0..1]of Byte;
  5330. begin
  5331. result := false;
  5332. // reading first two bytes to test file and set cursor back to begin
  5333. StreamPos := Stream.Position;
  5334. Stream.Read(Temp[0], 2);
  5335. Stream.Position := StreamPos;
  5336. // if Bitmap then read file.
  5337. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  5338. bmp := TBitmap.Create;
  5339. try
  5340. jpg := TJPEGImage.Create;
  5341. try
  5342. jpg.LoadFromStream(Stream);
  5343. bmp.Assign(jpg);
  5344. result := AssignFromBitmap(bmp);
  5345. finally
  5346. jpg.Free;
  5347. end;
  5348. finally
  5349. bmp.Free;
  5350. end;
  5351. end;
  5352. end;
  5353. {$IFEND}
  5354. {$ENDIF}
  5355. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  5356. {$IF DEFEFINED(GLB_LIB_JPEG)}
  5357. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5358. procedure TglBitmap.SaveJPEG(Stream: TStream);
  5359. var
  5360. jpeg: jpeg_compress_struct;
  5361. jpeg_err: jpeg_error_mgr;
  5362. Row: Integer;
  5363. pTemp, pTemp2: pByte;
  5364. procedure CopyRow(pDest, pSource: pByte);
  5365. var
  5366. X: Integer;
  5367. begin
  5368. for X := 0 to Width - 1 do begin
  5369. pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
  5370. pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
  5371. pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
  5372. Inc(pDest, 3);
  5373. Inc(pSource, 3);
  5374. end;
  5375. end;
  5376. begin
  5377. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  5378. raise EglBitmapUnsupportedInternalFormat.Create('SaveJpg - ' + UNSUPPORTED_INTERNAL_FORMAT);
  5379. if not init_libJPEG then
  5380. raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
  5381. try
  5382. FillChar(jpeg, SizeOf(jpeg_compress_struct), $00);
  5383. FillChar(jpeg_err, SizeOf(jpeg_error_mgr), $00);
  5384. // error managment
  5385. jpeg.err := jpeg_std_error(@jpeg_err);
  5386. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  5387. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  5388. // compression struct
  5389. jpeg_create_compress(@jpeg);
  5390. // allocation space for streaming methods
  5391. jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
  5392. // seeting up custom functions
  5393. with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
  5394. pub.init_destination := glBitmap_libJPEG_init_destination;
  5395. pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
  5396. pub.term_destination := glBitmap_libJPEG_term_destination;
  5397. pub.next_output_byte := @DestBuffer[1];
  5398. pub.free_in_buffer := Length(DestBuffer);
  5399. DestStream := Stream;
  5400. end;
  5401. // very important state
  5402. jpeg.global_state := CSTATE_START;
  5403. jpeg.image_width := Width;
  5404. jpeg.image_height := Height;
  5405. case InternalFormat of
  5406. ifAlpha, ifLuminance, ifDepth8: begin
  5407. jpeg.input_components := 1;
  5408. jpeg.in_color_space := JCS_GRAYSCALE;
  5409. end;
  5410. ifRGB8, ifBGR8: begin
  5411. jpeg.input_components := 3;
  5412. jpeg.in_color_space := JCS_RGB;
  5413. end;
  5414. end;
  5415. jpeg_set_defaults(@jpeg);
  5416. jpeg_set_quality(@jpeg, 95, true);
  5417. jpeg_start_compress(@jpeg, true);
  5418. pTemp := Data;
  5419. if InternalFormat = ifBGR8 then
  5420. GetMem(pTemp2, fRowSize)
  5421. else
  5422. pTemp2 := pTemp;
  5423. try
  5424. for Row := 0 to jpeg.image_height -1 do begin
  5425. // prepare row
  5426. if InternalFormat = ifBGR8 then
  5427. CopyRow(pTemp2, pTemp)
  5428. else
  5429. pTemp2 := pTemp;
  5430. // write row
  5431. jpeg_write_scanlines(@jpeg, @pTemp2, 1);
  5432. inc(pTemp, fRowSize);
  5433. end;
  5434. finally
  5435. // free memory
  5436. if InternalFormat = ifBGR8 then
  5437. FreeMem(pTemp2);
  5438. end;
  5439. jpeg_finish_compress(@jpeg);
  5440. jpeg_destroy_compress(@jpeg);
  5441. finally
  5442. quit_libJPEG;
  5443. end;
  5444. end;
  5445. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  5446. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5447. procedure TglBitmap.SaveJPEG(Stream: TStream);
  5448. var
  5449. Bmp: TBitmap;
  5450. Jpg: TJPEGImage;
  5451. begin
  5452. if not (ftJPEG in FormatGetSupportedFiles (InternalFormat)) then
  5453. raise EglBitmapUnsupportedInternalFormat.Create('SaveJpg - ' + UNSUPPORTED_INTERNAL_FORMAT);
  5454. Bmp := TBitmap.Create;
  5455. try
  5456. Jpg := TJPEGImage.Create;
  5457. try
  5458. AssignToBitmap(Bmp);
  5459. if FInternalFormat in [ifAlpha, ifLuminance, ifDepth8] then begin
  5460. Jpg.Grayscale := true;
  5461. Jpg.PixelFormat := jf8Bit;
  5462. end;
  5463. Jpg.Assign(Bmp);
  5464. Jpg.SaveToStream(Stream);
  5465. finally
  5466. FreeAndNil(Jpg);
  5467. end;
  5468. finally
  5469. FreeAndNil(Bmp);
  5470. end;
  5471. end;
  5472. {$ENDIF}
  5473. {$ENDIF}
  5474. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5475. //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5476. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5477. const
  5478. BMP_MAGIC = $4D42;
  5479. BMP_COMP_RGB = 0;
  5480. BMP_COMP_RLE8 = 1;
  5481. BMP_COMP_RLE4 = 2;
  5482. BMP_COMP_BITFIELDS = 3;
  5483. type
  5484. TBMPHeader = packed record
  5485. bfType: Word;
  5486. bfSize: Cardinal;
  5487. bfReserved1: Word;
  5488. bfReserved2: Word;
  5489. bfOffBits: Cardinal;
  5490. end;
  5491. TBMPInfo = packed record
  5492. biSize: Cardinal;
  5493. biWidth: Longint;
  5494. biHeight: Longint;
  5495. biPlanes: Word;
  5496. biBitCount: Word;
  5497. biCompression: Cardinal;
  5498. biSizeImage: Cardinal;
  5499. biXPelsPerMeter: Longint;
  5500. biYPelsPerMeter: Longint;
  5501. biClrUsed: Cardinal;
  5502. biClrImportant: Cardinal;
  5503. end;
  5504. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5505. function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
  5506. //////////////////////////////////////////////////////////////////////////////////////////////////
  5507. function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapColorRec): TglBitmapFormat;
  5508. begin
  5509. result := tfEmpty;
  5510. aStream.Read(aInfo{%H-}, SizeOf(aInfo));
  5511. FillChar(aMask{%H-}, SizeOf(aMask), 0);
  5512. //Read Compression
  5513. case aInfo.biCompression of
  5514. BMP_COMP_RLE4,
  5515. BMP_COMP_RLE8: begin
  5516. raise EglBitmapException.Create('RLE compression is not supported');
  5517. end;
  5518. BMP_COMP_BITFIELDS: begin
  5519. if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
  5520. aStream.Read(aMask.r, SizeOf(aMask.r));
  5521. aStream.Read(aMask.g, SizeOf(aMask.g));
  5522. aStream.Read(aMask.b, SizeOf(aMask.b));
  5523. aStream.Read(aMask.a, SizeOf(aMask.a));
  5524. end else
  5525. raise EglBitmapException.Create('Bitfields are only supported for 16bit and 32bit formats');
  5526. end;
  5527. end;
  5528. //get suitable format
  5529. case aInfo.biBitCount of
  5530. 8: result := tfLuminance8;
  5531. 16: result := tfBGR5;
  5532. 24: result := tfBGR8;
  5533. 32: result := tfBGRA8;
  5534. end;
  5535. end;
  5536. function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
  5537. var
  5538. i, c: Integer;
  5539. ColorTable: TbmpColorTable;
  5540. begin
  5541. result := nil;
  5542. if (aInfo.biBitCount >= 16) then
  5543. exit;
  5544. aFormat := tfLuminance8;
  5545. c := aInfo.biClrUsed;
  5546. if (c = 0) then
  5547. c := 1 shl aInfo.biBitCount;
  5548. SetLength(ColorTable, c);
  5549. for i := 0 to c-1 do begin
  5550. aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
  5551. if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
  5552. aFormat := tfRGB8;
  5553. end;
  5554. result := TbmpColorTableFormat.Create;
  5555. result.PixelSize := aInfo.biBitCount / 8;
  5556. result.ColorTable := ColorTable;
  5557. result.Range := glBitmapColorRec($FF, $FF, $FF, $00);
  5558. end;
  5559. //////////////////////////////////////////////////////////////////////////////////////////////////
  5560. function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
  5561. const aInfo: TBMPInfo): TbmpBitfieldFormat;
  5562. var
  5563. TmpFormat: TglBitmapFormat;
  5564. FormatDesc: TFormatDescriptor;
  5565. begin
  5566. result := nil;
  5567. if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
  5568. for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  5569. FormatDesc := TFormatDescriptor.Get(TmpFormat);
  5570. if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin
  5571. aFormat := FormatDesc.Format;
  5572. exit;
  5573. end;
  5574. end;
  5575. if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then
  5576. aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;
  5577. if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
  5578. aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;
  5579. result := TbmpBitfieldFormat.Create;
  5580. result.PixelSize := aInfo.biBitCount / 8;
  5581. result.RedMask := aMask.r;
  5582. result.GreenMask := aMask.g;
  5583. result.BlueMask := aMask.b;
  5584. result.AlphaMask := aMask.a;
  5585. end;
  5586. end;
  5587. var
  5588. //simple types
  5589. StartPos: Int64;
  5590. ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
  5591. PaddingBuff: Cardinal;
  5592. LineBuf, ImageData, TmpData: PByte;
  5593. SourceMD, DestMD: Pointer;
  5594. BmpFormat: TglBitmapFormat;
  5595. //records
  5596. Mask: TglBitmapColorRec;
  5597. Header: TBMPHeader;
  5598. Info: TBMPInfo;
  5599. //classes
  5600. SpecialFormat: TFormatDescriptor;
  5601. FormatDesc: TFormatDescriptor;
  5602. //////////////////////////////////////////////////////////////////////////////////////////////////
  5603. procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
  5604. var
  5605. i: Integer;
  5606. Pixel: TglBitmapPixelData;
  5607. begin
  5608. aStream.Read(aLineBuf^, rbLineSize);
  5609. SpecialFormat.PreparePixel(Pixel);
  5610. for i := 0 to Info.biWidth-1 do begin
  5611. SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
  5612. glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
  5613. FormatDesc.Map(Pixel, aData, DestMD);
  5614. end;
  5615. end;
  5616. begin
  5617. result := false;
  5618. BmpFormat := tfEmpty;
  5619. SpecialFormat := nil;
  5620. LineBuf := nil;
  5621. SourceMD := nil;
  5622. DestMD := nil;
  5623. // Header
  5624. StartPos := aStream.Position;
  5625. aStream.Read(Header{%H-}, SizeOf(Header));
  5626. if Header.bfType = BMP_MAGIC then begin
  5627. try try
  5628. BmpFormat := ReadInfo(Info, Mask);
  5629. SpecialFormat := ReadColorTable(BmpFormat, Info);
  5630. if not Assigned(SpecialFormat) then
  5631. SpecialFormat := CheckBitfields(BmpFormat, Mask, Info);
  5632. aStream.Position := StartPos + Header.bfOffBits;
  5633. if (BmpFormat <> tfEmpty) then begin
  5634. FormatDesc := TFormatDescriptor.Get(BmpFormat);
  5635. rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
  5636. wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);
  5637. Padding := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
  5638. //get Memory
  5639. DestMD := FormatDesc.CreateMappingData;
  5640. ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
  5641. GetMem(ImageData, ImageSize);
  5642. if Assigned(SpecialFormat) then begin
  5643. GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
  5644. SourceMD := SpecialFormat.CreateMappingData;
  5645. end;
  5646. //read Data
  5647. try try
  5648. FillChar(ImageData^, ImageSize, $FF);
  5649. TmpData := ImageData;
  5650. if (Info.biHeight > 0) then
  5651. Inc(TmpData, wbLineSize * (Info.biHeight-1));
  5652. for i := 0 to Abs(Info.biHeight)-1 do begin
  5653. if Assigned(SpecialFormat) then
  5654. SpecialFormatReadLine(TmpData, LineBuf) //if is special format read and convert data
  5655. else
  5656. aStream.Read(TmpData^, wbLineSize); //else only read data
  5657. if (Info.biHeight > 0) then
  5658. dec(TmpData, wbLineSize)
  5659. else
  5660. inc(TmpData, wbLineSize);
  5661. aStream.Read(PaddingBuff{%H-}, Padding);
  5662. end;
  5663. SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight));
  5664. result := true;
  5665. finally
  5666. if Assigned(LineBuf) then
  5667. FreeMem(LineBuf);
  5668. if Assigned(SourceMD) then
  5669. SpecialFormat.FreeMappingData(SourceMD);
  5670. FormatDesc.FreeMappingData(DestMD);
  5671. end;
  5672. except
  5673. FreeMem(ImageData);
  5674. raise;
  5675. end;
  5676. end else
  5677. raise EglBitmapException.Create('LoadBMP - No suitable format found');
  5678. except
  5679. aStream.Position := StartPos;
  5680. raise;
  5681. end;
  5682. finally
  5683. FreeAndNil(SpecialFormat);
  5684. end;
  5685. end
  5686. else aStream.Position := StartPos;
  5687. end;
  5688. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5689. procedure TglBitmap.SaveBMP(const aStream: TStream);
  5690. var
  5691. Header: TBMPHeader;
  5692. Info: TBMPInfo;
  5693. Converter: TbmpColorTableFormat;
  5694. FormatDesc: TFormatDescriptor;
  5695. SourceFD, DestFD: Pointer;
  5696. pData, srcData, dstData, ConvertBuffer: pByte;
  5697. Pixel: TglBitmapPixelData;
  5698. ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
  5699. RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
  5700. PaddingBuff: Cardinal;
  5701. function GetLineWidth : Integer;
  5702. begin
  5703. result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
  5704. end;
  5705. begin
  5706. if not (ftBMP in FormatGetSupportedFiles(Format)) then
  5707. raise EglBitmapUnsupportedFormat.Create(Format);
  5708. Converter := nil;
  5709. FormatDesc := TFormatDescriptor.Get(Format);
  5710. ImageSize := FormatDesc.GetSize(Dimension);
  5711. FillChar(Header{%H-}, SizeOf(Header), 0);
  5712. Header.bfType := BMP_MAGIC;
  5713. Header.bfSize := SizeOf(Header) + SizeOf(Info) + ImageSize;
  5714. Header.bfReserved1 := 0;
  5715. Header.bfReserved2 := 0;
  5716. Header.bfOffBits := SizeOf(Header) + SizeOf(Info);
  5717. FillChar(Info{%H-}, SizeOf(Info), 0);
  5718. Info.biSize := SizeOf(Info);
  5719. Info.biWidth := Width;
  5720. Info.biHeight := Height;
  5721. Info.biPlanes := 1;
  5722. Info.biCompression := BMP_COMP_RGB;
  5723. Info.biSizeImage := ImageSize;
  5724. try
  5725. case Format of
  5726. tfLuminance4: begin
  5727. Info.biBitCount := 4;
  5728. Header.bfSize := Header.bfSize + 16 * SizeOf(Cardinal);
  5729. Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
  5730. Converter := TbmpColorTableFormat.Create;
  5731. Converter.PixelSize := 0.5;
  5732. Converter.Format := Format;
  5733. Converter.Range := glBitmapColorRec($F, $F, $F, $0);
  5734. Converter.CreateColorTable;
  5735. end;
  5736. tfR3G3B2, tfLuminance8: begin
  5737. Info.biBitCount := 8;
  5738. Header.bfSize := Header.bfSize + 256 * SizeOf(Cardinal);
  5739. Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
  5740. Converter := TbmpColorTableFormat.Create;
  5741. Converter.PixelSize := 1;
  5742. Converter.Format := Format;
  5743. if (Format = tfR3G3B2) then begin
  5744. Converter.Range := glBitmapColorRec($7, $7, $3, $0);
  5745. Converter.Shift := glBitmapShiftRec(0, 3, 6, 0);
  5746. end else
  5747. Converter.Range := glBitmapColorRec($FF, $FF, $FF, $0);
  5748. Converter.CreateColorTable;
  5749. end;
  5750. tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
  5751. tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin
  5752. Info.biBitCount := 16;
  5753. Info.biCompression := BMP_COMP_BITFIELDS;
  5754. end;
  5755. tfBGR8, tfRGB8: begin
  5756. Info.biBitCount := 24;
  5757. end;
  5758. tfRGB10, tfRGB10A2, tfRGBA8,
  5759. tfBGR10, tfBGR10A2, tfBGRA8: begin
  5760. Info.biBitCount := 32;
  5761. Info.biCompression := BMP_COMP_BITFIELDS;
  5762. end;
  5763. else
  5764. raise EglBitmapUnsupportedFormat.Create(Format);
  5765. end;
  5766. Info.biXPelsPerMeter := 2835;
  5767. Info.biYPelsPerMeter := 2835;
  5768. // prepare bitmasks
  5769. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  5770. Header.bfSize := Header.bfSize + 4 * SizeOf(Cardinal);
  5771. Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
  5772. RedMask := FormatDesc.RedMask;
  5773. GreenMask := FormatDesc.GreenMask;
  5774. BlueMask := FormatDesc.BlueMask;
  5775. AlphaMask := FormatDesc.AlphaMask;
  5776. end;
  5777. // headers
  5778. aStream.Write(Header, SizeOf(Header));
  5779. aStream.Write(Info, SizeOf(Info));
  5780. // colortable
  5781. if Assigned(Converter) then
  5782. aStream.Write(Converter.ColorTable[0].b,
  5783. SizeOf(TbmpColorTableEnty) * Length(Converter.ColorTable));
  5784. // bitmasks
  5785. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  5786. aStream.Write(RedMask, SizeOf(Cardinal));
  5787. aStream.Write(GreenMask, SizeOf(Cardinal));
  5788. aStream.Write(BlueMask, SizeOf(Cardinal));
  5789. aStream.Write(AlphaMask, SizeOf(Cardinal));
  5790. end;
  5791. // image data
  5792. rbLineSize := Round(Info.biWidth * FormatDesc.PixelSize);
  5793. wbLineSize := Round(Info.biWidth * Info.biBitCount / 8);
  5794. Padding := GetLineWidth - wbLineSize;
  5795. PaddingBuff := 0;
  5796. pData := Data;
  5797. inc(pData, (Height-1) * rbLineSize);
  5798. // prepare row buffer. But only for RGB because RGBA supports color masks
  5799. // so it's possible to change color within the image.
  5800. if Assigned(Converter) then begin
  5801. FormatDesc.PreparePixel(Pixel);
  5802. GetMem(ConvertBuffer, wbLineSize);
  5803. SourceFD := FormatDesc.CreateMappingData;
  5804. DestFD := Converter.CreateMappingData;
  5805. end else
  5806. ConvertBuffer := nil;
  5807. try
  5808. for LineIdx := 0 to Height - 1 do begin
  5809. // preparing row
  5810. if Assigned(Converter) then begin
  5811. srcData := pData;
  5812. dstData := ConvertBuffer;
  5813. for PixelIdx := 0 to Info.biWidth-1 do begin
  5814. FormatDesc.Unmap(srcData, Pixel, SourceFD);
  5815. glBitmapConvertPixel(Pixel, FormatDesc, Converter);
  5816. Converter.Map(Pixel, dstData, DestFD);
  5817. end;
  5818. aStream.Write(ConvertBuffer^, wbLineSize);
  5819. end else begin
  5820. aStream.Write(pData^, rbLineSize);
  5821. end;
  5822. dec(pData, rbLineSize);
  5823. if (Padding > 0) then
  5824. aStream.Write(PaddingBuff, Padding);
  5825. end;
  5826. finally
  5827. // destroy row buffer
  5828. if Assigned(ConvertBuffer) then begin
  5829. FormatDesc.FreeMappingData(SourceFD);
  5830. Converter.FreeMappingData(DestFD);
  5831. FreeMem(ConvertBuffer);
  5832. end;
  5833. end;
  5834. finally
  5835. if Assigned(Converter) then
  5836. Converter.Free;
  5837. end;
  5838. end;
  5839. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5840. //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5841. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5842. type
  5843. TTGAHeader = packed record
  5844. ImageID: Byte;
  5845. ColorMapType: Byte;
  5846. ImageType: Byte;
  5847. //ColorMapSpec: Array[0..4] of Byte;
  5848. ColorMapStart: Word;
  5849. ColorMapLength: Word;
  5850. ColorMapEntrySize: Byte;
  5851. OrigX: Word;
  5852. OrigY: Word;
  5853. Width: Word;
  5854. Height: Word;
  5855. Bpp: Byte;
  5856. ImageDesc: Byte;
  5857. end;
  5858. const
  5859. TGA_UNCOMPRESSED_RGB = 2;
  5860. TGA_UNCOMPRESSED_GRAY = 3;
  5861. TGA_COMPRESSED_RGB = 10;
  5862. TGA_COMPRESSED_GRAY = 11;
  5863. TGA_NONE_COLOR_TABLE = 0;
  5864. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5865. function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
  5866. var
  5867. Header: TTGAHeader;
  5868. ImageData: System.PByte;
  5869. StartPosition: Int64;
  5870. PixelSize, LineSize: Integer;
  5871. tgaFormat: TglBitmapFormat;
  5872. FormatDesc: TFormatDescriptor;
  5873. Counter: packed record
  5874. X, Y: packed record
  5875. low, high, dir: Integer;
  5876. end;
  5877. end;
  5878. const
  5879. CACHE_SIZE = $4000;
  5880. ////////////////////////////////////////////////////////////////////////////////////////
  5881. procedure ReadUncompressed;
  5882. var
  5883. i, j: Integer;
  5884. buf, tmp1, tmp2: System.PByte;
  5885. begin
  5886. buf := nil;
  5887. if (Counter.X.dir < 0) then
  5888. buf := GetMem(LineSize);
  5889. try
  5890. while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
  5891. tmp1 := ImageData + (Counter.Y.low * LineSize); //pointer to LineStart
  5892. if (Counter.X.dir < 0) then begin //flip X
  5893. aStream.Read(buf^, LineSize);
  5894. tmp2 := buf + LineSize - PixelSize; //pointer to last pixel in line
  5895. for i := 0 to Header.Width-1 do begin //for all pixels in line
  5896. for j := 0 to PixelSize-1 do begin //for all bytes in pixel
  5897. tmp1^ := tmp2^;
  5898. inc(tmp1);
  5899. inc(tmp2);
  5900. end;
  5901. dec(tmp2, 2*PixelSize); //move 2 backwards, because j-loop moved 1 forward
  5902. end;
  5903. end else
  5904. aStream.Read(tmp1^, LineSize);
  5905. inc(Counter.Y.low, Counter.Y.dir); //move to next line index
  5906. end;
  5907. finally
  5908. if Assigned(buf) then
  5909. FreeMem(buf);
  5910. end;
  5911. end;
  5912. ////////////////////////////////////////////////////////////////////////////////////////
  5913. procedure ReadCompressed;
  5914. /////////////////////////////////////////////////////////////////
  5915. var
  5916. TmpData: System.PByte;
  5917. LinePixelsRead: Integer;
  5918. procedure CheckLine;
  5919. begin
  5920. if (LinePixelsRead >= Header.Width) then begin
  5921. LinePixelsRead := 0;
  5922. inc(Counter.Y.low, Counter.Y.dir); //next line index
  5923. TmpData := ImageData + Counter.Y.low * LineSize; //set line
  5924. if (Counter.X.dir < 0) then //if x flipped then
  5925. TmpData := TmpData + LineSize - PixelSize; //set last pixel
  5926. end;
  5927. end;
  5928. /////////////////////////////////////////////////////////////////
  5929. var
  5930. Cache: PByte;
  5931. CacheSize, CachePos: Integer;
  5932. procedure CachedRead(out Buffer; Count: Integer);
  5933. var
  5934. BytesRead: Integer;
  5935. begin
  5936. if (CachePos + Count > CacheSize) then begin
  5937. //if buffer overflow save non read bytes
  5938. BytesRead := 0;
  5939. if (CacheSize - CachePos > 0) then begin
  5940. BytesRead := CacheSize - CachePos;
  5941. Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
  5942. inc(CachePos, BytesRead);
  5943. end;
  5944. //load cache from file
  5945. CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
  5946. aStream.Read(Cache^, CacheSize);
  5947. CachePos := 0;
  5948. //read rest of requested bytes
  5949. if (Count - BytesRead > 0) then begin
  5950. Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
  5951. inc(CachePos, Count - BytesRead);
  5952. end;
  5953. end else begin
  5954. //if no buffer overflow just read the data
  5955. Move(PByteArray(Cache)^[CachePos], Buffer, Count);
  5956. inc(CachePos, Count);
  5957. end;
  5958. end;
  5959. procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
  5960. begin
  5961. case PixelSize of
  5962. 1: begin
  5963. aBuffer^ := aData^;
  5964. inc(aBuffer, Counter.X.dir);
  5965. end;
  5966. 2: begin
  5967. PWord(aBuffer)^ := PWord(aData)^;
  5968. inc(aBuffer, 2 * Counter.X.dir);
  5969. end;
  5970. 3: begin
  5971. PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
  5972. PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
  5973. PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
  5974. inc(aBuffer, 3 * Counter.X.dir);
  5975. end;
  5976. 4: begin
  5977. PCardinal(aBuffer)^ := PCardinal(aData)^;
  5978. inc(aBuffer, 4 * Counter.X.dir);
  5979. end;
  5980. end;
  5981. end;
  5982. var
  5983. TotalPixelsToRead, TotalPixelsRead: Integer;
  5984. Temp: Byte;
  5985. buf: array [0..3] of Byte; //1 pixel is max 32bit long
  5986. PixelRepeat: Boolean;
  5987. PixelsToRead, PixelCount: Integer;
  5988. begin
  5989. CacheSize := 0;
  5990. CachePos := 0;
  5991. TotalPixelsToRead := Header.Width * Header.Height;
  5992. TotalPixelsRead := 0;
  5993. LinePixelsRead := 0;
  5994. GetMem(Cache, CACHE_SIZE);
  5995. try
  5996. TmpData := ImageData + Counter.Y.low * LineSize; //set line
  5997. if (Counter.X.dir < 0) then //if x flipped then
  5998. TmpData := TmpData + LineSize - PixelSize; //set last pixel
  5999. repeat
  6000. //read CommandByte
  6001. CachedRead(Temp, 1);
  6002. PixelRepeat := (Temp and $80) > 0;
  6003. PixelsToRead := (Temp and $7F) + 1;
  6004. inc(TotalPixelsRead, PixelsToRead);
  6005. if PixelRepeat then
  6006. CachedRead(buf[0], PixelSize);
  6007. while (PixelsToRead > 0) do begin
  6008. CheckLine;
  6009. PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
  6010. while (PixelCount > 0) do begin
  6011. if not PixelRepeat then
  6012. CachedRead(buf[0], PixelSize);
  6013. PixelToBuffer(@buf[0], TmpData);
  6014. inc(LinePixelsRead);
  6015. dec(PixelsToRead);
  6016. dec(PixelCount);
  6017. end;
  6018. end;
  6019. until (TotalPixelsRead >= TotalPixelsToRead);
  6020. finally
  6021. FreeMem(Cache);
  6022. end;
  6023. end;
  6024. function IsGrayFormat: Boolean;
  6025. begin
  6026. result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
  6027. end;
  6028. begin
  6029. result := false;
  6030. // reading header to test file and set cursor back to begin
  6031. StartPosition := aStream.Position;
  6032. aStream.Read(Header{%H-}, SizeOf(Header));
  6033. // no colormapped files
  6034. if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
  6035. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
  6036. begin
  6037. try
  6038. if Header.ImageID <> 0 then // skip image ID
  6039. aStream.Position := aStream.Position + Header.ImageID;
  6040. case Header.Bpp of
  6041. 8: if IsGrayFormat then case (Header.ImageDesc and $F) of
  6042. 0: tgaFormat := tfLuminance8;
  6043. 8: tgaFormat := tfAlpha8;
  6044. end;
  6045. 16: if IsGrayFormat then case (Header.ImageDesc and $F) of
  6046. 0: tgaFormat := tfLuminance16;
  6047. 8: tgaFormat := tfLuminance8Alpha8;
  6048. end else case (Header.ImageDesc and $F) of
  6049. 0: tgaFormat := tfBGR5;
  6050. 1: tgaFormat := tfBGR5A1;
  6051. 4: tgaFormat := tfBGRA4;
  6052. end;
  6053. 24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  6054. 0: tgaFormat := tfBGR8;
  6055. end;
  6056. 32: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  6057. 2: tgaFormat := tfBGR10A2;
  6058. 8: tgaFormat := tfBGRA8;
  6059. end;
  6060. end;
  6061. if (tgaFormat = tfEmpty) then
  6062. raise EglBitmapException.Create('LoadTga - unsupported format');
  6063. FormatDesc := TFormatDescriptor.Get(tgaFormat);
  6064. PixelSize := FormatDesc.GetSize(1, 1);
  6065. LineSize := FormatDesc.GetSize(Header.Width, 1);
  6066. GetMem(ImageData, LineSize * Header.Height);
  6067. try
  6068. //column direction
  6069. if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
  6070. Counter.X.low := Header.Height-1;;
  6071. Counter.X.high := 0;
  6072. Counter.X.dir := -1;
  6073. end else begin
  6074. Counter.X.low := 0;
  6075. Counter.X.high := Header.Height-1;
  6076. Counter.X.dir := 1;
  6077. end;
  6078. // Row direction
  6079. if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
  6080. Counter.Y.low := 0;
  6081. Counter.Y.high := Header.Height-1;
  6082. Counter.Y.dir := 1;
  6083. end else begin
  6084. Counter.Y.low := Header.Height-1;;
  6085. Counter.Y.high := 0;
  6086. Counter.Y.dir := -1;
  6087. end;
  6088. // Read Image
  6089. case Header.ImageType of
  6090. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
  6091. ReadUncompressed;
  6092. TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
  6093. ReadCompressed;
  6094. end;
  6095. SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height);
  6096. result := true;
  6097. except
  6098. FreeMem(ImageData);
  6099. raise;
  6100. end;
  6101. finally
  6102. aStream.Position := StartPosition;
  6103. end;
  6104. end
  6105. else aStream.Position := StartPosition;
  6106. end;
  6107. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6108. procedure TglBitmap.SaveTGA(const aStream: TStream);
  6109. var
  6110. Header: TTGAHeader;
  6111. LineSize, Size, x, y: Integer;
  6112. Pixel: TglBitmapPixelData;
  6113. LineBuf, SourceData, DestData: PByte;
  6114. SourceMD, DestMD: Pointer;
  6115. FormatDesc: TFormatDescriptor;
  6116. Converter: TFormatDescriptor;
  6117. begin
  6118. if not (ftTGA in FormatGetSupportedFiles(Format)) then
  6119. raise EglBitmapUnsupportedFormat.Create(Format);
  6120. //prepare header
  6121. FillChar(Header{%H-}, SizeOf(Header), 0);
  6122. //set ImageType
  6123. if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,
  6124. tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then
  6125. Header.ImageType := TGA_UNCOMPRESSED_GRAY
  6126. else
  6127. Header.ImageType := TGA_UNCOMPRESSED_RGB;
  6128. //set BitsPerPixel
  6129. if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then
  6130. Header.Bpp := 8
  6131. else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,
  6132. tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then
  6133. Header.Bpp := 16
  6134. else if (Format in [tfBGR8, tfRGB8]) then
  6135. Header.Bpp := 24
  6136. else
  6137. Header.Bpp := 32;
  6138. //set AlphaBitCount
  6139. case Format of
  6140. tfRGB5A1, tfBGR5A1:
  6141. Header.ImageDesc := 1 and $F;
  6142. tfRGB10A2, tfBGR10A2:
  6143. Header.ImageDesc := 2 and $F;
  6144. tfRGBA4, tfBGRA4:
  6145. Header.ImageDesc := 4 and $F;
  6146. tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:
  6147. Header.ImageDesc := 8 and $F;
  6148. end;
  6149. Header.Width := Width;
  6150. Header.Height := Height;
  6151. Header.ImageDesc := Header.ImageDesc or $20; //flip y
  6152. aStream.Write(Header, SizeOf(Header));
  6153. // convert RGB(A) to BGR(A)
  6154. Converter := nil;
  6155. FormatDesc := TFormatDescriptor.Get(Format);
  6156. Size := FormatDesc.GetSize(Dimension);
  6157. if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin
  6158. if (FormatDesc.RGBInverted = tfEmpty) then
  6159. raise EglBitmapException.Create('inverted RGB format is empty');
  6160. Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);
  6161. if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or
  6162. (Converter.PixelSize <> FormatDesc.PixelSize) then
  6163. raise EglBitmapException.Create('invalid inverted RGB format');
  6164. end;
  6165. if Assigned(Converter) then begin
  6166. LineSize := FormatDesc.GetSize(Width, 1);
  6167. LineBuf := GetMem(LineSize);
  6168. SourceMD := FormatDesc.CreateMappingData;
  6169. DestMD := Converter.CreateMappingData;
  6170. try
  6171. SourceData := Data;
  6172. for y := 0 to Height-1 do begin
  6173. DestData := LineBuf;
  6174. for x := 0 to Width-1 do begin
  6175. FormatDesc.Unmap(SourceData, Pixel, SourceMD);
  6176. Converter.Map(Pixel, DestData, DestMD);
  6177. end;
  6178. aStream.Write(LineBuf^, LineSize);
  6179. end;
  6180. finally
  6181. FreeMem(LineBuf);
  6182. FormatDesc.FreeMappingData(SourceMD);
  6183. FormatDesc.FreeMappingData(DestMD);
  6184. end;
  6185. end else
  6186. aStream.Write(Data^, Size);
  6187. end;
  6188. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6189. //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6190. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6191. const
  6192. DDS_MAGIC: Cardinal = $20534444;
  6193. // DDS_header.dwFlags
  6194. DDSD_CAPS = $00000001;
  6195. DDSD_HEIGHT = $00000002;
  6196. DDSD_WIDTH = $00000004;
  6197. DDSD_PIXELFORMAT = $00001000;
  6198. // DDS_header.sPixelFormat.dwFlags
  6199. DDPF_ALPHAPIXELS = $00000001;
  6200. DDPF_ALPHA = $00000002;
  6201. DDPF_FOURCC = $00000004;
  6202. DDPF_RGB = $00000040;
  6203. DDPF_LUMINANCE = $00020000;
  6204. // DDS_header.sCaps.dwCaps1
  6205. DDSCAPS_TEXTURE = $00001000;
  6206. // DDS_header.sCaps.dwCaps2
  6207. DDSCAPS2_CUBEMAP = $00000200;
  6208. D3DFMT_DXT1 = $31545844;
  6209. D3DFMT_DXT3 = $33545844;
  6210. D3DFMT_DXT5 = $35545844;
  6211. type
  6212. TDDSPixelFormat = packed record
  6213. dwSize: Cardinal;
  6214. dwFlags: Cardinal;
  6215. dwFourCC: Cardinal;
  6216. dwRGBBitCount: Cardinal;
  6217. dwRBitMask: Cardinal;
  6218. dwGBitMask: Cardinal;
  6219. dwBBitMask: Cardinal;
  6220. dwABitMask: Cardinal;
  6221. end;
  6222. TDDSCaps = packed record
  6223. dwCaps1: Cardinal;
  6224. dwCaps2: Cardinal;
  6225. dwDDSX: Cardinal;
  6226. dwReserved: Cardinal;
  6227. end;
  6228. TDDSHeader = packed record
  6229. dwSize: Cardinal;
  6230. dwFlags: Cardinal;
  6231. dwHeight: Cardinal;
  6232. dwWidth: Cardinal;
  6233. dwPitchOrLinearSize: Cardinal;
  6234. dwDepth: Cardinal;
  6235. dwMipMapCount: Cardinal;
  6236. dwReserved: array[0..10] of Cardinal;
  6237. PixelFormat: TDDSPixelFormat;
  6238. Caps: TDDSCaps;
  6239. dwReserved2: Cardinal;
  6240. end;
  6241. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6242. function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
  6243. var
  6244. Header: TDDSHeader;
  6245. Converter: TbmpBitfieldFormat;
  6246. function GetDDSFormat: TglBitmapFormat;
  6247. var
  6248. fd: TFormatDescriptor;
  6249. i: Integer;
  6250. Range: TglBitmapColorRec;
  6251. match: Boolean;
  6252. begin
  6253. result := tfEmpty;
  6254. with Header.PixelFormat do begin
  6255. // Compresses
  6256. if ((dwFlags and DDPF_FOURCC) > 0) then begin
  6257. case Header.PixelFormat.dwFourCC of
  6258. D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
  6259. D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
  6260. D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
  6261. end;
  6262. end else if ((Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin
  6263. //find matching format
  6264. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  6265. fd := TFormatDescriptor.Get(result);
  6266. if fd.MaskMatch(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask) and
  6267. (8 * fd.PixelSize = dwRGBBitCount) then
  6268. exit;
  6269. end;
  6270. //find format with same Range
  6271. Range.r := dwRBitMask;
  6272. Range.g := dwGBitMask;
  6273. Range.b := dwBBitMask;
  6274. Range.a := dwABitMask;
  6275. for i := 0 to 3 do begin
  6276. while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do
  6277. Range.arr[i] := Range.arr[i] shr 1;
  6278. end;
  6279. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  6280. fd := TFormatDescriptor.Get(result);
  6281. match := true;
  6282. for i := 0 to 3 do
  6283. if (fd.Range.arr[i] <> Range.arr[i]) then begin
  6284. match := false;
  6285. break;
  6286. end;
  6287. if match then
  6288. break;
  6289. end;
  6290. //no format with same range found -> use default
  6291. if (result = tfEmpty) then begin
  6292. if (dwABitMask > 0) then
  6293. result := tfBGRA8
  6294. else
  6295. result := tfBGR8;
  6296. end;
  6297. Converter := TbmpBitfieldFormat.Create;
  6298. Converter.RedMask := dwRBitMask;
  6299. Converter.GreenMask := dwGBitMask;
  6300. Converter.BlueMask := dwBBitMask;
  6301. Converter.AlphaMask := dwABitMask;
  6302. Converter.PixelSize := dwRGBBitCount / 8;
  6303. end;
  6304. end;
  6305. end;
  6306. var
  6307. StreamPos: Int64;
  6308. x, y, LineSize, RowSize, Magic: Cardinal;
  6309. NewImage, TmpData, RowData, SrcData: System.PByte;
  6310. SourceMD, DestMD: Pointer;
  6311. Pixel: TglBitmapPixelData;
  6312. ddsFormat: TglBitmapFormat;
  6313. FormatDesc: TFormatDescriptor;
  6314. begin
  6315. result := false;
  6316. Converter := nil;
  6317. StreamPos := aStream.Position;
  6318. // Magic
  6319. aStream.Read(Magic{%H-}, sizeof(Magic));
  6320. if (Magic <> DDS_MAGIC) then begin
  6321. aStream.Position := StreamPos;
  6322. exit;
  6323. end;
  6324. //Header
  6325. aStream.Read(Header{%H-}, sizeof(Header));
  6326. if (Header.dwSize <> SizeOf(Header)) or
  6327. ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
  6328. (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
  6329. begin
  6330. aStream.Position := StreamPos;
  6331. exit;
  6332. end;
  6333. if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
  6334. raise EglBitmapException.Create('LoadDDS - CubeMaps are not supported');
  6335. ddsFormat := GetDDSFormat;
  6336. try
  6337. if (ddsFormat = tfEmpty) then
  6338. raise EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');
  6339. FormatDesc := TFormatDescriptor.Get(ddsFormat);
  6340. LineSize := Trunc(Header.dwWidth * FormatDesc.PixelSize);
  6341. GetMem(NewImage, Header.dwHeight * LineSize);
  6342. try
  6343. TmpData := NewImage;
  6344. //Converter needed
  6345. if Assigned(Converter) then begin
  6346. RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
  6347. GetMem(RowData, RowSize);
  6348. SourceMD := Converter.CreateMappingData;
  6349. DestMD := FormatDesc.CreateMappingData;
  6350. try
  6351. for y := 0 to Header.dwHeight-1 do begin
  6352. TmpData := NewImage + y * LineSize;
  6353. SrcData := RowData;
  6354. aStream.Read(SrcData^, RowSize);
  6355. for x := 0 to Header.dwWidth-1 do begin
  6356. Converter.Unmap(SrcData, Pixel, SourceMD);
  6357. glBitmapConvertPixel(Pixel, Converter, FormatDesc);
  6358. FormatDesc.Map(Pixel, TmpData, DestMD);
  6359. end;
  6360. end;
  6361. finally
  6362. Converter.FreeMappingData(SourceMD);
  6363. FormatDesc.FreeMappingData(DestMD);
  6364. FreeMem(RowData);
  6365. end;
  6366. end else
  6367. // Compressed
  6368. if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
  6369. RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
  6370. for Y := 0 to Header.dwHeight-1 do begin
  6371. aStream.Read(TmpData^, RowSize);
  6372. Inc(TmpData, LineSize);
  6373. end;
  6374. end else
  6375. // Uncompressed
  6376. if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
  6377. RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
  6378. for Y := 0 to Header.dwHeight-1 do begin
  6379. aStream.Read(TmpData^, RowSize);
  6380. Inc(TmpData, LineSize);
  6381. end;
  6382. end else
  6383. raise EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');
  6384. SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight);
  6385. result := true;
  6386. except
  6387. FreeMem(NewImage);
  6388. raise;
  6389. end;
  6390. finally
  6391. FreeAndNil(Converter);
  6392. end;
  6393. end;
  6394. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6395. procedure TglBitmap.SaveDDS(const aStream: TStream);
  6396. var
  6397. Header: TDDSHeader;
  6398. FormatDesc: TFormatDescriptor;
  6399. begin
  6400. if not (ftDDS in FormatGetSupportedFiles(Format)) then
  6401. raise EglBitmapUnsupportedFormat.Create(Format);
  6402. FormatDesc := TFormatDescriptor.Get(Format);
  6403. // Generell
  6404. FillChar(Header{%H-}, SizeOf(Header), 0);
  6405. Header.dwSize := SizeOf(Header);
  6406. Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
  6407. Header.dwWidth := Max(1, Width);
  6408. Header.dwHeight := Max(1, Height);
  6409. // Caps
  6410. Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
  6411. // Pixelformat
  6412. Header.PixelFormat.dwSize := sizeof(Header);
  6413. if (FormatDesc.IsCompressed) then begin
  6414. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
  6415. case Format of
  6416. tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
  6417. tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
  6418. tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
  6419. end;
  6420. end else if (Format in [tfAlpha8, tfAlpha16]) then begin
  6421. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHA;
  6422. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6423. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6424. end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin
  6425. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
  6426. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6427. Header.PixelFormat.dwRBitMask := FormatDesc.RedMask;
  6428. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6429. end else begin
  6430. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
  6431. Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);
  6432. Header.PixelFormat.dwRBitMask := FormatDesc.RedMask;
  6433. Header.PixelFormat.dwGBitMask := FormatDesc.GreenMask;
  6434. Header.PixelFormat.dwBBitMask := FormatDesc.BlueMask;
  6435. Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;
  6436. end;
  6437. if (FormatDesc.HasAlpha) then
  6438. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
  6439. aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
  6440. aStream.Write(Header, SizeOf(Header));
  6441. aStream.Write(Data^, FormatDesc.GetSize(Dimension));
  6442. end;
  6443. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6444. //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6445. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6446. function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
  6447. begin
  6448. if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
  6449. result := fLines[aIndex]
  6450. else
  6451. result := nil;
  6452. end;
  6453. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6454. procedure TglBitmap2D.SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
  6455. const aWidth: Integer; const aHeight: Integer);
  6456. var
  6457. Idx, LineWidth: Integer;
  6458. begin
  6459. inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
  6460. if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
  6461. (* TODO PixelFuncs
  6462. fGetPixelFunc := GetPixel2DUnmap;
  6463. fSetPixelFunc := SetPixel2DUnmap;
  6464. *)
  6465. // Assigning Data
  6466. if Assigned(Data) then begin
  6467. SetLength(fLines, GetHeight);
  6468. LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);
  6469. for Idx := 0 to GetHeight -1 do begin
  6470. fLines[Idx] := Data;
  6471. Inc(fLines[Idx], Idx * LineWidth);
  6472. end;
  6473. end
  6474. else SetLength(fLines, 0);
  6475. end else begin
  6476. SetLength(fLines, 0);
  6477. (*
  6478. fSetPixelFunc := nil;
  6479. case Format of
  6480. ifDXT1:
  6481. fGetPixelFunc := GetPixel2DDXT1;
  6482. ifDXT3:
  6483. fGetPixelFunc := GetPixel2DDXT3;
  6484. ifDXT5:
  6485. fGetPixelFunc := GetPixel2DDXT5;
  6486. else
  6487. fGetPixelFunc := nil;
  6488. end;
  6489. *)
  6490. end;
  6491. end;
  6492. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6493. procedure TglBitmap2D.UploadData(const aTarget: Cardinal; const aBuildWithGlu: Boolean);
  6494. var
  6495. FormatDesc: TFormatDescriptor;
  6496. begin
  6497. glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
  6498. FormatDesc := TFormatDescriptor.Get(Format);
  6499. if FormatDesc.IsCompressed then begin
  6500. glCompressedTexImage2D(Target, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)
  6501. end else if aBuildWithGlu then begin
  6502. gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,
  6503. FormatDesc.glFormat, FormatDesc.glDataFormat, Data)
  6504. end else begin
  6505. glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,
  6506. FormatDesc.glFormat, FormatDesc.glDataFormat, Data);
  6507. end;
  6508. // Freigeben
  6509. if (FreeDataAfterGenTexture) then
  6510. FreeData;
  6511. end;
  6512. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6513. procedure TglBitmap2D.AfterConstruction;
  6514. begin
  6515. inherited;
  6516. Target := GL_TEXTURE_2D;
  6517. end;
  6518. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6519. procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  6520. var
  6521. Temp: pByte;
  6522. Size, w, h: Integer;
  6523. FormatDesc: TFormatDescriptor;
  6524. begin
  6525. FormatDesc := TFormatDescriptor.Get(Format);
  6526. if FormatDesc.IsCompressed then
  6527. raise EglBitmapUnsupportedFormat.Create(Format);
  6528. w := aRight - aLeft;
  6529. h := aBottom - aTop;
  6530. Size := FormatDesc.GetSize(w, h);
  6531. GetMem(Temp, Size);
  6532. try
  6533. glPixelStorei(GL_PACK_ALIGNMENT, 1);
  6534. glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  6535. SetDataPointer(Temp, Format, w, h);
  6536. FlipVert;
  6537. except
  6538. FreeMem(Temp);
  6539. raise;
  6540. end;
  6541. end;
  6542. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6543. procedure TglBitmap2D.GetDataFromTexture;
  6544. var
  6545. Temp: PByte;
  6546. TempWidth, TempHeight: Integer;
  6547. TempIntFormat: Cardinal;
  6548. IntFormat, f: TglBitmapFormat;
  6549. FormatDesc: TFormatDescriptor;
  6550. begin
  6551. Bind;
  6552. // Request Data
  6553. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH, @TempWidth);
  6554. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT, @TempHeight);
  6555. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
  6556. IntFormat := tfEmpty;
  6557. for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
  6558. FormatDesc := TFormatDescriptor.Get(f);
  6559. if (FormatDesc.glInternalFormat = TempIntFormat) then begin
  6560. IntFormat := FormatDesc.Format;
  6561. break;
  6562. end;
  6563. end;
  6564. // Getting data from OpenGL
  6565. FormatDesc := TFormatDescriptor.Get(IntFormat);
  6566. GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
  6567. try
  6568. if FormatDesc.IsCompressed then
  6569. glGetCompressedTexImage(Target, 0, Temp)
  6570. else
  6571. glGetTexImage(Target, 0, FormatDesc.glInternalFormat, FormatDesc.glDataFormat, Temp);
  6572. SetDataPointer(Temp, IntFormat, TempWidth, TempHeight);
  6573. except
  6574. FreeMem(Temp);
  6575. raise;
  6576. end;
  6577. end;
  6578. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6579. procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
  6580. var
  6581. BuildWithGlu, PotTex, TexRec: Boolean;
  6582. TexSize: Integer;
  6583. begin
  6584. if Assigned(Data) then begin
  6585. // Check Texture Size
  6586. if (aTestTextureSize) then begin
  6587. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  6588. if ((Height > TexSize) or (Width > TexSize)) then
  6589. raise EglBitmapSizeToLargeException.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  6590. PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
  6591. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
  6592. if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  6593. raise EglBitmapNonPowerOfTwoException.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  6594. end;
  6595. CreateId;
  6596. SetupParameters(BuildWithGlu);
  6597. UploadData(Target, BuildWithGlu);
  6598. glAreTexturesResident(1, @fID, @fIsResident);
  6599. end;
  6600. end;
  6601. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6602. function TglBitmap2D.FlipHorz: Boolean;
  6603. var
  6604. Col, Row: Integer;
  6605. TempDestData, DestData, SourceData: PByte;
  6606. ImgSize: Integer;
  6607. begin
  6608. result := inherited FlipHorz;
  6609. if Assigned(Data) then begin
  6610. SourceData := Data;
  6611. ImgSize := Height * fRowSize;
  6612. GetMem(DestData, ImgSize);
  6613. try
  6614. TempDestData := DestData;
  6615. Dec(TempDestData, fRowSize + fPixelSize);
  6616. for Row := 0 to Height -1 do begin
  6617. Inc(TempDestData, fRowSize * 2);
  6618. for Col := 0 to Width -1 do begin
  6619. Move(SourceData^, TempDestData^, fPixelSize);
  6620. Inc(SourceData, fPixelSize);
  6621. Dec(TempDestData, fPixelSize);
  6622. end;
  6623. end;
  6624. SetDataPointer(DestData, Format);
  6625. result := true;
  6626. except
  6627. FreeMem(DestData);
  6628. raise;
  6629. end;
  6630. end;
  6631. end;
  6632. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6633. function TglBitmap2D.FlipVert: Boolean;
  6634. var
  6635. Row: Integer;
  6636. TempDestData, DestData, SourceData: PByte;
  6637. begin
  6638. result := inherited FlipVert;
  6639. if Assigned(Data) then begin
  6640. SourceData := Data;
  6641. GetMem(DestData, Height * fRowSize);
  6642. try
  6643. TempDestData := DestData;
  6644. Inc(TempDestData, Width * (Height -1) * fPixelSize);
  6645. for Row := 0 to Height -1 do begin
  6646. Move(SourceData^, TempDestData^, fRowSize);
  6647. Dec(TempDestData, fRowSize);
  6648. Inc(SourceData, fRowSize);
  6649. end;
  6650. SetDataPointer(DestData, Format);
  6651. result := true;
  6652. except
  6653. FreeMem(DestData);
  6654. raise;
  6655. end;
  6656. end;
  6657. end;
  6658. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6659. //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6660. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6661. type
  6662. TMatrixItem = record
  6663. X, Y: Integer;
  6664. W: Single;
  6665. end;
  6666. PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
  6667. TglBitmapToNormalMapRec = Record
  6668. Scale: Single;
  6669. Heights: array of Single;
  6670. MatrixU : array of TMatrixItem;
  6671. MatrixV : array of TMatrixItem;
  6672. end;
  6673. const
  6674. ONE_OVER_255 = 1 / 255;
  6675. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6676. procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
  6677. var
  6678. Val: Single;
  6679. begin
  6680. with FuncRec do begin
  6681. Val :=
  6682. Source.Data.r * LUMINANCE_WEIGHT_R +
  6683. Source.Data.g * LUMINANCE_WEIGHT_G +
  6684. Source.Data.b * LUMINANCE_WEIGHT_B;
  6685. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
  6686. end;
  6687. end;
  6688. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6689. procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  6690. begin
  6691. with FuncRec do
  6692. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
  6693. end;
  6694. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6695. procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
  6696. type
  6697. TVec = Array[0..2] of Single;
  6698. var
  6699. Idx: Integer;
  6700. du, dv: Double;
  6701. Len: Single;
  6702. Vec: TVec;
  6703. function GetHeight(X, Y: Integer): Single;
  6704. begin
  6705. with FuncRec do begin
  6706. X := Max(0, Min(Size.X -1, X));
  6707. Y := Max(0, Min(Size.Y -1, Y));
  6708. result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
  6709. end;
  6710. end;
  6711. begin
  6712. with FuncRec do begin
  6713. with PglBitmapToNormalMapRec(Args)^ do begin
  6714. du := 0;
  6715. for Idx := Low(MatrixU) to High(MatrixU) do
  6716. du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
  6717. dv := 0;
  6718. for Idx := Low(MatrixU) to High(MatrixU) do
  6719. dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
  6720. Vec[0] := -du * Scale;
  6721. Vec[1] := -dv * Scale;
  6722. Vec[2] := 1;
  6723. end;
  6724. // Normalize
  6725. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  6726. if Len <> 0 then begin
  6727. Vec[0] := Vec[0] * Len;
  6728. Vec[1] := Vec[1] * Len;
  6729. Vec[2] := Vec[2] * Len;
  6730. end;
  6731. // Farbe zuweisem
  6732. Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
  6733. Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
  6734. Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
  6735. end;
  6736. end;
  6737. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6738. procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
  6739. var
  6740. Rec: TglBitmapToNormalMapRec;
  6741. procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
  6742. begin
  6743. if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
  6744. Matrix[Index].X := X;
  6745. Matrix[Index].Y := Y;
  6746. Matrix[Index].W := W;
  6747. end;
  6748. end;
  6749. begin
  6750. if TFormatDescriptor.Get(Format).IsCompressed then
  6751. raise EglBitmapUnsupportedFormat.Create(Format);
  6752. if aScale > 100 then
  6753. Rec.Scale := 100
  6754. else if aScale < -100 then
  6755. Rec.Scale := -100
  6756. else
  6757. Rec.Scale := aScale;
  6758. SetLength(Rec.Heights, Width * Height);
  6759. try
  6760. case aFunc of
  6761. nm4Samples: begin
  6762. SetLength(Rec.MatrixU, 2);
  6763. SetEntry(Rec.MatrixU, 0, -1, 0, -0.5);
  6764. SetEntry(Rec.MatrixU, 1, 1, 0, 0.5);
  6765. SetLength(Rec.MatrixV, 2);
  6766. SetEntry(Rec.MatrixV, 0, 0, 1, 0.5);
  6767. SetEntry(Rec.MatrixV, 1, 0, -1, -0.5);
  6768. end;
  6769. nmSobel: begin
  6770. SetLength(Rec.MatrixU, 6);
  6771. SetEntry(Rec.MatrixU, 0, -1, 1, -1.0);
  6772. SetEntry(Rec.MatrixU, 1, -1, 0, -2.0);
  6773. SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
  6774. SetEntry(Rec.MatrixU, 3, 1, 1, 1.0);
  6775. SetEntry(Rec.MatrixU, 4, 1, 0, 2.0);
  6776. SetEntry(Rec.MatrixU, 5, 1, -1, 1.0);
  6777. SetLength(Rec.MatrixV, 6);
  6778. SetEntry(Rec.MatrixV, 0, -1, 1, 1.0);
  6779. SetEntry(Rec.MatrixV, 1, 0, 1, 2.0);
  6780. SetEntry(Rec.MatrixV, 2, 1, 1, 1.0);
  6781. SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
  6782. SetEntry(Rec.MatrixV, 4, 0, -1, -2.0);
  6783. SetEntry(Rec.MatrixV, 5, 1, -1, -1.0);
  6784. end;
  6785. nm3x3: begin
  6786. SetLength(Rec.MatrixU, 6);
  6787. SetEntry(Rec.MatrixU, 0, -1, 1, -1/6);
  6788. SetEntry(Rec.MatrixU, 1, -1, 0, -1/6);
  6789. SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
  6790. SetEntry(Rec.MatrixU, 3, 1, 1, 1/6);
  6791. SetEntry(Rec.MatrixU, 4, 1, 0, 1/6);
  6792. SetEntry(Rec.MatrixU, 5, 1, -1, 1/6);
  6793. SetLength(Rec.MatrixV, 6);
  6794. SetEntry(Rec.MatrixV, 0, -1, 1, 1/6);
  6795. SetEntry(Rec.MatrixV, 1, 0, 1, 1/6);
  6796. SetEntry(Rec.MatrixV, 2, 1, 1, 1/6);
  6797. SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
  6798. SetEntry(Rec.MatrixV, 4, 0, -1, -1/6);
  6799. SetEntry(Rec.MatrixV, 5, 1, -1, -1/6);
  6800. end;
  6801. nm5x5: begin
  6802. SetLength(Rec.MatrixU, 20);
  6803. SetEntry(Rec.MatrixU, 0, -2, 2, -1 / 16);
  6804. SetEntry(Rec.MatrixU, 1, -1, 2, -1 / 10);
  6805. SetEntry(Rec.MatrixU, 2, 1, 2, 1 / 10);
  6806. SetEntry(Rec.MatrixU, 3, 2, 2, 1 / 16);
  6807. SetEntry(Rec.MatrixU, 4, -2, 1, -1 / 10);
  6808. SetEntry(Rec.MatrixU, 5, -1, 1, -1 / 8);
  6809. SetEntry(Rec.MatrixU, 6, 1, 1, 1 / 8);
  6810. SetEntry(Rec.MatrixU, 7, 2, 1, 1 / 10);
  6811. SetEntry(Rec.MatrixU, 8, -2, 0, -1 / 2.8);
  6812. SetEntry(Rec.MatrixU, 9, -1, 0, -0.5);
  6813. SetEntry(Rec.MatrixU, 10, 1, 0, 0.5);
  6814. SetEntry(Rec.MatrixU, 11, 2, 0, 1 / 2.8);
  6815. SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
  6816. SetEntry(Rec.MatrixU, 13, -1, -1, -1 / 8);
  6817. SetEntry(Rec.MatrixU, 14, 1, -1, 1 / 8);
  6818. SetEntry(Rec.MatrixU, 15, 2, -1, 1 / 10);
  6819. SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
  6820. SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
  6821. SetEntry(Rec.MatrixU, 18, 1, -2, 1 / 10);
  6822. SetEntry(Rec.MatrixU, 19, 2, -2, 1 / 16);
  6823. SetLength(Rec.MatrixV, 20);
  6824. SetEntry(Rec.MatrixV, 0, -2, 2, 1 / 16);
  6825. SetEntry(Rec.MatrixV, 1, -1, 2, 1 / 10);
  6826. SetEntry(Rec.MatrixV, 2, 0, 2, 0.25);
  6827. SetEntry(Rec.MatrixV, 3, 1, 2, 1 / 10);
  6828. SetEntry(Rec.MatrixV, 4, 2, 2, 1 / 16);
  6829. SetEntry(Rec.MatrixV, 5, -2, 1, 1 / 10);
  6830. SetEntry(Rec.MatrixV, 6, -1, 1, 1 / 8);
  6831. SetEntry(Rec.MatrixV, 7, 0, 1, 0.5);
  6832. SetEntry(Rec.MatrixV, 8, 1, 1, 1 / 8);
  6833. SetEntry(Rec.MatrixV, 9, 2, 1, 1 / 16);
  6834. SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
  6835. SetEntry(Rec.MatrixV, 11, -1, -1, -1 / 8);
  6836. SetEntry(Rec.MatrixV, 12, 0, -1, -0.5);
  6837. SetEntry(Rec.MatrixV, 13, 1, -1, -1 / 8);
  6838. SetEntry(Rec.MatrixV, 14, 2, -1, -1 / 10);
  6839. SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
  6840. SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
  6841. SetEntry(Rec.MatrixV, 17, 0, -2, -0.25);
  6842. SetEntry(Rec.MatrixV, 18, 1, -2, -1 / 10);
  6843. SetEntry(Rec.MatrixV, 19, 2, -2, -1 / 16);
  6844. end;
  6845. end;
  6846. // Daten Sammeln
  6847. if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
  6848. AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
  6849. else
  6850. AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);
  6851. AddFunc(glBitmapToNormalMapFunc, false, @Rec);
  6852. finally
  6853. SetLength(Rec.Heights, 0);
  6854. end;
  6855. end;
  6856. (*
  6857. procedure TglBitmap1D.SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width, Height: Integer);
  6858. var
  6859. pTemp: pByte;
  6860. Size: Integer;
  6861. begin
  6862. if Height > 1 then begin
  6863. // extract first line of the data
  6864. Size := FormatGetImageSize(glBitmapPosition(Width), Format);
  6865. GetMem(pTemp, Size);
  6866. Move(Data^, pTemp^, Size);
  6867. FreeMem(Data);
  6868. end else
  6869. pTemp := Data;
  6870. // set data pointer
  6871. inherited SetDataPointer(pTemp, Format, Width);
  6872. if FormatIsUncompressed(Format) then begin
  6873. fUnmapFunc := FormatGetUnMapFunc(Format);
  6874. fGetPixelFunc := GetPixel1DUnmap;
  6875. end;
  6876. end;
  6877. procedure TglBitmap1D.GetPixel1DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
  6878. var
  6879. pTemp: pByte;
  6880. begin
  6881. pTemp := Data;
  6882. Inc(pTemp, Pos.X * fPixelSize);
  6883. fUnmapFunc(pTemp, Pixel);
  6884. end;
  6885. function TglBitmap1D.FlipHorz: Boolean;
  6886. var
  6887. Col: Integer;
  6888. pTempDest, pDest, pSource: pByte;
  6889. begin
  6890. result := inherited FlipHorz;
  6891. if Assigned(Data) and FormatIsUncompressed(InternalFormat) then begin
  6892. pSource := Data;
  6893. GetMem(pDest, fRowSize);
  6894. try
  6895. pTempDest := pDest;
  6896. Inc(pTempDest, fRowSize);
  6897. for Col := 0 to Width -1 do begin
  6898. Move(pSource^, pTempDest^, fPixelSize);
  6899. Inc(pSource, fPixelSize);
  6900. Dec(pTempDest, fPixelSize);
  6901. end;
  6902. SetDataPointer(pDest, InternalFormat);
  6903. result := true;
  6904. finally
  6905. FreeMem(pDest);
  6906. end;
  6907. end;
  6908. end;
  6909. procedure TglBitmap1D.UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
  6910. begin
  6911. // Upload data
  6912. if Self.InternalFormat in [ifDXT1, ifDXT3, ifDXT5] then
  6913. glCompressedTexImage1D(Target, 0, InternalFormat, Width, 0, Trunc(Width * FormatGetSize(Self.InternalFormat)), Data)
  6914. else
  6915. // Upload data
  6916. if BuildWithGlu then
  6917. gluBuild1DMipmaps(Target, InternalFormat, Width, Format, Typ, Data)
  6918. else
  6919. glTexImage1D(Target, 0, InternalFormat, Width, 0, Format, Typ, Data);
  6920. // Freigeben
  6921. if (FreeDataAfterGenTexture) then
  6922. FreeData;
  6923. end;
  6924. procedure TglBitmap1D.GenTexture(TestTextureSize: Boolean);
  6925. var
  6926. BuildWithGlu, TexRec: Boolean;
  6927. glFormat, glInternalFormat, glType: Cardinal;
  6928. TexSize: Integer;
  6929. begin
  6930. if Assigned(Data) then begin
  6931. // Check Texture Size
  6932. if (TestTextureSize) then begin
  6933. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  6934. if (Width > TexSize) then
  6935. raise EglBitmapSizeToLargeException.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  6936. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
  6937. (Target = GL_TEXTURE_RECTANGLE_ARB);
  6938. if not (IsPowerOfTwo (Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  6939. raise EglBitmapNonPowerOfTwoException.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  6940. end;
  6941. CreateId;
  6942. SetupParameters(BuildWithGlu);
  6943. SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
  6944. UploadData(Target, glFormat, glInternalFormat, glType, BuildWithGlu);
  6945. // Infos sammeln
  6946. glAreTexturesResident(1, @fID, @fIsResident);
  6947. end;
  6948. end;
  6949. procedure TglBitmap1D.AfterConstruction;
  6950. begin
  6951. inherited;
  6952. Target := GL_TEXTURE_1D;
  6953. end;
  6954. { TglBitmapCubeMap }
  6955. procedure TglBitmapCubeMap.AfterConstruction;
  6956. begin
  6957. inherited;
  6958. if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
  6959. raise EglBitmapException.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
  6960. SetWrap; // set all to GL_CLAMP_TO_EDGE
  6961. Target := GL_TEXTURE_CUBE_MAP;
  6962. fGenMode := GL_REFLECTION_MAP;
  6963. end;
  6964. procedure TglBitmapCubeMap.Bind(EnableTexCoordsGen, EnableTextureUnit: Boolean);
  6965. begin
  6966. inherited Bind (EnableTextureUnit);
  6967. if EnableTexCoordsGen then begin
  6968. glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
  6969. glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
  6970. glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
  6971. glEnable(GL_TEXTURE_GEN_S);
  6972. glEnable(GL_TEXTURE_GEN_T);
  6973. glEnable(GL_TEXTURE_GEN_R);
  6974. end;
  6975. end;
  6976. procedure TglBitmapCubeMap.GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean);
  6977. var
  6978. glFormat, glInternalFormat, glType: Cardinal;
  6979. BuildWithGlu: Boolean;
  6980. TexSize: Integer;
  6981. begin
  6982. // Check Texture Size
  6983. if (TestTextureSize) then begin
  6984. glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
  6985. if ((Height > TexSize) or (Width > TexSize)) then
  6986. raise EglBitmapSizeToLargeException.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
  6987. if not ((IsPowerOfTwo (Height) and IsPowerOfTwo (Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
  6988. raise EglBitmapNonPowerOfTwoException.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
  6989. end;
  6990. // create Texture
  6991. if ID = 0 then begin
  6992. CreateID;
  6993. SetupParameters(BuildWithGlu);
  6994. end;
  6995. SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
  6996. UploadData (CubeTarget, glFormat, glInternalFormat, glType, BuildWithGlu);
  6997. end;
  6998. procedure TglBitmapCubeMap.GenTexture(TestTextureSize: Boolean);
  6999. begin
  7000. Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
  7001. end;
  7002. procedure TglBitmapCubeMap.Unbind(DisableTexCoordsGen,
  7003. DisableTextureUnit: Boolean);
  7004. begin
  7005. inherited Unbind (DisableTextureUnit);
  7006. if DisableTexCoordsGen then begin
  7007. glDisable(GL_TEXTURE_GEN_S);
  7008. glDisable(GL_TEXTURE_GEN_T);
  7009. glDisable(GL_TEXTURE_GEN_R);
  7010. end;
  7011. end;
  7012. { TglBitmapNormalMap }
  7013. type
  7014. TVec = Array[0..2] of Single;
  7015. TglBitmapNormalMapGetVectorFunc = procedure (var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  7016. PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
  7017. TglBitmapNormalMapRec = record
  7018. HalfSize : Integer;
  7019. Func: TglBitmapNormalMapGetVectorFunc;
  7020. end;
  7021. procedure glBitmapNormalMapPosX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  7022. begin
  7023. Vec[0] := HalfSize;
  7024. Vec[1] := - (Position.Y + 0.5 - HalfSize);
  7025. Vec[2] := - (Position.X + 0.5 - HalfSize);
  7026. end;
  7027. procedure glBitmapNormalMapNegX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  7028. begin
  7029. Vec[0] := - HalfSize;
  7030. Vec[1] := - (Position.Y + 0.5 - HalfSize);
  7031. Vec[2] := Position.X + 0.5 - HalfSize;
  7032. end;
  7033. procedure glBitmapNormalMapPosY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  7034. begin
  7035. Vec[0] := Position.X + 0.5 - HalfSize;
  7036. Vec[1] := HalfSize;
  7037. Vec[2] := Position.Y + 0.5 - HalfSize;
  7038. end;
  7039. procedure glBitmapNormalMapNegY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  7040. begin
  7041. Vec[0] := Position.X + 0.5 - HalfSize;
  7042. Vec[1] := - HalfSize;
  7043. Vec[2] := - (Position.Y + 0.5 - HalfSize);
  7044. end;
  7045. procedure glBitmapNormalMapPosZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  7046. begin
  7047. Vec[0] := Position.X + 0.5 - HalfSize;
  7048. Vec[1] := - (Position.Y + 0.5 - HalfSize);
  7049. Vec[2] := HalfSize;
  7050. end;
  7051. procedure glBitmapNormalMapNegZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  7052. begin
  7053. Vec[0] := - (Position.X + 0.5 - HalfSize);
  7054. Vec[1] := - (Position.Y + 0.5 - HalfSize);
  7055. Vec[2] := - HalfSize;
  7056. end;
  7057. procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
  7058. var
  7059. Vec : TVec;
  7060. Len: Single;
  7061. begin
  7062. with FuncRec do begin
  7063. with PglBitmapNormalMapRec (CustomData)^ do begin
  7064. Func(Vec, Position, HalfSize);
  7065. // Normalize
  7066. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  7067. if Len <> 0 then begin
  7068. Vec[0] := Vec[0] * Len;
  7069. Vec[1] := Vec[1] * Len;
  7070. Vec[2] := Vec[2] * Len;
  7071. end;
  7072. // Scale Vector and AddVectro
  7073. Vec[0] := Vec[0] * 0.5 + 0.5;
  7074. Vec[1] := Vec[1] * 0.5 + 0.5;
  7075. Vec[2] := Vec[2] * 0.5 + 0.5;
  7076. end;
  7077. // Set Color
  7078. Dest.Red := Round(Vec[0] * 255);
  7079. Dest.Green := Round(Vec[1] * 255);
  7080. Dest.Blue := Round(Vec[2] * 255);
  7081. end;
  7082. end;
  7083. procedure TglBitmapNormalMap.AfterConstruction;
  7084. begin
  7085. inherited;
  7086. fGenMode := GL_NORMAL_MAP;
  7087. end;
  7088. procedure TglBitmapNormalMap.GenerateNormalMap(Size: Integer;
  7089. TestTextureSize: Boolean);
  7090. var
  7091. Rec: TglBitmapNormalMapRec;
  7092. SizeRec: TglBitmapPixelPosition;
  7093. begin
  7094. Rec.HalfSize := Size div 2;
  7095. FreeDataAfterGenTexture := false;
  7096. SizeRec.Fields := [ffX, ffY];
  7097. SizeRec.X := Size;
  7098. SizeRec.Y := Size;
  7099. // Positive X
  7100. Rec.Func := glBitmapNormalMapPosX;
  7101. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  7102. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, TestTextureSize);
  7103. // Negative X
  7104. Rec.Func := glBitmapNormalMapNegX;
  7105. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  7106. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, TestTextureSize);
  7107. // Positive Y
  7108. Rec.Func := glBitmapNormalMapPosY;
  7109. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  7110. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, TestTextureSize);
  7111. // Negative Y
  7112. Rec.Func := glBitmapNormalMapNegY;
  7113. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  7114. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, TestTextureSize);
  7115. // Positive Z
  7116. Rec.Func := glBitmapNormalMapPosZ;
  7117. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  7118. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, TestTextureSize);
  7119. // Negative Z
  7120. Rec.Func := glBitmapNormalMapNegZ;
  7121. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  7122. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, TestTextureSize);
  7123. end;
  7124. *)
  7125. initialization
  7126. glBitmapSetDefaultFormat(tfEmpty);
  7127. glBitmapSetDefaultMipmap(mmMipmap);
  7128. glBitmapSetDefaultFilter(GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
  7129. glBitmapSetDefaultWrap (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
  7130. glBitmapSetDefaultFreeDataAfterGenTexture(true);
  7131. glBitmapSetDefaultDeleteTextureOnFree (true);
  7132. TFormatDescriptor.Init;
  7133. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  7134. OpenGLInitialized := false;
  7135. InitOpenGLCS := TCriticalSection.Create;
  7136. {$ENDIF}
  7137. finalization
  7138. TFormatDescriptor.Finalize;
  7139. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}
  7140. FreeAndNil(InitOpenGLCS);
  7141. {$ENDIF}
  7142. end.