You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

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