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.

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