Nevar pievienot vairāk kā 25 tēmas Tēmai ir jāsākas ar burtu vai ciparu, tā var saturēt domu zīmes ('-') un var būt līdz 35 simboliem gara.

6758 rindas
225 KiB

  1. {***********************************************************
  2. glBitmap by Steffen Xonna aka Lossy eX (2003-2008)
  3. http://www.opengl24.de/index.php?cat=header&file=glbitmap
  4. ------------------------------------------------------------
  5. The contents of this file are used with permission, subject to
  6. the Mozilla Public License Version 1.1 (the "License"); you may
  7. not use this file except in compliance with the License. You may
  8. obtain a copy of the License at
  9. http://www.mozilla.org/MPL/MPL-1.1.html
  10. ------------------------------------------------------------
  11. Version 2.0.3
  12. ------------------------------------------------------------
  13. History
  14. 21-03-2010
  15. - The define GLB_DELPHI dosn't check versions anymore. If you say you are using delphi
  16. then it's your problem if that isn't true. This prevents the unit for incompatibility
  17. with newer versions of Delphi.
  18. - Problems with D2009+ resolved (Thanks noeska and all i forgot)
  19. - GetPixel isn't set if you are loading textures inside the constructor (Thanks Wilson)
  20. 10-08-2008
  21. - AddAlphaFromglBitmap used the custom pointer instead the imagedatapointer (Thanks Wilson)
  22. - Additional Datapointer for functioninterface now has the name CustomData
  23. 24-07-2008
  24. - AssigneAlphaToBitmap overwrites his own palette (Thanks Wilson)
  25. - If you load an texture from an file the property Filename will be set to the name of the file
  26. - Three new properties to attach custom data to the Texture objects
  27. - CustomName (free for use string)
  28. - CustomNameW (free for use widestring)
  29. - CustomDataPointer (free for use pointer to attach other objects or complex structures)
  30. 27-05-2008
  31. - RLE TGAs loaded much faster
  32. 26-05-2008
  33. - fixed some problem with reading RLE TGAs.
  34. 21-05-2008
  35. - function clone now only copys data if it's assigned and now it also copies the ID
  36. - it seems that lazarus dont like comments in comments.
  37. 01-05-2008
  38. - It's possible to set the id of the texture
  39. - define GLB_NO_NATIVE_GL deactivated by default
  40. 27-04-2008
  41. - Now supports the following libraries
  42. - SDL and SDL_image
  43. - libPNG
  44. - libJPEG
  45. - Linux compatibillity via free pascal compatibility (delphi sources optional)
  46. - BMPs now loaded manuel
  47. - Large restructuring
  48. - Property DataPtr now has the name Data
  49. - Functions are more flexible between RGB(A) and BGR(A). RGB can be saved as Bitmap and will be saved as BGR
  50. - Unused Depth removed
  51. - Function FreeData to freeing image data added
  52. 24-10-2007
  53. - ImageID flag of TGAs was ignored. (Thanks Zwoetzen)
  54. 15-11-2006
  55. - Function SetBorderColor implemented (only used by opengl if wrap is set to GL_CLAMP_TO_BORDER)
  56. - Function AddAlphaFromValue implemented to use an fixed Value as Alphachannel
  57. - Function ReadOpenGLExtension is now only intern
  58. 29-06-2006
  59. - pngimage now disabled by default like all other versions.
  60. 26-06-2006
  61. - Setting up an anisotropic filter of 0 isnt allowed by nvidia (Thanks Ogridi)
  62. 22-06-2006
  63. - Fixed some Problem with Delphi 5
  64. - Now uses the newest version of pngimage. Makes saving pngs much easier.
  65. 22-03-2006
  66. - Property IsCompressed and Size removed. Not really supported by Spec (Thanks Ogridi)
  67. 09-03-2006
  68. - Internal Format ifDepth8 added
  69. - function GrabScreen now supports all uncompressed formats
  70. 31-01-2006
  71. - AddAlphaFromglBitmap implemented
  72. 29-12-2005
  73. - LoadFromResource and LoadFromResourceId now needs an Instance and an ResourceType (for ID)
  74. 28-12-2005
  75. - Width, Height and Depth internal changed to TglBitmapPixelPosition.
  76. property Width, Height, Depth are still existing and new property Dimension are avail
  77. 11-12-2005
  78. - Added native OpenGL Support. Breaking the dglOpenGL "barrier".
  79. 19-10-2005
  80. - Added function GrabScreen to class TglBitmap2D
  81. 18-10-2005
  82. - Added support to Save images
  83. - Added function Clone to Clone Instance
  84. 11-10-2005
  85. - Functions now works with Cardinals for each channel. Up to 32 Bits per channel.
  86. Usefull for Future
  87. - Several speed optimizations
  88. 09-10-2005
  89. - Internal structure change. Loading of TGA, PNG and DDS improved.
  90. Data, format and size will now set directly with SetDataPtr.
  91. - AddFunc now works with all Types of Images and Formats
  92. - Some Funtions moved to Baseclass TglBitmap
  93. 06-10-2005
  94. - Added Support to decompress DXT3 and DXT5 compressed Images.
  95. - Added Mapping to convert data from one format into an other.
  96. 05-10-2005
  97. - Added method ConvertTo in Class TglBitmap2D. Method allows to convert every
  98. supported Input format (supported by GetPixel) into any uncompresed Format
  99. - Added Support to decompress DXT1 compressed Images.
  100. - SwapColors replaced by ConvertTo
  101. 04-10-2005
  102. - Added Support for compressed DDSs
  103. - Added new internal formats (DXT1, DXT3, DXT5)
  104. 29-09-2005
  105. - Parameter Components renamed to InternalFormat
  106. 23-09-2005
  107. - Some AllocMem replaced with GetMem (little speed change)
  108. - better exception handling. Better protection from memory leaks.
  109. 22-09-2005
  110. - Added support for Direct Draw Surfaces (.DDS) (uncompressed images only)
  111. - Added new internal formats (RGB8, RGBA8, RGBA4, RGB5A1, RGB10A2, R5G6B5)
  112. 07-09-2005
  113. - Added support for Grayscale textures
  114. - Added internal formats (Alpha, Luminance, LuminanceAlpha, BGR8, BGRA8)
  115. 10-07-2005
  116. - Added support for GL_VERSION_2_0
  117. - Added support for GL_EXT_texture_filter_anisotropic
  118. 04-07-2005
  119. - Function FillWithColor fills the Image with one Color
  120. - Function LoadNormalMap added
  121. 30-06-2005
  122. - ToNormalMap allows to Create an NormalMap from the Alphachannel
  123. - ToNormalMap now supports Sobel (nmSobel) function.
  124. 29-06-2005
  125. - support for RLE Compressed RGB TGAs added
  126. 28-06-2005
  127. - Class TglBitmapNormalMap added to support Normalmap generation
  128. - Added function ToNormalMap in class TglBitmap2D to genereate normal maps from textures.
  129. 3 Filters are supported. (4 Samples, 3x3 and 5x5)
  130. 16-06-2005
  131. - Method LoadCubeMapClass removed
  132. - LoadCubeMap returnvalue is now the Texture paramter. Such as LoadTextures
  133. - virtual abstract method GenTexture in class TglBitmap now is protected
  134. 12-06-2005
  135. - now support DescriptionFlag in LoadTga. Allows vertical flipped images to be loaded as normal
  136. 10-06-2005
  137. - little enhancement for IsPowerOfTwo
  138. - TglBitmap1D.GenTexture now tests NPOT Textures
  139. 06-06-2005
  140. - some little name changes. All properties or function with Texture in name are
  141. now without texture in name. We have allways texture so we dosn't name it.
  142. 03-06-2005
  143. - GenTexture now tests if texture is NPOT and NPOT-Texture are supported or
  144. TextureTarget is GL_TEXTURE_RECTANGLE. Else it raised an exception.
  145. 02-06-2005
  146. - added support for GL_ARB_texture_rectangle, GL_EXT_texture_rectangle and GL_NV_texture_rectangle
  147. 25-04-2005
  148. - Function Unbind added
  149. - call of SetFilter or SetTextureWrap if TextureID exists results in setting properties to opengl texture.
  150. 21-04-2005
  151. - class TglBitmapCubeMap added (allows to Create Cubemaps)
  152. 29-03-2005
  153. - Added Support for PNG Images. (http://pngdelphi.sourceforge.net/)
  154. To Enable png's use the define pngimage
  155. 22-03-2005
  156. - New Functioninterface added
  157. - Function GetPixel added
  158. 27-11-2004
  159. - Property BuildMipMaps renamed to MipMap
  160. 21-11-2004
  161. - property Name removed.
  162. - BuildMipMaps is now a set of 3 values. None, GluBuildMipmaps and SGIS_generate_mipmap
  163. 22-05-2004
  164. - property name added. Only used in glForms!
  165. 26-11-2003
  166. - property FreeDataAfterGenTexture is now available as default (default = true)
  167. - BuildMipmaps now implemented in TglBitmap1D (i've forgotten it)
  168. - function MoveMemory replaced with function Move (little speed change)
  169. - several calculations stored in variables (little speed change)
  170. 29-09-2003
  171. - property BuildMipsMaps added (default = true)
  172. if BuildMipMaps isn't set GenTextures uses glTexImage[12]D else it use gluBuild[12]dMipmaps
  173. - property FreeDataAfterGenTexture added (default = true)
  174. if FreeDataAfterGenTexture is set the texturedata were deleted after the texture was generated.
  175. - parameter DisableOtherTextureUnits of Bind removed
  176. - parameter FreeDataAfterGeneration of GenTextures removed
  177. 12-09-2003
  178. - TglBitmap dosn't delete data if class was destroyed (fixed)
  179. 09-09-2003
  180. - Bind now enables TextureUnits (by params)
  181. - GenTextures can leave data (by param)
  182. - LoadTextures now optimal
  183. 03-09-2003
  184. - Performance optimization in AddFunc
  185. - procedure Bind moved to subclasses
  186. - Added new Class TglBitmap1D to support real OpenGL 1D Textures
  187. 19-08-2003
  188. - Texturefilter and texturewrap now also as defaults
  189. Minfilter = GL_LINEAR_MIPMAP_LINEAR
  190. Magfilter = GL_LINEAR
  191. Wrap(str) = GL_CLAMP_TO_EDGE
  192. - Added new format tfCompressed to create a compressed texture.
  193. - propertys IsCompressed, TextureSize and IsResident added
  194. IsCompressed and TextureSize only contains data from level 0
  195. 18-08-2003
  196. - Added function AddFunc to add PerPixelEffects to Image
  197. - LoadFromFunc now based on AddFunc
  198. - Invert now based on AddFunc
  199. - SwapColors now based on AddFunc
  200. 16-08-2003
  201. - Added function FlipHorz
  202. 15-08-2003
  203. - Added function LaodFromFunc to create images with function
  204. - Added function FlipVert
  205. - Added internal format RGB(A) if GL_EXT_bgra or OpenGL 1.2 isn't supported
  206. 29-07-2003
  207. - Added Alphafunctions to calculate alpha per function
  208. - Added Alpha from ColorKey using alphafunctions
  209. 28-07-2003
  210. - First full functionally Version of glBitmap
  211. - Support for 24Bit and 32Bit TGA Pictures added
  212. 25-07-2003
  213. - begin of programming
  214. ***********************************************************}
  215. unit glBitmap;
  216. {.$MESSAGE warn 'Hey. I''m the glBitmap.pas and i need to be configured. My master tell me your preferences! ;)'}
  217. // Please uncomment the defines below to configure the glBitmap to your preferences.
  218. // If you have configured the unit you can uncomment the warning above.
  219. // ###### Start of preferences ################################################
  220. {$DEFINE GLB_NO_NATIVE_GL}
  221. // To enable the dglOpenGL.pas Header
  222. // With native GL then bindings are staticlly declared to support other headers
  223. // or use the glBitmap inside of DLLs (minimize codesize).
  224. {.$DEFINE GLB_SDL}
  225. // To enable the support for SDL_surfaces
  226. {.$DEFINE GLB_DELPHI}
  227. // To enable the support for TBitmap from Delphi (not lazarus)
  228. // *** image libs ***
  229. {.$DEFINE GLB_SDL_IMAGE}
  230. // To enable the support of SDL_image to load files. (READ ONLY)
  231. // If you enable SDL_image all other libraries will be ignored!
  232. {.$DEFINE GLB_PNGIMAGE}
  233. // to enable png support with the unit pngimage. You can download it from http://pngdelphi.sourceforge.net/
  234. // if you enable pngimage the libPNG will be ignored
  235. {.$DEFINE GLB_LIB_PNG}
  236. // to use the libPNG http://www.libpng.org/
  237. // You will need an aditional header.
  238. // http://www.opengl24.de/index.php?cat=header&file=libpng
  239. {.$DEFINE GLB_DELPHI_JPEG}
  240. // if you enable delphi jpegs the libJPEG will be ignored
  241. {.$DEFINE GLB_LIB_JPEG}
  242. // to use the libJPEG http://www.ijg.org/
  243. // You will need an aditional header.
  244. // http://www.opengl24.de/index.php?cat=header&file=libjpeg
  245. // ###### End of preferences ##################################################
  246. // ###### PRIVATE. Do not change anything. ####################################
  247. // *** old defines for compatibility ***
  248. {$IFDEF NO_NATIVE_GL}
  249. {$DEFINE GLB_NO_NATIVE_GL}
  250. {$ENDIF}
  251. {$IFDEF pngimage}
  252. {$definde GLB_PNGIMAGE}
  253. {$ENDIF}
  254. // *** Delphi Versions ***
  255. {$IFDEF fpc}
  256. {$MODE Delphi}
  257. {$IFDEF CPUI386}
  258. {$DEFINE CPU386}
  259. {$ASMMODE INTEL}
  260. {$ENDIF}
  261. {$IFNDEF WINDOWS}
  262. {$linklib c}
  263. {$ENDIF}
  264. {$ENDIF}
  265. // *** checking define combinations ***
  266. {$IFDEF GLB_SDL_IMAGE}
  267. {$IFNDEF GLB_SDL}
  268. {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
  269. {$DEFINE GLB_SDL}
  270. {$ENDIF}
  271. {$IFDEF GLB_PNGIMAGE}
  272. {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
  273. {$undef GLB_PNGIMAGE}
  274. {$ENDIF}
  275. {$IFDEF GLB_DELPHI_JPEG}
  276. {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
  277. {$undef GLB_DELPHI_JPEG}
  278. {$ENDIF}
  279. {$IFDEF GLB_LIB_PNG}
  280. {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
  281. {$undef GLB_LIB_PNG}
  282. {$ENDIF}
  283. {$IFDEF GLB_LIB_JPEG}
  284. {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
  285. {$undef GLB_LIB_JPEG}
  286. {$ENDIF}
  287. {$DEFINE GLB_SUPPORT_PNG_READ}
  288. {$DEFINE GLB_SUPPORT_JPEG_READ}
  289. {$ENDIF}
  290. {$IFDEF GLB_PNGIMAGE}
  291. {$IFDEF GLB_LIB_PNG}
  292. {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
  293. {$undef GLB_LIB_PNG}
  294. {$ENDIF}
  295. {$DEFINE GLB_SUPPORT_PNG_READ}
  296. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  297. {$ENDIF}
  298. {$IFDEF GLB_LIB_PNG}
  299. {$DEFINE GLB_SUPPORT_PNG_READ}
  300. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  301. {$ENDIF}
  302. {$IFDEF GLB_DELPHI_JPEG}
  303. {$IFDEF GLB_LIB_JPEG}
  304. {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
  305. {$undef GLB_LIB_JPEG}
  306. {$ENDIF}
  307. {$DEFINE GLB_SUPPORT_JPEG_READ}
  308. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  309. {$ENDIF}
  310. {$IFDEF GLB_LIB_JPEG}
  311. {$DEFINE GLB_SUPPORT_JPEG_READ}
  312. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  313. {$ENDIF}
  314. // *** general options ***
  315. {$EXTENDEDSYNTAX ON}
  316. {$LONGSTRINGS ON}
  317. {$ALIGN ON}
  318. {$IFNDEF FPC}
  319. {$OPTIMIZATION ON}
  320. {$ENDIF}
  321. interface
  322. uses
  323. {$IFDEF GLB_NO_NATIVE_GL} dglOpenGL, {$ENDIF}
  324. {$IFDEF GLB_SDL} SDL, {$ENDIF}
  325. {$IFDEF GLB_DELPHI} Dialogs, Windows, Graphics, {$ENDIF}
  326. {$IFDEF GLB_SDL_IMAGE} SDL_image, {$ENDIF}
  327. {$IFDEF GLB_PNGIMAGE} pngimage, {$ENDIF}
  328. {$IFDEF GLB_LIB_PNG} libPNG, {$ENDIF}
  329. {$IFDEF GLB_DELPHI_JPEG} JPEG, {$ENDIF}
  330. {$IFDEF GLB_LIB_JPEG} libJPEG, {$ENDIF}
  331. Classes, SysUtils;
  332. {$IFNDEF GLB_DELPHI}
  333. type
  334. HGLRC = Cardinal;
  335. DWORD = Cardinal;
  336. PDWORD = ^DWORD;
  337. TRGBQuad = packed record
  338. rgbBlue: Byte;
  339. rgbGreen: Byte;
  340. rgbRed: Byte;
  341. rgbReserved: Byte;
  342. end;
  343. {$ENDIF}
  344. (* TODO dglOpenGL
  345. {$IFNDEF GLB_NO_NATIVE_GL}
  346. // Native OpenGL Implementation
  347. type
  348. PByteBool = ^ByteBool;
  349. {$IFDEF GLB_DELPHI}
  350. var
  351. gLastContext: HGLRC;
  352. {$ENDIF}
  353. const
  354. // Generell
  355. GL_VERSION = $1F02;
  356. GL_EXTENSIONS = $1F03;
  357. GL_TRUE = 1;
  358. GL_FALSE = 0;
  359. GL_TEXTURE_1D = $0DE0;
  360. GL_TEXTURE_2D = $0DE1;
  361. GL_MAX_TEXTURE_SIZE = $0D33;
  362. GL_PACK_ALIGNMENT = $0D05;
  363. GL_UNPACK_ALIGNMENT = $0CF5;
  364. // Textureformats
  365. GL_RGB = $1907;
  366. GL_RGB4 = $804F;
  367. GL_RGB8 = $8051;
  368. GL_RGBA = $1908;
  369. GL_RGBA4 = $8056;
  370. GL_RGBA8 = $8058;
  371. GL_BGR = $80E0;
  372. GL_BGRA = $80E1;
  373. GL_ALPHA4 = $803B;
  374. GL_ALPHA8 = $803C;
  375. GL_LUMINANCE4 = $803F;
  376. GL_LUMINANCE8 = $8040;
  377. GL_LUMINANCE4_ALPHA4 = $8043;
  378. GL_LUMINANCE8_ALPHA8 = $8045;
  379. GL_DEPTH_COMPONENT = $1902;
  380. GL_UNSIGNED_BYTE = $1401;
  381. GL_ALPHA = $1906;
  382. GL_LUMINANCE = $1909;
  383. GL_LUMINANCE_ALPHA = $190A;
  384. GL_TEXTURE_WIDTH = $1000;
  385. GL_TEXTURE_HEIGHT = $1001;
  386. GL_TEXTURE_INTERNAL_FORMAT = $1003;
  387. GL_TEXTURE_RED_SIZE = $805C;
  388. GL_TEXTURE_GREEN_SIZE = $805D;
  389. GL_TEXTURE_BLUE_SIZE = $805E;
  390. GL_TEXTURE_ALPHA_SIZE = $805F;
  391. GL_TEXTURE_LUMINANCE_SIZE = $8060;
  392. // Dataformats
  393. GL_UNSIGNED_SHORT_5_6_5 = $8363;
  394. GL_UNSIGNED_SHORT_5_6_5_REV = $8364;
  395. GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;
  396. GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;
  397. GL_UNSIGNED_INT_2_10_10_10_REV = $8368;
  398. // Filter
  399. GL_NEAREST = $2600;
  400. GL_LINEAR = $2601;
  401. GL_NEAREST_MIPMAP_NEAREST = $2700;
  402. GL_LINEAR_MIPMAP_NEAREST = $2701;
  403. GL_NEAREST_MIPMAP_LINEAR = $2702;
  404. GL_LINEAR_MIPMAP_LINEAR = $2703;
  405. GL_TEXTURE_MAG_FILTER = $2800;
  406. GL_TEXTURE_MIN_FILTER = $2801;
  407. // Wrapmodes
  408. GL_TEXTURE_WRAP_S = $2802;
  409. GL_TEXTURE_WRAP_T = $2803;
  410. GL_CLAMP = $2900;
  411. GL_REPEAT = $2901;
  412. GL_CLAMP_TO_EDGE = $812F;
  413. GL_CLAMP_TO_BORDER = $812D;
  414. GL_TEXTURE_WRAP_R = $8072;
  415. GL_MIRRORED_REPEAT = $8370;
  416. // Border Color
  417. GL_TEXTURE_BORDER_COLOR = $1004;
  418. // Texgen
  419. GL_NORMAL_MAP = $8511;
  420. GL_REFLECTION_MAP = $8512;
  421. GL_S = $2000;
  422. GL_T = $2001;
  423. GL_R = $2002;
  424. GL_TEXTURE_GEN_MODE = $2500;
  425. GL_TEXTURE_GEN_S = $0C60;
  426. GL_TEXTURE_GEN_T = $0C61;
  427. GL_TEXTURE_GEN_R = $0C62;
  428. // Cubemaps
  429. GL_MAX_CUBE_MAP_TEXTURE_SIZE = $851C;
  430. GL_TEXTURE_CUBE_MAP = $8513;
  431. GL_TEXTURE_BINDING_CUBE_MAP = $8514;
  432. GL_TEXTURE_CUBE_MAP_POSITIVE_X = $8515;
  433. GL_TEXTURE_CUBE_MAP_NEGATIVE_X = $8516;
  434. GL_TEXTURE_CUBE_MAP_POSITIVE_Y = $8517;
  435. GL_TEXTURE_CUBE_MAP_NEGATIVE_Y = $8518;
  436. GL_TEXTURE_CUBE_MAP_POSITIVE_Z = $8519;
  437. GL_TEXTURE_CUBE_MAP_NEGATIVE_Z = $851A;
  438. GL_TEXTURE_RECTANGLE_ARB = $84F5;
  439. // GL_SGIS_generate_mipmap
  440. GL_GENERATE_MIPMAP = $8191;
  441. // GL_EXT_texture_compression_s3tc
  442. GL_COMPRESSED_RGB_S3TC_DXT1_EXT = $83F0;
  443. GL_COMPRESSED_RGBA_S3TC_DXT1_EXT = $83F1;
  444. GL_COMPRESSED_RGBA_S3TC_DXT3_EXT = $83F2;
  445. GL_COMPRESSED_RGBA_S3TC_DXT5_EXT = $83F3;
  446. // GL_EXT_texture_filter_anisotropic
  447. GL_TEXTURE_MAX_ANISOTROPY_EXT = $84FE;
  448. GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;
  449. // GL_ARB_texture_compression
  450. GL_COMPRESSED_RGB = $84ED;
  451. GL_COMPRESSED_RGBA = $84EE;
  452. GL_COMPRESSED_ALPHA = $84E9;
  453. GL_COMPRESSED_LUMINANCE = $84EA;
  454. GL_COMPRESSED_LUMINANCE_ALPHA = $84EB;
  455. // Extensions
  456. var
  457. GL_VERSION_1_2,
  458. GL_VERSION_1_3,
  459. GL_VERSION_1_4,
  460. GL_VERSION_2_0,
  461. GL_ARB_texture_border_clamp,
  462. GL_ARB_texture_cube_map,
  463. GL_ARB_texture_compression,
  464. GL_ARB_texture_non_power_of_two,
  465. GL_ARB_texture_rectangle,
  466. GL_ARB_texture_mirrored_repeat,
  467. GL_EXT_bgra,
  468. GL_EXT_texture_edge_clamp,
  469. GL_EXT_texture_cube_map,
  470. GL_EXT_texture_compression_s3tc,
  471. GL_EXT_texture_filter_anisotropic,
  472. GL_EXT_texture_rectangle,
  473. GL_NV_texture_rectangle,
  474. GL_IBM_texture_mirrored_repeat,
  475. GL_SGIS_generate_mipmap: Boolean;
  476. const
  477. {$IFDEF LINUX}
  478. libglu = 'libGLU.so.1';
  479. libopengl = 'libGL.so.1';
  480. {$else}
  481. libglu = 'glu32.dll';
  482. libopengl = 'opengl32.dll';
  483. {$ENDIF}
  484. {$IFDEF LINUX}
  485. function glXGetProcAddress(ProcName: PAnsiChar): Pointer; cdecl; external libopengl;
  486. {$else}
  487. function wglGetProcAddress(ProcName: PAnsiChar): Pointer; stdcall; external libopengl;
  488. {$ENDIF}
  489. function glGetString(name: Cardinal): PAnsiChar; {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
  490. procedure glEnable(cap: Cardinal); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
  491. procedure glDisable(cap: Cardinal); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
  492. procedure glGetIntegerv(pname: Cardinal; params: PInteger); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
  493. procedure glTexImage1D(target: Cardinal; level, internalformat, width, border: Integer; format, atype: Cardinal; const pixels: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
  494. procedure glTexImage2D(target: Cardinal; level, internalformat, width, height, border: Integer; format, atype: Cardinal; const pixels: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
  495. procedure glGenTextures(n: Integer; Textures: PCardinal); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
  496. procedure glBindTexture(target: Cardinal; Texture: Cardinal); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
  497. procedure glDeleteTextures(n: Integer; const textures: PCardinal); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
  498. procedure glReadPixels(x, y: Integer; width, height: Integer; format, atype: Cardinal; pixels: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
  499. procedure glPixelStorei(pname: Cardinal; param: Integer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
  500. procedure glGetTexImage(target: Cardinal; level: Integer; format: Cardinal; _type: Cardinal; pixels: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
  501. function glAreTexturesResident(n: Integer; const Textures: PCardinal; residences: PByteBool): ByteBool; {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
  502. procedure glTexParameteri(target: Cardinal; pname: Cardinal; param: Integer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
  503. procedure glTexParameterfv(target: Cardinal; pname: Cardinal; const params: PSingle); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
  504. procedure glGetTexLevelParameteriv(target: Cardinal; level: Integer; pname: Cardinal; params: PInteger); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
  505. procedure glTexGeni(coord, pname: Cardinal; param: Integer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;
  506. function gluBuild1DMipmaps(Target: Cardinal; Components, Width: Integer; Format, atype: Cardinal; Data: Pointer): Integer; {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libglu;
  507. function gluBuild2DMipmaps(Target: Cardinal; Components, Width, Height: Integer; Format, aType: Cardinal; Data: Pointer): Integer; {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libglu;
  508. var
  509. glCompressedTexImage2D : procedure(target: Cardinal; level: Integer; internalformat: Cardinal; width, height: Integer; border: Integer; imageSize: Integer; const data: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF}
  510. glCompressedTexImage1D : procedure(target: Cardinal; level: Integer; internalformat: Cardinal; width: Integer; border: Integer; imageSize: Integer; const data: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF}
  511. glGetCompressedTexImage : procedure(target: Cardinal; level: Integer; img: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF}
  512. {$ENDIF}
  513. *)
  514. type
  515. ////////////////////////////////////////////////////////////////////////////////////////////////////
  516. EglBitmapException = class(Exception);
  517. EglBitmapSizeToLargeException = class(EglBitmapException);
  518. EglBitmapNonPowerOfTwoException = class(EglBitmapException);
  519. EglBitmapUnsupportedFormatFormat = class(EglBitmapException);
  520. ////////////////////////////////////////////////////////////////////////////////////////////////////
  521. TglBitmapPixelDesc = packed record
  522. RedRange: Cardinal;
  523. RedShift: Shortint;
  524. GreenRange: Cardinal;
  525. GreenShift: Shortint;
  526. BlueRange: Cardinal;
  527. BlueShift: Shortint;
  528. AlphaRange: Cardinal;
  529. AlphaShift: Shortint;
  530. end;
  531. PglBitmapPixelDesc = ^TglBitmapPixelDesc;
  532. ////////////////////////////////////////////////////////////////////////////////////////////////////
  533. TglBitmapPixelData = packed record
  534. Red: Cardinal;
  535. Green: Cardinal;
  536. Blue: Cardinal;
  537. Alpha: Cardinal;
  538. PixelDesc: TglBitmapPixelDesc;
  539. end;
  540. ////////////////////////////////////////////////////////////////////////////////////////////////////
  541. TglBitmapFormatDesc = packed record
  542. Format: Cardinal;
  543. InternalFormat: Cardinal;
  544. DataType: Cardinal;
  545. end;
  546. ////////////////////////////////////////////////////////////////////////////////////////////////////
  547. TglBitmapPixelPositionFields = set of (ffX, ffY);
  548. TglBitmapPixelPosition = record
  549. Fields : TglBitmapPixelPositionFields;
  550. X : Word;
  551. Y : Word;
  552. end;
  553. ////////////////////////////////////////////////////////////////////////////////////////////////////
  554. TglBitmap = class;
  555. TglBitmapFunctionRec = record
  556. Sender: TglBitmap;
  557. Size: TglBitmapPixelPosition;
  558. Position: TglBitmapPixelPosition;
  559. Source: TglBitmapPixelData;
  560. Dest: TglBitmapPixelData;
  561. Args: PtrInt;
  562. end;
  563. TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
  564. ////////////////////////////////////////////////////////////////////////////////////////////////////
  565. TglBitmapFileType = (
  566. {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG, {$ENDIF}
  567. {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}
  568. ftDDS,
  569. ftTGA,
  570. ftBMP);
  571. TglBitmapFileTypes = set of TglBitmapFileType;
  572. TglBitmapMipMap = (
  573. mmNone,
  574. mmMipmap,
  575. mmMipmapGlu);
  576. TglBitmapNormalMapFunc = (
  577. nm4Samples,
  578. nmSobel,
  579. nm3x3,
  580. nm5x5);
  581. TglBitmapFormat = (
  582. tfEmpty = 0,
  583. //TODO
  584. //tfAlpha4,
  585. //tfAlpha8,
  586. //tfAlpha12,
  587. //tfAlpha16,
  588. //tfLuminance4,
  589. tfLuminance8,
  590. //tfLuminance12,
  591. //tfLuminance16,
  592. //
  593. //tfuminance4Alpha4,
  594. //tfLuminance6Alpha2,
  595. tfLuminance8Alpha8,
  596. //tfLuminance12Alpha4,
  597. //tfLuminance12Alpha12,
  598. //tfLuminance16Alpha16,
  599. //tfR3G3B2,
  600. //tfRGB4,
  601. tfRGB5,
  602. tfRGB8,
  603. //tfRGB10,
  604. //tfRGB12,
  605. //tfRGB16,
  606. //tfRGBA2,
  607. //tfRGBA4,
  608. tfRGB5A1,
  609. tfRGBA8,
  610. //tfRGB10A2,
  611. //tfRGBA12,
  612. //tfRGBA16,
  613. //tfBGR4,
  614. //tfBGR5,
  615. tfBGR8,
  616. //tfBGR10,
  617. //tfBGR12,
  618. //tfBGR16,
  619. //tfBGRA2,
  620. //tfBGRA4,
  621. //tfBGR5A1,
  622. tfBGRA8
  623. //tfBGR10A2,
  624. //tfBGRA12,
  625. //tfBGRA16,
  626. //tfDepth16,
  627. //tfDepth24,
  628. //tfDepth32
  629. );
  630. ////////////////////////////////////////////////////////////////////////////////////////////////////
  631. TglBitmapGetPixel = procedure(const aPos: TglBitmapPixelPosition; var aPixel: TglBitmapPixelData) of object;
  632. TglBitmapSetPixel = procedure(const aPos: TglBitmapPixelPosition; const aPixel: TglBitmapPixelData) of object;
  633. TglBitmapMapFunc = procedure(const aPixel: TglBitmapPixelData; var aData: PByte; var aBitOffset: Byte);
  634. TglBitmapUnMapFunc = procedure(var aData: PByte; var aBitOffset: Byte; var aPixel: TglBitmapPixelData);
  635. ////////////////////////////////////////////////////////////////////////////////////////////////////
  636. TglBitmapFormatDescriptor = class(TObject)
  637. public
  638. //virtual abstract
  639. class function GetFormat: TglBitmapFormat; virtual; abstract;
  640. class function GetPixelDesc: TglBitmapPixelDesc; virtual; abstract;
  641. class function GetFormatDesc: TglBitmapFormatDesc; virtual; abstract;
  642. class procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte); virtual; abstract;
  643. class procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData); virtual; abstract;
  644. //virtual
  645. class function WithoutAlpha: TglBitmapFormat; virtual;
  646. class function WithAlpha: TglBitmapFormat; virtual;
  647. class function GetSize: Single; virtual; overload;
  648. class function GetSize(const aSize: TglBitmapPixelPosition): Integer; virtual; overload;
  649. class function GetColorCompCount: Integer; virtual;
  650. class function IsEmpty: Boolean; virtual;
  651. class function HasAlpha: Boolean; virtual;
  652. class function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: UInt64): Boolean; virtual;
  653. class procedure PreparePixel(var aPixel: TglBitmapPixelData); virtual;
  654. (* TODO
  655. function FormatIsCompressed(Format: TglBitmapInternalFormat): boolean;
  656. function FormatIsUncompressed(Format: TglBitmapInternalFormat): boolean;
  657. function LoadTexture(Filename: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal = 0{$ENDIF}): Boolean;
  658. function LoadCubeMap(PositiveX, NegativeX, PositiveY, NegativeY, PositiveZ, NegativeZ: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal = 0{$ENDIF}): Boolean;
  659. function LoadNormalMap(Size: Integer; var Texture: Cardinal): Boolean;
  660. *)
  661. end;
  662. TglBitmapFormatDescClass = class of TglBitmapFormatDescriptor;
  663. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  664. TglBitmap = class
  665. protected
  666. fID: GLuint;
  667. fTarget: GLuint;
  668. fAnisotropic: Integer;
  669. fDeleteTextureOnFree: Boolean;
  670. fFreeDataAfterGenTexture: Boolean;
  671. fData: PByte;
  672. fIsResident: Boolean;
  673. fBorderColor: array[0..3] of Single;
  674. fDimension: TglBitmapPixelPosition;
  675. fMipMap: TglBitmapMipMap;
  676. fFormat: TglBitmapFormat;
  677. // Mapping
  678. fPixelSize: Integer;
  679. fRowSize: Integer;
  680. //TODO delete? fUnmapFunc: TglBitmapUnMapFunc;
  681. //TODO delete? fMapFunc: TglBitmapMapFunc;
  682. // Filtering
  683. fFilterMin: Cardinal;
  684. fFilterMag: Cardinal;
  685. // TexturWarp
  686. fWrapS: Cardinal;
  687. fWrapT: Cardinal;
  688. fWrapR: Cardinal;
  689. //TODO delete? fGetPixelFunc: TglBitmapGetPixel;
  690. //TODO delete? fSetPixelFunc: TglBitmapSetPixel;
  691. // CustomData
  692. fFilename: String;
  693. fCustomName: String;
  694. fCustomNameW: WideString;
  695. fCustomData: Pointer;
  696. //Getter
  697. function GetWidth: Integer; virtual;
  698. function GetHeight: Integer; virtual;
  699. function GetFileWidth: Integer; virtual;
  700. function GetFileHeight: Integer; virtual;
  701. //Setter
  702. procedure SetCustomData(const aValue: Pointer);
  703. procedure SetCustomName(const aValue: String);
  704. procedure SetCustomNameW(const aValue: WideString);
  705. procedure SetDeleteTextureOnFree(const aValue: Boolean);
  706. procedure SetFormat(const aValue: TglBitmapFormat);
  707. procedure SetFreeDataAfterGenTexture(const aValue: Boolean);
  708. procedure SetID(const aValue: Cardinal);
  709. procedure SetMipMap(const aValue: TglBitmapMipMap);
  710. procedure SetTarget(const aValue: Cardinal);
  711. procedure SetAnisotropic(const aValue: Integer);
  712. procedure CreateID;
  713. procedure SetupParameters(var aBuildWithGlu: Boolean);
  714. procedure SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
  715. const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;
  716. procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;
  717. function FlipHorz: Boolean; virtual;
  718. function FlipVert: Boolean; virtual;
  719. property Width: Integer read GetWidth;
  720. property Height: Integer read GetHeight;
  721. property FileWidth: Integer read GetFileWidth;
  722. property FileHeight: Integer read GetFileHeight;
  723. public
  724. //Properties
  725. property ID: Cardinal read fID write SetID;
  726. property Target: Cardinal read fTarget write SetTarget;
  727. property Format: TglBitmapFormat read fFormat write SetFormat;
  728. property MipMap: TglBitmapMipMap read fMipMap write SetMipMap;
  729. property Anisotropic: Integer read fAnisotropic write SetAnisotropic;
  730. property Filename: String read fFilename;
  731. property CustomName: String read fCustomName write SetCustomName;
  732. property CustomNameW: WideString read fCustomNameW write SetCustomNameW;
  733. property CustomData: Pointer read fCustomData write SetCustomData;
  734. property DeleteTextureOnFree: Boolean read fDeleteTextureOnFree write SetDeleteTextureOnFree;
  735. property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;
  736. property Dimension: TglBitmapPixelPosition read fDimension;
  737. property Data: PByte read fData;
  738. property IsResident: Boolean read fIsResident;
  739. procedure AfterConstruction; override;
  740. procedure BeforeDestruction; override;
  741. //Load
  742. procedure LoadFromFile(const aFilename: String);
  743. procedure LoadFromStream(const aStream: TStream); virtual;
  744. procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  745. const aFormat: TglBitmapFormat; const aArgs: PtrInt = 0);
  746. {$IFDEF GLB_DELPHI}
  747. procedure LoadFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil);
  748. procedure LoadFromResourceID(const sInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  749. {$ENDIF}
  750. //Save
  751. procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  752. procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
  753. //Convert
  754. function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: PtrInt = 0): Boolean; overload;
  755. function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  756. const aFormat: TglBitmapFormat; const aArgs: PtrInt = 0): Boolean; overload;
  757. public
  758. //Alpha & Co
  759. {$IFDEF GLB_SDL}
  760. function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  761. function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  762. function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  763. function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;
  764. const aArgs: PtrInt = 0): Boolean;
  765. {$ENDIF}
  766. {$IFDEF GLB_DELPHI}
  767. function AssignToBitmap(const aBitmap: TBitmap): Boolean;
  768. function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  769. function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  770. function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
  771. const aArgs: PtrInt = 0): Boolean;
  772. function AddAlphaFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil;
  773. const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;
  774. function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  775. const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;
  776. {$ENDIF}
  777. function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: PtrInt = 0): Boolean; virtual;
  778. function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;
  779. function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;
  780. function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;
  781. function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
  782. function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
  783. function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
  784. function AddAlphaFromValue(const aAlpha: Byte): Boolean;
  785. function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  786. function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  787. function RemoveAlpha: Boolean; virtual;
  788. public
  789. //Common
  790. function Clone: TglBitmap;
  791. function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
  792. procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);
  793. procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  794. procedure FreeData;
  795. //ColorFill
  796. procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
  797. procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
  798. procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);
  799. //TexParameters
  800. procedure SetFilter(const aMin, aMag: Cardinal);
  801. procedure SetWrap(
  802. const S: Cardinal = GL_CLAMP_TO_EDGE;
  803. const T: Cardinal = GL_CLAMP_TO_EDGE;
  804. const R: Cardinal = GL_CLAMP_TO_EDGE);
  805. procedure GetPixel(const aPos: TglBitmapPixelPosition; var aPixel: TglBitmapPixelData); virtual;
  806. procedure SetPixel(const aPos: TglBitmapPixelPosition; const aPixel: TglBitmapPixelData); virtual;
  807. procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
  808. procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
  809. //Constructors
  810. constructor Create; overload;
  811. constructor Create(const aFileName: String); overload;
  812. constructor Create(const aStream: TStream); overload;
  813. constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat); overload;
  814. constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: PtrInt = 0); overload;
  815. {$IFDEF GLB_DELPHI}
  816. constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
  817. constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
  818. {$ENDIF}
  819. private
  820. {$IFDEF GLB_SUPPORT_PNG_READ}
  821. function LoadPNG(const aStream: TStream): Boolean; virtual;
  822. procedure SavePNG(const aStream: TStream); virtual;
  823. {$ENDIF}
  824. {$IFDEF GLB_SUPPORT_JPEG_READ}
  825. function LoadJPEG(const aStream: TStream): Boolean; virtual;
  826. procedure SaveJPEG(const aStream: TStream); virtual;
  827. {$ENDIF}
  828. function LoadBMP(const aStream: TStream): Boolean; virtual;
  829. procedure SaveBMP(const aStream: TStream); virtual;
  830. function LoadTGA(const aStream: TStream): Boolean; virtual;
  831. procedure SaveTGA(const aStream: TStream); virtual;
  832. function LoadDDS(const aStream: TStream): Boolean; virtual;
  833. procedure SaveDDS(const aStream: TStream); virtual;
  834. end;
  835. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  836. TglBitmap2D = class(TglBitmap)
  837. protected
  838. // Bildeinstellungen
  839. fLines: array of PByte;
  840. (* TODO
  841. procedure GetDXTColorBlock(pData: pByte; relX, relY: Integer; var Pixel: TglBitmapPixelData);
  842. procedure GetPixel2DDXT1(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
  843. procedure GetPixel2DDXT3(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
  844. procedure GetPixel2DDXT5(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
  845. procedure GetPixel2DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
  846. procedure SetPixel2DUnmap(const Pos: TglBitmapPixelPosition; const Pixel: TglBitmapPixelData);
  847. *)
  848. function GetScanline(const aIndex: Integer): Pointer;
  849. procedure SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
  850. const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
  851. procedure UploadData(const aTarget: Cardinal; const aBuildWithGlu: Boolean);
  852. public
  853. property Width;
  854. property Height;
  855. property Scanline[const aIndex: Integer]: Pointer read GetScanline;
  856. procedure AfterConstruction; override;
  857. procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  858. procedure GetDataFromTexture;
  859. procedure GenTexture(const aTestTextureSize: Boolean = true); override;
  860. function FlipHorz: Boolean; override;
  861. function FlipVert: Boolean; override;
  862. procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
  863. const aScale: Single = 2; const aUseAlpha: Boolean = false);
  864. end;
  865. (* TODO
  866. TglBitmapCubeMap = class(TglBitmap2D)
  867. protected
  868. fGenMode: Integer;
  869. // Hide GenTexture
  870. procedure GenTexture(TestTextureSize: Boolean = true); reintroduce;
  871. public
  872. procedure AfterConstruction; override;
  873. procedure GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean = true);
  874. procedure Unbind(DisableTexCoordsGen: Boolean = true; DisableTextureUnit: Boolean = true); reintroduce; virtual;
  875. procedure Bind(EnableTexCoordsGen: Boolean = true; EnableTextureUnit: Boolean = true); reintroduce; virtual;
  876. end;
  877. TglBitmapNormalMap = class(TglBitmapCubeMap)
  878. public
  879. procedure AfterConstruction; override;
  880. procedure GenerateNormalMap(Size: Integer = 32; TestTextureSize: Boolean = true);
  881. end;
  882. TglBitmap1D = class(TglBitmap)
  883. protected
  884. procedure GetPixel1DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
  885. procedure SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width: Integer = -1; Height: Integer = -1); override;
  886. procedure UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
  887. public
  888. // propertys
  889. property Width;
  890. procedure AfterConstruction; override;
  891. // Other
  892. function FlipHorz: Boolean; override;
  893. // Generation
  894. procedure GenTexture(TestTextureSize: Boolean = true); override;
  895. end;
  896. *)
  897. const
  898. NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);
  899. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  900. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  901. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  902. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  903. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  904. procedure glBitmapSetDefaultWrap(
  905. const S: Cardinal = GL_CLAMP_TO_EDGE;
  906. const T: Cardinal = GL_CLAMP_TO_EDGE;
  907. const R: Cardinal = GL_CLAMP_TO_EDGE);
  908. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  909. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  910. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  911. function glBitmapGetDefaultFormat: TglBitmapFormat;
  912. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  913. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  914. function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
  915. var
  916. glBitmapDefaultDeleteTextureOnFree: Boolean;
  917. glBitmapDefaultFreeDataAfterGenTextures: Boolean;
  918. glBitmapDefaultFormat: TglBitmapFormat;
  919. glBitmapDefaultMipmap: TglBitmapMipMap;
  920. glBitmapDefaultFilterMin: Cardinal;
  921. glBitmapDefaultFilterMag: Cardinal;
  922. glBitmapDefaultWrapS: Cardinal;
  923. glBitmapDefaultWrapT: Cardinal;
  924. glBitmapDefaultWrapR: Cardinal;
  925. {$IFDEF GLB_DELPHI}
  926. function CreateGrayPalette: HPALETTE;
  927. {$ENDIF}
  928. implementation
  929. uses
  930. Math;
  931. type
  932. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  933. TBitfieldFormat = class(TObject)
  934. private
  935. fRedShift: ShortInt;
  936. fGreenShift: ShortInt;
  937. fBlueShift: ShortInt;
  938. fAlphaShift: ShortInt;
  939. fRedRange: Cardinal;
  940. fGreenRange: Cardinal;
  941. fBlueRange: Cardinal;
  942. fAlphaRange: Cardinal;
  943. fRedMask: UInt64;
  944. fGreenMask: UInt64;
  945. fBlueMask: UInt64;
  946. fAlphaMask: UInt64;
  947. function GetSize: Integer;
  948. procedure SetAlphaMask(aValue: UInt64);
  949. procedure SetAlphaRange(aValue: Cardinal);
  950. procedure SetAlphaShift(aValue: ShortInt);
  951. procedure SetBlueMask(aValue: UInt64);
  952. procedure SetBlueRange(aValue: Cardinal);
  953. procedure SetBlueShift(aValue: ShortInt);
  954. procedure SetGreenMask(aValue: UInt64);
  955. procedure SetGreenRange(aValue: Cardinal);
  956. procedure SetGreenShift(aValue: ShortInt);
  957. procedure SetRedMask(aValue: UInt64);
  958. procedure SetRedRange(aValue: Cardinal);
  959. procedure SetRedShift(aValue: ShortInt);
  960. procedure CalcShiftAndRange(aMask: UInt64; out aRange: Cardinal; out aShift: ShortInt);
  961. public
  962. property RedShift: ShortInt read fRedShift write SetRedShift;
  963. property GreenShift: ShortInt read fGreenShift write SetGreenShift;
  964. property BlueShift: ShortInt read fBlueShift write SetBlueShift;
  965. property AlphaShift: ShortInt read fAlphaShift write SetAlphaShift;
  966. property RedRange: Cardinal read fRedRange write SetRedRange;
  967. property GreenRange: Cardinal read fGreenRange write SetGreenRange;
  968. property BlueRange: Cardinal read fBlueRange write SetBlueRange;
  969. property AlphaRange: Cardinal read fAlphaRange write SetAlphaRange;
  970. property RedMask: UInt64 read fRedMask write SetRedMask;
  971. property GreenMask: UInt64 read fGreenMask write SetGreenMask;
  972. property BlueMask: UInt64 read fBlueMask write SetBlueMask;
  973. property AlphaMask: UInt64 read fAlphaMask write SetAlphaMask;
  974. property Size: Integer read GetSize;
  975. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte);
  976. procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData); overload;
  977. procedure Unmap(const aData: UInt64; var aPixel: TglBitmapPixelData); overload;
  978. end;
  979. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  980. TfdEmpty = class(TglBitmapFormatDescriptor)
  981. public
  982. class function GetFormat: TglBitmapFormat; override;
  983. class function GetPixelDesc: TglBitmapPixelDesc; override;
  984. class function GetFormatDesc: TglBitmapFormatDesc; override;
  985. class procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte); override;
  986. class procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData); override;
  987. end;
  988. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  989. TfdLuminance8 = class(TglBitmapFormatDescriptor)
  990. public
  991. class function GetFormat: TglBitmapFormat; override;
  992. class function GetPixelDesc: TglBitmapPixelDesc; override;
  993. class function GetFormatDesc: TglBitmapFormatDesc; override;
  994. class function WithAlpha: TglBitmapFormat; override;
  995. class procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte); override;
  996. class procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData); override;
  997. end;
  998. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  999. TfdLuminance8Alpha8 = class(TglBitmapFormatDescriptor)
  1000. public
  1001. class function GetFormat: TglBitmapFormat; override;
  1002. class function GetPixelDesc: TglBitmapPixelDesc; override;
  1003. class function GetFormatDesc: TglBitmapFormatDesc; override;
  1004. class function WithoutAlpha: TglBitmapFormat; override;
  1005. class procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte); override;
  1006. class procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData); override;
  1007. end;
  1008. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1009. TfdRGB5 = class(TglBitmapFormatDescriptor)
  1010. public
  1011. class function GetFormat: TglBitmapFormat; override;
  1012. class function GetPixelDesc: TglBitmapPixelDesc; override;
  1013. class function GetFormatDesc: TglBitmapFormatDesc; override;
  1014. class function WithAlpha: TglBitmapFormat; override;
  1015. class procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte); override;
  1016. class procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData); override;
  1017. end;
  1018. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1019. TfdRGB8 = class(TglBitmapFormatDescriptor)
  1020. public
  1021. class function GetFormat: TglBitmapFormat; override;
  1022. class function GetPixelDesc: TglBitmapPixelDesc; override;
  1023. class function GetFormatDesc: TglBitmapFormatDesc; override;
  1024. class function WithAlpha: TglBitmapFormat; override;
  1025. class procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte); override;
  1026. class procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData); override;
  1027. end;
  1028. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1029. TfdRGB5A1 = class(TglBitmapFormatDescriptor)
  1030. public
  1031. class function GetFormat: TglBitmapFormat; override;
  1032. class function GetPixelDesc: TglBitmapPixelDesc; override;
  1033. class function GetFormatDesc: TglBitmapFormatDesc; override;
  1034. class function WithoutAlpha: TglBitmapFormat; override;
  1035. class procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte); override;
  1036. class procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData); override;
  1037. end;
  1038. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1039. TfdRGBA8 = class(TglBitmapFormatDescriptor)
  1040. public
  1041. class function GetFormat: TglBitmapFormat; override;
  1042. class function GetPixelDesc: TglBitmapPixelDesc; override;
  1043. class function GetFormatDesc: TglBitmapFormatDesc; override;
  1044. class function WithoutAlpha: TglBitmapFormat; override;
  1045. class procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte); override;
  1046. class procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData); override;
  1047. end;
  1048. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1049. TfdBGR8 = class(TglBitmapFormatDescriptor)
  1050. public
  1051. class function GetFormat: TglBitmapFormat; override;
  1052. class function GetPixelDesc: TglBitmapPixelDesc; override;
  1053. class function GetFormatDesc: TglBitmapFormatDesc; override;
  1054. class function WithAlpha: TglBitmapFormat; override;
  1055. class procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte); override;
  1056. class procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData); override;
  1057. end;
  1058. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1059. TfdBGRA8 = class(TglBitmapFormatDescriptor)
  1060. public
  1061. class function GetFormat: TglBitmapFormat; override;
  1062. class function GetPixelDesc: TglBitmapPixelDesc; override;
  1063. class function GetFormatDesc: TglBitmapFormatDesc; override;
  1064. class function WithoutAlpha: TglBitmapFormat; override;
  1065. class procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte); override;
  1066. class procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData); override;
  1067. end;
  1068. const
  1069. LUMINANCE_WEIGHT_R = 0.30;
  1070. LUMINANCE_WEIGHT_G = 0.59;
  1071. LUMINANCE_WEIGHT_B = 0.11;
  1072. ALPHA_WEIGHT_R = 0.30;
  1073. ALPHA_WEIGHT_G = 0.59;
  1074. ALPHA_WEIGHT_B = 0.11;
  1075. UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';
  1076. FORMAT_DESCRIPTORS: array[TglBitmapFormat] of TglBitmapFormatDescClass = (
  1077. TfdEmpty,
  1078. TfdLuminance8,
  1079. TfdLuminance8Alpha8,
  1080. TfdRGB5,
  1081. TfdRGB8,
  1082. TfdRGB5A1,
  1083. TfdRGBA8,
  1084. TfdBGR8,
  1085. TfdBGRA8
  1086. );
  1087. {$REGION Private Helper}
  1088. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1089. function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
  1090. begin
  1091. result.Fields := [];
  1092. if X >= 0 then
  1093. result.Fields := result.Fields + [ffX];
  1094. if Y >= 0 then
  1095. result.Fields := result.Fields + [ffY];
  1096. result.X := Max(0, X);
  1097. result.Y := Max(0, Y);
  1098. end;
  1099. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1100. function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
  1101. begin
  1102. //TODO Supported File Formats!
  1103. result := [ftDDS, ftTGA, ftBMP];
  1104. (*
  1105. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  1106. if aFormat in [
  1107. tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
  1108. tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
  1109. tfuminance4Alpha4, tfLuminance6Alpha2, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16,
  1110. tfR3G3B2, tfRGB4, tfRGB5, tfRGB8, tfRGB10, tfRGB12, tfRGB16,
  1111. tfRGBA2, tfRGBA4, tfRGB5A1, tfRGBA8, tfRGB10A2, tfRGBA12, tfRGBA16,
  1112. tfDepth16, tfDepth24, tfDepth32]
  1113. then
  1114. result := result + [ftPNG];
  1115. {$ENDIF}
  1116. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  1117. if Format in [
  1118. tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
  1119. tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
  1120. tfR3G3B2, tfRGB4, tfRGB5, tfRGB8, tfRGB10, tfRGB12, tfRGB16,
  1121. tfDepth16, tfDepth24, tfDepth32]
  1122. then
  1123. result := result + [ftJPEG];
  1124. {$ENDIF}
  1125. if aFormat in [
  1126. tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
  1127. tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
  1128. tfuminance4Alpha4, tfLuminance6Alpha2, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16,
  1129. tfR3G3B2, tfRGB4, tfRGB5, tfRGB8, tfRGB10, tfRGB12, tfRGB16,
  1130. tfRGBA2, tfRGBA4, tfRGB5A1, tfRGBA8, tfRGB10A2, tfRGBA12, tfRGBA16,
  1131. tfDepth16, tfDepth24, tfDepth32]
  1132. then
  1133. result := result + [ftDDS, ftTGA, ftBMP];
  1134. *)
  1135. end;
  1136. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1137. function IsPowerOfTwo(aNumber: Integer): Boolean;
  1138. begin
  1139. while (aNumber and 1) = 0 do
  1140. aNumber := aNumber shr 1;
  1141. result := aNumber = 1;
  1142. end;
  1143. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1144. function GetTopMostBit(aBitSet: UInt64): Integer;
  1145. begin
  1146. result := 0;
  1147. while aBitSet > 0 do begin
  1148. inc(result);
  1149. aBitSet := aBitSet shr 1;
  1150. end;
  1151. end;
  1152. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1153. function CountSetBits(aBitSet: UInt64): Integer;
  1154. begin
  1155. result := 0;
  1156. while aBitSet > 0 do begin
  1157. if (aBitSet and 1) = 1 then
  1158. inc(result);
  1159. aBitSet := aBitSet shr 1;
  1160. end;
  1161. end;
  1162. {$ENDREGION}
  1163. //TODO check _ARB functions and constants
  1164. (* GLB_NO_NATIVE_GL
  1165. {$IFNDEF GLB_NO_NATIVE_GL}
  1166. procedure ReadOpenGLExtensions;
  1167. var
  1168. {$IFDEF GLB_DELPHI}
  1169. Context: HGLRC;
  1170. {$ENDIF}
  1171. Buffer: AnsiString;
  1172. MajorVersion, MinorVersion: Integer;
  1173. procedure TrimVersionString(Buffer: AnsiString; var Major, Minor: Integer);
  1174. var
  1175. Separator: Integer;
  1176. begin
  1177. Minor := 0;
  1178. Major := 0;
  1179. Separator := Pos(AnsiString('.'), Buffer);
  1180. if (Separator > 1) and (Separator < Length(Buffer)) and
  1181. (Buffer[Separator - 1] in ['0'..'9']) and
  1182. (Buffer[Separator + 1] in ['0'..'9']) then begin
  1183. Dec(Separator);
  1184. while (Separator > 0) and (Buffer[Separator] in ['0'..'9']) do
  1185. Dec(Separator);
  1186. Delete(Buffer, 1, Separator);
  1187. Separator := Pos(AnsiString('.'), Buffer) + 1;
  1188. while (Separator <= Length(Buffer)) and (AnsiChar(Buffer[Separator]) in ['0'..'9']) do
  1189. Inc(Separator);
  1190. Delete(Buffer, Separator, 255);
  1191. Separator := Pos(AnsiString('.'), Buffer);
  1192. Major := StrToInt(Copy(String(Buffer), 1, Separator - 1));
  1193. Minor := StrToInt(Copy(String(Buffer), Separator + 1, 1));
  1194. end;
  1195. end;
  1196. function CheckExtension(const Extension: AnsiString): Boolean;
  1197. var
  1198. ExtPos: Integer;
  1199. begin
  1200. ExtPos := Pos(Extension, Buffer);
  1201. result := ExtPos > 0;
  1202. if result then
  1203. result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);
  1204. end;
  1205. function glLoad (aFunc: pAnsiChar): pointer;
  1206. begin
  1207. {$IFDEF LINUX}
  1208. result := glXGetProcAddress(aFunc);
  1209. {$else}
  1210. result := wglGetProcAddress(aFunc);
  1211. {$ENDIF}
  1212. end;
  1213. begin
  1214. {$IFDEF GLB_DELPHI}
  1215. Context := wglGetCurrentContext;
  1216. if Context <> gLastContext then begin
  1217. gLastContext := Context;
  1218. {$ENDIF}
  1219. // Version
  1220. Buffer := glGetString(GL_VERSION);
  1221. TrimVersionString(Buffer, MajorVersion, MinorVersion);
  1222. GL_VERSION_1_2 := false;
  1223. GL_VERSION_1_3 := false;
  1224. GL_VERSION_1_4 := false;
  1225. GL_VERSION_2_0 := false;
  1226. if MajorVersion = 1 then begin
  1227. if MinorVersion >= 1 then begin
  1228. if MinorVersion >= 2 then
  1229. GL_VERSION_1_2 := true;
  1230. if MinorVersion >= 3 then
  1231. GL_VERSION_1_3 := true;
  1232. if MinorVersion >= 4 then
  1233. GL_VERSION_1_4 := true;
  1234. end;
  1235. end;
  1236. if MajorVersion >= 2 then begin
  1237. GL_VERSION_1_2 := true;
  1238. GL_VERSION_1_3 := true;
  1239. GL_VERSION_1_4 := true;
  1240. GL_VERSION_2_0 := true;
  1241. end;
  1242. // Extensions
  1243. Buffer := glGetString(GL_EXTENSIONS);
  1244. GL_ARB_texture_border_clamp := CheckExtension('GL_ARB_texture_border_clamp');
  1245. GL_ARB_texture_cube_map := CheckExtension('GL_ARB_texture_cube_map');
  1246. GL_ARB_texture_compression := CheckExtension('GL_ARB_texture_compression');
  1247. GL_ARB_texture_non_power_of_two := CheckExtension('GL_ARB_texture_non_power_of_two');
  1248. GL_ARB_texture_rectangle := CheckExtension('GL_ARB_texture_rectangle');
  1249. GL_ARB_texture_mirrored_repeat := CheckExtension('GL_ARB_texture_mirrored_repeat');
  1250. GL_EXT_bgra := CheckExtension('GL_EXT_bgra');
  1251. GL_EXT_texture_edge_clamp := CheckExtension('GL_EXT_texture_edge_clamp');
  1252. GL_EXT_texture_cube_map := CheckExtension('GL_EXT_texture_cube_map');
  1253. GL_EXT_texture_compression_s3tc := CheckExtension('GL_EXT_texture_compression_s3tc');
  1254. GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');
  1255. GL_EXT_texture_rectangle := CheckExtension('GL_EXT_texture_rectangle');
  1256. GL_NV_texture_rectangle := CheckExtension('GL_NV_texture_rectangle');
  1257. GL_IBM_texture_mirrored_repeat := CheckExtension('GL_IBM_texture_mirrored_repeat');
  1258. GL_SGIS_generate_mipmap := CheckExtension('GL_SGIS_generate_mipmap');
  1259. // Funtions
  1260. if GL_VERSION_1_3 then begin
  1261. // Loading Core
  1262. glCompressedTexImage1D := glLoad('glCompressedTexImage1D');
  1263. glCompressedTexImage2D := glLoad('glCompressedTexImage2D');
  1264. glGetCompressedTexImage := glLoad('glGetCompressedTexImage');
  1265. end else
  1266. begin
  1267. // Try loading Extension
  1268. glCompressedTexImage1D := glLoad('glCompressedTexImage1DARB');
  1269. glCompressedTexImage2D := glLoad('glCompressedTexImage2DARB');
  1270. glGetCompressedTexImage := glLoad('glGetCompressedTexImageARB');
  1271. end;
  1272. {$IFDEF GLB_DELPHI}
  1273. end;
  1274. {$ENDIF}
  1275. end;
  1276. {$ENDIF}
  1277. *)
  1278. (* TODO GLB_DELPHI
  1279. {$IFDEF GLB_DELPHI}
  1280. function CreateGrayPalette: HPALETTE;
  1281. var
  1282. Idx: Integer;
  1283. Pal: PLogPalette;
  1284. begin
  1285. GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
  1286. Pal.palVersion := $300;
  1287. Pal.palNumEntries := 256;
  1288. {$IFOPT R+}
  1289. {$DEFINE GLB_TEMPRANGECHECK}
  1290. {$R-}
  1291. {$ENDIF}
  1292. for Idx := 0 to 256 - 1 do begin
  1293. Pal.palPalEntry[Idx].peRed := Idx;
  1294. Pal.palPalEntry[Idx].peGreen := Idx;
  1295. Pal.palPalEntry[Idx].peBlue := Idx;
  1296. Pal.palPalEntry[Idx].peFlags := 0;
  1297. end;
  1298. {$IFDEF GLB_TEMPRANGECHECK}
  1299. {$UNDEF GLB_TEMPRANGECHECK}
  1300. {$R+}
  1301. {$ENDIF}
  1302. result := CreatePalette(Pal^);
  1303. FreeMem(Pal);
  1304. end;
  1305. {$ENDIF}
  1306. *)
  1307. (* TODO GLB_SDL_IMAGE
  1308. {$IFDEF GLB_SDL_IMAGE}
  1309. function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
  1310. begin
  1311. result := TStream(context^.unknown.data1).Seek(offset, whence);
  1312. end;
  1313. function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
  1314. begin
  1315. result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
  1316. end;
  1317. function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
  1318. begin
  1319. result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
  1320. end;
  1321. function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
  1322. begin
  1323. result := 0;
  1324. end;
  1325. function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
  1326. begin
  1327. result := SDL_AllocRW;
  1328. if result = nil then
  1329. raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
  1330. result^.seek := glBitmapRWseek;
  1331. result^.read := glBitmapRWread;
  1332. result^.write := glBitmapRWwrite;
  1333. result^.close := glBitmapRWclose;
  1334. result^.unknown.data1 := Stream;
  1335. end;
  1336. {$ENDIF}
  1337. *)
  1338. (* TODO LoadFuncs
  1339. function LoadTexture(Filename: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal{$ENDIF}): Boolean;
  1340. var
  1341. glBitmap: TglBitmap2D;
  1342. begin
  1343. result := false;
  1344. Texture := 0;
  1345. {$IFDEF GLB_DELPHI}
  1346. if Instance = 0 then
  1347. Instance := HInstance;
  1348. if (LoadFromRes) then
  1349. glBitmap := TglBitmap2D.CreateFromResourceName(Instance, FileName)
  1350. else
  1351. {$ENDIF}
  1352. glBitmap := TglBitmap2D.Create(FileName);
  1353. try
  1354. glBitmap.DeleteTextureOnFree := false;
  1355. glBitmap.FreeDataAfterGenTexture := false;
  1356. glBitmap.GenTexture(true);
  1357. if (glBitmap.ID > 0) then begin
  1358. Texture := glBitmap.ID;
  1359. result := true;
  1360. end;
  1361. finally
  1362. glBitmap.Free;
  1363. end;
  1364. end;
  1365. function LoadCubeMap(PositiveX, NegativeX, PositiveY, NegativeY, PositiveZ, NegativeZ: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal{$ENDIF}): Boolean;
  1366. var
  1367. CM: TglBitmapCubeMap;
  1368. begin
  1369. Texture := 0;
  1370. {$IFDEF GLB_DELPHI}
  1371. if Instance = 0 then
  1372. Instance := HInstance;
  1373. {$ENDIF}
  1374. CM := TglBitmapCubeMap.Create;
  1375. try
  1376. CM.DeleteTextureOnFree := false;
  1377. // Maps
  1378. {$IFDEF GLB_DELPHI}
  1379. if (LoadFromRes) then
  1380. CM.LoadFromResource(Instance, PositiveX)
  1381. else
  1382. {$ENDIF}
  1383. CM.LoadFromFile(PositiveX);
  1384. CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X);
  1385. {$IFDEF GLB_DELPHI}
  1386. if (LoadFromRes) then
  1387. CM.LoadFromResource(Instance, NegativeX)
  1388. else
  1389. {$ENDIF}
  1390. CM.LoadFromFile(NegativeX);
  1391. CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X);
  1392. {$IFDEF GLB_DELPHI}
  1393. if (LoadFromRes) then
  1394. CM.LoadFromResource(Instance, PositiveY)
  1395. else
  1396. {$ENDIF}
  1397. CM.LoadFromFile(PositiveY);
  1398. CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y);
  1399. {$IFDEF GLB_DELPHI}
  1400. if (LoadFromRes) then
  1401. CM.LoadFromResource(Instance, NegativeY)
  1402. else
  1403. {$ENDIF}
  1404. CM.LoadFromFile(NegativeY);
  1405. CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y);
  1406. {$IFDEF GLB_DELPHI}
  1407. if (LoadFromRes) then
  1408. CM.LoadFromResource(Instance, PositiveZ)
  1409. else
  1410. {$ENDIF}
  1411. CM.LoadFromFile(PositiveZ);
  1412. CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z);
  1413. {$IFDEF GLB_DELPHI}
  1414. if (LoadFromRes) then
  1415. CM.LoadFromResource(Instance, NegativeZ)
  1416. else
  1417. {$ENDIF}
  1418. CM.LoadFromFile(NegativeZ);
  1419. CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z);
  1420. Texture := CM.ID;
  1421. result := true;
  1422. finally
  1423. CM.Free;
  1424. end;
  1425. end;
  1426. function LoadNormalMap(Size: Integer; var Texture: Cardinal): Boolean;
  1427. var
  1428. NM: TglBitmapNormalMap;
  1429. begin
  1430. Texture := 0;
  1431. NM := TglBitmapNormalMap.Create;
  1432. try
  1433. NM.DeleteTextureOnFree := false;
  1434. NM.GenerateNormalMap(Size);
  1435. Texture := NM.ID;
  1436. result := true;
  1437. finally
  1438. NM.Free;
  1439. end;
  1440. end;
  1441. *)
  1442. {$REGION default Setter and Gettter}
  1443. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1444. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1445. begin
  1446. glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
  1447. end;
  1448. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1449. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1450. begin
  1451. glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
  1452. end;
  1453. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1454. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1455. begin
  1456. glBitmapDefaultMipmap := aValue;
  1457. end;
  1458. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1459. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1460. begin
  1461. glBitmapDefaultFormat := aFormat;
  1462. end;
  1463. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1464. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1465. begin
  1466. glBitmapDefaultFilterMin := aMin;
  1467. glBitmapDefaultFilterMag := aMag;
  1468. end;
  1469. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1470. procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
  1471. begin
  1472. glBitmapDefaultWrapS := S;
  1473. glBitmapDefaultWrapT := T;
  1474. glBitmapDefaultWrapR := R;
  1475. end;
  1476. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1477. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1478. begin
  1479. result := glBitmapDefaultDeleteTextureOnFree;
  1480. end;
  1481. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1482. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1483. begin
  1484. result := glBitmapDefaultFreeDataAfterGenTextures;
  1485. end;
  1486. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1487. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1488. begin
  1489. result := glBitmapDefaultMipmap;
  1490. end;
  1491. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1492. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1493. begin
  1494. result := glBitmapDefaultFormat;
  1495. end;
  1496. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1497. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  1498. begin
  1499. aMin := glBitmapDefaultFilterMin;
  1500. aMag := glBitmapDefaultFilterMag;
  1501. end;
  1502. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1503. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  1504. begin
  1505. S := glBitmapDefaultWrapS;
  1506. T := glBitmapDefaultWrapT;
  1507. R := glBitmapDefaultWrapR;
  1508. end;
  1509. {$ENDREGION}
  1510. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1511. //TCustomFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1512. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1513. procedure TBitfieldFormat.SetAlphaMask(aValue: UInt64);
  1514. begin
  1515. if fAlphaMask = aValue then Exit;
  1516. fAlphaMask := aValue;
  1517. CalcShiftAndRange(fAlphaMask, fAlphaRange, fAlphaShift);
  1518. end;
  1519. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1520. function TBitfieldFormat.GetSize: Integer;
  1521. var
  1522. tmp: UInt64;
  1523. begin
  1524. tmp :=
  1525. (fRedRange shl fRedShift) or
  1526. (fGreenRange shl fGreenShift) or
  1527. (fBlueRange shl fBlueShift) or
  1528. (fAlphaRange shl fAlphaShift);
  1529. result := Trunc(GetTopMostBit(tmp) / 8);
  1530. end;
  1531. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1532. procedure TBitfieldFormat.SetAlphaRange(aValue: Cardinal);
  1533. begin
  1534. if fAlphaRange = aValue then Exit;
  1535. fAlphaRange := aValue;
  1536. fAlphaMask := fAlphaRange shl fAlphaShift;
  1537. end;
  1538. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1539. procedure TBitfieldFormat.SetAlphaShift(aValue: ShortInt);
  1540. begin
  1541. if fAlphaShift = aValue then Exit;
  1542. fAlphaShift := aValue;
  1543. fAlphaMask := fAlphaRange shl fAlphaShift;
  1544. end;
  1545. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1546. procedure TBitfieldFormat.SetBlueMask(aValue: UInt64);
  1547. begin
  1548. if fBlueMask = aValue then Exit;
  1549. fBlueMask := aValue;
  1550. CalcShiftAndRange(fBlueMask, fBlueRange, fBlueShift);
  1551. end;
  1552. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1553. procedure TBitfieldFormat.SetBlueRange(aValue: Cardinal);
  1554. begin
  1555. if fBlueRange = aValue then Exit;
  1556. fBlueRange := aValue;
  1557. fBlueMask := fBlueRange shl fBlueShift;
  1558. end;
  1559. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1560. procedure TBitfieldFormat.SetBlueShift(aValue: ShortInt);
  1561. begin
  1562. if fBlueShift = aValue then Exit;
  1563. fBlueShift := aValue;
  1564. fBlueMask := fBlueRange shl fBlueShift;
  1565. end;
  1566. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1567. procedure TBitfieldFormat.SetGreenMask(aValue: UInt64);
  1568. begin
  1569. if fGreenMask = aValue then Exit;
  1570. fGreenMask := aValue;
  1571. CalcShiftAndRange(fGreenMask, fGreenRange, fGreenShift);
  1572. end;
  1573. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1574. procedure TBitfieldFormat.SetGreenRange(aValue: Cardinal);
  1575. begin
  1576. if fGreenRange = aValue then Exit;
  1577. fGreenRange := aValue;
  1578. fGreenMask := fGreenRange shl fGreenShift;
  1579. end;
  1580. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1581. procedure TBitfieldFormat.SetGreenShift(aValue: ShortInt);
  1582. begin
  1583. if fGreenShift = aValue then Exit;
  1584. fGreenShift := aValue;
  1585. fGreenMask := fGreenRange shl fGreenShift;
  1586. end;
  1587. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1588. procedure TBitfieldFormat.SetRedMask(aValue: UInt64);
  1589. begin
  1590. if fRedMask = aValue then Exit;
  1591. fRedMask := aValue;
  1592. CalcShiftAndRange(fRedMask, fRedRange, fRedShift);
  1593. end;
  1594. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1595. procedure TBitfieldFormat.SetRedRange(aValue: Cardinal);
  1596. begin
  1597. if fRedRange = aValue then Exit;
  1598. fRedRange := aValue;
  1599. fRedMask := fRedRange shl fRedShift;
  1600. end;
  1601. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1602. procedure TBitfieldFormat.SetRedShift(aValue: ShortInt);
  1603. begin
  1604. if fRedShift = aValue then Exit;
  1605. fRedShift := aValue;
  1606. fRedMask := fRedRange shl fRedShift;
  1607. end;
  1608. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1609. procedure TBitfieldFormat.CalcShiftAndRange(aMask: UInt64; out aRange: Cardinal;
  1610. out aShift: ShortInt);
  1611. begin
  1612. aShift := 0;
  1613. aRange := 0;
  1614. if (aMask = 0) then
  1615. exit;
  1616. while (aMask > 0) and ((aMask and 1) = 0) do begin
  1617. inc(aShift);
  1618. aMask := aMask shr 1;
  1619. end;
  1620. aRange := 1;
  1621. while (aMask > 0) do begin
  1622. aRange := aRange shl 1;
  1623. aMask := aMask shr 1;
  1624. end;
  1625. dec(aRange);
  1626. end;
  1627. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1628. procedure TBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte);
  1629. var
  1630. data: UInt64;
  1631. s: Integer;
  1632. type
  1633. PUInt64 = ^UInt64;
  1634. begin
  1635. data :=
  1636. ((aPixel.Red and fRedRange) shl fRedShift) or
  1637. ((aPixel.Green and fGreenRange) shl fGreenShift) or
  1638. ((aPixel.Blue and fBlueRange) shl fBlueShift) or
  1639. ((aPixel.Alpha and fAlphaRange) shl fAlphaShift);
  1640. s := Size;
  1641. case s of
  1642. 1: aData^ := data;
  1643. 2: PWord(aData)^ := data;
  1644. 4: PCardinal(aData)^ := data;
  1645. 8: PUInt64(aData)^ := data;
  1646. end;
  1647. inc(aData, s);
  1648. end;
  1649. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1650. procedure TBitfieldFormat.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData);
  1651. var
  1652. data: UInt64;
  1653. s: Integer;
  1654. type
  1655. PUInt64 = ^UInt64;
  1656. begin
  1657. s := Size;
  1658. case s of
  1659. 1: data := aData^;
  1660. 2: data := PWord(aData)^;
  1661. 4: data := PCardinal(aData)^;
  1662. 8: data := PUInt64(aData)^;
  1663. end;
  1664. Unmap(data, aPixel);
  1665. inc(aData, s);
  1666. end;
  1667. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1668. procedure TBitfieldFormat.Unmap(const aData: UInt64; var aPixel: TglBitmapPixelData);
  1669. begin
  1670. aPixel.Red := (aData shr fRedShift) and fRedRange;
  1671. aPixel.Green := (aData shr fGreenShift) and fGreenRange;
  1672. aPixel.Blue := (aData shr fBlueShift) and fBlueRange;
  1673. aPixel.Alpha := (aData shr fAlphaShift) and fAlphaRange;
  1674. end;
  1675. {$REGION TglBitmapFormatDescriptor}
  1676. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1677. //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1678. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1679. class function TglBitmapFormatDescriptor.WithoutAlpha: TglBitmapFormat;
  1680. begin
  1681. if not HasAlpha then
  1682. result := GetFormat
  1683. else
  1684. result := tfEmpty;
  1685. end;
  1686. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1687. class function TglBitmapFormatDescriptor.WithAlpha: TglBitmapFormat;
  1688. begin
  1689. if HasAlpha then
  1690. result := GetFormat
  1691. else
  1692. result := tfEmpty;
  1693. end;
  1694. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1695. class function TglBitmapFormatDescriptor.GetSize: Single;
  1696. var
  1697. tmp: UInt64;
  1698. begin
  1699. with GetPixelDesc do begin
  1700. tmp :=
  1701. (RedRange shl RedShift) or
  1702. (GreenRange shl GreenShift) or
  1703. (BlueRange shl BlueShift) or
  1704. (AlphaRange shl AlphaShift);
  1705. end;
  1706. result := Trunc(GetTopMostBit(tmp) / 4) / 2;
  1707. end;
  1708. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1709. class function TglBitmapFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;
  1710. var
  1711. w, h: Integer;
  1712. begin
  1713. if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
  1714. w := Max(1, aSize.X);
  1715. h := Max(1, aSize.Y);
  1716. result := Ceil(w * h * GetSize);
  1717. end else
  1718. result := 0;
  1719. end;
  1720. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1721. class function TglBitmapFormatDescriptor.GetColorCompCount: Integer;
  1722. begin
  1723. result := 0;
  1724. with GetPixelDesc do begin
  1725. if (RedRange > 0) then
  1726. inc(result);
  1727. if (GreenRange > 0) then
  1728. inc(result);
  1729. if (BlueRange > 0) then
  1730. inc(result);
  1731. if (AlphaRange > 0) then
  1732. inc(result);
  1733. end;
  1734. end;
  1735. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1736. class function TglBitmapFormatDescriptor.IsEmpty: Boolean;
  1737. begin
  1738. result := (GetFormat = tfEmpty);
  1739. end;
  1740. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1741. class function TglBitmapFormatDescriptor.HasAlpha: Boolean;
  1742. begin
  1743. result := (GetPixelDesc.AlphaRange > 0);
  1744. end;
  1745. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1746. class function TglBitmapFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: UInt64): Boolean;
  1747. var
  1748. PixelDesc: TglBitmapPixelDesc;
  1749. begin
  1750. result := false;
  1751. if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
  1752. raise EglBitmapException.Create('FormatCheckFormat - All Masks are 0');
  1753. PixelDesc := GetPixelDesc;
  1754. with PixelDesc do begin
  1755. if (aRedMask <> 0) and (aRedMask <> (RedRange shl RedShift)) then
  1756. exit;
  1757. if (aGreenMask <> 0) and (aGreenMask <> (GreenRange shl GreenShift)) then
  1758. exit;
  1759. if (aBlueMask <> 0) and (aBlueMask <> (BlueRange shl BlueShift)) then
  1760. exit;
  1761. if (aAlphaMask <> 0) and (aAlphaMask <> (AlphaRange shl AlphaShift)) then
  1762. exit;
  1763. end;
  1764. result := true;
  1765. end;
  1766. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1767. class procedure TglBitmapFormatDescriptor.PreparePixel(var aPixel: TglBitmapPixelData);
  1768. begin
  1769. FillChar(aPixel, SizeOf(aPixel), 0);
  1770. aPixel.PixelDesc := GetPixelDesc;
  1771. with aPixel.PixelDesc do begin
  1772. aPixel.Red := RedRange;
  1773. aPixel.Green := GreenRange;
  1774. aPixel.Blue := BlueRange;
  1775. aPixel.Alpha := AlphaRange;
  1776. end;
  1777. end;
  1778. {$ENDREGION}
  1779. {$REGION TfdEmpty}
  1780. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1781. //TfdEmpty////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1782. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1783. class function TfdEmpty.GetFormat: TglBitmapFormat;
  1784. begin
  1785. result := tfEmpty;
  1786. end;
  1787. class function TfdEmpty.GetPixelDesc: TglBitmapPixelDesc;
  1788. begin
  1789. with result do begin
  1790. RedRange := $00000000; RedShift := 0;
  1791. GreenRange := $00000000; GreenShift := 0;
  1792. BlueRange := $00000000; BlueShift := 0;
  1793. AlphaRange := $00000000; AlphaShift := 0;
  1794. end;
  1795. end;
  1796. class function TfdEmpty.GetFormatDesc: TglBitmapFormatDesc;
  1797. begin
  1798. with result do begin
  1799. Format := 0;
  1800. InternalFormat := 0;
  1801. DataType := 0;
  1802. end;
  1803. end;
  1804. class procedure TfdEmpty.Map(const aPixel: TglBitmapPixelData; var aData: PByte );
  1805. begin
  1806. raise EglBitmapException.Create('format does not support mapping');
  1807. end;
  1808. class procedure TfdEmpty.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData);
  1809. begin
  1810. raise EglBitmapException.Create('format does not support unmapping');
  1811. end;
  1812. {$ENDREGION}
  1813. {$REGION TfdLuminance8}
  1814. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1815. //TfdLuminance8///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1816. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1817. class function TfdLuminance8.GetFormat: TglBitmapFormat;
  1818. begin
  1819. result := tfEmpty;
  1820. end;
  1821. class function TfdLuminance8.GetPixelDesc: TglBitmapPixelDesc;
  1822. begin
  1823. with result do begin
  1824. RedRange := $000000FF; RedShift := 0;
  1825. GreenRange := $000000FF; GreenShift := 0;
  1826. BlueRange := $000000FF; BlueShift := 0;
  1827. AlphaRange := $00000000; AlphaShift := 0;
  1828. end;
  1829. end;
  1830. class function TfdLuminance8.GetFormatDesc: TglBitmapFormatDesc;
  1831. begin
  1832. with result do begin
  1833. Format := GL_LUMINANCE;
  1834. InternalFormat := GL_LUMINANCE8;
  1835. DataType := GL_UNSIGNED_BYTE;
  1836. end;
  1837. end;
  1838. class function TfdLuminance8.WithAlpha: TglBitmapFormat;
  1839. begin
  1840. result := tfLuminance8Alpha8;
  1841. end;
  1842. class procedure TfdLuminance8.Map(const aPixel: TglBitmapPixelData; var aData: PByte);
  1843. begin
  1844. aData^ := Trunc(
  1845. aPixel.Red * LUMINANCE_WEIGHT_R +
  1846. aPixel.Green * LUMINANCE_WEIGHT_G +
  1847. aPixel.Blue * LUMINANCE_WEIGHT_B);
  1848. inc(aData);
  1849. end;
  1850. class procedure TfdLuminance8.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData);
  1851. begin
  1852. aPixel.Red := aData^;
  1853. aPixel.Green := aData^;
  1854. aPixel.Blue := aData^;
  1855. aPixel.Alpha := 0;
  1856. inc(aData);
  1857. end;
  1858. {$ENDREGION}
  1859. {$REGION TfdLuminance8Alpha8}
  1860. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1861. //TfdLuminance8Alpha8/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1862. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1863. class function TfdLuminance8Alpha8.GetFormat: TglBitmapFormat;
  1864. begin
  1865. result := tfLuminance8Alpha8;
  1866. end;
  1867. class function TfdLuminance8Alpha8.GetPixelDesc: TglBitmapPixelDesc;
  1868. begin
  1869. with result do begin
  1870. RedRange := $000000FF; RedShift := 0;
  1871. GreenRange := $000000FF; GreenShift := 0;
  1872. BlueRange := $000000FF; BlueShift := 0;
  1873. AlphaRange := $000000FF; AlphaShift := 8;
  1874. end;
  1875. end;
  1876. class function TfdLuminance8Alpha8.GetFormatDesc: TglBitmapFormatDesc;
  1877. begin
  1878. with result do begin
  1879. Format := GL_LUMINANCE_ALPHA;
  1880. InternalFormat := GL_LUMINANCE8_ALPHA8;
  1881. DataType := GL_UNSIGNED_BYTE;
  1882. end;
  1883. end;
  1884. class function TfdLuminance8Alpha8.WithoutAlpha: TglBitmapFormat;
  1885. begin
  1886. result := tfLuminance8;
  1887. end;
  1888. class procedure TfdLuminance8Alpha8.Map(const aPixel: TglBitmapPixelData; var aData: PByte);
  1889. begin
  1890. aData^ := Trunc(
  1891. aPixel.Red * LUMINANCE_WEIGHT_R +
  1892. aPixel.Green * LUMINANCE_WEIGHT_G +
  1893. aPixel.Blue * LUMINANCE_WEIGHT_B);
  1894. inc(aData);
  1895. aData^ := aPixel.Alpha;
  1896. inc(aData);
  1897. end;
  1898. class procedure TfdLuminance8Alpha8.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData);
  1899. begin
  1900. aPixel.Red := aData^;
  1901. aPixel.Green := aData^;
  1902. aPixel.Blue := aData^;
  1903. inc(aData);
  1904. aPixel.Alpha := aData^;
  1905. inc(aData);
  1906. end;
  1907. {$ENDREGION}
  1908. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1909. //TfdRGB5/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1910. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1911. class function TfdRGB5.GetFormat: TglBitmapFormat;
  1912. begin
  1913. result := tfRGB5;
  1914. end;
  1915. class function TfdRGB5.GetPixelDesc: TglBitmapPixelDesc;
  1916. begin
  1917. with result do begin
  1918. RedRange := $0000001F; RedShift := 0;
  1919. GreenRange := $0000001F; GreenShift := 5;
  1920. BlueRange := $0000001F; BlueShift := 10;
  1921. AlphaRange := $00000000; AlphaShift := 0;
  1922. end;
  1923. end;
  1924. class function TfdRGB5.GetFormatDesc: TglBitmapFormatDesc;
  1925. begin
  1926. with result do begin
  1927. Format := GL_RGB;
  1928. InternalFormat := GL_RGB5;
  1929. DataType := GL_UNSIGNED_SHORT_5_5_5_1;
  1930. end;
  1931. end;
  1932. class function TfdRGB5.WithAlpha: TglBitmapFormat;
  1933. begin
  1934. result := tfRGB5A1;
  1935. end;
  1936. class procedure TfdRGB5.Map(const aPixel: TglBitmapPixelData; var aData: PByte);
  1937. begin
  1938. PWord(aData)^ :=
  1939. ((aPixel.Red and aPixel.PixelDesc.RedRange) shl aPixel.PixelDesc.RedShift) or
  1940. ((aPixel.Green and aPixel.PixelDesc.GreenRange) shl aPixel.PixelDesc.GreenShift) or
  1941. ((aPixel.Blue and aPixel.PixelDesc.BlueRange) shl aPixel.PixelDesc.BlueShift);
  1942. inc(aData, 2);
  1943. end;
  1944. class procedure TfdRGB5.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData);
  1945. begin
  1946. aPixel.Red := (PWord(aData)^ shr aPixel.PixelDesc.RedShift) and aPixel.PixelDesc.RedRange;
  1947. aPixel.Green := (PWord(aData)^ shr aPixel.PixelDesc.GreenShift) and aPixel.PixelDesc.GreenRange;
  1948. aPixel.Blue := (PWord(aData)^ shr aPixel.PixelDesc.BlueShift) and aPixel.PixelDesc.BlueRange;
  1949. aPixel.Alpha := 0;
  1950. inc(aData, 2);
  1951. end;
  1952. {$REGION TfdRGB8}
  1953. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1954. //TfdRGB8/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1955. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1956. class function TfdRGB8.GetFormat: TglBitmapFormat;
  1957. begin
  1958. result := tfRGB8;
  1959. end;
  1960. class function TfdRGB8.GetPixelDesc: TglBitmapPixelDesc;
  1961. begin
  1962. with result do begin
  1963. RedRange := $000000FF; RedShift := 0;
  1964. GreenRange := $000000FF; GreenShift := 8;
  1965. BlueRange := $000000FF; BlueShift := 16;
  1966. AlphaRange := $00000000; AlphaShift := 0;
  1967. end;
  1968. end;
  1969. class function TfdRGB8.GetFormatDesc: TglBitmapFormatDesc;
  1970. begin
  1971. with result do begin
  1972. Format := GL_LUMINANCE;
  1973. InternalFormat := GL_LUMINANCE8;
  1974. DataType := GL_UNSIGNED_BYTE;
  1975. end;
  1976. end;
  1977. class function TfdRGB8.WithAlpha: TglBitmapFormat;
  1978. begin
  1979. result := tfRGBA8;
  1980. end;
  1981. class procedure TfdRGB8.Map(const aPixel: TglBitmapPixelData; var aData: PByte);
  1982. begin
  1983. aData^ := aPixel.Red;
  1984. inc(aData);
  1985. aData^ := aPixel.Green;
  1986. inc(aData);
  1987. aData^ := aPixel.Blue;
  1988. inc(aData);
  1989. end;
  1990. class procedure TfdRGB8.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData);
  1991. begin
  1992. aPixel.Red := aData^;
  1993. inc(aData);
  1994. aPixel.Green := aData^;
  1995. inc(aData);
  1996. aPixel.Blue := aData^;
  1997. inc(aData);
  1998. aPixel.Alpha := 0;
  1999. end;
  2000. {$ENDREGION}
  2001. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2002. //TfdRGB5A1///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2003. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2004. class function TfdRGB5A1.GetFormat: TglBitmapFormat;
  2005. begin
  2006. result := tfRGB5A1;
  2007. end;
  2008. class function TfdRGB5A1.GetPixelDesc: TglBitmapPixelDesc;
  2009. begin
  2010. with result do begin
  2011. RedRange := $0000001F; RedShift := 0;
  2012. GreenRange := $0000001F; GreenShift := 5;
  2013. BlueRange := $0000001F; BlueShift := 10;
  2014. AlphaRange := $00000001; AlphaShift := 15;
  2015. end;
  2016. end;
  2017. class function TfdRGB5A1.GetFormatDesc: TglBitmapFormatDesc;
  2018. begin
  2019. with result do begin
  2020. Format := GL_RGBA;
  2021. InternalFormat := GL_RGB5_A1;
  2022. DataType := GL_UNSIGNED_SHORT_5_5_5_1;
  2023. end;
  2024. end;
  2025. class function TfdRGB5A1.WithoutAlpha: TglBitmapFormat;
  2026. begin
  2027. //TODO result := tfRGB5;
  2028. end;
  2029. class procedure TfdRGB5A1.Map(const aPixel: TglBitmapPixelData; var aData: PByte);
  2030. begin
  2031. PWord(aData)^ :=
  2032. ((aPixel.Red and aPixel.PixelDesc.RedRange) shl aPixel.PixelDesc.RedShift) or
  2033. ((aPixel.Green and aPixel.PixelDesc.GreenRange) shl aPixel.PixelDesc.GreenShift) or
  2034. ((aPixel.Blue and aPixel.PixelDesc.BlueRange) shl aPixel.PixelDesc.BlueShift) or
  2035. ((aPixel.Alpha and aPixel.PixelDesc.AlphaRange) shl aPixel.PixelDesc.AlphaShift);
  2036. inc(aData, 2);
  2037. end;
  2038. class procedure TfdRGB5A1.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData);
  2039. begin
  2040. aPixel.Red := (PWord(aData)^ shr aPixel.PixelDesc.RedShift) and aPixel.PixelDesc.RedRange;
  2041. aPixel.Green := (PWord(aData)^ shr aPixel.PixelDesc.GreenShift) and aPixel.PixelDesc.GreenRange;
  2042. aPixel.Blue := (PWord(aData)^ shr aPixel.PixelDesc.BlueShift) and aPixel.PixelDesc.BlueRange;
  2043. aPixel.Alpha := (PWord(aData)^ shr aPixel.PixelDesc.AlphaShift) and aPixel.PixelDesc.AlphaRange;
  2044. inc(aData, 2);
  2045. end;
  2046. {$REGION TfdRGBA8}
  2047. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2048. //TfdRGBA8////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2049. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2050. class function TfdRGBA8.GetFormat: TglBitmapFormat;
  2051. begin
  2052. result := tfRGBA8;
  2053. end;
  2054. class function TfdRGBA8.GetPixelDesc: TglBitmapPixelDesc;
  2055. begin
  2056. with result do begin
  2057. RedRange := $000000FF; RedShift := 0;
  2058. GreenRange := $000000FF; GreenShift := 8;
  2059. BlueRange := $000000FF; BlueShift := 16;
  2060. AlphaRange := $000000FF; AlphaShift := 24;
  2061. end;
  2062. end;
  2063. class function TfdRGBA8.GetFormatDesc: TglBitmapFormatDesc;
  2064. begin
  2065. with result do begin
  2066. Format := GL_RGB;
  2067. InternalFormat := GL_RGB8;
  2068. DataType := GL_UNSIGNED_BYTE;
  2069. end;
  2070. end;
  2071. class function TfdRGBA8.WithoutAlpha: TglBitmapFormat;
  2072. begin
  2073. result := tfRGB8;
  2074. end;
  2075. class procedure TfdRGBA8.Map(const aPixel: TglBitmapPixelData; var aData: PByte);
  2076. begin
  2077. aData^ := aPixel.Red;
  2078. inc(aData);
  2079. aData^ := aPixel.Green;
  2080. inc(aData);
  2081. aData^ := aPixel.Blue;
  2082. inc(aData);
  2083. aData^ := aPixel.Alpha;
  2084. inc(aData);
  2085. end;
  2086. class procedure TfdRGBA8.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData);
  2087. begin
  2088. aPixel.Red := aData^;
  2089. inc(aData);
  2090. aPixel.Green := aData^;
  2091. inc(aData);
  2092. aPixel.Blue := aData^;
  2093. inc(aData);
  2094. aPixel.Alpha := aData^;
  2095. inc(aData);
  2096. end;
  2097. {$ENDREGION}
  2098. {$REGION TfdBGR8}
  2099. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2100. //TfdBGR8/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2101. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2102. class function TfdBGR8.GetFormat: TglBitmapFormat;
  2103. begin
  2104. result := tfBGR8;
  2105. end;
  2106. class function TfdBGR8.GetPixelDesc: TglBitmapPixelDesc;
  2107. begin
  2108. with result do begin
  2109. RedRange := $000000FF; RedShift := 16;
  2110. GreenRange := $000000FF; GreenShift := 8;
  2111. BlueRange := $000000FF; BlueShift := 0;
  2112. AlphaRange := $00000000; AlphaShift := 0;
  2113. end;
  2114. end;
  2115. class function TfdBGR8.GetFormatDesc: TglBitmapFormatDesc;
  2116. begin
  2117. with result do begin
  2118. Format := GL_BGR;
  2119. InternalFormat := GL_RGB8;
  2120. DataType := GL_UNSIGNED_BYTE;
  2121. end;
  2122. end;
  2123. class function TfdBGR8.WithAlpha: TglBitmapFormat;
  2124. begin
  2125. result := tfBGRA8;
  2126. end;
  2127. class procedure TfdBGR8.Map(const aPixel: TglBitmapPixelData; var aData: PByte);
  2128. begin
  2129. aData^ := aPixel.Blue;
  2130. inc(aData);
  2131. aData^ := aPixel.Green;
  2132. inc(aData);
  2133. aData^ := aPixel.Red;
  2134. inc(aData);
  2135. end;
  2136. class procedure TfdBGR8.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData);
  2137. begin
  2138. aPixel.Blue := aData^;
  2139. inc(aData);
  2140. aPixel.Green := aData^;
  2141. inc(aData);
  2142. aPixel.Red := aData^;
  2143. inc(aData);
  2144. end;
  2145. {$ENDREGION}
  2146. {$REGION TfdBGRA8}
  2147. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2148. //TfdBGRA8////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2149. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2150. class function TfdBGRA8.GetFormat: TglBitmapFormat;
  2151. begin
  2152. result := tfBGRA8;
  2153. end;
  2154. class function TfdBGRA8.GetPixelDesc: TglBitmapPixelDesc;
  2155. begin
  2156. with result do begin
  2157. RedRange := $000000FF; RedShift := 16;
  2158. GreenRange := $000000FF; GreenShift := 8;
  2159. BlueRange := $000000FF; BlueShift := 0;
  2160. AlphaRange := $000000FF; AlphaShift := 24;
  2161. end;
  2162. end;
  2163. class function TfdBGRA8.GetFormatDesc: TglBitmapFormatDesc;
  2164. begin
  2165. with result do begin
  2166. Format := GL_BGRA;
  2167. InternalFormat := GL_RGBA8;
  2168. DataType := GL_UNSIGNED_BYTE;
  2169. end;
  2170. end;
  2171. class function TfdBGRA8.WithoutAlpha: TglBitmapFormat;
  2172. begin
  2173. result := tfBGR8;
  2174. end;
  2175. class procedure TfdBGRA8.Map(const aPixel: TglBitmapPixelData; var aData: PByte);
  2176. begin
  2177. aData^ := aPixel.Blue;
  2178. inc(aData);
  2179. aData^ := aPixel.Green;
  2180. inc(aData);
  2181. aData^ := aPixel.Red;
  2182. inc(aData);
  2183. aData^ := aPixel.Alpha;
  2184. inc(aData);
  2185. end;
  2186. class procedure TfdBGRA8.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData);
  2187. begin
  2188. aPixel.Blue := aData^;
  2189. inc(aData);
  2190. aPixel.Green := aData^;
  2191. inc(aData);
  2192. aPixel.Red := aData^;
  2193. inc(aData);
  2194. aPixel.Alpha := aData^;
  2195. inc(aData);
  2196. end;
  2197. {$ENDREGION}
  2198. {$REGION TglBitmap}
  2199. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2200. //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2201. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2202. procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
  2203. begin
  2204. with aFuncRec do begin
  2205. if (Source.PixelDesc.RedRange > 0) then
  2206. Dest.Red := Source.Red;
  2207. if (Source.PixelDesc.GreenRange > 0) then
  2208. Dest.Green := Source.Green;
  2209. if (Source.PixelDesc.BlueRange > 0) then
  2210. Dest.Blue := Source.Blue;
  2211. if (Source.PixelDesc.AlphaRange > 0) then
  2212. Dest.Alpha := Source.Alpha;
  2213. end;
  2214. end;
  2215. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2216. procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  2217. begin
  2218. with aFuncRec do begin
  2219. if (Source.PixelDesc.RedRange > 0) then
  2220. Dest.Red := Round(Dest.PixelDesc.RedRange * Source.Red / Source.PixelDesc.RedRange);
  2221. if (Source.PixelDesc.GreenRange > 0) then
  2222. Dest.Green := Round(Dest.PixelDesc.GreenRange * Source.Green / Source.PixelDesc.GreenRange);
  2223. if (Source.PixelDesc.BlueRange > 0) then
  2224. Dest.Blue := Round(Dest.PixelDesc.BlueRange * Source.Blue / Source.PixelDesc.BlueRange);
  2225. if (Source.PixelDesc.AlphaRange > 0) then
  2226. Dest.Alpha := Round(Dest.PixelDesc.AlphaRange * Source.Alpha / Source.PixelDesc.AlphaRange);
  2227. end;
  2228. end;
  2229. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2230. procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  2231. begin
  2232. with aFuncRec do
  2233. with PglBitmapPixelDesc(Args)^ do begin
  2234. if (Source.PixelDesc.RedRange > 0) then
  2235. Dest.Red := Source.Red shr RedShift;
  2236. if (Source.PixelDesc.GreenRange > 0) then
  2237. Dest.Green := Source.Green shr GreenShift;
  2238. if (Source.PixelDesc.BlueRange > 0) then
  2239. Dest.Blue := Source.Blue shr BlueShift;
  2240. if (Source.PixelDesc.AlphaRange > 0) then
  2241. Dest.Alpha := Source.Alpha shr AlphaShift;
  2242. end;
  2243. end;
  2244. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2245. procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
  2246. begin
  2247. with aFuncRec do begin
  2248. Dest.Red := Source.Red;
  2249. Dest.Green := Source.Green;
  2250. Dest.Blue := Source.Blue;
  2251. Dest.Alpha := Source.Alpha;
  2252. if (Args and $1 > 0) then begin
  2253. Dest.Red := Dest.Red xor Dest.PixelDesc.RedRange;
  2254. Dest.Green := Dest.Green xor Dest.PixelDesc.GreenRange;
  2255. Dest.Blue := Dest.Blue xor Dest.PixelDesc.BlueRange;
  2256. end;
  2257. if (Args and $2 > 0) then begin
  2258. Dest.Alpha := Dest.Alpha xor Dest.PixelDesc.AlphaRange;
  2259. end;
  2260. end;
  2261. end;
  2262. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2263. procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
  2264. type
  2265. PglBitmapPixelData = ^TglBitmapPixelData;
  2266. begin
  2267. with aFuncRec do begin
  2268. Dest.Red := PglBitmapPixelData(Args)^.Red;
  2269. Dest.Green := PglBitmapPixelData(Args)^.Green;
  2270. Dest.Blue := PglBitmapPixelData(Args)^.Blue;
  2271. Dest.Alpha := PglBitmapPixelData(Args)^.Alpha;
  2272. end;
  2273. end;
  2274. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2275. procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  2276. var
  2277. Temp: Single;
  2278. begin
  2279. with FuncRec do begin
  2280. if (FuncRec.Args = 0) then begin //source has no alpha
  2281. Temp :=
  2282. Source.Red / Source.PixelDesc.RedRange * ALPHA_WEIGHT_R +
  2283. Source.Green / Source.PixelDesc.GreenRange * ALPHA_WEIGHT_G +
  2284. Source.Blue / Source.PixelDesc.BlueRange * ALPHA_WEIGHT_B;
  2285. Dest.Alpha := Round(Dest.PixelDesc.AlphaRange * Temp);
  2286. end else
  2287. Dest.Alpha := Round(Source.Alpha / Source.PixelDesc.AlphaRange * Dest.PixelDesc.AlphaRange);
  2288. end;
  2289. end;
  2290. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2291. procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  2292. type
  2293. PglBitmapPixelData = ^TglBitmapPixelData;
  2294. begin
  2295. with FuncRec do begin
  2296. Dest.Red := Source.Red;
  2297. Dest.Green := Source.Green;
  2298. Dest.Blue := Source.Blue;
  2299. with PglBitmapPixelData(Args)^ do
  2300. if ((Dest.Red <= Red ) and (Dest.Red >= PixelDesc.RedRange ) and
  2301. (Dest.Green <= Green) and (Dest.Green >= PixelDesc.GreenRange) and
  2302. (Dest.Blue <= Blue ) and (Dest.Blue >= PixelDesc.BlueRange )) then
  2303. Dest.Alpha := 0
  2304. else
  2305. Dest.Alpha := Dest.PixelDesc.AlphaRange;
  2306. end;
  2307. end;
  2308. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2309. procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  2310. type
  2311. PglBitmapPixelData = ^TglBitmapPixelData;
  2312. begin
  2313. with FuncRec do begin
  2314. Dest.Red := Source.Red;
  2315. Dest.Green := Source.Green;
  2316. Dest.Blue := Source.Blue;
  2317. with PglBitmapPixelData(Args)^ do
  2318. Dest.Alpha := Alpha;
  2319. end;
  2320. end;
  2321. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2322. procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
  2323. type
  2324. PRGBPix = ^TRGBPix;
  2325. TRGBPix = array [0..2] of byte;
  2326. var
  2327. Temp: Byte;
  2328. begin
  2329. while aWidth > 0 do begin
  2330. Temp := PRGBPix(aData)^[0];
  2331. PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
  2332. PRGBPix(aData)^[2] := Temp;
  2333. if aHasAlpha then
  2334. Inc(aData, 4)
  2335. else
  2336. Inc(aData, 3);
  2337. dec(aWidth);
  2338. end;
  2339. end;
  2340. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2341. //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2342. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2343. {$REGION Getter}
  2344. function TglBitmap.GetWidth: Integer;
  2345. begin
  2346. if (ffX in fDimension.Fields) then
  2347. result := fDimension.X
  2348. else
  2349. result := -1;
  2350. end;
  2351. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2352. function TglBitmap.GetHeight: Integer;
  2353. begin
  2354. if (ffY in fDimension.Fields) then
  2355. result := fDimension.Y
  2356. else
  2357. result := -1;
  2358. end;
  2359. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2360. function TglBitmap.GetFileWidth: Integer;
  2361. begin
  2362. result := Max(1, Width);
  2363. end;
  2364. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2365. function TglBitmap.GetFileHeight: Integer;
  2366. begin
  2367. result := Max(1, Height);
  2368. end;
  2369. {$ENDREGION}
  2370. {$REGION Setter}
  2371. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2372. procedure TglBitmap.SetCustomData(const aValue: Pointer);
  2373. begin
  2374. if fCustomData = aValue then
  2375. exit;
  2376. fCustomData := aValue;
  2377. end;
  2378. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2379. procedure TglBitmap.SetCustomName(const aValue: String);
  2380. begin
  2381. if fCustomName = aValue then
  2382. exit;
  2383. fCustomName := aValue;
  2384. end;
  2385. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2386. procedure TglBitmap.SetCustomNameW(const aValue: WideString);
  2387. begin
  2388. if fCustomNameW = aValue then
  2389. exit;
  2390. fCustomNameW := aValue;
  2391. end;
  2392. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2393. procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
  2394. begin
  2395. if fDeleteTextureOnFree = aValue then
  2396. exit;
  2397. fDeleteTextureOnFree := aValue;
  2398. end;
  2399. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2400. procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);
  2401. begin
  2402. if fFormat = aValue then
  2403. exit;
  2404. if (FORMAT_DESCRIPTORS[Format].GetSize <> FORMAT_DESCRIPTORS[aValue].GetSize) then
  2405. raise EglBitmapUnsupportedFormatFormat.Create('SetInternalFormat - ' + UNSUPPORTED_FORMAT);
  2406. SetDataPointer(Data, aValue, Width, Height);
  2407. end;
  2408. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2409. procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);
  2410. begin
  2411. if fFreeDataAfterGenTexture = aValue then
  2412. exit;
  2413. fFreeDataAfterGenTexture := aValue;
  2414. end;
  2415. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2416. procedure TglBitmap.SetID(const aValue: Cardinal);
  2417. begin
  2418. if fID = aValue then
  2419. exit;
  2420. fID := aValue;
  2421. end;
  2422. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2423. procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
  2424. begin
  2425. if fMipMap = aValue then
  2426. exit;
  2427. fMipMap := aValue;
  2428. end;
  2429. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2430. procedure TglBitmap.SetTarget(const aValue: Cardinal);
  2431. begin
  2432. if fTarget = aValue then
  2433. exit;
  2434. fTarget := aValue;
  2435. end;
  2436. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2437. procedure TglBitmap.SetAnisotropic(const aValue: Integer);
  2438. var
  2439. MaxAnisotropic: Integer;
  2440. begin
  2441. fAnisotropic := aValue;
  2442. if (ID > 0) then begin
  2443. if GL_EXT_texture_filter_anisotropic then begin
  2444. if fAnisotropic > 0 then begin
  2445. Bind(false);
  2446. glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
  2447. if aValue > MaxAnisotropic then
  2448. fAnisotropic := MaxAnisotropic;
  2449. glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
  2450. end;
  2451. end else begin
  2452. fAnisotropic := 0;
  2453. end;
  2454. end;
  2455. end;
  2456. {$ENDREGION}
  2457. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2458. procedure TglBitmap.CreateID;
  2459. begin
  2460. if (ID <> 0) then
  2461. glDeleteTextures(1, @fID);
  2462. glGenTextures(1, @fID);
  2463. Bind(false);
  2464. end;
  2465. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2466. procedure TglBitmap.SetupParameters(var aBuildWithGlu: Boolean);
  2467. begin
  2468. // Set Up Parameters
  2469. SetWrap(fWrapS, fWrapT, fWrapR);
  2470. SetFilter(fFilterMin, fFilterMag);
  2471. SetAnisotropic(fAnisotropic);
  2472. SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
  2473. // Mip Maps Generation Mode
  2474. aBuildWithGlu := false;
  2475. if (MipMap = mmMipmap) then begin
  2476. if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
  2477. glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
  2478. else
  2479. aBuildWithGlu := true;
  2480. end else if (MipMap = mmMipmapGlu) then
  2481. aBuildWithGlu := true;
  2482. end;
  2483. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2484. procedure TglBitmap.SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
  2485. const aWidth: Integer; const aHeight: Integer);
  2486. var
  2487. s: Single;
  2488. begin
  2489. if (Data <> aData) then begin
  2490. if (Assigned(Data)) then
  2491. FreeMem(Data);
  2492. fData := aData;
  2493. end;
  2494. FillChar(fDimension, SizeOf(fDimension), 0);
  2495. if not Assigned(fData) then begin
  2496. fFormat := tfEmpty;
  2497. fPixelSize := 0;
  2498. fRowSize := 0;
  2499. end else begin
  2500. if aWidth <> -1 then begin
  2501. fDimension.Fields := fDimension.Fields + [ffX];
  2502. fDimension.X := aWidth;
  2503. end;
  2504. if aHeight <> -1 then begin
  2505. fDimension.Fields := fDimension.Fields + [ffY];
  2506. fDimension.Y := aHeight;
  2507. end;
  2508. s := FORMAT_DESCRIPTORS[aFormat].GetSize;
  2509. fFormat := aFormat;
  2510. fPixelSize := Ceil(s);
  2511. fRowSize := Ceil(s * aWidth);
  2512. end;
  2513. end;
  2514. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2515. function TglBitmap.FlipHorz: Boolean;
  2516. begin
  2517. result := false;
  2518. end;
  2519. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2520. function TglBitmap.FlipVert: Boolean;
  2521. begin
  2522. result := false;
  2523. end;
  2524. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2525. //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2526. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2527. procedure TglBitmap.AfterConstruction;
  2528. begin
  2529. inherited AfterConstruction;
  2530. fID := 0;
  2531. fTarget := 0;
  2532. fIsResident := false;
  2533. fFormat := glBitmapGetDefaultFormat;
  2534. fMipMap := glBitmapDefaultMipmap;
  2535. fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;
  2536. fDeleteTextureOnFree := glBitmapGetDefaultDeleteTextureOnFree;
  2537. glBitmapGetDefaultFilter (fFilterMin, fFilterMag);
  2538. glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
  2539. end;
  2540. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2541. procedure TglBitmap.BeforeDestruction;
  2542. begin
  2543. SetDataPointer(nil, tfEmpty);
  2544. if (fID > 0) and fDeleteTextureOnFree then
  2545. glDeleteTextures(1, @fID);
  2546. inherited BeforeDestruction;
  2547. end;
  2548. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2549. procedure TglBitmap.LoadFromFile(const aFilename: String);
  2550. var
  2551. fs: TFileStream;
  2552. begin
  2553. fFilename := aFilename;
  2554. fs := TFileStream.Create(fFilename, fmOpenRead);
  2555. try
  2556. fs.Position := 0;
  2557. LoadFromStream(fs);
  2558. finally
  2559. fs.Free;
  2560. end;
  2561. end;
  2562. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2563. procedure TglBitmap.LoadFromStream(const aStream: TStream);
  2564. begin
  2565. {$IFDEF GLB_SUPPORT_PNG_READ}
  2566. if not LoadPNG(aStream) then
  2567. {$ENDIF}
  2568. {$IFDEF GLB_SUPPORT_JPEG_READ}
  2569. if not LoadJPEG(aStream) then
  2570. {$ENDIF}
  2571. if not LoadDDS(aStream) then
  2572. if not LoadTGA(aStream) then
  2573. if not LoadBMP(aStream) then
  2574. raise EglBitmapException.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
  2575. end;
  2576. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2577. procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
  2578. const aFormat: TglBitmapFormat; const aArgs: PtrInt);
  2579. var
  2580. tmpData: PByte;
  2581. size: Integer;
  2582. begin
  2583. size := FORMAT_DESCRIPTORS[aFormat].GetSize(aSize);
  2584. GetMem(tmpData, size);
  2585. try
  2586. FillChar(tmpData^, size, #$FF);
  2587. SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y);
  2588. except
  2589. FreeMem(tmpData);
  2590. raise;
  2591. end;
  2592. AddFunc(Self, aFunc, false, Format, aArgs);
  2593. end;
  2594. {$IFDEF GLB_DELPHI}
  2595. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2596. procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil);
  2597. var
  2598. rs: TResourceStream;
  2599. TempPos: Integer;
  2600. ResTypeStr: String;
  2601. TempResType: PChar;
  2602. begin
  2603. if not Assigned(ResType) then begin
  2604. TempPos := Pos('.', Resource);
  2605. ResTypeStr := UpperCase(Copy(Resource, TempPos + 1, Length(Resource) - TempPos));
  2606. Resource := UpperCase(Copy(Resource, 0, TempPos -1));
  2607. TempResType := PChar(ResTypeStr);
  2608. end else
  2609. TempResType := ResType
  2610. rs := TResourceStream.Create(Instance, Resource, TempResType);
  2611. try
  2612. LoadFromStream(rs);
  2613. finally
  2614. rs.Free;
  2615. end;
  2616. end;
  2617. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2618. procedure TglBitmap.LoadFromResourceID(const sInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  2619. var
  2620. rs: TResourceStream;
  2621. begin
  2622. rs := TResourceStream.CreateFromID(Instance, ResourceID, ResType);
  2623. try
  2624. LoadFromStream(rs);
  2625. finally
  2626. rs.Free;
  2627. end;
  2628. end;
  2629. {$ENDIF}
  2630. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2631. procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
  2632. var
  2633. fs: TFileStream;
  2634. begin
  2635. fs := TFileStream.Create(aFileName, fmCreate);
  2636. try
  2637. fs.Position := 0;
  2638. SaveToStream(fs, aFileType);
  2639. finally
  2640. fs.Free;
  2641. end;
  2642. end;
  2643. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2644. procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
  2645. begin
  2646. case aFileType of
  2647. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  2648. ftPNG: SavePng(aStream);
  2649. {$ENDIF}
  2650. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  2651. ftJPEG: SaveJPEG(aStream);
  2652. {$ENDIF}
  2653. ftDDS: SaveDDS(aStream);
  2654. ftTGA: SaveTGA(aStream);
  2655. ftBMP: SaveBMP(aStream);
  2656. end;
  2657. end;
  2658. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2659. function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: PtrInt): Boolean;
  2660. begin
  2661. result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);
  2662. end;
  2663. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2664. function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  2665. const aFormat: TglBitmapFormat; const aArgs: PtrInt): Boolean;
  2666. var
  2667. DestData, TmpData, SourceData: pByte;
  2668. TempHeight, TempWidth: Integer;
  2669. SourceFD, DestFD: TglBitmapFormatDescClass;
  2670. FuncRec: TglBitmapFunctionRec;
  2671. begin
  2672. Assert(Assigned(Data));
  2673. Assert(Assigned(aSource));
  2674. Assert(Assigned(aSource.Data));
  2675. result := false;
  2676. if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
  2677. SourceFD := FORMAT_DESCRIPTORS[aSource.Format];
  2678. DestFD := FORMAT_DESCRIPTORS[aFormat];
  2679. // inkompatible Formats so CreateTemp
  2680. if (SourceFD.GetSize <> DestFD.GetSize) then
  2681. aCreateTemp := true;
  2682. // Values
  2683. TempHeight := Max(1, aSource.Height);
  2684. TempWidth := Max(1, aSource.Width);
  2685. FuncRec.Sender := Self;
  2686. FuncRec.Args := aArgs;
  2687. TmpData := nil;
  2688. if aCreateTemp then begin
  2689. GetMem(TmpData, Ceil(FORMAT_DESCRIPTORS[aFormat].GetSize * TempHeight * TempWidth));
  2690. DestData := TmpData;
  2691. end else
  2692. DestData := Data;
  2693. try
  2694. SourceFD.PreparePixel(FuncRec.Source);
  2695. DestFD.PreparePixel (FuncRec.Dest);
  2696. FuncRec.Size := aSource.Dimension;
  2697. FuncRec.Position.Fields := FuncRec.Size.Fields;
  2698. if {FormatIsUncompressed(Source.InternalFormat)} true then begin
  2699. SourceData := aSource.Data;
  2700. FuncRec.Position.Y := 0;
  2701. while FuncRec.Position.Y < TempHeight do begin
  2702. FuncRec.Position.X := 0;
  2703. while FuncRec.Position.X < TempWidth do begin
  2704. SourceFD.Unmap(SourceData, FuncRec.Source);
  2705. aFunc(FuncRec);
  2706. DestFD.Map(FuncRec.Dest, DestData);
  2707. inc(FuncRec.Position.X);
  2708. end;
  2709. inc(FuncRec.Position.Y);
  2710. end;
  2711. end else begin
  2712. (* TODO
  2713. // Compressed Images
  2714. FuncRec.Position.Y := 0;
  2715. while FuncRec.Position.Y < TempHeight do begin
  2716. FuncRec.Position.X := 0;
  2717. while FuncRec.Position.X < TempWidth do begin
  2718. // Get Data
  2719. fGetPixelFunc(FuncRec.Position, FuncRec.Source);
  2720. // Func
  2721. Func(FuncRec);
  2722. // Set Data
  2723. MapFunc(FuncRec.Dest, dest);
  2724. Inc(FuncRec.Position.X);
  2725. end;
  2726. Inc(FuncRec.Position.Y);
  2727. end;
  2728. *)
  2729. end;
  2730. // Updating Image or InternalFormat
  2731. if aCreateTemp then
  2732. SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height)
  2733. else if (aFormat <> fFormat) then
  2734. Format := aFormat;
  2735. result := true;
  2736. except
  2737. if aCreateTemp then
  2738. FreeMem(TmpData);
  2739. raise;
  2740. end;
  2741. end;
  2742. end;
  2743. {$IFDEF GLB_SDL}
  2744. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2745. function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  2746. var
  2747. Row, RowSize: Integer;
  2748. SourceData, TmpData: PByte;
  2749. TempDepth: Integer;
  2750. Pix: TglBitmapPixelData;
  2751. FormatDesc: TglBitmapFormatDescriptor;
  2752. function GetRowPointer(Row: Integer): pByte;
  2753. begin
  2754. result := Surface.pixels;
  2755. Inc(result, Row * RowSize);
  2756. end;
  2757. begin
  2758. result := false;
  2759. (* TODO
  2760. if not FormatIsUncompressed(InternalFormat) then
  2761. raise EglBitmapUnsupportedInternalFormat.Create('AssignToSurface - ' + UNSUPPORTED_INTERNAL_FORMAT);
  2762. *)
  2763. FormatDesc := FORMAT_DESCRIPTORS[Format];
  2764. if Assigned(Data) then begin
  2765. case Trunc(FormatDesc.GetSize) of
  2766. 1: TempDepth := 8;
  2767. 2: TempDepth := 16;
  2768. 3: TempDepth := 24;
  2769. 4: TempDepth := 32;
  2770. else
  2771. raise EglBitmapException.Create('AssignToSurface - ' + UNSUPPORTED_INTERNAL_FORMAT);
  2772. end;
  2773. FormatDesc.PreparePixel(Pix);
  2774. with Pix.PixelDesc do
  2775. Surface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
  2776. RedRange shl RedShift, GreenRange shl GreenShift, BlueRange shl BlueShift, AlphaRange shl AlphaShift);
  2777. SourceData := Data;
  2778. RowSize := Ceil(FileWidth * FormatDesc.GetSize);
  2779. for Row := 0 to FileHeight -1 do begin
  2780. TmpData := GetRowPointer(Row);
  2781. if Assigned(TmpData) then begin
  2782. Move(SourceData^, TmpData^, RowSize);
  2783. inc(SourceData, RowSize);
  2784. end;
  2785. end;
  2786. result := true;
  2787. end;
  2788. end;
  2789. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2790. function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  2791. var
  2792. pSource, pData, pTempData: PByte;
  2793. Row, RowSize, TempWidth, TempHeight: Integer;
  2794. IntFormat, f: TglBitmapInternalFormat;
  2795. FormatDesc: TglBitmapFormatDescriptor;
  2796. function GetRowPointer(Row: Integer): pByte;
  2797. begin
  2798. result := Surface^.pixels;
  2799. Inc(result, Row * RowSize);
  2800. end;
  2801. begin
  2802. result := false;
  2803. if (Assigned(Surface)) then begin
  2804. with Surface^.format^ do begin
  2805. IntFormat := tfEmpty;
  2806. for f := Low(f) to High(f) do begin
  2807. if FORMAT_DESCRIPTORS[f].MaskMatch(RMask, GMask, BMask, AMask) then begin
  2808. IntFormat := f;
  2809. break;
  2810. end;
  2811. end;
  2812. if (IntFormat = tfEmpty) then
  2813. raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');
  2814. end;
  2815. FormatDesc := FORMAT_DESCRIPTORS[IntFormat];
  2816. TempWidth := Surface^.w;
  2817. TempHeight := Surface^.h;
  2818. RowSize := Trunc(TempWidth * FormatDesc.GetSize);
  2819. GetMem(pData, TempHeight * RowSize);
  2820. try
  2821. pTempData := pData;
  2822. for Row := 0 to TempHeight -1 do begin
  2823. pSource := GetRowPointer(Row);
  2824. if (Assigned(pSource)) then begin
  2825. Move(pSource^, pTempData^, RowSize);
  2826. Inc(pTempData, RowSize);
  2827. end;
  2828. end;
  2829. SetDataPointer(pData, IntFormat, TempWidth, TempHeight);
  2830. result := true;
  2831. except
  2832. FreeMem(pData);
  2833. raise;
  2834. end;
  2835. end;
  2836. end;
  2837. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2838. function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  2839. var
  2840. Row, Col, AlphaInterleave: Integer;
  2841. pSource, pDest: PByte;
  2842. function GetRowPointer(Row: Integer): pByte;
  2843. begin
  2844. result := aSurface.pixels;
  2845. Inc(result, Row * Width);
  2846. end;
  2847. begin
  2848. result := false;
  2849. if Assigned(Data) then begin
  2850. if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin
  2851. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
  2852. AlphaInterleave := 0;
  2853. case Format of
  2854. ifLuminance8Alpha8:
  2855. AlphaInterleave := 1;
  2856. ifBGRA8, ifRGBA8:
  2857. AlphaInterleave := 3;
  2858. end;
  2859. pSource := Data;
  2860. for Row := 0 to Height -1 do begin
  2861. pDest := GetRowPointer(Row);
  2862. if Assigned(pDest) then begin
  2863. for Col := 0 to Width -1 do begin
  2864. Inc(pSource, AlphaInterleave);
  2865. pDest^ := pSource^;
  2866. Inc(pDest);
  2867. Inc(pSource);
  2868. end;
  2869. end;
  2870. end;
  2871. result := true;
  2872. end;
  2873. end;
  2874. end;
  2875. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2876. function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
  2877. var
  2878. bmp: TglBitmap2D;
  2879. begin
  2880. bmp := TglBitmap2D.Create;
  2881. try
  2882. bmp.AssignFromSurface(Surface);
  2883. result := AddAlphaFromGlBitmap(bmp, Func, CustomData);
  2884. finally
  2885. bmp.Free;
  2886. end;
  2887. end;
  2888. {$ENDIF}
  2889. {$IFDEF GLB_DELPHI}
  2890. //TODO rework & test
  2891. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2892. function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;
  2893. var
  2894. Row: Integer;
  2895. pSource, pData: PByte;
  2896. begin
  2897. result := false;
  2898. if Assigned(Data) then begin
  2899. if Assigned(aBitmap) then begin
  2900. aBitmap.Width := Width;
  2901. aBitmap.Height := Height;
  2902. case Format of
  2903. tfAlpha8, ifLuminance, ifDepth8:
  2904. begin
  2905. Bitmap.PixelFormat := pf8bit;
  2906. Bitmap.Palette := CreateGrayPalette;
  2907. end;
  2908. ifRGB5A1:
  2909. Bitmap.PixelFormat := pf15bit;
  2910. ifR5G6B5:
  2911. Bitmap.PixelFormat := pf16bit;
  2912. ifRGB8, ifBGR8:
  2913. Bitmap.PixelFormat := pf24bit;
  2914. ifRGBA8, ifBGRA8:
  2915. Bitmap.PixelFormat := pf32bit;
  2916. else
  2917. raise EglBitmapException.Create('AssignToBitmap - Invalid Pixelformat.');
  2918. end;
  2919. pSource := Data;
  2920. for Row := 0 to FileHeight -1 do begin
  2921. pData := Bitmap.Scanline[Row];
  2922. Move(pSource^, pData^, fRowSize);
  2923. Inc(pSource, fRowSize);
  2924. // swap RGB(A) to BGR(A)
  2925. if InternalFormat in [ifRGB8, ifRGBA8] then
  2926. SwapRGB(pData, FileWidth, InternalFormat = ifRGBA8);
  2927. end;
  2928. result := true;
  2929. end;
  2930. end;
  2931. end;
  2932. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2933. function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  2934. var
  2935. pSource, pData, pTempData: PByte;
  2936. Row, RowSize, TempWidth, TempHeight: Integer;
  2937. IntFormat: TglBitmapInternalFormat;
  2938. begin
  2939. result := false;
  2940. if (Assigned(Bitmap)) then begin
  2941. case Bitmap.PixelFormat of
  2942. pf8bit:
  2943. IntFormat := ifLuminance;
  2944. pf15bit:
  2945. IntFormat := ifRGB5A1;
  2946. pf16bit:
  2947. IntFormat := ifR5G6B5;
  2948. pf24bit:
  2949. IntFormat := ifBGR8;
  2950. pf32bit:
  2951. IntFormat := ifBGRA8;
  2952. else
  2953. raise EglBitmapException.Create('AssignFromBitmap - Invalid Pixelformat.');
  2954. end;
  2955. TempWidth := Bitmap.Width;
  2956. TempHeight := Bitmap.Height;
  2957. RowSize := Trunc(TempWidth * FormatGetSize(IntFormat));
  2958. GetMem(pData, TempHeight * RowSize);
  2959. try
  2960. pTempData := pData;
  2961. for Row := 0 to TempHeight -1 do begin
  2962. pSource := Bitmap.Scanline[Row];
  2963. if (Assigned(pSource)) then begin
  2964. Move(pSource^, pTempData^, RowSize);
  2965. Inc(pTempData, RowSize);
  2966. end;
  2967. end;
  2968. SetDataPointer(pData, IntFormat, TempWidth, TempHeight);
  2969. result := true;
  2970. except
  2971. FreeMem(pData);
  2972. raise;
  2973. end;
  2974. end;
  2975. end;
  2976. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2977. function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  2978. var
  2979. Row, Col, AlphaInterleave: Integer;
  2980. pSource, pDest: PByte;
  2981. begin
  2982. result := false;
  2983. if Assigned(Data) then begin
  2984. if InternalFormat in [ifAlpha, ifLuminanceAlpha, ifRGBA8, ifBGRA8] then begin
  2985. if Assigned(Bitmap) then begin
  2986. Bitmap.PixelFormat := pf8bit;
  2987. Bitmap.Palette := CreateGrayPalette;
  2988. Bitmap.Width := Width;
  2989. Bitmap.Height := Height;
  2990. case InternalFormat of
  2991. ifLuminanceAlpha:
  2992. AlphaInterleave := 1;
  2993. ifRGBA8, ifBGRA8:
  2994. AlphaInterleave := 3;
  2995. else
  2996. AlphaInterleave := 0;
  2997. end;
  2998. // Copy Data
  2999. pSource := Data;
  3000. for Row := 0 to Height -1 do begin
  3001. pDest := Bitmap.Scanline[Row];
  3002. if Assigned(pDest) then begin
  3003. for Col := 0 to Width -1 do begin
  3004. Inc(pSource, AlphaInterleave);
  3005. pDest^ := pSource^;
  3006. Inc(pDest);
  3007. Inc(pSource);
  3008. end;
  3009. end;
  3010. end;
  3011. result := true;
  3012. end;
  3013. end;
  3014. end;
  3015. end;
  3016. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3017. function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
  3018. var
  3019. tex: TglBitmap2D;
  3020. begin
  3021. tex := TglBitmap2D.Create;
  3022. try
  3023. tex.AssignFromBitmap(Bitmap);
  3024. result := AddAlphaFromglBitmap(tex, Func, CustomData);
  3025. finally
  3026. tex.Free;
  3027. end;
  3028. end;
  3029. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3030. function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar;
  3031. const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
  3032. var
  3033. RS: TResourceStream;
  3034. TempPos: Integer;
  3035. ResTypeStr: String;
  3036. TempResType: PChar;
  3037. begin
  3038. if Assigned(ResType) then
  3039. TempResType := ResType
  3040. else
  3041. begin
  3042. TempPos := Pos('.', Resource);
  3043. ResTypeStr := UpperCase(Copy(Resource, TempPos + 1, Length(Resource) - TempPos));
  3044. Resource := UpperCase(Copy(Resource, 0, TempPos -1));
  3045. TempResType := PChar(ResTypeStr);
  3046. end;
  3047. RS := TResourceStream.Create(Instance, Resource, TempResType);
  3048. try
  3049. result := AddAlphaFromStream(RS, Func, CustomData);
  3050. finally
  3051. RS.Free;
  3052. end;
  3053. end;
  3054. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3055. function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  3056. const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
  3057. var
  3058. RS: TResourceStream;
  3059. begin
  3060. RS := TResourceStream.CreateFromID(Instance, ResourceID, ResType);
  3061. try
  3062. result := AddAlphaFromStream(RS, Func, CustomData);
  3063. finally
  3064. RS.Free;
  3065. end;
  3066. end;
  3067. {$ENDIF}
  3068. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3069. function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
  3070. begin
  3071. (* TODO
  3072. if not FormatIsUncompressed(InternalFormat) then
  3073. raise EglBitmapUnsupportedFormatFormat.Create('AddAlphaFromFunc - ' + UNSUPPORTED_FORMAT);
  3074. *)
  3075. result := AddFunc(Self, aFunc, false, FORMAT_DESCRIPTORS[Format].WithAlpha, aArgs);
  3076. end;
  3077. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3078. function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
  3079. var
  3080. FS: TFileStream;
  3081. begin
  3082. FS := TFileStream.Create(FileName, fmOpenRead);
  3083. try
  3084. result := AddAlphaFromStream(FS, aFunc, aArgs);
  3085. finally
  3086. FS.Free;
  3087. end;
  3088. end;
  3089. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3090. function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
  3091. var
  3092. tex: TglBitmap2D;
  3093. begin
  3094. tex := TglBitmap2D.Create(aStream);
  3095. try
  3096. result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
  3097. finally
  3098. tex.Free;
  3099. end;
  3100. end;
  3101. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3102. function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
  3103. var
  3104. DestData, DestData2, SourceData: pByte;
  3105. TempHeight, TempWidth: Integer;
  3106. SourceFD, DestFD: TglBitmapFormatDescClass;
  3107. FuncRec: TglBitmapFunctionRec;
  3108. begin
  3109. result := false;
  3110. Assert(Assigned(Data));
  3111. Assert(Assigned(aBitmap));
  3112. Assert(Assigned(aBitmap.Data));
  3113. if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin
  3114. result := ConvertTo(FORMAT_DESCRIPTORS[Format].WithAlpha);
  3115. if not Assigned(aFunc) then
  3116. aFunc := glBitmapAlphaFunc;
  3117. SourceFD := FORMAT_DESCRIPTORS[aBitmap.Format];
  3118. DestFD := FORMAT_DESCRIPTORS[Format];
  3119. // Values
  3120. TempHeight := aBitmap.FileHeight;
  3121. TempWidth := aBitmap.FileWidth;
  3122. FuncRec.Sender := Self;
  3123. FuncRec.Args := aArgs;
  3124. FuncRec.Size := Dimension;
  3125. FuncRec.Position.Fields := FuncRec.Size.Fields;
  3126. FuncRec.Args := PtrInt(SourceFD.HasAlpha) and 1;
  3127. DestData := Data;
  3128. DestData2 := Data;
  3129. SourceData := aBitmap.Data;
  3130. // Mapping
  3131. SourceFD.PreparePixel(FuncRec.Source);
  3132. DestFD.PreparePixel (FuncRec.Dest);
  3133. FuncRec.Position.Y := 0;
  3134. while FuncRec.Position.Y < TempHeight do begin
  3135. FuncRec.Position.X := 0;
  3136. while FuncRec.Position.X < TempWidth do begin
  3137. SourceFD.Unmap(SourceData, FuncRec.Source);
  3138. DestFD.Unmap (DestData, FuncRec.Dest);
  3139. aFunc(FuncRec);
  3140. DestFD.Map(FuncRec.Dest, DestData2);
  3141. inc(FuncRec.Position.X);
  3142. end;
  3143. inc(FuncRec.Position.Y);
  3144. end;
  3145. end;
  3146. end;
  3147. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3148. function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
  3149. begin
  3150. result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
  3151. end;
  3152. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3153. function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
  3154. var
  3155. PixelData: TglBitmapPixelData;
  3156. begin
  3157. FORMAT_DESCRIPTORS[FORMAT_DESCRIPTORS[Format].WithAlpha].PreparePixel(PixelData);
  3158. result := AddAlphaFromColorKeyFloat(
  3159. aRed / PixelData.PixelDesc.RedRange,
  3160. aGreen / PixelData.PixelDesc.GreenRange,
  3161. aBlue / PixelData.PixelDesc.BlueRange,
  3162. aDeviation / Max(PixelData.PixelDesc.RedRange, Max(PixelData.PixelDesc.GreenRange, PixelData.PixelDesc.BlueRange)));
  3163. end;
  3164. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3165. function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
  3166. var
  3167. TempR, TempG, TempB: Cardinal;
  3168. PixelData: TglBitmapPixelData;
  3169. begin
  3170. FORMAT_DESCRIPTORS[FORMAT_DESCRIPTORS[Format].WithAlpha].PreparePixel(PixelData);
  3171. with PixelData.PixelDesc do begin
  3172. TempR := Trunc(RedRange * aDeviation);
  3173. TempG := Trunc(GreenRange * aDeviation);
  3174. TempB := Trunc(BlueRange * aDeviation);
  3175. PixelData.Red := Min(RedRange, Trunc(RedRange * aRed) + TempR);
  3176. RedRange := Max(0, Trunc(RedRange * aRed) - TempR);
  3177. PixelData.Green := Min(GreenRange, Trunc(GreenRange * aGreen) + TempG);
  3178. GreenRange := Max(0, Trunc(GreenRange * aGreen) - TempG);
  3179. PixelData.Blue := Min(BlueRange, Trunc(BlueRange * aBlue) + TempB);
  3180. BlueRange := Max(0, Trunc(BlueRange * aBlue) - TempB);
  3181. PixelData.Alpha := 0;
  3182. AlphaRange := 0;
  3183. end;
  3184. result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, PtrInt(@PixelData));
  3185. end;
  3186. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3187. function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;
  3188. begin
  3189. result := AddAlphaFromValueFloat(aAlpha / $FF);
  3190. end;
  3191. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3192. function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  3193. var
  3194. PixelData: TglBitmapPixelData;
  3195. begin
  3196. FORMAT_DESCRIPTORS[FORMAT_DESCRIPTORS[Format].WithAlpha].PreparePixel(PixelData);
  3197. result := AddAlphaFromValueFloat(aAlpha / PixelData.PixelDesc.AlphaRange);
  3198. end;
  3199. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3200. function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  3201. var
  3202. PixelData: TglBitmapPixelData;
  3203. begin
  3204. FORMAT_DESCRIPTORS[FORMAT_DESCRIPTORS[Format].WithAlpha].PreparePixel(PixelData);
  3205. with PixelData.PixelDesc do
  3206. PixelData.Alpha := Min(AlphaRange, Max(0, Round(AlphaRange * aAlpha)));
  3207. result := AddAlphaFromFunc(glBitmapValueAlphaFunc, PtrInt(@PixelData));
  3208. end;
  3209. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3210. function TglBitmap.RemoveAlpha: Boolean;
  3211. var
  3212. FormatDesc: TglBitmapFormatDescClass;
  3213. begin
  3214. result := false;
  3215. FormatDesc := FORMAT_DESCRIPTORS[Format];
  3216. if Assigned(Data) then begin
  3217. if not ({FormatDesc.IsUncompressed or }FormatDesc.HasAlpha) then
  3218. raise EglBitmapUnsupportedFormatFormat.Create('RemoveAlpha - ' + UNSUPPORTED_FORMAT);
  3219. result := ConvertTo(FormatDesc.WithoutAlpha);
  3220. end;
  3221. end;
  3222. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3223. function TglBitmap.Clone: TglBitmap;
  3224. var
  3225. Temp: TglBitmap;
  3226. TempPtr: PByte;
  3227. Size: Integer;
  3228. begin
  3229. result := nil;
  3230. Temp := (ClassType.Create as TglBitmap);
  3231. try
  3232. // copy texture data if assigned
  3233. if Assigned(Data) then begin
  3234. Size := FORMAT_DESCRIPTORS[Format].GetSize(fDimension);
  3235. GetMem(TempPtr, Size);
  3236. try
  3237. Move(Data^, TempPtr^, Size);
  3238. Temp.SetDataPointer(TempPtr, Format, Width, Height);
  3239. except
  3240. FreeMem(TempPtr);
  3241. raise;
  3242. end;
  3243. end else
  3244. Temp.SetDataPointer(nil, Format, Width, Height);
  3245. // copy properties
  3246. Temp.fID := ID;
  3247. Temp.fTarget := Target;
  3248. Temp.fFormat := Format;
  3249. Temp.fMipMap := MipMap;
  3250. Temp.fAnisotropic := Anisotropic;
  3251. Temp.fBorderColor := fBorderColor;
  3252. Temp.fDeleteTextureOnFree := DeleteTextureOnFree;
  3253. Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;
  3254. Temp.fFilterMin := fFilterMin;
  3255. Temp.fFilterMag := fFilterMag;
  3256. Temp.fWrapS := fWrapS;
  3257. Temp.fWrapT := fWrapT;
  3258. Temp.fWrapR := fWrapR;
  3259. Temp.fFilename := fFilename;
  3260. Temp.fCustomName := fCustomName;
  3261. Temp.fCustomNameW := fCustomNameW;
  3262. Temp.fCustomData := fCustomData;
  3263. result := Temp;
  3264. except
  3265. FreeAndNil(Temp);
  3266. raise;
  3267. end;
  3268. end;
  3269. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3270. function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
  3271. var
  3272. SourceFD, DestFD: TglBitmapFormatDescClass;
  3273. SourcePD, DestPD: TglBitmapPixelData;
  3274. PixelDesc: TglBitmapPixelDesc;
  3275. function CanCopyDirect: Boolean;
  3276. begin
  3277. result :=
  3278. ((SourcePD.PixelDesc.RedRange = DestPD.PixelDesc.RedRange) or (SourcePD.PixelDesc.RedRange = 0) or (DestPD.PixelDesc.RedRange = 0)) and
  3279. ((SourcePD.PixelDesc.GreenRange = DestPD.PixelDesc.GreenRange) or (SourcePD.PixelDesc.GreenRange = 0) or (DestPD.PixelDesc.GreenRange = 0)) and
  3280. ((SourcePD.PixelDesc.BlueRange = DestPD.PixelDesc.BlueRange) or (SourcePD.PixelDesc.BlueRange = 0) or (DestPD.PixelDesc.BlueRange = 0)) and
  3281. ((SourcePD.PixelDesc.AlphaRange = DestPD.PixelDesc.AlphaRange) or (SourcePD.PixelDesc.AlphaRange = 0) or (DestPD.PixelDesc.AlphaRange = 0));
  3282. end;
  3283. function CanShift: Boolean;
  3284. begin
  3285. result :=
  3286. ((SourcePD.PixelDesc.RedRange >= DestPD.PixelDesc.RedRange ) or (SourcePD.PixelDesc.RedRange = 0) or (DestPD.PixelDesc.RedRange = 0)) and
  3287. ((SourcePD.PixelDesc.GreenRange >= DestPD.PixelDesc.GreenRange) or (SourcePD.PixelDesc.GreenRange = 0) or (DestPD.PixelDesc.GreenRange = 0)) and
  3288. ((SourcePD.PixelDesc.BlueRange >= DestPD.PixelDesc.BlueRange ) or (SourcePD.PixelDesc.BlueRange = 0) or (DestPD.PixelDesc.BlueRange = 0)) and
  3289. ((SourcePD.PixelDesc.AlphaRange >= DestPD.PixelDesc.AlphaRange) or (SourcePD.PixelDesc.AlphaRange = 0) or (DestPD.PixelDesc.AlphaRange = 0));
  3290. end;
  3291. function GetShift(aSource, aDest: Cardinal) : ShortInt;
  3292. begin
  3293. result := 0;
  3294. while (aSource > aDest) and (aSource > 0) do begin
  3295. inc(result);
  3296. aSource := aSource shr 1;
  3297. end;
  3298. end;
  3299. begin
  3300. if aFormat <> fFormat then begin
  3301. SourceFD := FORMAT_DESCRIPTORS[Format];
  3302. DestFD := FORMAT_DESCRIPTORS[aFormat];
  3303. SourceFD.PreparePixel(SourcePD);
  3304. DestFD.PreparePixel (DestPD);
  3305. if CanCopyDirect then
  3306. result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)
  3307. else if CanShift then begin
  3308. PixelDesc.RedShift := GetShift(SourcePD.PixelDesc.RedRange, DestPD.PixelDesc.RedRange);
  3309. PixelDesc.GreenShift := GetShift(SourcePD.PixelDesc.GreenRange, DestPD.PixelDesc.GreenRange);
  3310. PixelDesc.BlueShift := GetShift(SourcePD.PixelDesc.BlueRange, DestPD.PixelDesc.BlueRange);
  3311. PixelDesc.AlphaShift := GetShift(SourcePD.PixelDesc.AlphaRange, DestPD.PixelDesc.AlphaRange);
  3312. result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, PtrInt(@PixelDesc));
  3313. end else
  3314. result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
  3315. end else
  3316. result := true;
  3317. end;
  3318. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3319. procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);
  3320. begin
  3321. if aUseRGB or aUseAlpha then
  3322. AddFunc(glBitmapInvertFunc, false, ((PtrInt(aUseAlpha) and 1) shl 1) or (PtrInt(aUseRGB) and 1));
  3323. end;
  3324. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3325. procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  3326. begin
  3327. fBorderColor[0] := aRed;
  3328. fBorderColor[1] := aGreen;
  3329. fBorderColor[2] := aBlue;
  3330. fBorderColor[3] := aAlpha;
  3331. if (ID > 0) then begin
  3332. Bind(false);
  3333. glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
  3334. end;
  3335. end;
  3336. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3337. procedure TglBitmap.FreeData;
  3338. begin
  3339. SetDataPointer(nil, tfEmpty);
  3340. end;
  3341. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3342. procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;
  3343. const aAlpha: Byte);
  3344. begin
  3345. FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
  3346. end;
  3347. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3348. procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
  3349. var
  3350. PixelData: TglBitmapPixelData;
  3351. begin
  3352. FORMAT_DESCRIPTORS[FORMAT_DESCRIPTORS[Format].WithAlpha].PreparePixel(PixelData);
  3353. FillWithColorFloat(
  3354. aRed / PixelData.PixelDesc.RedRange,
  3355. aGreen / PixelData.PixelDesc.GreenRange,
  3356. aBlue / PixelData.PixelDesc.BlueRange,
  3357. aAlpha / PixelData.PixelDesc.AlphaRange);
  3358. end;
  3359. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3360. procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
  3361. var
  3362. PixelData: TglBitmapPixelData;
  3363. begin
  3364. FORMAT_DESCRIPTORS[Format].PreparePixel(PixelData);
  3365. PixelData.Red := Max(0, Min(PixelData.PixelDesc.RedRange, Trunc(PixelData.PixelDesc.RedRange * aRed)));
  3366. PixelData.Green := Max(0, Min(PixelData.PixelDesc.GreenRange, Trunc(PixelData.PixelDesc.GreenRange * aGreen)));
  3367. PixelData.Blue := Max(0, Min(PixelData.PixelDesc.BlueRange, Trunc(PixelData.PixelDesc.BlueRange * aBlue)));
  3368. PixelData.Alpha := Max(0, Min(PixelData.PixelDesc.AlphaRange, Trunc(PixelData.PixelDesc.AlphaRange * aAlpha)));
  3369. AddFunc(glBitmapFillWithColorFunc, false, PtrInt(@PixelData));
  3370. end;
  3371. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3372. procedure TglBitmap.SetFilter(const aMin, aMag: Cardinal);
  3373. begin
  3374. //check MIN filter
  3375. case aMin of
  3376. GL_NEAREST:
  3377. fFilterMin := GL_NEAREST;
  3378. GL_LINEAR:
  3379. fFilterMin := GL_LINEAR;
  3380. GL_NEAREST_MIPMAP_NEAREST:
  3381. fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
  3382. GL_LINEAR_MIPMAP_NEAREST:
  3383. fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
  3384. GL_NEAREST_MIPMAP_LINEAR:
  3385. fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
  3386. GL_LINEAR_MIPMAP_LINEAR:
  3387. fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
  3388. else
  3389. raise EglBitmapException.Create('SetFilter - Unknow MIN filter.');
  3390. end;
  3391. //check MAG filter
  3392. case aMag of
  3393. GL_NEAREST:
  3394. fFilterMag := GL_NEAREST;
  3395. GL_LINEAR:
  3396. fFilterMag := GL_LINEAR;
  3397. else
  3398. raise EglBitmapException.Create('SetFilter - Unknow MAG filter.');
  3399. end;
  3400. //apply filter
  3401. if (ID > 0) then begin
  3402. Bind(false);
  3403. glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
  3404. if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin
  3405. case fFilterMin of
  3406. GL_NEAREST, GL_LINEAR:
  3407. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  3408. GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
  3409. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
  3410. GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
  3411. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
  3412. end;
  3413. end else
  3414. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  3415. end;
  3416. end;
  3417. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3418. procedure TglBitmap.SetWrap(const S: Cardinal; const T: Cardinal; const R: Cardinal);
  3419. procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
  3420. begin
  3421. case aValue of
  3422. GL_CLAMP:
  3423. aTarget := GL_CLAMP;
  3424. GL_REPEAT:
  3425. aTarget := GL_REPEAT;
  3426. GL_CLAMP_TO_EDGE: begin
  3427. if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then
  3428. aTarget := GL_CLAMP_TO_EDGE
  3429. else
  3430. aTarget := GL_CLAMP;
  3431. end;
  3432. GL_CLAMP_TO_BORDER: begin
  3433. if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
  3434. aTarget := GL_CLAMP_TO_BORDER
  3435. else
  3436. aTarget := GL_CLAMP;
  3437. end;
  3438. GL_MIRRORED_REPEAT: begin
  3439. if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
  3440. aTarget := GL_MIRRORED_REPEAT
  3441. else
  3442. raise EglBitmapException.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
  3443. end;
  3444. else
  3445. raise EglBitmapException.Create('SetWrap - Unknow Texturewrap (S).');
  3446. end;
  3447. end;
  3448. begin
  3449. CheckAndSetWrap(S, fWrapS);
  3450. CheckAndSetWrap(T, fWrapT);
  3451. CheckAndSetWrap(R, fWrapR);
  3452. if (ID > 0) then begin
  3453. Bind(false);
  3454. glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
  3455. glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
  3456. glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
  3457. end;
  3458. end;
  3459. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3460. procedure TglBitmap.GetPixel(const aPos: TglBitmapPixelPosition; var aPixel: TglBitmapPixelData);
  3461. begin
  3462. { TODO delete?
  3463. if Assigned (fGetPixelFunc) then
  3464. fGetPixelFunc(aPos, aPixel);
  3465. }
  3466. end;
  3467. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3468. procedure TglBitmap.SetPixel(const aPos: TglBitmapPixelPosition; const aPixel: TglBitmapPixelData);
  3469. begin
  3470. {TODO delete?
  3471. if Assigned (fSetPixelFunc) then
  3472. fSetPixelFuc(aPos, aPixel);
  3473. }
  3474. end;
  3475. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3476. procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
  3477. begin
  3478. if aEnableTextureUnit then
  3479. glEnable(Target);
  3480. if (ID > 0) then
  3481. glBindTexture(Target, ID);
  3482. end;
  3483. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3484. procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
  3485. begin
  3486. if aDisableTextureUnit then
  3487. glDisable(Target);
  3488. glBindTexture(Target, 0);
  3489. end;
  3490. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3491. constructor TglBitmap.Create;
  3492. begin
  3493. {$IFNDEF GLB_NO_NATIVE_GL}
  3494. ReadOpenGLExtensions;
  3495. {$ENDIF}
  3496. if (ClassType = TglBitmap) then
  3497. raise EglBitmapException.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
  3498. inherited Create;
  3499. end;
  3500. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3501. constructor TglBitmap.Create(const aFileName: String);
  3502. begin
  3503. Create;
  3504. LoadFromFile(FileName);
  3505. end;
  3506. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3507. constructor TglBitmap.Create(const aStream: TStream);
  3508. begin
  3509. Create;
  3510. LoadFromStream(aStream);
  3511. end;
  3512. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3513. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat);
  3514. var
  3515. Image: PByte;
  3516. ImageSize: Integer;
  3517. begin
  3518. Create;
  3519. ImageSize := FORMAT_DESCRIPTORS[aFormat].GetSize(aSize);
  3520. GetMem(Image, ImageSize);
  3521. try
  3522. FillChar(Image^, ImageSize, #$FF);
  3523. SetDataPointer(Image, aFormat, aSize.X, aSize.Y);
  3524. except
  3525. FreeMem(Image);
  3526. raise;
  3527. end;
  3528. end;
  3529. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3530. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat;
  3531. const aFunc: TglBitmapFunction; const aArgs: PtrInt);
  3532. begin
  3533. Create;
  3534. LoadFromFunc(aSize, aFunc, aFormat, aArgs);
  3535. end;
  3536. {$IFDEF GLB_DELPHI}
  3537. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3538. constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
  3539. begin
  3540. Create;
  3541. LoadFromResource(aInstance, aResource, aResType);
  3542. end;
  3543. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3544. constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  3545. begin
  3546. Create;
  3547. LoadFromResourceID(aInstance, aResourceID, aResType);
  3548. end;
  3549. {$ENDIF}
  3550. {$IFDEF GLB_SUPPORT_PNG_READ}
  3551. {$IF DEFINED(GLB_SDL_IMAGE)}
  3552. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3553. //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3554. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3555. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  3556. var
  3557. Surface: PSDL_Surface;
  3558. RWops: PSDL_RWops;
  3559. begin
  3560. result := false;
  3561. RWops := glBitmapCreateRWops(aStream);
  3562. try
  3563. if IMG_isPNG(RWops) > 0 then begin
  3564. Surface := IMG_LoadPNG_RW(RWops);
  3565. try
  3566. AssignFromSurface(Surface);
  3567. Rresult := true;
  3568. finally
  3569. SDL_FreeSurface(Surface);
  3570. end;
  3571. end;
  3572. finally
  3573. SDL_FreeRW(RWops);
  3574. end;
  3575. end;
  3576. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  3577. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3578. procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  3579. begin
  3580. TStream(png_get_io_ptr(png)).Read(buffer^, size);
  3581. end;
  3582. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3583. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  3584. var
  3585. StreamPos: Int64;
  3586. signature: array [0..7] of byte;
  3587. png: png_structp;
  3588. png_info: png_infop;
  3589. TempHeight, TempWidth: Integer;
  3590. Format: TglBitmapInternalFormat;
  3591. png_data: pByte;
  3592. png_rows: array of pByte;
  3593. Row, LineSize: Integer;
  3594. begin
  3595. result := false;
  3596. if not init_libPNG then
  3597. raise Exception.Create('LoadPNG - unable to initialize libPNG.');
  3598. try
  3599. // signature
  3600. StreamPos := Stream.Position;
  3601. Stream.Read(signature, 8);
  3602. Stream.Position := StreamPos;
  3603. if png_check_sig(@signature, 8) <> 0 then begin
  3604. // png read struct
  3605. png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  3606. if png = nil then
  3607. raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
  3608. // png info
  3609. png_info := png_create_info_struct(png);
  3610. if png_info = nil then begin
  3611. png_destroy_read_struct(@png, nil, nil);
  3612. raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
  3613. end;
  3614. // set read callback
  3615. png_set_read_fn(png, stream, glBitmap_libPNG_read_func);
  3616. // read informations
  3617. png_read_info(png, png_info);
  3618. // size
  3619. TempHeight := png_get_image_height(png, png_info);
  3620. TempWidth := png_get_image_width(png, png_info);
  3621. // format
  3622. case png_get_color_type(png, png_info) of
  3623. PNG_COLOR_TYPE_GRAY:
  3624. Format := tfLuminance8;
  3625. PNG_COLOR_TYPE_GRAY_ALPHA:
  3626. Format := tfLuminance8Alpha8;
  3627. PNG_COLOR_TYPE_RGB:
  3628. Format := tfRGB8;
  3629. PNG_COLOR_TYPE_RGB_ALPHA:
  3630. Format := tfRGBA8;
  3631. else
  3632. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  3633. end;
  3634. // cut upper 8 bit from 16 bit formats
  3635. if png_get_bit_depth(png, png_info) > 8 then
  3636. png_set_strip_16(png);
  3637. // expand bitdepth smaller than 8
  3638. if png_get_bit_depth(png, png_info) < 8 then
  3639. png_set_expand(png);
  3640. // allocating mem for scanlines
  3641. LineSize := png_get_rowbytes(png, png_info);
  3642. GetMem(png_data, TempHeight * LineSize);
  3643. try
  3644. SetLength(png_rows, TempHeight);
  3645. for Row := Low(png_rows) to High(png_rows) do begin
  3646. png_rows[Row] := png_data;
  3647. Inc(png_rows[Row], Row * LineSize);
  3648. end;
  3649. // read complete image into scanlines
  3650. png_read_image(png, @png_rows[0]);
  3651. // read end
  3652. png_read_end(png, png_info);
  3653. // destroy read struct
  3654. png_destroy_read_struct(@png, @png_info, nil);
  3655. SetLength(png_rows, 0);
  3656. // set new data
  3657. SetDataPointer(png_data, Format, TempWidth, TempHeight);
  3658. result := true;
  3659. except
  3660. FreeMem(png_data);
  3661. raise;
  3662. end;
  3663. end;
  3664. finally
  3665. quit_libPNG;
  3666. end;
  3667. end;
  3668. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  3669. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3670. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;
  3671. var
  3672. StreamPos: Int64;
  3673. Png: TPNGObject;
  3674. Header: Array[0..7] of Byte;
  3675. Row, Col, PixSize, LineSize: Integer;
  3676. NewImage, pSource, pDest, pAlpha: pByte;
  3677. Format: TglBitmapInternalFormat;
  3678. const
  3679. PngHeader: Array[0..7] of Byte = (#137, #80, #78, #71, #13, #10, #26, #10);
  3680. begin
  3681. result := false;
  3682. StreamPos := Stream.Position;
  3683. Stream.Read(Header[0], SizeOf(Header));
  3684. Stream.Position := StreamPos;
  3685. {Test if the header matches}
  3686. if Header = PngHeader then begin
  3687. Png := TPNGObject.Create;
  3688. try
  3689. Png.LoadFromStream(Stream);
  3690. case Png.Header.ColorType of
  3691. COLOR_GRAYSCALE:
  3692. Format := ifLuminance;
  3693. COLOR_GRAYSCALEALPHA:
  3694. Format := ifLuminanceAlpha;
  3695. COLOR_RGB:
  3696. Format := ifBGR8;
  3697. COLOR_RGBALPHA:
  3698. Format := ifBGRA8;
  3699. else
  3700. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  3701. end;
  3702. PixSize := Trunc(FormatGetSize(Format));
  3703. LineSize := Integer(Png.Header.Width) * PixSize;
  3704. GetMem(NewImage, LineSize * Integer(Png.Header.Height));
  3705. try
  3706. pDest := NewImage;
  3707. case Png.Header.ColorType of
  3708. COLOR_RGB, COLOR_GRAYSCALE:
  3709. begin
  3710. for Row := 0 to Png.Height -1 do begin
  3711. Move (Png.Scanline[Row]^, pDest^, LineSize);
  3712. Inc(pDest, LineSize);
  3713. end;
  3714. end;
  3715. COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
  3716. begin
  3717. PixSize := PixSize -1;
  3718. for Row := 0 to Png.Height -1 do begin
  3719. pSource := Png.Scanline[Row];
  3720. pAlpha := pByte(Png.AlphaScanline[Row]);
  3721. for Col := 0 to Png.Width -1 do begin
  3722. Move (pSource^, pDest^, PixSize);
  3723. Inc(pSource, PixSize);
  3724. Inc(pDest, PixSize);
  3725. pDest^ := pAlpha^;
  3726. inc(pAlpha);
  3727. Inc(pDest);
  3728. end;
  3729. end;
  3730. end;
  3731. else
  3732. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  3733. end;
  3734. SetDataPointer(NewImage, Format, Png.Header.Width, Png.Header.Height);
  3735. result := true;
  3736. except
  3737. FreeMem(NewImage);
  3738. raise;
  3739. end;
  3740. finally
  3741. Png.Free;
  3742. end;
  3743. end;
  3744. end;
  3745. {$IFEND}
  3746. {$ENDIF}
  3747. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  3748. {$IFDEF GLB_LIB_PNG}
  3749. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3750. procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  3751. begin
  3752. TStream(png_get_io_ptr(png)).Write(buffer^, size);
  3753. end;
  3754. {$ENDIF}
  3755. {$IF DEFINED(GLB_LIB_PNG)}
  3756. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3757. procedure TglBitmap.SavePNG(const aStream: TStream);
  3758. var
  3759. png: png_structp;
  3760. png_info: png_infop;
  3761. png_rows: array of pByte;
  3762. LineSize: Integer;
  3763. ColorType: Integer;
  3764. Row: Integer;
  3765. begin
  3766. if not (ftPNG in FormatGetSupportedFiles (InternalFormat)) then
  3767. raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
  3768. if not init_libPNG then
  3769. raise Exception.Create('SavePNG - unable to initialize libPNG.');
  3770. try
  3771. case FInternalFormat of
  3772. ifAlpha, ifLuminance, ifDepth8:
  3773. ColorType := PNG_COLOR_TYPE_GRAY;
  3774. ifLuminanceAlpha:
  3775. ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
  3776. ifBGR8, ifRGB8:
  3777. ColorType := PNG_COLOR_TYPE_RGB;
  3778. ifBGRA8, ifRGBA8:
  3779. ColorType := PNG_COLOR_TYPE_RGBA;
  3780. else
  3781. raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
  3782. end;
  3783. LineSize := Trunc(FormatGetSize(FInternalFormat) * Width);
  3784. // creating array for scanline
  3785. SetLength(png_rows, Height);
  3786. try
  3787. for Row := 0 to Height - 1 do begin
  3788. png_rows[Row] := Data;
  3789. Inc(png_rows[Row], Row * LineSize)
  3790. end;
  3791. // write struct
  3792. png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  3793. if png = nil then
  3794. raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
  3795. // create png info
  3796. png_info := png_create_info_struct(png);
  3797. if png_info = nil then begin
  3798. png_destroy_write_struct(@png, nil);
  3799. raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
  3800. end;
  3801. // set read callback
  3802. png_set_write_fn(png, stream, glBitmap_libPNG_write_func, nil);
  3803. // set compression
  3804. png_set_compression_level(png, 6);
  3805. if InternalFormat in [ifBGR8, ifBGRA8] then
  3806. png_set_bgr(png);
  3807. png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
  3808. png_write_info(png, png_info);
  3809. png_write_image(png, @png_rows[0]);
  3810. png_write_end(png, png_info);
  3811. png_destroy_write_struct(@png, @png_info);
  3812. finally
  3813. SetLength(png_rows, 0);
  3814. end;
  3815. finally
  3816. quit_libPNG;
  3817. end;
  3818. end;
  3819. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  3820. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3821. procedure TglBitmap.SavePNG(const aStream: TStream);
  3822. var
  3823. Png: TPNGObject;
  3824. pSource, pDest: pByte;
  3825. X, Y, PixSize: Integer;
  3826. ColorType: Cardinal;
  3827. Alpha: Boolean;
  3828. pTemp: pByte;
  3829. Temp: Byte;
  3830. begin
  3831. if not (ftPNG in FormatGetSupportedFiles (InternalFormat)) then
  3832. raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
  3833. case FInternalFormat of
  3834. ifAlpha, ifLuminance, ifDepth8: begin
  3835. ColorType := COLOR_GRAYSCALE;
  3836. PixSize := 1;
  3837. Alpha := false;
  3838. end;
  3839. ifLuminanceAlpha: begin
  3840. ColorType := COLOR_GRAYSCALEALPHA;
  3841. PixSize := 1;
  3842. Alpha := true;
  3843. end;
  3844. ifBGR8, ifRGB8: begin
  3845. ColorType := COLOR_RGB;
  3846. PixSize := 3;
  3847. Alpha := false;
  3848. end;
  3849. ifBGRA8, ifRGBA8: begin
  3850. ColorType := COLOR_RGBALPHA;
  3851. PixSize := 3;
  3852. Alpha := true
  3853. end;
  3854. else
  3855. raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);
  3856. end;
  3857. Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
  3858. try
  3859. // Copy ImageData
  3860. pSource := Data;
  3861. for Y := 0 to Height -1 do begin
  3862. pDest := png.ScanLine[Y];
  3863. for X := 0 to Width -1 do begin
  3864. Move(pSource^, pDest^, PixSize);
  3865. Inc(pDest, PixSize);
  3866. Inc(pSource, PixSize);
  3867. if Alpha then begin
  3868. png.AlphaScanline[Y]^[X] := pSource^;
  3869. Inc(pSource);
  3870. end;
  3871. end;
  3872. // convert RGB line to BGR
  3873. if InternalFormat in [ifRGB8, ifRGBA8] then begin
  3874. pTemp := png.ScanLine[Y];
  3875. for X := 0 to Width -1 do begin
  3876. Temp := pByteArray(pTemp)^[0];
  3877. pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
  3878. pByteArray(pTemp)^[2] := Temp;
  3879. Inc(pTemp, 3);
  3880. end;
  3881. end;
  3882. end;
  3883. // Save to Stream
  3884. Png.CompressionLevel := 6;
  3885. Png.SaveToStream(Stream);
  3886. finally
  3887. FreeAndNil(Png);
  3888. end;
  3889. end;
  3890. {$IFEND}
  3891. {$ENDIF}
  3892. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3893. //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3894. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3895. {$IFDEF GLB_LIB_JPEG}
  3896. type
  3897. glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
  3898. glBitmap_libJPEG_source_mgr = record
  3899. pub: jpeg_source_mgr;
  3900. SrcStream: TStream;
  3901. SrcBuffer: array [1..4096] of byte;
  3902. end;
  3903. glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
  3904. glBitmap_libJPEG_dest_mgr = record
  3905. pub: jpeg_destination_mgr;
  3906. DestStream: TStream;
  3907. DestBuffer: array [1..4096] of byte;
  3908. end;
  3909. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3910. {
  3911. procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
  3912. var
  3913. Msg: String;
  3914. begin
  3915. SetLength(Msg, 256);
  3916. cinfo^.err^.format_message(cinfo, pChar(Msg));
  3917. Writeln('ERROR [' + IntToStr(cinfo^.err^.msg_code) + '] ' + Msg);
  3918. cinfo^.global_state := 0;
  3919. jpeg_abort(cinfo);
  3920. end;
  3921. }
  3922. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3923. {
  3924. procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
  3925. var
  3926. Msg: String;
  3927. begin
  3928. SetLength(Msg, 256);
  3929. cinfo^.err^.format_message(cinfo, pChar(Msg));
  3930. Writeln('OUTPUT [' + IntToStr(cinfo^.err^.msg_code) + '] ' + Msg);
  3931. cinfo^.global_state := 0;
  3932. end;
  3933. }
  3934. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3935. {
  3936. procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
  3937. begin
  3938. end;
  3939. }
  3940. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3941. function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
  3942. var
  3943. src: glBitmap_libJPEG_source_mgr_ptr;
  3944. bytes: integer;
  3945. begin
  3946. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  3947. bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
  3948. if (bytes <= 0) then begin
  3949. src^.SrcBuffer[1] := $FF;
  3950. src^.SrcBuffer[2] := JPEG_EOI;
  3951. bytes := 2;
  3952. end;
  3953. src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
  3954. src^.pub.bytes_in_buffer := bytes;
  3955. result := true;
  3956. end;
  3957. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3958. procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
  3959. var
  3960. src: glBitmap_libJPEG_source_mgr_ptr;
  3961. begin
  3962. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  3963. if num_bytes > 0 then begin
  3964. // wanted byte isn't in buffer so set stream position and read buffer
  3965. if num_bytes > src^.pub.bytes_in_buffer then begin
  3966. src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
  3967. src^.pub.fill_input_buffer(cinfo);
  3968. end else begin
  3969. // wanted byte is in buffer so only skip
  3970. inc(src^.pub.next_input_byte, num_bytes);
  3971. dec(src^.pub.bytes_in_buffer, num_bytes);
  3972. end;
  3973. end;
  3974. end;
  3975. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3976. {
  3977. procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
  3978. begin
  3979. end;
  3980. }
  3981. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3982. {
  3983. procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
  3984. begin
  3985. end;
  3986. }
  3987. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3988. function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
  3989. var
  3990. dest: glBitmap_libJPEG_dest_mgr_ptr;
  3991. begin
  3992. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  3993. if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
  3994. // write complete buffer
  3995. dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
  3996. // reset buffer
  3997. dest^.pub.next_output_byte := @dest^.DestBuffer[1];
  3998. dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
  3999. end;
  4000. result := true;
  4001. end;
  4002. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4003. procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
  4004. var
  4005. Idx: Integer;
  4006. dest: glBitmap_libJPEG_dest_mgr_ptr;
  4007. begin
  4008. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  4009. for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
  4010. // check for endblock
  4011. if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
  4012. // write endblock
  4013. dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
  4014. // leave
  4015. break;
  4016. end else
  4017. dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
  4018. end;
  4019. end;
  4020. {$ENDIF}
  4021. {$IFDEF GLB_SUPPORT_JPEG_READ}
  4022. {$IF DEFINED(GLB_SDL_IMAGE)}
  4023. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4024. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  4025. var
  4026. Surface: PSDL_Surface;
  4027. RWops: PSDL_RWops;
  4028. begin
  4029. result := false;
  4030. RWops := glBitmapCreateRWops(Stream);
  4031. try
  4032. if IMG_isJPG(RWops) > 0 then begin
  4033. Surface := IMG_LoadJPG_RW(RWops);
  4034. try
  4035. AssignFromSurface(Surface);
  4036. result := true;
  4037. finally
  4038. SDL_FreeSurface(Surface);
  4039. end;
  4040. end;
  4041. finally
  4042. SDL_FreeRW(RWops);
  4043. end;
  4044. end;
  4045. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  4046. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4047. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  4048. var
  4049. StreamPos: Int64;
  4050. Temp: array[0..1]of Byte;
  4051. jpeg: jpeg_decompress_struct;
  4052. jpeg_err: jpeg_error_mgr;
  4053. IntFormat: TglBitmapInternalFormat;
  4054. pImage: pByte;
  4055. TempHeight, TempWidth: Integer;
  4056. pTemp: pByte;
  4057. Row: Integer;
  4058. begin
  4059. result := false;
  4060. if not init_libJPEG then
  4061. raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
  4062. try
  4063. // reading first two bytes to test file and set cursor back to begin
  4064. StreamPos := Stream.Position;
  4065. Stream.Read(Temp[0], 2);
  4066. Stream.Position := StreamPos;
  4067. // if Bitmap then read file.
  4068. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  4069. FillChar(jpeg, SizeOf(jpeg_decompress_struct), $00);
  4070. FillChar(jpeg_err, SizeOf(jpeg_error_mgr), $00);
  4071. // error managment
  4072. jpeg.err := jpeg_std_error(@jpeg_err);
  4073. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  4074. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  4075. // decompression struct
  4076. jpeg_create_decompress(@jpeg);
  4077. // allocation space for streaming methods
  4078. jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
  4079. // seeting up custom functions
  4080. with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
  4081. pub.init_source := glBitmap_libJPEG_init_source;
  4082. pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
  4083. pub.skip_input_data := glBitmap_libJPEG_skip_input_data;
  4084. pub.resync_to_restart := jpeg_resync_to_restart; // use default method
  4085. pub.term_source := glBitmap_libJPEG_term_source;
  4086. pub.bytes_in_buffer := 0; // forces fill_input_buffer on first read
  4087. pub.next_input_byte := nil; // until buffer loaded
  4088. SrcStream := Stream;
  4089. end;
  4090. // set global decoding state
  4091. jpeg.global_state := DSTATE_START;
  4092. // read header of jpeg
  4093. jpeg_read_header(@jpeg, false);
  4094. // setting output parameter
  4095. case jpeg.jpeg_color_space of
  4096. JCS_GRAYSCALE:
  4097. begin
  4098. jpeg.out_color_space := JCS_GRAYSCALE;
  4099. IntFormat := ifLuminance;
  4100. end;
  4101. else
  4102. jpeg.out_color_space := JCS_RGB;
  4103. IntFormat := ifRGB8;
  4104. end;
  4105. // reading image
  4106. jpeg_start_decompress(@jpeg);
  4107. TempHeight := jpeg.output_height;
  4108. TempWidth := jpeg.output_width;
  4109. // creating new image
  4110. GetMem(pImage, FormatGetImageSize(glBitmapPosition(TempWidth, TempHeight), IntFormat));
  4111. try
  4112. pTemp := pImage;
  4113. for Row := 0 to TempHeight -1 do begin
  4114. jpeg_read_scanlines(@jpeg, @pTemp, 1);
  4115. Inc(pTemp, Trunc(FormatGetSize(IntFormat) * TempWidth));
  4116. end;
  4117. // finish decompression
  4118. jpeg_finish_decompress(@jpeg);
  4119. // destroy decompression
  4120. jpeg_destroy_decompress(@jpeg);
  4121. SetDataPointer(pImage, IntFormat, TempWidth, TempHeight);
  4122. result := true;
  4123. except
  4124. FreeMem(pImage);
  4125. raise;
  4126. end;
  4127. end;
  4128. finally
  4129. quit_libJPEG;
  4130. end;
  4131. end;
  4132. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  4133. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4134. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;
  4135. var
  4136. bmp: TBitmap;
  4137. jpg: TJPEGImage;
  4138. StreamPos: Int64;
  4139. Temp: array[0..1]of Byte;
  4140. begin
  4141. result := false;
  4142. // reading first two bytes to test file and set cursor back to begin
  4143. StreamPos := Stream.Position;
  4144. Stream.Read(Temp[0], 2);
  4145. Stream.Position := StreamPos;
  4146. // if Bitmap then read file.
  4147. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  4148. bmp := TBitmap.Create;
  4149. try
  4150. jpg := TJPEGImage.Create;
  4151. try
  4152. jpg.LoadFromStream(Stream);
  4153. bmp.Assign(jpg);
  4154. result := AssignFromBitmap(bmp);
  4155. finally
  4156. jpg.Free;
  4157. end;
  4158. finally
  4159. bmp.Free;
  4160. end;
  4161. end;
  4162. end;
  4163. {$IFEND}
  4164. {$ENDIF}
  4165. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  4166. {$IF DEFEFINED(GLB_LIB_JPEG)}
  4167. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4168. procedure TglBitmap.SaveJPEG(Stream: TStream);
  4169. var
  4170. jpeg: jpeg_compress_struct;
  4171. jpeg_err: jpeg_error_mgr;
  4172. Row: Integer;
  4173. pTemp, pTemp2: pByte;
  4174. procedure CopyRow(pDest, pSource: pByte);
  4175. var
  4176. X: Integer;
  4177. begin
  4178. for X := 0 to Width - 1 do begin
  4179. pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
  4180. pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
  4181. pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
  4182. Inc(pDest, 3);
  4183. Inc(pSource, 3);
  4184. end;
  4185. end;
  4186. begin
  4187. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  4188. raise EglBitmapUnsupportedInternalFormat.Create('SaveJpg - ' + UNSUPPORTED_INTERNAL_FORMAT);
  4189. if not init_libJPEG then
  4190. raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
  4191. try
  4192. FillChar(jpeg, SizeOf(jpeg_compress_struct), $00);
  4193. FillChar(jpeg_err, SizeOf(jpeg_error_mgr), $00);
  4194. // error managment
  4195. jpeg.err := jpeg_std_error(@jpeg_err);
  4196. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  4197. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  4198. // compression struct
  4199. jpeg_create_compress(@jpeg);
  4200. // allocation space for streaming methods
  4201. jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
  4202. // seeting up custom functions
  4203. with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
  4204. pub.init_destination := glBitmap_libJPEG_init_destination;
  4205. pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
  4206. pub.term_destination := glBitmap_libJPEG_term_destination;
  4207. pub.next_output_byte := @DestBuffer[1];
  4208. pub.free_in_buffer := Length(DestBuffer);
  4209. DestStream := Stream;
  4210. end;
  4211. // very important state
  4212. jpeg.global_state := CSTATE_START;
  4213. jpeg.image_width := Width;
  4214. jpeg.image_height := Height;
  4215. case InternalFormat of
  4216. ifAlpha, ifLuminance, ifDepth8: begin
  4217. jpeg.input_components := 1;
  4218. jpeg.in_color_space := JCS_GRAYSCALE;
  4219. end;
  4220. ifRGB8, ifBGR8: begin
  4221. jpeg.input_components := 3;
  4222. jpeg.in_color_space := JCS_RGB;
  4223. end;
  4224. end;
  4225. jpeg_set_defaults(@jpeg);
  4226. jpeg_set_quality(@jpeg, 95, true);
  4227. jpeg_start_compress(@jpeg, true);
  4228. pTemp := Data;
  4229. if InternalFormat = ifBGR8 then
  4230. GetMem(pTemp2, fRowSize)
  4231. else
  4232. pTemp2 := pTemp;
  4233. try
  4234. for Row := 0 to jpeg.image_height -1 do begin
  4235. // prepare row
  4236. if InternalFormat = ifBGR8 then
  4237. CopyRow(pTemp2, pTemp)
  4238. else
  4239. pTemp2 := pTemp;
  4240. // write row
  4241. jpeg_write_scanlines(@jpeg, @pTemp2, 1);
  4242. inc(pTemp, fRowSize);
  4243. end;
  4244. finally
  4245. // free memory
  4246. if InternalFormat = ifBGR8 then
  4247. FreeMem(pTemp2);
  4248. end;
  4249. jpeg_finish_compress(@jpeg);
  4250. jpeg_destroy_compress(@jpeg);
  4251. finally
  4252. quit_libJPEG;
  4253. end;
  4254. end;
  4255. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  4256. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4257. procedure TglBitmap.SaveJPEG(Stream: TStream);
  4258. var
  4259. Bmp: TBitmap;
  4260. Jpg: TJPEGImage;
  4261. begin
  4262. if not (ftJPEG in FormatGetSupportedFiles (InternalFormat)) then
  4263. raise EglBitmapUnsupportedInternalFormat.Create('SaveJpg - ' + UNSUPPORTED_INTERNAL_FORMAT);
  4264. Bmp := TBitmap.Create;
  4265. try
  4266. Jpg := TJPEGImage.Create;
  4267. try
  4268. AssignToBitmap(Bmp);
  4269. if FInternalFormat in [ifAlpha, ifLuminance, ifDepth8] then begin
  4270. Jpg.Grayscale := true;
  4271. Jpg.PixelFormat := jf8Bit;
  4272. end;
  4273. Jpg.Assign(Bmp);
  4274. Jpg.SaveToStream(Stream);
  4275. finally
  4276. FreeAndNil(Jpg);
  4277. end;
  4278. finally
  4279. FreeAndNil(Bmp);
  4280. end;
  4281. end;
  4282. {$ENDIF}
  4283. {$ENDIF}
  4284. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4285. //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4286. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4287. const
  4288. BMP_MAGIC = $4D42;
  4289. BMP_COMP_RGB = 0;
  4290. BMP_COMP_RLE8 = 1;
  4291. BMP_COMP_RLE4 = 2;
  4292. BMP_COMP_BITFIELDS = 3;
  4293. type
  4294. TBMPHeader = packed record
  4295. bfType: Word;
  4296. bfSize: Cardinal;
  4297. bfReserved1: Word;
  4298. bfReserved2: Word;
  4299. bfOffBits: Cardinal;
  4300. end;
  4301. TBMPInfo = packed record
  4302. biSize: Cardinal;
  4303. biWidth: Longint;
  4304. biHeight: Longint;
  4305. biPlanes: Word;
  4306. biBitCount: Word;
  4307. biCompression: Cardinal;
  4308. biSizeImage: Cardinal;
  4309. biXPelsPerMeter: Longint;
  4310. biYPelsPerMeter: Longint;
  4311. biClrUsed: Cardinal;
  4312. biClrImportant: Cardinal;
  4313. end;
  4314. TBMPInfoOS = packed record
  4315. biSize: Cardinal;
  4316. biWidth: Longint;
  4317. biHeight: Longint;
  4318. biPlanes: Word;
  4319. biBitCount: Word;
  4320. end;
  4321. // TBMPPalette = record
  4322. // case Boolean of
  4323. // true : (Colors: array[Byte] of TRGBQUAD);
  4324. // false: (redMask, greenMask, blueMask: Cardinal);
  4325. // end;
  4326. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4327. function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
  4328. type
  4329. TMaskValues = packed record
  4330. Red: Cardinal;
  4331. Green: Cardinal;
  4332. Blue: Cardinal;
  4333. Alpha: Cardinal;
  4334. end;
  4335. var
  4336. StartPos: Int64;
  4337. //////////////////////////////////////////////////////////////////////////////////////////////////
  4338. function ReadInfo(var aInfo: TBMPInfo; var aMask: TMaskValues): TglBitmapFormat;
  4339. begin
  4340. result := tfEmpty;
  4341. aStream.Read(aInfo, SizeOf(aInfo));
  4342. FillChar(aMask, SizeOf(aMask), 0);
  4343. //Read Compression
  4344. if aInfo.biCompression <> BMP_COMP_RGB then begin
  4345. if aInfo.biCompression = BMP_COMP_BITFIELDS then begin
  4346. // Read Bitmasks for 16 or 32 Bit (24 Bit dosn't support Bitmasks!)
  4347. if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
  4348. aStream.Read(aMask.Red, SizeOf(Cardinal));
  4349. aStream.Read(aMask.Green, SizeOf(Cardinal));
  4350. aStream.Read(aMask.Blue, SizeOf(Cardinal));
  4351. aStream.Read(aMask.Alpha, SizeOf(Cardinal));
  4352. end else
  4353. raise EglBitmapException.Create('Bitmask is not supported for 24bit formats');
  4354. end else begin
  4355. aStream.Position := StartPos;
  4356. raise EglBitmapException.Create('RLE compression is not supported');
  4357. end;
  4358. end;
  4359. //get suitable format
  4360. case aInfo.biBitCount of
  4361. 8: result := tfLuminance8;
  4362. 16: result := tfRGB5A1;
  4363. 24: result := tfBGR8;
  4364. 32: result := tfBGRA8;
  4365. end;
  4366. end;
  4367. //////////////////////////////////////////////////////////////////////////////////////////////////
  4368. function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TMaskValues): TBitfieldFormat;
  4369. var
  4370. TmpFormat: TglBitmapFormat;
  4371. FormatDesc: TglBitmapFormatDescClass;
  4372. begin
  4373. result := nil;
  4374. if (aMask.Red <> 0) or (aMask.Green <> 0) or (aMask.Blue <> 0) or (aMask.Alpha <> 0) then begin
  4375. for TmpFormat := High(FORMAT_DESCRIPTORS) downto Low(FORMAT_DESCRIPTORS) do begin
  4376. FormatDesc := FORMAT_DESCRIPTORS[TmpFormat];
  4377. if FormatDesc.MaskMatch(aMask.Red, aMask.Green, aMask.Blue, aMask.Alpha) then begin
  4378. aFormat := FormatDesc.GetFormat;
  4379. exit;
  4380. end;
  4381. end;
  4382. if (aMask.Alpha = 0) then
  4383. aFormat := FORMAT_DESCRIPTORS[aFormat].WithoutAlpha;
  4384. result := TBitfieldFormat.Create;
  4385. result.RedMask := aMask.Red;
  4386. result.GreenMask := aMask.Green;
  4387. result.BlueMask := aMask.Blue;
  4388. result.AlphaMask := aMask.Alpha;
  4389. end;
  4390. end;
  4391. var
  4392. //simple types
  4393. ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
  4394. PaddingBuff: Cardinal;
  4395. LineBuf, ImageData, TmpData: PByte;
  4396. BmpFormat: TglBitmapFormat;
  4397. //records
  4398. Mask: TMaskValues;
  4399. Header: TBMPHeader;
  4400. Info: TBMPInfo;
  4401. //classes
  4402. BitfieldFormat: TBitfieldFormat;
  4403. FormatDesc: TglBitmapFormatDescClass;
  4404. Tick: QWord;
  4405. {
  4406. ImageData, pData, pTmp, LineBuf, TmpData: PByte;
  4407. BitOffset: Byte;
  4408. BmpFormat: TglBitmapFormat;
  4409. LineSize, Padding, LineIdx, PixelIdx: Integer;
  4410. RedMask, GreenMask, BlueMask, AlphaMask, FormatSize: Cardinal;
  4411. Pixel: TglBitmapPixelData;
  4412. PaddingBuff: Cardinal;
  4413. }
  4414. //////////////////////////////////////////////////////////////////////////////////////////////////
  4415. procedure ReadBitfieldLine(aData: PByte; aLineBuf: PByte);
  4416. var
  4417. i: Integer;
  4418. Pixel: TglBitmapPixelData;
  4419. ////////////////////////////////////////////////////////////////////////////////////////////////
  4420. procedure ChangeRange(var aValue: Cardinal; const aOldRange, aNewRange: Cardinal);
  4421. begin
  4422. if (aOldRange = aNewRange) then
  4423. exit;
  4424. if (aOldRange > 0) then
  4425. aValue := Round(aValue / aOldRange * aNewRange)
  4426. else
  4427. aValue := 0;
  4428. end;
  4429. begin
  4430. aStream.Read(aLineBuf^, rbLineSize);
  4431. for i := 0 to Info.biWidth-1 do begin
  4432. BitfieldFormat.Unmap(PCardinal(aLineBuf)^, Pixel); //if is 16bit Bitfield only 2 last significant Bytes are taken from Cardinal
  4433. inc(aLineBuf, Info.biBitCount shr 3);
  4434. with FormatDesc.GetPixelDesc do begin
  4435. ChangeRange(Pixel.Red, BitfieldFormat.RedRange, RedRange);
  4436. ChangeRange(Pixel.Green, BitfieldFormat.GreenRange, GreenRange);
  4437. ChangeRange(Pixel.Blue, BitfieldFormat.BlueRange, BlueRange);
  4438. ChangeRange(Pixel.Alpha, BitfieldFormat.AlphaRange, AlphaRange);
  4439. end;
  4440. FormatDesc.Map(Pixel, aData);
  4441. end;
  4442. end;
  4443. begin
  4444. result := false;
  4445. BmpFormat := tfEmpty;
  4446. BitfieldFormat := nil;
  4447. LineBuf := nil;
  4448. // Header
  4449. StartPos := aStream.Position;
  4450. aStream.Read(Header, SizeOf(Header));
  4451. if Header.bfType = BMP_MAGIC then begin
  4452. BmpFormat := ReadInfo(Info, Mask);
  4453. BitfieldFormat := CheckBitfields(BmpFormat, Mask);
  4454. try
  4455. if (Info.biBitCount < 16) then
  4456. aStream.Position := aStream.Position + Info.biClrUsed * 4;
  4457. aStream.Position := StartPos + Header.bfOffBits;
  4458. if (BmpFormat <> tfEmpty) then begin
  4459. FormatDesc := FORMAT_DESCRIPTORS[BmpFormat];
  4460. rbLineSize := Info.biWidth * (Info.biBitCount shr 3); //ReadBuffer LineSize
  4461. wbLineSize := Trunc(Info.biWidth * FormatDesc.GetSize);
  4462. Padding := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
  4463. //get Memory
  4464. ImageSize := FormatDesc.GetSize(glBitmapPosition(Info.biWidth, Info.biHeight));
  4465. GetMem(ImageData, ImageSize);
  4466. if Assigned(BitfieldFormat) then
  4467. GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
  4468. //read Data
  4469. try try
  4470. FillChar(ImageData^, ImageSize, $FF);
  4471. TmpData := ImageData;
  4472. Inc(TmpData, wbLineSize * (Info.biHeight -1));
  4473. for i := 0 to Info.biHeight-1 do begin
  4474. if Assigned(BitfieldFormat) then
  4475. ReadBitfieldLine(TmpData, LineBuf) //if is bitfield format read and convert data
  4476. else
  4477. aStream.Read(TmpData^, wbLineSize); //else only read data
  4478. Dec(TmpData, wbLineSize);
  4479. aStream.Read(PaddingBuff, Padding);
  4480. end;
  4481. SetDataPointer(ImageData, BmpFormat, Info.biWidth, Info.biHeight);
  4482. result := true;
  4483. finally
  4484. if Assigned(LineBuf) then
  4485. FreeMem(LineBuf);
  4486. end;
  4487. except
  4488. FreeMem(ImageData);
  4489. raise;
  4490. end;
  4491. end else
  4492. raise EglBitmapException.Create('LoadBMP - No suitable format found');
  4493. finally
  4494. FreeAndNil(BitfieldFormat);
  4495. end;
  4496. end
  4497. else aStream.Position := StartPos;
  4498. end;
  4499. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4500. procedure TglBitmap.SaveBMP(const aStream: TStream);
  4501. var
  4502. Header: TBMPHeader;
  4503. Info: TBMPInfo;
  4504. pData, pTemp: pByte;
  4505. PixelFormat: TglBitmapPixelData;
  4506. ImageSize, LineSize, Padding, LineIdx, ColorIdx: Integer;
  4507. Temp, RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
  4508. PaddingBuff: Cardinal;
  4509. function GetLineWidth : Integer;
  4510. begin
  4511. result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
  4512. end;
  4513. begin
  4514. if not (ftBMP in FormatGetSupportedFiles(Format)) then
  4515. raise EglBitmapUnsupportedFormatFormat.Create('SaveBMP - ' + UNSUPPORTED_FORMAT);
  4516. ImageSize := FORMAT_DESCRIPTORS[Format].GetSize(Dimension);
  4517. Header.bfType := BMP_MAGIC;
  4518. Header.bfSize := SizeOf(Header) + SizeOf(Info) + ImageSize;
  4519. Header.bfReserved1 := 0;
  4520. Header.bfReserved2 := 0;
  4521. Header.bfOffBits := SizeOf(Header) + SizeOf(Info);
  4522. FillChar(Info, SizeOf(Info), 0);
  4523. Info.biSize := SizeOf(Info);
  4524. Info.biWidth := Width;
  4525. Info.biHeight := Height;
  4526. Info.biPlanes := 1;
  4527. Info.biCompression := BMP_COMP_RGB;
  4528. Info.biSizeImage := ImageSize;
  4529. case Format of
  4530. //TODO tfAlpha8, ifLuminance8, ifDepth8:
  4531. tfLuminance8:
  4532. begin
  4533. Info.biBitCount := 8;
  4534. Header.bfSize := Header.bfSize + 256 * SizeOf(Cardinal);
  4535. Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal);
  4536. Info.biClrUsed := 256;
  4537. Info.biClrImportant := 256;
  4538. end;
  4539. //TODO ifLuminance8Alpha8, tfRGBA4, ifR5G6B5, tfRGB5A1:
  4540. tfLuminance8Alpha8, tfRGB5A1:
  4541. begin
  4542. Info.biBitCount := 16;
  4543. Info.biCompression := BMP_COMP_BITFIELDS;
  4544. end;
  4545. tfBGR8, tfRGB8:
  4546. Info.biBitCount := 24;
  4547. //TODO tfBGRA8, tfRGBA8, tfRGB10A2:
  4548. tfBGRA8, tfRGBA8:
  4549. begin
  4550. Info.biBitCount := 32;
  4551. Info.biCompression := BMP_COMP_BITFIELDS;
  4552. end;
  4553. else
  4554. raise EglBitmapUnsupportedFormatFormat.Create('SaveBMP - ' + UNSUPPORTED_FORMAT);
  4555. end;
  4556. Info.biXPelsPerMeter := 2835;
  4557. Info.biYPelsPerMeter := 2835;
  4558. // prepare bitmasks
  4559. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  4560. Info.biSize := Info.biSize + 4 * SizeOf(Cardinal);
  4561. Header.bfSize := Header.bfSize + 4 * SizeOf(Cardinal);
  4562. Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
  4563. FORMAT_DESCRIPTORS[Format].PreparePixel(PixelFormat);
  4564. with PixelFormat.PixelDesc do begin
  4565. RedMask := RedRange shl RedShift;
  4566. GreenMask := GreenRange shl GreenShift;
  4567. BlueMask := BlueRange shl BlueShift;
  4568. AlphaMask := AlphaRange shl AlphaShift;
  4569. end;
  4570. end;
  4571. // headers
  4572. aStream.Write(Header, SizeOf(Header));
  4573. aStream.Write(Info, SizeOf(Info));
  4574. // colortable
  4575. if Info.biBitCount = 8 then begin
  4576. Temp := 0;
  4577. for ColorIdx := Low(Byte) to High(Byte) do begin
  4578. aStream.Write(Temp, 4);
  4579. Temp := Temp + $00010101;
  4580. end;
  4581. end;
  4582. // bitmasks
  4583. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  4584. aStream.Write(RedMask, SizeOf(Cardinal));
  4585. aStream.Write(GreenMask, SizeOf(Cardinal));
  4586. aStream.Write(BlueMask, SizeOf(Cardinal));
  4587. aStream.Write(AlphaMask, SizeOf(Cardinal));
  4588. end;
  4589. // image data
  4590. LineSize := Trunc(Width * FORMAT_DESCRIPTORS[Format].GetSize);
  4591. Padding := GetLineWidth - LineSize;
  4592. PaddingBuff := 0;
  4593. pData := Data;
  4594. Inc(pData, (Height -1) * LineSize);
  4595. // prepare row buffer. But only for RGB because RGBA supports color masks
  4596. // so it's possible to change color within the image.
  4597. if (Format = tfRGB8) then
  4598. GetMem(pTemp, fRowSize)
  4599. else
  4600. pTemp := nil;
  4601. try
  4602. // write image data
  4603. for LineIdx := 0 to Height - 1 do begin
  4604. // preparing row
  4605. if Format = tfRGB8 then begin
  4606. Move(pData^, pTemp^, fRowSize);
  4607. SwapRGB(pTemp, Width, false);
  4608. end else
  4609. pTemp := pData;
  4610. aStream.Write(pTemp^, LineSize);
  4611. Dec(pData, LineSize);
  4612. if Padding > 0 then
  4613. aStream.Write(PaddingBuff, Padding);
  4614. end;
  4615. finally
  4616. // destroy row buffer
  4617. if Format = tfRGB8 then
  4618. FreeMem(pTemp);
  4619. end;
  4620. end;
  4621. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4622. //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4623. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4624. type
  4625. TTGAHeader = packed record
  4626. ImageID: Byte;
  4627. ColorMapType: Byte;
  4628. ImageType: Byte;
  4629. ColorMapSpec: Array[0..4] of Byte;
  4630. OrigX: Word;
  4631. OrigY: Word;
  4632. Width: Word;
  4633. Height: Word;
  4634. Bpp: Byte;
  4635. ImageDes: Byte;
  4636. end;
  4637. const
  4638. TGA_UNCOMPRESSED_RGB = 2;
  4639. TGA_UNCOMPRESSED_GRAY = 3;
  4640. TGA_COMPRESSED_RGB = 10;
  4641. TGA_COMPRESSED_GRAY = 11;
  4642. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4643. function TglBitmap.LoadTGA(const aStream: TStream): Boolean;
  4644. var
  4645. Header: TTGAHeader;
  4646. NewImage, pData: PByte;
  4647. StreamPos: Int64;
  4648. PixelSize, LineSize, YStart, YEnd, YInc: Integer;
  4649. Format: TglBitmapFormat;
  4650. const
  4651. CACHE_SIZE = $4000;
  4652. ////////////////////////////////////////////////////////////////////////////////////////
  4653. procedure ReadUncompressed;
  4654. var
  4655. RowSize: Integer;
  4656. begin
  4657. RowSize := Header.Width * PixelSize;
  4658. // copy line by line
  4659. while YStart <> YEnd + YInc do begin
  4660. pData := NewImage;
  4661. Inc(pData, YStart * LineSize);
  4662. aStream.Read(pData^, RowSize);
  4663. Inc(YStart, YInc);
  4664. end;
  4665. end;
  4666. ////////////////////////////////////////////////////////////////////////////////////////
  4667. procedure ReadCompressed;
  4668. var
  4669. HeaderWidth, HeaderHeight: Integer;
  4670. LinePixelsRead, ImgPixelsRead, ImgPixelsToRead: Integer;
  4671. Cache: PByte;
  4672. CacheSize, CachePos: Integer;
  4673. Temp: Byte;
  4674. TempBuf: Array [0..15] of Byte;
  4675. PixelRepeat: Boolean;
  4676. PixelToRead, TempPixels: Integer;
  4677. /////////////////////////////////////////////////////////////////
  4678. procedure CheckLine;
  4679. begin
  4680. if LinePixelsRead >= HeaderWidth then begin
  4681. LinePixelsRead := 0;
  4682. pData := NewImage;
  4683. Inc(YStart, YInc);
  4684. Inc(pData, YStart * LineSize);
  4685. end;
  4686. end;
  4687. /////////////////////////////////////////////////////////////////
  4688. procedure CachedRead(out Buffer; Count: Integer);
  4689. var
  4690. BytesRead: Integer;
  4691. begin
  4692. if (CachePos + Count) > CacheSize then begin
  4693. BytesRead := 0;
  4694. // Read Data
  4695. if CacheSize - CachePos > 0 then begin
  4696. BytesRead := CacheSize - CachePos;
  4697. Move(pByteArray(Cache)^[CachePos], Buffer, BytesRead);
  4698. Inc(CachePos, BytesRead);
  4699. end;
  4700. // Reload Data
  4701. CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
  4702. aStream.Read(Cache^, CacheSize);
  4703. CachePos := 0;
  4704. // Read else
  4705. if Count - BytesRead > 0 then begin
  4706. Move(pByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
  4707. Inc(CachePos, Count - BytesRead);
  4708. end;
  4709. end else begin
  4710. Move(pByteArray(Cache)^[CachePos], Buffer, Count);
  4711. Inc(CachePos, Count);
  4712. end;
  4713. end;
  4714. begin
  4715. CacheSize := 0;
  4716. CachePos := 0;
  4717. HeaderWidth := Header.Width;
  4718. HeaderHeight := Header.Height;
  4719. GetMem(Cache, CACHE_SIZE); // 16K Buffer
  4720. try
  4721. ImgPixelsToRead := HeaderWidth * HeaderHeight;
  4722. ImgPixelsRead := 0;
  4723. LinePixelsRead := 0;
  4724. pData := NewImage;
  4725. Inc(pData, YStart * LineSize);
  4726. // Read until all Pixels
  4727. repeat
  4728. CachedRead(Temp, 1);
  4729. PixelRepeat := Temp and $80 > 0;
  4730. PixelToRead := (Temp and $7F) + 1;
  4731. Inc(ImgPixelsRead, PixelToRead);
  4732. if PixelRepeat then begin
  4733. // repeat one pixel x times
  4734. CachedRead(TempBuf[0], PixelSize);
  4735. // repeat Pixel
  4736. while PixelToRead > 0 do begin
  4737. CheckLine;
  4738. TempPixels := HeaderWidth - LinePixelsRead;
  4739. if PixelToRead < TempPixels then
  4740. TempPixels := PixelToRead;
  4741. Inc(LinePixelsRead, TempPixels);
  4742. Dec(PixelToRead, TempPixels);
  4743. while TempPixels > 0 do begin
  4744. case PixelSize of
  4745. 1: begin
  4746. pData^ := TempBuf[0];
  4747. Inc(pData);
  4748. end;
  4749. 2: begin
  4750. pWord(pData)^ := pWord(@TempBuf[0])^;
  4751. Inc(pData, 2);
  4752. end;
  4753. 3: begin
  4754. pWord(pData)^ := pWord(@TempBuf[0])^;
  4755. Inc(pData, 2);
  4756. pData^ := TempBuf[2];
  4757. Inc(pData);
  4758. end;
  4759. 4: begin
  4760. pDWord(pData)^ := pDWord(@TempBuf[0])^;
  4761. Inc(pData, 4);
  4762. end;
  4763. end;
  4764. Dec(TempPixels);
  4765. end;
  4766. end;
  4767. end else begin
  4768. // copy x pixels
  4769. while PixelToRead > 0 do begin
  4770. CheckLine;
  4771. TempPixels := HeaderWidth - LinePixelsRead;
  4772. if PixelToRead < TempPixels then
  4773. TempPixels := PixelToRead;
  4774. CachedRead(pData^, PixelSize * TempPixels);
  4775. Inc(pData, PixelSize * TempPixels);
  4776. Inc(LinePixelsRead, TempPixels);
  4777. Dec(PixelToRead, TempPixels);
  4778. end;
  4779. end;
  4780. until ImgPixelsRead >= ImgPixelsToRead;
  4781. finally
  4782. FreeMem(Cache)
  4783. end;
  4784. end;
  4785. begin
  4786. result := false;
  4787. // reading header to test file and set cursor back to begin
  4788. StreamPos := aStream.Position;
  4789. aStream.Read(Header, SizeOf(Header));
  4790. // no colormapped files
  4791. if (Header.ColorMapType = 0) then begin
  4792. if Header.ImageType in [TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY] then begin
  4793. case Header.Bpp of
  4794. //TODO 8: Format := tfAlpha8;
  4795. 16: Format := tfLuminance8Alpha8;
  4796. 24: Format := tfBGR8;
  4797. 32: Format := tfBGRA8;
  4798. else
  4799. raise EglBitmapException.Create('LoadTga - unsupported BitsPerPixel found.');
  4800. end;
  4801. // skip image ID
  4802. if Header.ImageID <> 0 then
  4803. aStream.Position := aStream.Position + Header.ImageID;
  4804. PixelSize := Trunc(FORMAT_DESCRIPTORS[Format].GetSize);
  4805. LineSize := Trunc(Header.Width * PixelSize);
  4806. GetMem(NewImage, LineSize * Header.Height);
  4807. try
  4808. // Row direction
  4809. if (Header.ImageDes and $20 > 0) then begin
  4810. YStart := 0;
  4811. YEnd := Header.Height -1;
  4812. YInc := 1;
  4813. end else begin
  4814. YStart := Header.Height -1;
  4815. YEnd := 0;
  4816. YInc := -1;
  4817. end;
  4818. // Read Image
  4819. case Header.ImageType of
  4820. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
  4821. ReadUncompressed;
  4822. TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
  4823. ReadCompressed;
  4824. end;
  4825. SetDataPointer(NewImage, Format, Header.Width, Header.Height);
  4826. result := true;
  4827. except
  4828. FreeMem(NewImage);
  4829. raise;
  4830. end;
  4831. end
  4832. else aStream.Position := StreamPos;
  4833. end
  4834. else aStream.Position := StreamPos;
  4835. end;
  4836. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4837. procedure TglBitmap.SaveTGA(const aStream: TStream);
  4838. var
  4839. Header: TTGAHeader;
  4840. Size: Integer;
  4841. pTemp: pByte;
  4842. FormatDesc: TglBitmapFormatDescClass;
  4843. procedure ConvertData(pTemp: pByte);
  4844. var
  4845. Idx, PixelSize: Integer;
  4846. Temp: byte;
  4847. begin
  4848. PixelSize := fPixelSize;
  4849. for Idx := 1 to Height * Width do begin
  4850. Temp := pByteArray(pTemp)^[2];
  4851. pByteArray(pTemp)^[2] := pByteArray(pTemp)^[0];
  4852. pByteArray(pTemp)^[0] := Temp;
  4853. Inc(pTemp, PixelSize);
  4854. end;
  4855. end;
  4856. begin
  4857. if not (ftTGA in FormatGetSupportedFiles(Format)) then
  4858. raise EglBitmapUnsupportedFormatFormat.Create('SaveTGA - ' + UNSUPPORTED_FORMAT);
  4859. FillChar(Header, SizeOf(Header), 0);
  4860. case Format of
  4861. //TODO ifAlpha8, ifLuminance8, ifDepth8: begin
  4862. tfLuminance8: begin
  4863. Header.ImageType := TGA_UNCOMPRESSED_GRAY;
  4864. Header.Bpp := 8;
  4865. end;
  4866. tfLuminance8Alpha8: begin
  4867. Header.ImageType := TGA_UNCOMPRESSED_GRAY;
  4868. Header.Bpp := 16;
  4869. end;
  4870. tfRGB8, tfBGR8: begin
  4871. Header.ImageType := TGA_UNCOMPRESSED_RGB;
  4872. Header.Bpp := 24;
  4873. end;
  4874. tfRGBA8, tfBGRA8: begin
  4875. Header.ImageType := TGA_UNCOMPRESSED_RGB;
  4876. Header.Bpp := 32;
  4877. end;
  4878. else
  4879. raise EglBitmapUnsupportedFormatFormat.Create('SaveTGA - ' + UNSUPPORTED_FORMAT);
  4880. end;
  4881. Header.Width := Width;
  4882. Header.Height := Height;
  4883. Header.ImageDes := $20;
  4884. FormatDesc := FORMAT_DESCRIPTORS[Format];
  4885. if FormatDesc.HasAlpha then
  4886. Header.ImageDes := Header.ImageDes or $08;
  4887. aStream.Write(Header, SizeOf(Header));
  4888. // convert RGB(A) to BGR(A)
  4889. Size := FormatDesc.GetSize(Dimension);
  4890. if Format in [tfRGB8, tfRGBA8] then begin
  4891. GetMem(pTemp, Size);
  4892. end else
  4893. pTemp := Data;
  4894. try
  4895. // convert data
  4896. if Format in [tfRGB8, tfRGBA8] then begin
  4897. Move(Data^, pTemp^, Size);
  4898. ConvertData(pTemp);
  4899. end;
  4900. // write data
  4901. aStream.Write(pTemp^, Size);
  4902. finally
  4903. // free tempdata
  4904. if Format in [tfRGB8, tfRGBA8] then
  4905. FreeMem(pTemp);
  4906. end;
  4907. end;
  4908. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4909. //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4910. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4911. const
  4912. DDS_MAGIC = $20534444;
  4913. // DDS_header.dwFlags
  4914. DDSD_CAPS = $00000001;
  4915. DDSD_HEIGHT = $00000002;
  4916. DDSD_WIDTH = $00000004;
  4917. DDSD_PITCH = $00000008;
  4918. DDSD_PIXELFORMAT = $00001000;
  4919. DDSD_MIPMAPCOUNT = $00020000;
  4920. DDSD_LINEARSIZE = $00080000;
  4921. DDSD_DEPTH = $00800000;
  4922. // DDS_header.sPixelFormat.dwFlags
  4923. DDPF_ALPHAPIXELS = $00000001;
  4924. DDPF_FOURCC = $00000004;
  4925. DDPF_INDEXED = $00000020;
  4926. DDPF_RGB = $00000040;
  4927. // DDS_header.sCaps.dwCaps1
  4928. DDSCAPS_COMPLEX = $00000008;
  4929. DDSCAPS_TEXTURE = $00001000;
  4930. DDSCAPS_MIPMAP = $00400000;
  4931. // DDS_header.sCaps.dwCaps2
  4932. DDSCAPS2_CUBEMAP = $00000200;
  4933. DDSCAPS2_CUBEMAP_POSITIVEX = $00000400;
  4934. DDSCAPS2_CUBEMAP_NEGATIVEX = $00000800;
  4935. DDSCAPS2_CUBEMAP_POSITIVEY = $00001000;
  4936. DDSCAPS2_CUBEMAP_NEGATIVEY = $00002000;
  4937. DDSCAPS2_CUBEMAP_POSITIVEZ = $00004000;
  4938. DDSCAPS2_CUBEMAP_NEGATIVEZ = $00008000;
  4939. DDSCAPS2_VOLUME = $00200000;
  4940. D3DFMT_DXT1 = $31545844;
  4941. D3DFMT_DXT3 = $33545844;
  4942. D3DFMT_DXT5 = $35545844;
  4943. type
  4944. TDDSPixelFormat = packed record
  4945. dwSize: Cardinal;
  4946. dwFlags: Cardinal;
  4947. dwFourCC: Cardinal;
  4948. dwRGBBitCount: Cardinal;
  4949. dwRBitMask: Cardinal;
  4950. dwGBitMask: Cardinal;
  4951. dwBBitMask: Cardinal;
  4952. dwAlphaBitMask: Cardinal;
  4953. end;
  4954. TDDSCaps = packed record
  4955. dwCaps1: Cardinal;
  4956. dwCaps2: Cardinal;
  4957. dwDDSX: Cardinal;
  4958. dwReserved: Cardinal;
  4959. end;
  4960. TDDSHeader = packed record
  4961. dwMagic: Cardinal;
  4962. dwSize: Cardinal;
  4963. dwFlags: Cardinal;
  4964. dwHeight: Cardinal;
  4965. dwWidth: Cardinal;
  4966. dwPitchOrLinearSize: Cardinal;
  4967. dwDepth: Cardinal;
  4968. dwMipMapCount: Cardinal;
  4969. dwReserved: array[0..10] of Cardinal;
  4970. PixelFormat: TDDSPixelFormat;
  4971. Caps: TDDSCaps;
  4972. dwReserved2: Cardinal;
  4973. end;
  4974. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4975. function TglBitmap.LoadDDS(const aStream: TStream): Boolean;
  4976. var
  4977. Header: TDDSHeader;
  4978. StreamPos: Int64;
  4979. Y, LineSize: Cardinal;
  4980. RowSize: Cardinal;
  4981. NewImage, pData: pByte;
  4982. ddsFormat: TglBitmapFormat;
  4983. function RaiseEx : Exception;
  4984. begin
  4985. result := EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');
  4986. end;
  4987. function GetDDSFormat: TglBitmapFormat;
  4988. begin
  4989. with Header.PixelFormat do begin
  4990. // Compresses
  4991. if (dwFlags and DDPF_FOURCC) > 0 then begin
  4992. (* TODO
  4993. case Header.PixelFormat.dwFourCC of
  4994. D3DFMT_DXT1: result := ifDXT1;
  4995. D3DFMT_DXT3: result := ifDXT3;
  4996. D3DFMT_DXT5: result := ifDXT5;
  4997. else
  4998. raise RaiseEx;
  4999. end;
  5000. *)
  5001. raise RaiseEx;
  5002. end else
  5003. // RGB
  5004. if (dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS)) > 0 then begin
  5005. case dwRGBBitCount of
  5006. 8: begin
  5007. (* TODO if dwFlags and DDPF_ALPHAPIXELS > 0 then
  5008. result := tfAlpha
  5009. else
  5010. *)
  5011. result := tfLuminance8;
  5012. end;
  5013. 16: begin
  5014. if dwFlags and DDPF_ALPHAPIXELS > 0 then begin
  5015. // Alpha
  5016. case CountSetBits(dwRBitMask) of
  5017. 5: result := tfRGB5A1;
  5018. //TODO 4: result := tfRGBA4;
  5019. else
  5020. result := tfLuminance8Alpha8;
  5021. end;
  5022. end else begin
  5023. // no Alpha
  5024. //TODO result := ifR5G6B5;
  5025. raise RaiseEx;
  5026. end;
  5027. end;
  5028. 24: begin
  5029. if dwRBitMask > dwBBitMask then
  5030. result := tfBGR8
  5031. else
  5032. result := tfRGB8;
  5033. end;
  5034. 32: begin
  5035. if CountSetBits(dwRBitMask) = 10 then
  5036. //TODO result := tfRGB10A2
  5037. raise RaiseEx
  5038. else
  5039. if dwRBitMask > dwBBitMask then
  5040. result := tfBGRA8
  5041. else
  5042. result := tfRGBA8;
  5043. end;
  5044. else
  5045. raise RaiseEx;
  5046. end;
  5047. end else
  5048. raise RaiseEx;
  5049. end;
  5050. end;
  5051. begin
  5052. result := false;
  5053. // Header
  5054. StreamPos := aStream.Position;
  5055. aStream.Read(Header, sizeof(Header));
  5056. if ((Header.dwMagic <> DDS_MAGIC) or (Header.dwSize <> 124) or
  5057. ((Header.dwFlags and DDSD_PIXELFORMAT) = 0) or ((Header.dwFlags and DDSD_CAPS) = 0)) then begin
  5058. aStream.Position := StreamPos;
  5059. exit;
  5060. end;
  5061. ddsFormat := GetDDSFormat;
  5062. LineSize := Trunc(Header.dwWidth * FORMAT_DESCRIPTORS[ddsFormat].GetSize);
  5063. GetMem(NewImage, Header.dwHeight * LineSize);
  5064. try
  5065. pData := NewImage;
  5066. // Compressed
  5067. if (Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0 then begin
  5068. RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
  5069. for Y := 0 to Header.dwHeight -1 do begin
  5070. aStream.Read(pData^, RowSize);
  5071. Inc(pData, LineSize);
  5072. end;
  5073. end else
  5074. // RGB(A)
  5075. if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS)) > 0 then begin
  5076. RowSize := Header.dwPitchOrLinearSize;
  5077. for Y := 0 to Header.dwHeight -1 do begin
  5078. aStream.Read(pData^, RowSize);
  5079. Inc(pData, LineSize);
  5080. end;
  5081. end else
  5082. raise RaiseEx;
  5083. SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight);
  5084. result := true;
  5085. except
  5086. FreeMem(NewImage);
  5087. raise;
  5088. end;
  5089. end;
  5090. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5091. procedure TglBitmap.SaveDDS(const aStream: TStream);
  5092. var
  5093. Header: TDDSHeader;
  5094. Pix: TglBitmapPixelData;
  5095. begin
  5096. //if not FormatIsUncompressed(InternalFormat) then
  5097. // raise EglBitmapUnsupportedFormatFormat.Create('SaveDDS - ' + UNSUPPORTED_FORMAT);
  5098. (* TODO if Format = tfAlpha8 then
  5099. FORMAT_DESCRIPTORS[tfLuminance8].PreparePixel(Pix);
  5100. else *)
  5101. FORMAT_DESCRIPTORS[Format].PreparePixel(Pix);
  5102. // Generell
  5103. FillChar(Header, SizeOf(Header), 0);
  5104. Header.dwMagic := DDS_MAGIC;
  5105. Header.dwSize := 124;
  5106. Header.dwFlags := DDSD_PITCH or DDSD_CAPS or DDSD_PIXELFORMAT;
  5107. if Width > 0 then begin
  5108. Header.dwWidth := Width;
  5109. Header.dwFlags := Header.dwFlags or DDSD_WIDTH;
  5110. end;
  5111. if Height > 0 then begin
  5112. Header.dwHeight := Height;
  5113. Header.dwFlags := Header.dwFlags or DDSD_HEIGHT;
  5114. end;
  5115. Header.dwPitchOrLinearSize := fRowSize;
  5116. Header.dwMipMapCount := 1;
  5117. // Caps
  5118. Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
  5119. // Pixelformat
  5120. Header.PixelFormat.dwSize := Sizeof(Header.PixelFormat);
  5121. Header.PixelFormat.dwFlags := DDPF_RGB;
  5122. (* TODO tfAlpha8
  5123. if FORMAT_DESCRIPTORS[Format].HasAlpha and (Format <> tfAlpha8) then
  5124. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
  5125. *)
  5126. Header.PixelFormat.dwRGBBitCount := Trunc(FORMAT_DESCRIPTORS[Format].GetSize * 8);
  5127. Header.PixelFormat.dwRBitMask := Pix.PixelDesc.RedRange shl Pix.PixelDesc.RedShift;
  5128. Header.PixelFormat.dwGBitMask := Pix.PixelDesc.GreenRange shl Pix.PixelDesc.GreenShift;
  5129. Header.PixelFormat.dwBBitMask := Pix.PixelDesc.BlueRange shl Pix.PixelDesc.BlueShift;
  5130. Header.PixelFormat.dwAlphaBitMask := Pix.PixelDesc.AlphaRange shl Pix.PixelDesc.AlphaShift;
  5131. aStream.Write(Header, SizeOf(Header));
  5132. aStream.Write(Data^, FORMAT_DESCRIPTORS[Format].GetSize(Dimension));
  5133. end;
  5134. {$ENDREGION}
  5135. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5136. //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5137. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5138. function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;
  5139. begin
  5140. if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then
  5141. result := fLines[aIndex]
  5142. else
  5143. result := nil;
  5144. end;
  5145. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5146. procedure TglBitmap2D.SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
  5147. const aWidth: Integer; const aHeight: Integer);
  5148. var
  5149. Idx, LineWidth: Integer;
  5150. begin
  5151. inherited SetDataPointer(aData, aFormat, aWidth, aHeight);
  5152. //TODO compression
  5153. if {FormatIsUncompressed(Format)} true then begin
  5154. (* TODO PixelFuncs
  5155. fGetPixelFunc := GetPixel2DUnmap;
  5156. fSetPixelFunc := SetPixel2DUnmap;
  5157. *)
  5158. // Assigning Data
  5159. if Assigned(Data) then begin
  5160. SetLength(fLines, GetHeight);
  5161. LineWidth := Trunc(GetWidth * FORMAT_DESCRIPTORS[Format].GetSize);
  5162. for Idx := 0 to GetHeight -1 do begin
  5163. fLines[Idx] := Data;
  5164. Inc(fLines[Idx], Idx * LineWidth);
  5165. end;
  5166. end
  5167. else SetLength(fLines, 0);
  5168. end else begin
  5169. (*
  5170. SetLength(fLines, 0);
  5171. fSetPixelFunc := nil;
  5172. case Format of
  5173. ifDXT1:
  5174. fGetPixelFunc := GetPixel2DDXT1;
  5175. ifDXT3:
  5176. fGetPixelFunc := GetPixel2DDXT3;
  5177. ifDXT5:
  5178. fGetPixelFunc := GetPixel2DDXT5;
  5179. else
  5180. fGetPixelFunc := nil;
  5181. end;
  5182. *)
  5183. end;
  5184. end;
  5185. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5186. procedure TglBitmap2D.UploadData(const aTarget: Cardinal; const aBuildWithGlu: Boolean);
  5187. var
  5188. FormatDescriptor: TglBitmapFormatDescClass;
  5189. FormatDesc: TglBitmapFormatDesc;
  5190. begin
  5191. glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
  5192. (* TODO compression
  5193. if Self.InternalFormat in [ifDXT1, ifDXT3, ifDXT5] then
  5194. glCompressedTexImage2D(Target, 0, InternalFormat, Width, Height, 0, Trunc(Width * Height * FormatGetSize(Self.InternalFormat)), Data)
  5195. else
  5196. *)
  5197. FormatDescriptor := FORMAT_DESCRIPTORS[Format];
  5198. FormatDesc := FormatDescriptor.GetFormatDesc;
  5199. if aBuildWithGlu then
  5200. gluBuild2DMipmaps(aTarget, FormatDescriptor.GetColorCompCount, Width, Height,
  5201. FormatDesc.Format, FormatDesc.DataType, Data)
  5202. else
  5203. glTexImage2D(aTarget, 0, FormatDesc.InternalFormat, Width, Height, 0,
  5204. FormatDesc.Format, FormatDesc.DataType, Data);
  5205. // Freigeben
  5206. if (FreeDataAfterGenTexture) then
  5207. FreeData;
  5208. end;
  5209. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5210. procedure TglBitmap2D.AfterConstruction;
  5211. begin
  5212. inherited;
  5213. Target := GL_TEXTURE_2D;
  5214. end;
  5215. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5216. procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);
  5217. var
  5218. Temp: pByte;
  5219. Size, w, h: Integer;
  5220. FormatDesc: TglBitmapFormatDescClass;
  5221. glFormatDesc: TglBitmapFormatDesc;
  5222. begin
  5223. (* TODO compression
  5224. if not FormatIsUncompressed(Format) then
  5225. raise EglBitmapUnsupportedFormatFormat.Create('TglBitmap2D.GrabScreen - ' + UNSUPPORTED_FORMAT);
  5226. *)
  5227. w := aRight - aLeft;
  5228. h := aBottom - aTop;
  5229. FormatDesc := FORMAT_DESCRIPTORS[Format];
  5230. glFormatDesc := FormatDesc.GetFormatDesc;
  5231. Size := FormatDesc.GetSize(glBitmapPosition(w, h));
  5232. GetMem(Temp, Size);
  5233. try
  5234. glPixelStorei(GL_PACK_ALIGNMENT, 1);
  5235. glReadPixels(aLeft, aTop, w, h, glFormatDesc.Format, glFormatDesc.DataType, Temp);
  5236. SetDataPointer(Temp, Format, w, h);
  5237. FlipVert;
  5238. except
  5239. FreeMem(Temp);
  5240. raise;
  5241. end;
  5242. end;
  5243. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5244. procedure TglBitmap2D.GetDataFromTexture;
  5245. var
  5246. Temp: PByte;
  5247. TempWidth, TempHeight, RedSize, GreenSize, BlueSize, AlphaSize, LumSize: Integer;
  5248. TempType, TempIntFormat: Cardinal;
  5249. IntFormat: TglBitmapFormat;
  5250. FormatDesc: TglBitmapFormatDescClass;
  5251. begin
  5252. Bind;
  5253. // Request Data
  5254. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH, @TempWidth);
  5255. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT, @TempHeight);
  5256. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
  5257. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_RED_SIZE, @RedSize);
  5258. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_GREEN_SIZE, @GreenSize);
  5259. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_BLUE_SIZE, @BlueSize);
  5260. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_ALPHA_SIZE, @AlphaSize);
  5261. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_LUMINANCE_SIZE, @LumSize);
  5262. IntFormat := tfEmpty;
  5263. for FormatDesc in FORMAT_DESCRIPTORS do
  5264. if (FormatDesc.GetFormatDesc.InternalFormat = TempIntFormat) then begin
  5265. IntFormat := FormatDesc.GetFormat;
  5266. break;
  5267. end;
  5268. // Getting data from OpenGL
  5269. GetMem(Temp, FormatDesc.GetSize(glBitmapPosition(TempWidth, TempHeight)));
  5270. try
  5271. (* TODO Compression
  5272. if FormatIsCompressed(IntFormat) and (GL_VERSION_1_3 or GL_ARB_texture_compression) then
  5273. glGetCompressedTexImage(Target, 0, Temp)
  5274. else
  5275. *)
  5276. with FormatDesc.GetFormatDesc do
  5277. glGetTexImage(Target, 0, InternalFormat, DataType, Temp);
  5278. SetDataPointer(Temp, IntFormat, TempWidth, TempHeight);
  5279. except
  5280. FreeMem(Temp);
  5281. raise;
  5282. end;
  5283. end;
  5284. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5285. procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);
  5286. var
  5287. BuildWithGlu, PotTex, TexRec: Boolean;
  5288. TexSize: Integer;
  5289. begin
  5290. if Assigned(Data) then begin
  5291. // Check Texture Size
  5292. if (aTestTextureSize) then begin
  5293. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  5294. if ((Height > TexSize) or (Width > TexSize)) then
  5295. raise EglBitmapSizeToLargeException.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  5296. PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);
  5297. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE_ARB);
  5298. if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  5299. raise EglBitmapNonPowerOfTwoException.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  5300. end;
  5301. CreateId;
  5302. SetupParameters(BuildWithGlu);
  5303. UploadData(Target, BuildWithGlu);
  5304. glAreTexturesResident(1, @fID, @fIsResident);
  5305. end;
  5306. end;
  5307. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5308. function TglBitmap2D.FlipHorz: Boolean;
  5309. var
  5310. Col, Row: Integer;
  5311. TempDestData, DestData, SourceData: PByte;
  5312. ImgSize: Integer;
  5313. begin
  5314. result := inherited FlipHorz;
  5315. if Assigned(Data) then begin
  5316. SourceData := Data;
  5317. ImgSize := Height * fRowSize;
  5318. GetMem(DestData, ImgSize);
  5319. try
  5320. TempDestData := DestData;
  5321. Dec(TempDestData, fRowSize + fPixelSize);
  5322. for Row := 0 to Height -1 do begin
  5323. Inc(TempDestData, fRowSize * 2);
  5324. for Col := 0 to Width -1 do begin
  5325. Move(SourceData^, TempDestData^, fPixelSize);
  5326. Inc(SourceData, fPixelSize);
  5327. Dec(TempDestData, fPixelSize);
  5328. end;
  5329. end;
  5330. SetDataPointer(DestData, Format);
  5331. result := true;
  5332. except
  5333. FreeMem(DestData);
  5334. raise;
  5335. end;
  5336. end;
  5337. end;
  5338. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5339. function TglBitmap2D.FlipVert: Boolean;
  5340. var
  5341. Row: Integer;
  5342. TempDestData, DestData, SourceData: PByte;
  5343. begin
  5344. result := inherited FlipVert;
  5345. if Assigned(Data) then begin
  5346. SourceData := Data;
  5347. GetMem(DestData, Height * fRowSize);
  5348. try
  5349. TempDestData := DestData;
  5350. Inc(TempDestData, Width * (Height -1) * fPixelSize);
  5351. for Row := 0 to Height -1 do begin
  5352. Move(SourceData^, TempDestData^, fRowSize);
  5353. Dec(TempDestData, fRowSize);
  5354. Inc(SourceData, fRowSize);
  5355. end;
  5356. SetDataPointer(DestData, Format);
  5357. result := true;
  5358. except
  5359. FreeMem(DestData);
  5360. raise;
  5361. end;
  5362. end;
  5363. end;
  5364. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5365. //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5366. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5367. type
  5368. TMatrixItem = record
  5369. X, Y: Integer;
  5370. W: Single;
  5371. end;
  5372. PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
  5373. TglBitmapToNormalMapRec = Record
  5374. Scale: Single;
  5375. Heights: array of Single;
  5376. MatrixU : array of TMatrixItem;
  5377. MatrixV : array of TMatrixItem;
  5378. end;
  5379. const
  5380. oneover255 = 1 / 255;
  5381. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5382. procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
  5383. var
  5384. Val: Single;
  5385. begin
  5386. with FuncRec do begin
  5387. Val := Source.Red * 0.3 + Source.Green * 0.59 + Source.Blue * 0.11;
  5388. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * oneover255;
  5389. end;
  5390. end;
  5391. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5392. procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  5393. begin
  5394. with FuncRec do
  5395. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Alpha * oneover255;
  5396. end;
  5397. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5398. procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
  5399. type
  5400. TVec = Array[0..2] of Single;
  5401. var
  5402. Idx: Integer;
  5403. du, dv: Double;
  5404. Len: Single;
  5405. Vec: TVec;
  5406. function GetHeight(X, Y: Integer): Single;
  5407. begin
  5408. with FuncRec do begin
  5409. X := Max(0, Min(Size.X -1, X));
  5410. Y := Max(0, Min(Size.Y -1, Y));
  5411. result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
  5412. end;
  5413. end;
  5414. begin
  5415. with FuncRec do begin
  5416. with PglBitmapToNormalMapRec(Args)^ do begin
  5417. du := 0;
  5418. for Idx := Low(MatrixU) to High(MatrixU) do
  5419. du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
  5420. dv := 0;
  5421. for Idx := Low(MatrixU) to High(MatrixU) do
  5422. dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
  5423. Vec[0] := -du * Scale;
  5424. Vec[1] := -dv * Scale;
  5425. Vec[2] := 1;
  5426. end;
  5427. // Normalize
  5428. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  5429. if Len <> 0 then begin
  5430. Vec[0] := Vec[0] * Len;
  5431. Vec[1] := Vec[1] * Len;
  5432. Vec[2] := Vec[2] * Len;
  5433. end;
  5434. // Farbe zuweisem
  5435. Dest.Red := Trunc((Vec[0] + 1) * 127.5);
  5436. Dest.Green := Trunc((Vec[1] + 1) * 127.5);
  5437. Dest.Blue := Trunc((Vec[2] + 1) * 127.5);
  5438. end;
  5439. end;
  5440. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5441. procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
  5442. var
  5443. Rec: TglBitmapToNormalMapRec;
  5444. procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
  5445. begin
  5446. if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
  5447. Matrix[Index].X := X;
  5448. Matrix[Index].Y := Y;
  5449. Matrix[Index].W := W;
  5450. end;
  5451. end;
  5452. begin
  5453. (* TODO Compression
  5454. if not FormatIsUncompressed(InternalFormat) then
  5455. raise EglBitmapUnsupportedFormatFormat.Create('TglBitmap2D.ToNormalMap - ' + UNSUPPORTED_FORMAT);
  5456. *)
  5457. if aScale > 100 then
  5458. Rec.Scale := 100
  5459. else if aScale < -100 then
  5460. Rec.Scale := -100
  5461. else
  5462. Rec.Scale := aScale;
  5463. SetLength(Rec.Heights, Width * Height);
  5464. try
  5465. case aFunc of
  5466. nm4Samples: begin
  5467. SetLength(Rec.MatrixU, 2);
  5468. SetEntry(Rec.MatrixU, 0, -1, 0, -0.5);
  5469. SetEntry(Rec.MatrixU, 1, 1, 0, 0.5);
  5470. SetLength(Rec.MatrixV, 2);
  5471. SetEntry(Rec.MatrixV, 0, 0, 1, 0.5);
  5472. SetEntry(Rec.MatrixV, 1, 0, -1, -0.5);
  5473. end;
  5474. nmSobel: begin
  5475. SetLength(Rec.MatrixU, 6);
  5476. SetEntry(Rec.MatrixU, 0, -1, 1, -1.0);
  5477. SetEntry(Rec.MatrixU, 1, -1, 0, -2.0);
  5478. SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
  5479. SetEntry(Rec.MatrixU, 3, 1, 1, 1.0);
  5480. SetEntry(Rec.MatrixU, 4, 1, 0, 2.0);
  5481. SetEntry(Rec.MatrixU, 5, 1, -1, 1.0);
  5482. SetLength(Rec.MatrixV, 6);
  5483. SetEntry(Rec.MatrixV, 0, -1, 1, 1.0);
  5484. SetEntry(Rec.MatrixV, 1, 0, 1, 2.0);
  5485. SetEntry(Rec.MatrixV, 2, 1, 1, 1.0);
  5486. SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
  5487. SetEntry(Rec.MatrixV, 4, 0, -1, -2.0);
  5488. SetEntry(Rec.MatrixV, 5, 1, -1, -1.0);
  5489. end;
  5490. nm3x3: begin
  5491. SetLength(Rec.MatrixU, 6);
  5492. SetEntry(Rec.MatrixU, 0, -1, 1, -1/6);
  5493. SetEntry(Rec.MatrixU, 1, -1, 0, -1/6);
  5494. SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
  5495. SetEntry(Rec.MatrixU, 3, 1, 1, 1/6);
  5496. SetEntry(Rec.MatrixU, 4, 1, 0, 1/6);
  5497. SetEntry(Rec.MatrixU, 5, 1, -1, 1/6);
  5498. SetLength(Rec.MatrixV, 6);
  5499. SetEntry(Rec.MatrixV, 0, -1, 1, 1/6);
  5500. SetEntry(Rec.MatrixV, 1, 0, 1, 1/6);
  5501. SetEntry(Rec.MatrixV, 2, 1, 1, 1/6);
  5502. SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
  5503. SetEntry(Rec.MatrixV, 4, 0, -1, -1/6);
  5504. SetEntry(Rec.MatrixV, 5, 1, -1, -1/6);
  5505. end;
  5506. nm5x5: begin
  5507. SetLength(Rec.MatrixU, 20);
  5508. SetEntry(Rec.MatrixU, 0, -2, 2, -1 / 16);
  5509. SetEntry(Rec.MatrixU, 1, -1, 2, -1 / 10);
  5510. SetEntry(Rec.MatrixU, 2, 1, 2, 1 / 10);
  5511. SetEntry(Rec.MatrixU, 3, 2, 2, 1 / 16);
  5512. SetEntry(Rec.MatrixU, 4, -2, 1, -1 / 10);
  5513. SetEntry(Rec.MatrixU, 5, -1, 1, -1 / 8);
  5514. SetEntry(Rec.MatrixU, 6, 1, 1, 1 / 8);
  5515. SetEntry(Rec.MatrixU, 7, 2, 1, 1 / 10);
  5516. SetEntry(Rec.MatrixU, 8, -2, 0, -1 / 2.8);
  5517. SetEntry(Rec.MatrixU, 9, -1, 0, -0.5);
  5518. SetEntry(Rec.MatrixU, 10, 1, 0, 0.5);
  5519. SetEntry(Rec.MatrixU, 11, 2, 0, 1 / 2.8);
  5520. SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
  5521. SetEntry(Rec.MatrixU, 13, -1, -1, -1 / 8);
  5522. SetEntry(Rec.MatrixU, 14, 1, -1, 1 / 8);
  5523. SetEntry(Rec.MatrixU, 15, 2, -1, 1 / 10);
  5524. SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
  5525. SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
  5526. SetEntry(Rec.MatrixU, 18, 1, -2, 1 / 10);
  5527. SetEntry(Rec.MatrixU, 19, 2, -2, 1 / 16);
  5528. SetLength(Rec.MatrixV, 20);
  5529. SetEntry(Rec.MatrixV, 0, -2, 2, 1 / 16);
  5530. SetEntry(Rec.MatrixV, 1, -1, 2, 1 / 10);
  5531. SetEntry(Rec.MatrixV, 2, 0, 2, 0.25);
  5532. SetEntry(Rec.MatrixV, 3, 1, 2, 1 / 10);
  5533. SetEntry(Rec.MatrixV, 4, 2, 2, 1 / 16);
  5534. SetEntry(Rec.MatrixV, 5, -2, 1, 1 / 10);
  5535. SetEntry(Rec.MatrixV, 6, -1, 1, 1 / 8);
  5536. SetEntry(Rec.MatrixV, 7, 0, 1, 0.5);
  5537. SetEntry(Rec.MatrixV, 8, 1, 1, 1 / 8);
  5538. SetEntry(Rec.MatrixV, 9, 2, 1, 1 / 16);
  5539. SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
  5540. SetEntry(Rec.MatrixV, 11, -1, -1, -1 / 8);
  5541. SetEntry(Rec.MatrixV, 12, 0, -1, -0.5);
  5542. SetEntry(Rec.MatrixV, 13, 1, -1, -1 / 8);
  5543. SetEntry(Rec.MatrixV, 14, 2, -1, -1 / 10);
  5544. SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
  5545. SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
  5546. SetEntry(Rec.MatrixV, 17, 0, -2, -0.25);
  5547. SetEntry(Rec.MatrixV, 18, 1, -2, -1 / 10);
  5548. SetEntry(Rec.MatrixV, 19, 2, -2, -1 / 16);
  5549. end;
  5550. end;
  5551. // Daten Sammeln
  5552. if aUseAlpha and FORMAT_DESCRIPTORS[Format].HasAlpha then
  5553. AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, PtrInt(@Rec))
  5554. else
  5555. AddFunc(glBitmapToNormalMapPrepareFunc, false, PtrInt(@Rec));
  5556. AddFunc(glBitmapToNormalMapFunc, false, PtrInt(@Rec));
  5557. finally
  5558. SetLength(Rec.Heights, 0);
  5559. end;
  5560. end;
  5561. (*
  5562. procedure TglBitmap1D.SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width, Height: Integer);
  5563. var
  5564. pTemp: pByte;
  5565. Size: Integer;
  5566. begin
  5567. if Height > 1 then begin
  5568. // extract first line of the data
  5569. Size := FormatGetImageSize(glBitmapPosition(Width), Format);
  5570. GetMem(pTemp, Size);
  5571. Move(Data^, pTemp^, Size);
  5572. FreeMem(Data);
  5573. end else
  5574. pTemp := Data;
  5575. // set data pointer
  5576. inherited SetDataPointer(pTemp, Format, Width);
  5577. if FormatIsUncompressed(Format) then begin
  5578. fUnmapFunc := FormatGetUnMapFunc(Format);
  5579. fGetPixelFunc := GetPixel1DUnmap;
  5580. end;
  5581. end;
  5582. procedure TglBitmap1D.GetPixel1DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
  5583. var
  5584. pTemp: pByte;
  5585. begin
  5586. pTemp := Data;
  5587. Inc(pTemp, Pos.X * fPixelSize);
  5588. fUnmapFunc(pTemp, Pixel);
  5589. end;
  5590. function TglBitmap1D.FlipHorz: Boolean;
  5591. var
  5592. Col: Integer;
  5593. pTempDest, pDest, pSource: pByte;
  5594. begin
  5595. result := inherited FlipHorz;
  5596. if Assigned(Data) and FormatIsUncompressed(InternalFormat) then begin
  5597. pSource := Data;
  5598. GetMem(pDest, fRowSize);
  5599. try
  5600. pTempDest := pDest;
  5601. Inc(pTempDest, fRowSize);
  5602. for Col := 0 to Width -1 do begin
  5603. Move(pSource^, pTempDest^, fPixelSize);
  5604. Inc(pSource, fPixelSize);
  5605. Dec(pTempDest, fPixelSize);
  5606. end;
  5607. SetDataPointer(pDest, InternalFormat);
  5608. result := true;
  5609. finally
  5610. FreeMem(pDest);
  5611. end;
  5612. end;
  5613. end;
  5614. procedure TglBitmap1D.UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);
  5615. begin
  5616. // Upload data
  5617. if Self.InternalFormat in [ifDXT1, ifDXT3, ifDXT5] then
  5618. glCompressedTexImage1D(Target, 0, InternalFormat, Width, 0, Trunc(Width * FormatGetSize(Self.InternalFormat)), Data)
  5619. else
  5620. // Upload data
  5621. if BuildWithGlu then
  5622. gluBuild1DMipmaps(Target, InternalFormat, Width, Format, Typ, Data)
  5623. else
  5624. glTexImage1D(Target, 0, InternalFormat, Width, 0, Format, Typ, Data);
  5625. // Freigeben
  5626. if (FreeDataAfterGenTexture) then
  5627. FreeData;
  5628. end;
  5629. procedure TglBitmap1D.GenTexture(TestTextureSize: Boolean);
  5630. var
  5631. BuildWithGlu, TexRec: Boolean;
  5632. glFormat, glInternalFormat, glType: Cardinal;
  5633. TexSize: Integer;
  5634. begin
  5635. if Assigned(Data) then begin
  5636. // Check Texture Size
  5637. if (TestTextureSize) then begin
  5638. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  5639. if (Width > TexSize) then
  5640. raise EglBitmapSizeToLargeException.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  5641. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
  5642. (Target = GL_TEXTURE_RECTANGLE_ARB);
  5643. if not (IsPowerOfTwo (Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  5644. raise EglBitmapNonPowerOfTwoException.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  5645. end;
  5646. CreateId;
  5647. SetupParameters(BuildWithGlu);
  5648. SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
  5649. UploadData(Target, glFormat, glInternalFormat, glType, BuildWithGlu);
  5650. // Infos sammeln
  5651. glAreTexturesResident(1, @fID, @fIsResident);
  5652. end;
  5653. end;
  5654. procedure TglBitmap1D.AfterConstruction;
  5655. begin
  5656. inherited;
  5657. Target := GL_TEXTURE_1D;
  5658. end;
  5659. { TglBitmapCubeMap }
  5660. procedure TglBitmapCubeMap.AfterConstruction;
  5661. begin
  5662. inherited;
  5663. if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
  5664. raise EglBitmapException.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
  5665. SetWrap; // set all to GL_CLAMP_TO_EDGE
  5666. Target := GL_TEXTURE_CUBE_MAP;
  5667. fGenMode := GL_REFLECTION_MAP;
  5668. end;
  5669. procedure TglBitmapCubeMap.Bind(EnableTexCoordsGen, EnableTextureUnit: Boolean);
  5670. begin
  5671. inherited Bind (EnableTextureUnit);
  5672. if EnableTexCoordsGen then begin
  5673. glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
  5674. glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
  5675. glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
  5676. glEnable(GL_TEXTURE_GEN_S);
  5677. glEnable(GL_TEXTURE_GEN_T);
  5678. glEnable(GL_TEXTURE_GEN_R);
  5679. end;
  5680. end;
  5681. procedure TglBitmapCubeMap.GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean);
  5682. var
  5683. glFormat, glInternalFormat, glType: Cardinal;
  5684. BuildWithGlu: Boolean;
  5685. TexSize: Integer;
  5686. begin
  5687. // Check Texture Size
  5688. if (TestTextureSize) then begin
  5689. glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
  5690. if ((Height > TexSize) or (Width > TexSize)) then
  5691. raise EglBitmapSizeToLargeException.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
  5692. if not ((IsPowerOfTwo (Height) and IsPowerOfTwo (Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
  5693. raise EglBitmapNonPowerOfTwoException.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');
  5694. end;
  5695. // create Texture
  5696. if ID = 0 then begin
  5697. CreateID;
  5698. SetupParameters(BuildWithGlu);
  5699. end;
  5700. SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);
  5701. UploadData (CubeTarget, glFormat, glInternalFormat, glType, BuildWithGlu);
  5702. end;
  5703. procedure TglBitmapCubeMap.GenTexture(TestTextureSize: Boolean);
  5704. begin
  5705. Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');
  5706. end;
  5707. procedure TglBitmapCubeMap.Unbind(DisableTexCoordsGen,
  5708. DisableTextureUnit: Boolean);
  5709. begin
  5710. inherited Unbind (DisableTextureUnit);
  5711. if DisableTexCoordsGen then begin
  5712. glDisable(GL_TEXTURE_GEN_S);
  5713. glDisable(GL_TEXTURE_GEN_T);
  5714. glDisable(GL_TEXTURE_GEN_R);
  5715. end;
  5716. end;
  5717. { TglBitmapNormalMap }
  5718. type
  5719. TVec = Array[0..2] of Single;
  5720. TglBitmapNormalMapGetVectorFunc = procedure (var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  5721. PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
  5722. TglBitmapNormalMapRec = record
  5723. HalfSize : Integer;
  5724. Func: TglBitmapNormalMapGetVectorFunc;
  5725. end;
  5726. procedure glBitmapNormalMapPosX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  5727. begin
  5728. Vec[0] := HalfSize;
  5729. Vec[1] := - (Position.Y + 0.5 - HalfSize);
  5730. Vec[2] := - (Position.X + 0.5 - HalfSize);
  5731. end;
  5732. procedure glBitmapNormalMapNegX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  5733. begin
  5734. Vec[0] := - HalfSize;
  5735. Vec[1] := - (Position.Y + 0.5 - HalfSize);
  5736. Vec[2] := Position.X + 0.5 - HalfSize;
  5737. end;
  5738. procedure glBitmapNormalMapPosY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  5739. begin
  5740. Vec[0] := Position.X + 0.5 - HalfSize;
  5741. Vec[1] := HalfSize;
  5742. Vec[2] := Position.Y + 0.5 - HalfSize;
  5743. end;
  5744. procedure glBitmapNormalMapNegY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  5745. begin
  5746. Vec[0] := Position.X + 0.5 - HalfSize;
  5747. Vec[1] := - HalfSize;
  5748. Vec[2] := - (Position.Y + 0.5 - HalfSize);
  5749. end;
  5750. procedure glBitmapNormalMapPosZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  5751. begin
  5752. Vec[0] := Position.X + 0.5 - HalfSize;
  5753. Vec[1] := - (Position.Y + 0.5 - HalfSize);
  5754. Vec[2] := HalfSize;
  5755. end;
  5756. procedure glBitmapNormalMapNegZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);
  5757. begin
  5758. Vec[0] := - (Position.X + 0.5 - HalfSize);
  5759. Vec[1] := - (Position.Y + 0.5 - HalfSize);
  5760. Vec[2] := - HalfSize;
  5761. end;
  5762. procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
  5763. var
  5764. Vec : TVec;
  5765. Len: Single;
  5766. begin
  5767. with FuncRec do begin
  5768. with PglBitmapNormalMapRec (CustomData)^ do begin
  5769. Func(Vec, Position, HalfSize);
  5770. // Normalize
  5771. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  5772. if Len <> 0 then begin
  5773. Vec[0] := Vec[0] * Len;
  5774. Vec[1] := Vec[1] * Len;
  5775. Vec[2] := Vec[2] * Len;
  5776. end;
  5777. // Scale Vector and AddVectro
  5778. Vec[0] := Vec[0] * 0.5 + 0.5;
  5779. Vec[1] := Vec[1] * 0.5 + 0.5;
  5780. Vec[2] := Vec[2] * 0.5 + 0.5;
  5781. end;
  5782. // Set Color
  5783. Dest.Red := Round(Vec[0] * 255);
  5784. Dest.Green := Round(Vec[1] * 255);
  5785. Dest.Blue := Round(Vec[2] * 255);
  5786. end;
  5787. end;
  5788. procedure TglBitmapNormalMap.AfterConstruction;
  5789. begin
  5790. inherited;
  5791. fGenMode := GL_NORMAL_MAP;
  5792. end;
  5793. procedure TglBitmapNormalMap.GenerateNormalMap(Size: Integer;
  5794. TestTextureSize: Boolean);
  5795. var
  5796. Rec: TglBitmapNormalMapRec;
  5797. SizeRec: TglBitmapPixelPosition;
  5798. begin
  5799. Rec.HalfSize := Size div 2;
  5800. FreeDataAfterGenTexture := false;
  5801. SizeRec.Fields := [ffX, ffY];
  5802. SizeRec.X := Size;
  5803. SizeRec.Y := Size;
  5804. // Positive X
  5805. Rec.Func := glBitmapNormalMapPosX;
  5806. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  5807. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, TestTextureSize);
  5808. // Negative X
  5809. Rec.Func := glBitmapNormalMapNegX;
  5810. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  5811. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, TestTextureSize);
  5812. // Positive Y
  5813. Rec.Func := glBitmapNormalMapPosY;
  5814. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  5815. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, TestTextureSize);
  5816. // Negative Y
  5817. Rec.Func := glBitmapNormalMapNegY;
  5818. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  5819. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, TestTextureSize);
  5820. // Positive Z
  5821. Rec.Func := glBitmapNormalMapPosZ;
  5822. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  5823. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, TestTextureSize);
  5824. // Negative Z
  5825. Rec.Func := glBitmapNormalMapNegZ;
  5826. LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);
  5827. GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, TestTextureSize);
  5828. end;
  5829. *)
  5830. initialization
  5831. glBitmapSetDefaultFormat(tfEmpty);
  5832. glBitmapSetDefaultMipmap(mmMipmap);
  5833. glBitmapSetDefaultFilter(GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
  5834. glBitmapSetDefaultWrap (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
  5835. glBitmapSetDefaultFreeDataAfterGenTexture(true);
  5836. glBitmapSetDefaultDeleteTextureOnFree (true);
  5837. finalization
  5838. end.