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.

8877 regels
316 KiB

  1. { glBitmap by Steffen Xonna aka Lossy eX (2003-2008)
  2. http://www.opengl24.de/index.php?cat=header&file=glbitmap
  3. modified by Delphi OpenGL Community (http://delphigl.com/) (2013)
  4. The contents of this file are used with permission, subject to
  5. the Mozilla Public License Version 1.1 (the "License"); you may
  6. not use this file except in compliance with the License. You may
  7. obtain a copy of the License at
  8. http://www.mozilla.org/MPL/MPL-1.1.html
  9. The glBitmap is a Delphi/FPC unit that contains several wrapper classes
  10. to manage OpenGL texture objects. Below you can find a list of the main
  11. functionality of this classes:
  12. - load texture data from file (e.g. BMP, TGA, DDS, PNG, JPEG, ...)
  13. - load texture data from several other image objects (e.g. TBitmap, TLazIntfImage, SDL Surface)
  14. - save texture data to file (e.g. BMP, TGA, DDS, PNG, JPEG, ...)
  15. - save texture data to several other image objects (e.g. TBitmap, TLazIntfImage, SDL Surface)
  16. - support for many texture formats (e.g. RGB8, BGR8, RGBA8, BGRA8, ...)
  17. - manage texture properties (e.g. Filter, Clamp, Mipmap, ...)
  18. - upload texture data to video card
  19. - download texture data from video card
  20. - manipulate texture data (e.g. add alpha, remove alpha, convert to other format, switch RGB, ...) }
  21. unit glBitmap;
  22. {$I glBitmapConf.inc}
  23. // Delphi Versions
  24. {$IFDEF fpc}
  25. {$MODE Delphi}
  26. {$IFDEF CPUI386}
  27. {$DEFINE CPU386}
  28. {$ASMMODE INTEL}
  29. {$ENDIF}
  30. {$IFNDEF WINDOWS}
  31. {$linklib c}
  32. {$ENDIF}
  33. {$ENDIF}
  34. // Operation System
  35. {$IF DEFINED(WIN32) or DEFINED(WIN64) or DEFINED(WINDOWS)}
  36. {$DEFINE GLB_WIN}
  37. {$ELSEIF DEFINED(LINUX)}
  38. {$DEFINE GLB_LINUX}
  39. {$IFEND}
  40. // OpenGL ES
  41. {$IF DEFINED(OPENGL_ES_EXT)} {$DEFINE OPENGL_ES_1_1} {$IFEND}
  42. {$IF DEFINED(OPENGL_ES_3_0)} {$DEFINE OPENGL_ES_2_0} {$IFEND}
  43. {$IF DEFINED(OPENGL_ES_2_0)} {$DEFINE OPENGL_ES_1_1} {$IFEND}
  44. {$IF DEFINED(OPENGL_ES_1_1)} {$DEFINE OPENGL_ES} {$IFEND}
  45. // checking define combinations
  46. //SDL Image
  47. {$IFDEF GLB_SDL_IMAGE}
  48. {$IFNDEF GLB_SDL}
  49. {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
  50. {$DEFINE GLB_SDL}
  51. {$ENDIF}
  52. {$IFDEF GLB_LAZ_PNG}
  53. {$MESSAGE warn 'The Lazarus TPortableNetworkGraphics will be ignored because you are using SDL_image.'}
  54. {$undef GLB_LAZ_PNG}
  55. {$ENDIF}
  56. {$IFDEF GLB_PNGIMAGE}
  57. {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
  58. {$undef GLB_PNGIMAGE}
  59. {$ENDIF}
  60. {$IFDEF GLB_LAZ_JPEG}
  61. {$MESSAGE warn 'The Lazarus TJPEGImage will be ignored because you are using SDL_image.'}
  62. {$undef GLB_LAZ_JPEG}
  63. {$ENDIF}
  64. {$IFDEF GLB_DELPHI_JPEG}
  65. {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
  66. {$undef GLB_DELPHI_JPEG}
  67. {$ENDIF}
  68. {$IFDEF GLB_LIB_PNG}
  69. {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
  70. {$undef GLB_LIB_PNG}
  71. {$ENDIF}
  72. {$IFDEF GLB_LIB_JPEG}
  73. {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
  74. {$undef GLB_LIB_JPEG}
  75. {$ENDIF}
  76. {$DEFINE GLB_SUPPORT_PNG_READ}
  77. {$DEFINE GLB_SUPPORT_JPEG_READ}
  78. {$ENDIF}
  79. // Lazarus TPortableNetworkGraphic
  80. {$IFDEF GLB_LAZ_PNG}
  81. {$IFNDEF GLB_LAZARUS}
  82. {$MESSAGE warn 'Lazarus TPortableNetworkGraphic won''t work without Lazarus. Lazarus will be activated.'}
  83. {$DEFINE GLB_LAZARUS}
  84. {$ENDIF}
  85. {$IFDEF GLB_PNGIMAGE}
  86. {$MESSAGE warn 'The pngimage will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
  87. {$undef GLB_PNGIMAGE}
  88. {$ENDIF}
  89. {$IFDEF GLB_LIB_PNG}
  90. {$MESSAGE warn 'The library libPNG will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
  91. {$undef GLB_LIB_PNG}
  92. {$ENDIF}
  93. {$DEFINE GLB_SUPPORT_PNG_READ}
  94. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  95. {$ENDIF}
  96. // PNG Image
  97. {$IFDEF GLB_PNGIMAGE}
  98. {$IFDEF GLB_LIB_PNG}
  99. {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
  100. {$undef GLB_LIB_PNG}
  101. {$ENDIF}
  102. {$DEFINE GLB_SUPPORT_PNG_READ}
  103. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  104. {$ENDIF}
  105. // libPNG
  106. {$IFDEF GLB_LIB_PNG}
  107. {$DEFINE GLB_SUPPORT_PNG_READ}
  108. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  109. {$ENDIF}
  110. // Lazarus TJPEGImage
  111. {$IFDEF GLB_LAZ_JPEG}
  112. {$IFNDEF GLB_LAZARUS}
  113. {$MESSAGE warn 'Lazarus TJPEGImage won''t work without Lazarus. Lazarus will be activated.'}
  114. {$DEFINE GLB_LAZARUS}
  115. {$ENDIF}
  116. {$IFDEF GLB_DELPHI_JPEG}
  117. {$MESSAGE warn 'The Delphi JPEGImage will be ignored if you are using the Lazarus TJPEGImage.'}
  118. {$undef GLB_DELPHI_JPEG}
  119. {$ENDIF}
  120. {$IFDEF GLB_LIB_JPEG}
  121. {$MESSAGE warn 'The library libJPEG will be ignored if you are using the Lazarus TJPEGImage.'}
  122. {$undef GLB_LIB_JPEG}
  123. {$ENDIF}
  124. {$DEFINE GLB_SUPPORT_JPEG_READ}
  125. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  126. {$ENDIF}
  127. // JPEG Image
  128. {$IFDEF GLB_DELPHI_JPEG}
  129. {$IFDEF GLB_LIB_JPEG}
  130. {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
  131. {$undef GLB_LIB_JPEG}
  132. {$ENDIF}
  133. {$DEFINE GLB_SUPPORT_JPEG_READ}
  134. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  135. {$ENDIF}
  136. // libJPEG
  137. {$IFDEF GLB_LIB_JPEG}
  138. {$DEFINE GLB_SUPPORT_JPEG_READ}
  139. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  140. {$ENDIF}
  141. // general options
  142. {$EXTENDEDSYNTAX ON}
  143. {$LONGSTRINGS ON}
  144. {$ALIGN ON}
  145. {$IFNDEF FPC}
  146. {$OPTIMIZATION ON}
  147. {$ENDIF}
  148. {$UNDEF GLB_LAZARUS}
  149. interface
  150. uses
  151. {$IFDEF OPENGL_ES} dglOpenGLES,
  152. {$ELSE} dglOpenGL, {$ENDIF}
  153. {$IF DEFINED(GLB_WIN) AND
  154. DEFINED(GLB_DELPHI)} windows, {$IFEND}
  155. {$IFDEF GLB_SDL} SDL, {$ENDIF}
  156. {$IFDEF GLB_LAZARUS} IntfGraphics, GraphType, Graphics, {$ENDIF}
  157. {$IFDEF GLB_DELPHI} Dialogs, Graphics, Types, {$ENDIF}
  158. {$IFDEF GLB_SDL_IMAGE} SDL_image, {$ENDIF}
  159. {$IFDEF GLB_PNGIMAGE} pngimage, {$ENDIF}
  160. {$IFDEF GLB_LIB_PNG} libPNG, {$ENDIF}
  161. {$IFDEF GLB_DELPHI_JPEG} JPEG, {$ENDIF}
  162. {$IFDEF GLB_LIB_JPEG} libJPEG, {$ENDIF}
  163. Classes, SysUtils;
  164. type
  165. {$IFNDEF fpc}
  166. QWord = System.UInt64;
  167. PQWord = ^QWord;
  168. PtrInt = Longint;
  169. PtrUInt = DWord;
  170. {$ENDIF}
  171. { type that describes the format of the data stored in a texture.
  172. the name of formats is composed of the following constituents:
  173. - multiple channels:
  174. - channel (e.g. R, G, B, A or Alpha, Luminance or X (reserved))
  175. - width of the chanel in bit (4, 8, 16, ...)
  176. - data type (e.g. ub, us, ui)
  177. - number of elements of data types }
  178. TglBitmapFormat = (
  179. tfEmpty = 0,
  180. tfAlpha4ub1, //< 1 x unsigned byte
  181. tfAlpha8ub1, //< 1 x unsigned byte
  182. tfAlpha16us1, //< 1 x unsigned short
  183. tfLuminance4ub1, //< 1 x unsigned byte
  184. tfLuminance8ub1, //< 1 x unsigned byte
  185. tfLuminance16us1, //< 1 x unsigned short
  186. tfLuminance4Alpha4ub2, //< 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
  187. tfLuminance6Alpha2ub2, //< 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
  188. tfLuminance8Alpha8ub2, //< 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
  189. tfLuminance12Alpha4us2, //< 1 x unsigned short (lum), 1 x unsigned short (alpha)
  190. tfLuminance16Alpha16us2, //< 1 x unsigned short (lum), 1 x unsigned short (alpha)
  191. tfR3G3B2ub1, //< 1 x unsigned byte (3bit red, 3bit green, 2bit blue)
  192. tfRGBX4us1, //< 1 x unsigned short (4bit red, 4bit green, 4bit blue, 4bit reserverd)
  193. tfXRGB4us1, //< 1 x unsigned short (4bit reserved, 4bit red, 4bit green, 4bit blue)
  194. tfR5G6B5us1, //< 1 x unsigned short (5bit red, 6bit green, 5bit blue)
  195. tfRGB5X1us1, //< 1 x unsigned short (5bit red, 5bit green, 5bit blue, 1bit reserved)
  196. tfX1RGB5us1, //< 1 x unsigned short (1bit reserved, 5bit red, 5bit green, 5bit blue)
  197. tfRGB8ub3, //< 1 x unsigned byte (red), 1 x unsigned byte (green), 1 x unsigned byte (blue)
  198. tfRGBX8ui1, //< 1 x unsigned int (8bit red, 8bit green, 8bit blue, 8bit reserved)
  199. tfXRGB8ui1, //< 1 x unsigned int (8bit reserved, 8bit red, 8bit green, 8bit blue)
  200. tfRGB10X2ui1, //< 1 x unsigned int (10bit red, 10bit green, 10bit blue, 2bit reserved)
  201. tfX2RGB10ui1, //< 1 x unsigned int (2bit reserved, 10bit red, 10bit green, 10bit blue)
  202. tfRGB16us3, //< 1 x unsigned short (red), 1 x unsigned short (green), 1 x unsigned short (blue)
  203. tfRGBA4us1, //< 1 x unsigned short (4bit red, 4bit green, 4bit blue, 4bit alpha)
  204. tfARGB4us1, //< 1 x unsigned short (4bit alpha, 4bit red, 4bit green, 4bit blue)
  205. tfRGB5A1us1, //< 1 x unsigned short (5bit red, 5bit green, 5bit blue, 1bit alpha)
  206. tfA1RGB5us1, //< 1 x unsigned short (1bit alpha, 5bit red, 5bit green, 5bit blue)
  207. tfRGBA8ui1, //< 1 x unsigned int (8bit red, 8bit green, 8bit blue, 8 bit alpha)
  208. tfARGB8ui1, //< 1 x unsigned int (8 bit alpha, 8bit red, 8bit green, 8bit blue)
  209. tfRGBA8ub4, //< 1 x unsigned byte (red), 1 x unsigned byte (green), 1 x unsigned byte (blue), 1 x unsigned byte (alpha)
  210. tfRGB10A2ui1, //< 1 x unsigned int (10bit red, 10bit green, 10bit blue, 2bit alpha)
  211. tfA2RGB10ui1, //< 1 x unsigned int (2bit alpha, 10bit red, 10bit green, 10bit blue)
  212. tfRGBA16us4, //< 1 x unsigned short (red), 1 x unsigned short (green), 1 x unsigned short (blue), 1 x unsigned short (alpha)
  213. tfBGRX4us1, //< 1 x unsigned short (4bit blue, 4bit green, 4bit red, 4bit reserved)
  214. tfXBGR4us1, //< 1 x unsigned short (4bit reserved, 4bit blue, 4bit green, 4bit red)
  215. tfB5G6R5us1, //< 1 x unsigned short (5bit blue, 6bit green, 5bit red)
  216. tfBGR5X1us1, //< 1 x unsigned short (5bit blue, 5bit green, 5bit red, 1bit reserved)
  217. tfX1BGR5us1, //< 1 x unsigned short (1bit reserved, 5bit blue, 5bit green, 5bit red)
  218. tfBGR8ub3, //< 1 x unsigned byte (blue), 1 x unsigned byte (green), 1 x unsigned byte (red)
  219. tfBGRX8ui1, //< 1 x unsigned int (8bit blue, 8bit green, 8bit red, 8bit reserved)
  220. tfXBGR8ui1, //< 1 x unsigned int (8bit reserved, 8bit blue, 8bit green, 8bit red)
  221. tfBGR10X2ui1, //< 1 x unsigned int (10bit blue, 10bit green, 10bit red, 2bit reserved)
  222. tfX2BGR10ui1, //< 1 x unsigned int (2bit reserved, 10bit blue, 10bit green, 10bit red)
  223. tfBGR16us3, //< 1 x unsigned short (blue), 1 x unsigned short (green), 1 x unsigned short (red)
  224. tfBGRA4us1, //< 1 x unsigned short (4bit blue, 4bit green, 4bit red, 4bit alpha)
  225. tfABGR4us1, //< 1 x unsigned short (4bit alpha, 4bit blue, 4bit green, 4bit red)
  226. tfBGR5A1us1, //< 1 x unsigned short (5bit blue, 5bit green, 5bit red, 1bit alpha)
  227. tfA1BGR5us1, //< 1 x unsigned short (1bit alpha, 5bit blue, 5bit green, 5bit red)
  228. tfBGRA8ui1, //< 1 x unsigned int (8bit blue, 8bit green, 8bit red, 8bit alpha)
  229. tfABGR8ui1, //< 1 x unsigned int (8bit alpha, 8bit blue, 8bit green, 8bit red)
  230. tfBGRA8ub4, //< 1 x unsigned byte (blue), 1 x unsigned byte (green), 1 x unsigned byte (red), 1 x unsigned byte (alpha)
  231. tfBGR10A2ui1, //< 1 x unsigned int (10bit blue, 10bit green, 10bit red, 2bit alpha)
  232. tfA2BGR10ui1, //< 1 x unsigned int (2bit alpha, 10bit blue, 10bit green, 10bit red)
  233. tfBGRA16us4, //< 1 x unsigned short (blue), 1 x unsigned short (green), 1 x unsigned short (red), 1 x unsigned short (alpha)
  234. tfDepth16us1, //< 1 x unsigned short (depth)
  235. tfDepth24ui1, //< 1 x unsigned int (depth)
  236. tfDepth32ui1, //< 1 x unsigned int (depth)
  237. tfS3tcDtx1RGBA,
  238. tfS3tcDtx3RGBA,
  239. tfS3tcDtx5RGBA
  240. );
  241. { type to define suitable file formats }
  242. TglBitmapFileType = (
  243. {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG, {$ENDIF} //< Portable Network Graphic file (PNG)
  244. {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF} //< JPEG file
  245. ftDDS, //< Direct Draw Surface file (DDS)
  246. ftTGA, //< Targa Image File (TGA)
  247. ftBMP, //< Windows Bitmap File (BMP)
  248. ftRAW); //< glBitmap RAW file format
  249. TglBitmapFileTypes = set of TglBitmapFileType;
  250. { possible mipmap types }
  251. TglBitmapMipMap = (
  252. mmNone, //< no mipmaps
  253. mmMipmap, //< normal mipmaps
  254. mmMipmapGlu); //< mipmaps generated with glu functions
  255. { possible normal map functions }
  256. TglBitmapNormalMapFunc = (
  257. nm4Samples,
  258. nmSobel,
  259. nm3x3,
  260. nm5x5);
  261. ////////////////////////////////////////////////////////////////////////////////////////////////////
  262. EglBitmap = class(Exception); //< glBitmap exception
  263. EglBitmapNotSupported = class(Exception); //< exception for not supported functions
  264. EglBitmapSizeToLarge = class(EglBitmap); //< exception for to large textures
  265. EglBitmapNonPowerOfTwo = class(EglBitmap); //< exception for non power of two textures
  266. EglBitmapUnsupportedFormat = class(EglBitmap) //< exception for unsupporetd formats
  267. public
  268. constructor Create(const aFormat: TglBitmapFormat); overload;
  269. constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;
  270. end;
  271. ////////////////////////////////////////////////////////////////////////////////////////////////////
  272. { record that stores 4 unsigned integer values }
  273. TglBitmapRec4ui = packed record
  274. case Integer of
  275. 0: (r, g, b, a: Cardinal);
  276. 1: (arr: array[0..3] of Cardinal);
  277. end;
  278. { record that stores 4 unsigned byte values }
  279. TglBitmapRec4ub = packed record
  280. case Integer of
  281. 0: (r, g, b, a: Byte);
  282. 1: (arr: array[0..3] of Byte);
  283. end;
  284. { record that stores 4 unsigned long integer values }
  285. TglBitmapRec4ul = packed record
  286. case Integer of
  287. 0: (r, g, b, a: QWord);
  288. 1: (arr: array[0..3] of QWord);
  289. end;
  290. { structure to store pixel data in }
  291. TglBitmapPixelData = packed record
  292. Data: TglBitmapRec4ui; //< color data for each color channel
  293. Range: TglBitmapRec4ui; //< maximal color value for each channel
  294. Format: TglBitmapFormat; //< format of the pixel
  295. end;
  296. PglBitmapPixelData = ^TglBitmapPixelData;
  297. TglBitmapSizeFields = set of (ffX, ffY);
  298. TglBitmapSize = packed record
  299. Fields: TglBitmapSizeFields;
  300. X: Word;
  301. Y: Word;
  302. end;
  303. TglBitmapPixelPosition = TglBitmapSize;
  304. { describes the properties of a given texture data format }
  305. TglBitmapFormatDescriptor = class(TObject)
  306. private
  307. // cached properties
  308. fBytesPerPixel: Single; //< number of bytes for each pixel
  309. fChannelCount: Integer; //< number of color channels
  310. fMask: TglBitmapRec4ul; //< bitmask for each color channel
  311. fRange: TglBitmapRec4ui; //< maximal value of each color channel
  312. { @return @true if the format has a red color channel, @false otherwise }
  313. function GetHasRed: Boolean;
  314. { @return @true if the format has a green color channel, @false otherwise }
  315. function GetHasGreen: Boolean;
  316. { @return @true if the format has a blue color channel, @false otherwise }
  317. function GetHasBlue: Boolean;
  318. { @return @true if the format has a alpha color channel, @false otherwise }
  319. function GetHasAlpha: Boolean;
  320. { @return @true if the format has any color color channel, @false otherwise }
  321. function GetHasColor: Boolean;
  322. { @return @true if the format is a grayscale format, @false otherwise }
  323. function GetIsGrayscale: Boolean;
  324. protected
  325. fFormat: TglBitmapFormat; //< format this descriptor belongs to
  326. fWithAlpha: TglBitmapFormat; //< suitable format with alpha channel
  327. fWithoutAlpha: TglBitmapFormat; //< suitable format without alpha channel
  328. fOpenGLFormat: TglBitmapFormat; //< suitable format that is supported by OpenGL
  329. fRGBInverted: TglBitmapFormat; //< suitable format with inverted RGB channels
  330. fUncompressed: TglBitmapFormat; //< suitable format with uncompressed data
  331. fBitsPerPixel: Integer; //< number of bits per pixel
  332. fIsCompressed: Boolean; //< @true if the format is compressed, @false otherwise
  333. fPrecision: TglBitmapRec4ub; //< number of bits for each color channel
  334. fShift: TglBitmapRec4ub; //< bit offset for each color channel
  335. fglFormat: GLenum; //< OpenGL format enum (e.g. GL_RGB)
  336. fglInternalFormat: GLenum; //< OpenGL internal format enum (e.g. GL_RGB8)
  337. fglDataFormat: GLenum; //< OpenGL data format enum (e.g. GL_UNSIGNED_BYTE)
  338. { set values for this format descriptor }
  339. procedure SetValues; virtual;
  340. { calculate cached values }
  341. procedure CalcValues;
  342. public
  343. property Format: TglBitmapFormat read fFormat; //< format this descriptor belongs to
  344. property ChannelCount: Integer read fChannelCount; //< number of color channels
  345. property IsCompressed: Boolean read fIsCompressed; //< @true if the format is compressed, @false otherwise
  346. property BitsPerPixel: Integer read fBitsPerPixel; //< number of bytes per pixel
  347. property BytesPerPixel: Single read fBytesPerPixel; //< number of bits per pixel
  348. property Precision: TglBitmapRec4ub read fPrecision; //< number of bits for each color channel
  349. property Shift: TglBitmapRec4ub read fShift; //< bit offset for each color channel
  350. property Range: TglBitmapRec4ui read fRange; //< maximal value of each color channel
  351. property Mask: TglBitmapRec4ul read fMask; //< bitmask for each color channel
  352. property RGBInverted: TglBitmapFormat read fRGBInverted; //< suitable format with inverted RGB channels
  353. property WithAlpha: TglBitmapFormat read fWithAlpha; //< suitable format with alpha channel
  354. property WithoutAlpha: TglBitmapFormat read fWithAlpha; //< suitable format without alpha channel
  355. property OpenGLFormat: TglBitmapFormat read fOpenGLFormat; //< suitable format that is supported by OpenGL
  356. property Uncompressed: TglBitmapFormat read fUncompressed; //< suitable format with uncompressed data
  357. property glFormat: GLenum read fglFormat; //< OpenGL format enum (e.g. GL_RGB)
  358. property glInternalFormat: GLenum read fglInternalFormat; //< OpenGL internal format enum (e.g. GL_RGB8)
  359. property glDataFormat: GLenum read fglDataFormat; //< OpenGL data format enum (e.g. GL_UNSIGNED_BYTE)
  360. property HasRed: Boolean read GetHasRed; //< @true if the format has a red color channel, @false otherwise
  361. property HasGreen: Boolean read GetHasGreen; //< @true if the format has a green color channel, @false otherwise
  362. property HasBlue: Boolean read GetHasBlue; //< @true if the format has a blue color channel, @false otherwise
  363. property HasAlpha: Boolean read GetHasAlpha; //< @true if the format has a alpha color channel, @false otherwise
  364. property HasColor: Boolean read GetHasColor; //< @true if the format has any color color channel, @false otherwise
  365. property IsGrayscale: Boolean read GetIsGrayscale; //< @true if the format is a grayscale format, @false otherwise
  366. function GetSize(const aSize: TglBitmapSize): Integer; overload; virtual;
  367. function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
  368. { constructor }
  369. constructor Create;
  370. public
  371. { get the format descriptor by a given OpenGL internal format
  372. @param aInternalFormat OpenGL internal format to get format descriptor for
  373. @returns suitable format descriptor or tfEmpty-Descriptor }
  374. class function GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
  375. end;
  376. ////////////////////////////////////////////////////////////////////////////////////////////////////
  377. TglBitmapData = class;
  378. { structure to store data for converting in }
  379. TglBitmapFunctionRec = record
  380. Sender: TglBitmapData; //< texture object that stores the data to convert
  381. Size: TglBitmapSize; //< size of the texture
  382. Position: TglBitmapPixelPosition; //< position of the currently pixel
  383. Source: TglBitmapPixelData; //< pixel data of the current pixel
  384. Dest: TglBitmapPixelData; //< new data of the pixel (must be filled in)
  385. Args: Pointer; //< user defined args that was passed to the convert function
  386. end;
  387. { callback to use for converting texture data }
  388. TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
  389. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  390. { class to store texture data in. used to load, save and
  391. manipulate data before assigned to texture object
  392. all operations on a data object can be done from a background thread }
  393. TglBitmapData = class
  394. private { fields }
  395. fData: PByte; //< texture data
  396. fDimension: TglBitmapSize; //< pixel size of the data
  397. fFormat: TglBitmapFormat; //< format the texture data is stored in
  398. fFilename: String; //< file the data was load from
  399. fScanlines: array of PByte; //< pointer to begin of each line
  400. fHasScanlines: Boolean; //< @true if scanlines are initialized, @false otherwise
  401. private { getter / setter }
  402. { @returns the format descriptor suitable to the texture data format }
  403. function GetFormatDescriptor: TglBitmapFormatDescriptor;
  404. { @returns the width of the texture data (in pixel) or -1 if no data is set }
  405. function GetWidth: Integer;
  406. { @returns the height of the texture data (in pixel) or -1 if no data is set }
  407. function GetHeight: Integer;
  408. { get scanline at index aIndex
  409. @returns Pointer to start of line or @nil }
  410. function GetScanlines(const aIndex: Integer): PByte;
  411. { set new value for the data format. only possible if new format has the same pixel size.
  412. if you want to convert the texture data, see ConvertTo function }
  413. procedure SetFormat(const aValue: TglBitmapFormat);
  414. private { internal misc }
  415. { splits a resource identifier into the resource and it's type
  416. @param aResource resource identifier to split and store name in
  417. @param aResType type of the resource }
  418. procedure PrepareResType(var aResource: String; var aResType: PChar);
  419. { updates scanlines array }
  420. procedure UpdateScanlines;
  421. private { internal load and save }
  422. {$IFDEF GLB_SUPPORT_PNG_READ}
  423. { try to load a PNG from a stream
  424. @param aStream stream to load PNG from
  425. @returns @true on success, @false otherwise }
  426. function LoadPNG(const aStream: TStream): Boolean; virtual;
  427. {$ENDIF}
  428. {$ifdef GLB_SUPPORT_PNG_WRITE}
  429. { save texture data as PNG to stream
  430. @param aStream stream to save data to}
  431. procedure SavePNG(const aStream: TStream); virtual;
  432. {$ENDIF}
  433. {$IFDEF GLB_SUPPORT_JPEG_READ}
  434. { try to load a JPEG from a stream
  435. @param aStream stream to load JPEG from
  436. @returns @true on success, @false otherwise }
  437. function LoadJPEG(const aStream: TStream): Boolean; virtual;
  438. {$ENDIF}
  439. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  440. { save texture data as JPEG to stream
  441. @param aStream stream to save data to}
  442. procedure SaveJPEG(const aStream: TStream); virtual;
  443. {$ENDIF}
  444. { try to load a RAW image from a stream
  445. @param aStream stream to load RAW image from
  446. @returns @true on success, @false otherwise }
  447. function LoadRAW(const aStream: TStream): Boolean;
  448. { save texture data as RAW image to stream
  449. @param aStream stream to save data to}
  450. procedure SaveRAW(const aStream: TStream);
  451. { try to load a BMP from a stream
  452. @param aStream stream to load BMP from
  453. @returns @true on success, @false otherwise }
  454. function LoadBMP(const aStream: TStream): Boolean;
  455. { save texture data as BMP to stream
  456. @param aStream stream to save data to}
  457. procedure SaveBMP(const aStream: TStream);
  458. { try to load a TGA from a stream
  459. @param aStream stream to load TGA from
  460. @returns @true on success, @false otherwise }
  461. function LoadTGA(const aStream: TStream): Boolean;
  462. { save texture data as TGA to stream
  463. @param aStream stream to save data to}
  464. procedure SaveTGA(const aStream: TStream);
  465. { try to load a DDS from a stream
  466. @param aStream stream to load DDS from
  467. @returns @true on success, @false otherwise }
  468. function LoadDDS(const aStream: TStream): Boolean;
  469. { save texture data as DDS to stream
  470. @param aStream stream to save data to}
  471. procedure SaveDDS(const aStream: TStream);
  472. public { properties }
  473. property Data: PByte read fData; //< texture data (be carefull with this!)
  474. property Dimension: TglBitmapSize read fDimension; //< size of the texture data (in pixel)
  475. property Filename: String read fFilename; //< file the data was loaded from
  476. property Width: Integer read GetWidth; //< width of the texture data (in pixel)
  477. property Height: Integer read GetHeight; //< height of the texture data (in pixel)
  478. property Format: TglBitmapFormat read fFormat write SetFormat; //< format the texture data is stored in
  479. property Scanlines[const aIndex: Integer]: PByte read GetScanlines; //< pointer to begin of line at given index or @nil
  480. property FormatDescriptor: TglBitmapFormatDescriptor read GetFormatDescriptor; //< descriptor object that describes the format of the stored data
  481. public { flip }
  482. { flip texture horizontal
  483. @returns @true in success, @false otherwise }
  484. function FlipHorz: Boolean; virtual;
  485. { flip texture vertical
  486. @returns @true in success, @false otherwise }
  487. function FlipVert: Boolean; virtual;
  488. public { load }
  489. { load a texture from a file
  490. @param aFilename file to load texuture from }
  491. procedure LoadFromFile(const aFilename: String);
  492. { load a texture from a stream
  493. @param aStream stream to load texture from }
  494. procedure LoadFromStream(const aStream: TStream); virtual;
  495. { use a function to generate texture data
  496. @param aSize size of the texture
  497. @param aFormat format of the texture data
  498. @param aFunc callback to use for generation
  499. @param aArgs user defined paramaters (use at will) }
  500. procedure LoadFromFunc(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil);
  501. { load a texture from a resource
  502. @param aInstance resource handle
  503. @param aResource resource indentifier
  504. @param aResType resource type (if known) }
  505. procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
  506. { load a texture from a resource id
  507. @param aInstance resource handle
  508. @param aResource resource ID
  509. @param aResType resource type }
  510. procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  511. public { save }
  512. { save texture data to a file
  513. @param aFilename filename to store texture in
  514. @param aFileType file type to store data into }
  515. procedure SaveToFile(const aFilename: String; const aFileType: TglBitmapFileType);
  516. { save texture data to a stream
  517. @param aFilename filename to store texture in
  518. @param aFileType file type to store data into }
  519. procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
  520. public { convert }
  521. { convert texture data using a user defined callback
  522. @param aFunc callback to use for converting
  523. @param aCreateTemp create a temporary buffer to use for converting
  524. @param aArgs user defined paramters (use at will)
  525. @returns @true if converting was successful, @false otherwise }
  526. function Convert(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
  527. { convert texture data using a user defined callback
  528. @param aSource glBitmap to read data from
  529. @param aFunc callback to use for converting
  530. @param aCreateTemp create a temporary buffer to use for converting
  531. @param aFormat format of the new data
  532. @param aArgs user defined paramters (use at will)
  533. @returns @true if converting was successful, @false otherwise }
  534. function Convert(const aSource: TglBitmapData; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  535. const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
  536. { convert texture data using a specific format
  537. @param aFormat new format of texture data
  538. @returns @true if converting was successful, @false otherwise }
  539. function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
  540. {$IFDEF GLB_SDL}
  541. public { SDL }
  542. { assign texture data to SDL surface
  543. @param aSurface SDL surface to write data to
  544. @returns @true on success, @false otherwise }
  545. function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  546. { assign texture data from SDL surface
  547. @param aSurface SDL surface to read data from
  548. @returns @true on success, @false otherwise }
  549. function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  550. { assign alpha channel data to SDL surface
  551. @param aSurface SDL surface to write alpha channel data to
  552. @returns @true on success, @false otherwise }
  553. function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  554. { assign alpha channel data from SDL surface
  555. @param aSurface SDL surface to read data from
  556. @param aFunc callback to use for converting
  557. @param aArgs user defined parameters (use at will)
  558. @returns @true on success, @false otherwise }
  559. function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  560. {$ENDIF}
  561. {$IFDEF GLB_DELPHI}
  562. public { Delphi }
  563. { assign texture data to TBitmap object
  564. @param aBitmap TBitmap to write data to
  565. @returns @true on success, @false otherwise }
  566. function AssignToBitmap(const aBitmap: TBitmap): Boolean;
  567. { assign texture data from TBitmap object
  568. @param aBitmap TBitmap to read data from
  569. @returns @true on success, @false otherwise }
  570. function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  571. { assign alpha channel data to TBitmap object
  572. @param aBitmap TBitmap to write data to
  573. @returns @true on success, @false otherwise }
  574. function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  575. { assign alpha channel data from TBitmap object
  576. @param aBitmap TBitmap to read data from
  577. @param aFunc callback to use for converting
  578. @param aArgs user defined parameters (use at will)
  579. @returns @true on success, @false otherwise }
  580. function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  581. {$ENDIF}
  582. {$IFDEF GLB_LAZARUS}
  583. public { Lazarus }
  584. { assign texture data to TLazIntfImage object
  585. @param aImage TLazIntfImage to write data to
  586. @returns @true on success, @false otherwise }
  587. function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  588. { assign texture data from TLazIntfImage object
  589. @param aImage TLazIntfImage to read data from
  590. @returns @true on success, @false otherwise }
  591. function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  592. { assign alpha channel data to TLazIntfImage object
  593. @param aImage TLazIntfImage to write data to
  594. @returns @true on success, @false otherwise }
  595. function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  596. { assign alpha channel data from TLazIntfImage object
  597. @param aImage TLazIntfImage to read data from
  598. @param aFunc callback to use for converting
  599. @param aArgs user defined parameters (use at will)
  600. @returns @true on success, @false otherwise }
  601. function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  602. {$ENDIF}
  603. public { Alpha }
  604. { load alpha channel data from resource
  605. @param aInstance resource handle
  606. @param aResource resource ID
  607. @param aResType resource type
  608. @param aFunc callback to use for converting
  609. @param aArgs user defined parameters (use at will)
  610. @returns @true on success, @false otherwise }
  611. function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  612. { load alpha channel data from resource ID
  613. @param aInstance resource handle
  614. @param aResourceID resource ID
  615. @param aResType resource type
  616. @param aFunc callback to use for converting
  617. @param aArgs user defined parameters (use at will)
  618. @returns @true on success, @false otherwise }
  619. function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  620. { add alpha channel data from function
  621. @param aFunc callback to get data from
  622. @param aArgs user defined parameters (use at will)
  623. @returns @true on success, @false otherwise }
  624. function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
  625. { add alpha channel data from file (macro for: new glBitmap, LoadFromFile, AddAlphaFromGlBitmap)
  626. @param aFilename file to load alpha channel data from
  627. @param aFunc callback to use for converting
  628. @param aArgs SetFormat user defined parameters (use at will)
  629. @returns @true on success, @false otherwise }
  630. function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  631. { add alpha channel data from stream (macro for: new glBitmap, LoadFromStream, AddAlphaFromGlBitmap)
  632. @param aStream stream to load alpha channel data from
  633. @param aFunc callback to use for converting
  634. @param aArgs user defined parameters (use at will)
  635. @returns @true on success, @false otherwise }
  636. function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  637. { add alpha channel data from existing glBitmap object
  638. @param aBitmap TglBitmap to copy alpha channel data from
  639. @param aFunc callback to use for converting
  640. @param aArgs user defined parameters (use at will)
  641. @returns @true on success, @false otherwise }
  642. function AddAlphaFromDataObj(const aDataObj: TglBitmapData; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  643. { add alpha to pixel if the pixels color is greter than the given color value
  644. @param aRed red threshold (0-255)
  645. @param aGreen green threshold (0-255)
  646. @param aBlue blue threshold (0-255)
  647. @param aDeviatation accepted deviatation (0-255)
  648. @returns @true on success, @false otherwise }
  649. function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
  650. { add alpha to pixel if the pixels color is greter than the given color value
  651. @param aRed red threshold (0-Range.r)
  652. @param aGreen green threshold (0-Range.g)
  653. @param aBlue blue threshold (0-Range.b)
  654. @param aDeviatation accepted deviatation (0-max(Range.rgb))
  655. @returns @true on success, @false otherwise }
  656. function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
  657. { add alpha to pixel if the pixels color is greter than the given color value
  658. @param aRed red threshold (0.0-1.0)
  659. @param aGreen green threshold (0.0-1.0)
  660. @param aBlue blue threshold (0.0-1.0)
  661. @param aDeviatation accepted deviatation (0.0-1.0)
  662. @returns @true on success, @false otherwise }
  663. function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
  664. { add a constand alpha value to all pixels
  665. @param aAlpha alpha value to add (0-255)
  666. @returns @true on success, @false otherwise }
  667. function AddAlphaFromValue(const aAlpha: Byte): Boolean;
  668. { add a constand alpha value to all pixels
  669. @param aAlpha alpha value to add (0-max(Range.rgb))
  670. @returns @true on success, @false otherwise }
  671. function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  672. { add a constand alpha value to all pixels
  673. @param aAlpha alpha value to add (0.0-1.0)
  674. @returns @true on success, @false otherwise }
  675. function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  676. { remove alpha channel
  677. @returns @true on success, @false otherwise }
  678. function RemoveAlpha: Boolean; virtual;
  679. public { fill }
  680. { fill complete texture with one color
  681. @param aRed red color for border (0-255)
  682. @param aGreen green color for border (0-255)
  683. @param aBlue blue color for border (0-255)
  684. @param aAlpha alpha color for border (0-255) }
  685. procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
  686. { fill complete texture with one color
  687. @param aRed red color for border (0-Range.r)
  688. @param aGreen green color for border (0-Range.g)
  689. @param aBlue blue color for border (0-Range.b)
  690. @param aAlpha alpha color for border (0-Range.a) }
  691. procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
  692. { fill complete texture with one color
  693. @param aRed red color for border (0.0-1.0)
  694. @param aGreen green color for border (0.0-1.0)
  695. @param aBlue blue color for border (0.0-1.0)
  696. @param aAlpha alpha color for border (0.0-1.0) }
  697. procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single = 1.0);
  698. public { Misc }
  699. { set data pointer of texture data
  700. @param aData pointer to new texture data
  701. @param aFormat format of the data stored at aData
  702. @param aWidth width of the texture data
  703. @param aHeight height of the texture data }
  704. procedure SetData(const aData: PByte; const aFormat: TglBitmapFormat;
  705. const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;
  706. { create a clone of the current object
  707. @returns clone of this object}
  708. function Clone: TglBitmapData;
  709. { invert color data (bitwise not)
  710. @param aRed invert red channel
  711. @param aGreen invert green channel
  712. @param aBlue invert blue channel
  713. @param aAlpha invert alpha channel }
  714. procedure Invert(const aRed, aGreen, aBlue, aAlpha: Boolean);
  715. { create normal map from texture data
  716. @param aFunc normal map function to generate normalmap with
  717. @param aScale scale of the normale stored in the normal map
  718. @param aUseAlpha generate normalmap from alpha channel data (if present) }
  719. procedure GenerateNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
  720. const aScale: Single = 2; const aUseAlpha: Boolean = false);
  721. public { constructor }
  722. { constructor - creates a texutre data object }
  723. constructor Create; overload;
  724. { constructor - creates a texture data object and loads it from a file
  725. @param aFilename file to load texture from }
  726. constructor Create(const aFileName: String); overload;
  727. { constructor - creates a texture data object and loads it from a stream
  728. @param aStream stream to load texture from }
  729. constructor Create(const aStream: TStream); overload;
  730. { constructor - creates a texture data object with the given size, format and data
  731. @param aSize size of the texture
  732. @param aFormat format of the given data
  733. @param aData texture data - be carefull: the data will now be managed by the texture data object }
  734. constructor Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; aData: PByte = nil); overload;
  735. { constructor - creates a texture data object with the given size and format and uses the given callback to create the data
  736. @param aSize size of the texture
  737. @param aFormat format of the given data
  738. @param aFunc callback to use for generating the data
  739. @param aArgs user defined parameters (use at will) }
  740. constructor Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
  741. { constructor - creates a texture data object and loads it from a resource
  742. @param aInstance resource handle
  743. @param aResource resource indentifier
  744. @param aResType resource type (if known) }
  745. constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
  746. { constructor - creates a texture data object and loads it from a resource
  747. @param aInstance resource handle
  748. @param aResourceID resource ID
  749. @param aResType resource type (if known) }
  750. constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
  751. { destructor }
  752. destructor Destroy; override;
  753. end;
  754. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  755. { base class for all glBitmap classes. used to manage OpenGL texture objects
  756. all operations on a bitmap object must be done from the render thread }
  757. TglBitmap = class
  758. protected
  759. fID: GLuint; //< name of the OpenGL texture object
  760. fTarget: GLuint; //< texture target (e.g. GL_TEXTURE_2D)
  761. fDeleteTextureOnFree: Boolean; //< delete OpenGL texture object when this object is destroyed
  762. // texture properties
  763. fFilterMin: GLenum; //< min filter to apply to the texture
  764. fFilterMag: GLenum; //< mag filter to apply to the texture
  765. fWrapS: GLenum; //< texture wrapping for x axis
  766. fWrapT: GLenum; //< texture wrapping for y axis
  767. fWrapR: GLenum; //< texture wrapping for z axis
  768. fAnisotropic: Integer; //< anisotropic level
  769. fBorderColor: array[0..3] of Single; //< color of the texture border
  770. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  771. //Swizzle
  772. fSwizzle: array[0..3] of GLenum; //< color channel swizzle
  773. {$IFEND}
  774. {$IFNDEF OPENGL_ES}
  775. fIsResident: GLboolean; //< @true if OpenGL texture object has data, @false otherwise
  776. {$ENDIF}
  777. fDimension: TglBitmapSize; //< size of this texture
  778. fMipMap: TglBitmapMipMap; //< mipmap type
  779. // CustomData
  780. fCustomData: Pointer; //< user defined data
  781. fCustomName: String; //< user defined name
  782. fCustomNameW: WideString; //< user defined name
  783. protected
  784. { @returns the actual width of the texture }
  785. function GetWidth: Integer; virtual;
  786. { @returns the actual height of the texture }
  787. function GetHeight: Integer; virtual;
  788. protected
  789. { set a new value for fCustomData }
  790. procedure SetCustomData(const aValue: Pointer);
  791. { set a new value for fCustomName }
  792. procedure SetCustomName(const aValue: String);
  793. { set a new value for fCustomNameW }
  794. procedure SetCustomNameW(const aValue: WideString);
  795. { set new value for fDeleteTextureOnFree }
  796. procedure SetDeleteTextureOnFree(const aValue: Boolean);
  797. { set name of OpenGL texture object }
  798. procedure SetID(const aValue: Cardinal);
  799. { set new value for fMipMap }
  800. procedure SetMipMap(const aValue: TglBitmapMipMap);
  801. { set new value for target }
  802. procedure SetTarget(const aValue: Cardinal);
  803. { set new value for fAnisotrophic }
  804. procedure SetAnisotropic(const aValue: Integer);
  805. protected
  806. { create OpenGL texture object (delete exisiting object if exists) }
  807. procedure CreateID;
  808. { setup texture parameters }
  809. procedure SetupParameters({$IFNDEF OPENGL_ES}out aBuildWithGlu: Boolean{$ENDIF});
  810. protected
  811. property Width: Integer read GetWidth; //< the actual width of the texture
  812. property Height: Integer read GetHeight; //< the actual height of the texture
  813. public
  814. property ID: Cardinal read fID write SetID; //< name of the OpenGL texture object
  815. property Target: Cardinal read fTarget write SetTarget; //< texture target (e.g. GL_TEXTURE_2D)
  816. property DeleteTextureOnFree: Boolean read fDeleteTextureOnFree write SetDeleteTextureOnFree; //< delete texture object when this object is destroyed
  817. property MipMap: TglBitmapMipMap read fMipMap write SetMipMap; //< mipmap type
  818. property Anisotropic: Integer read fAnisotropic write SetAnisotropic; //< anisotropic level
  819. property CustomData: Pointer read fCustomData write SetCustomData; //< user defined data (use at will)
  820. property CustomName: String read fCustomName write SetCustomName; //< user defined name (use at will)
  821. property CustomNameW: WideString read fCustomNameW write SetCustomNameW; //< user defined name (as WideString; use at will)
  822. property Dimension: TglBitmapSize read fDimension; //< size of the texture
  823. {$IFNDEF OPENGL_ES}
  824. property IsResident: GLboolean read fIsResident; //< @true if OpenGL texture object has data, @false otherwise
  825. {$ENDIF}
  826. { this method is called after the constructor and sets the default values of this object }
  827. procedure AfterConstruction; override;
  828. { this method is called before the destructor and does some cleanup }
  829. procedure BeforeDestruction; override;
  830. public
  831. {$IFNDEF OPENGL_ES}
  832. { set the new value for texture border color
  833. @param aRed red color for border (0.0-1.0)
  834. @param aGreen green color for border (0.0-1.0)
  835. @param aBlue blue color for border (0.0-1.0)
  836. @param aAlpha alpha color for border (0.0-1.0) }
  837. procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  838. {$ENDIF}
  839. public
  840. { set new texture filer
  841. @param aMin min filter
  842. @param aMag mag filter }
  843. procedure SetFilter(const aMin, aMag: GLenum);
  844. { set new texture wrapping
  845. @param S texture wrapping for x axis
  846. @param T texture wrapping for y axis
  847. @param R texture wrapping for z axis }
  848. procedure SetWrap(
  849. const S: GLenum = GL_CLAMP_TO_EDGE;
  850. const T: GLenum = GL_CLAMP_TO_EDGE;
  851. const R: GLenum = GL_CLAMP_TO_EDGE);
  852. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  853. { set new swizzle
  854. @param r swizzle for red channel
  855. @param g swizzle for green channel
  856. @param b swizzle for blue channel
  857. @param a swizzle for alpha channel }
  858. procedure SetSwizzle(const r, g, b, a: GLenum);
  859. {$IFEND}
  860. public
  861. { bind texture
  862. @param aEnableTextureUnit enable texture unit for this texture (e.g. glEnable(GL_TEXTURE_2D)) }
  863. procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
  864. { bind texture
  865. @param aDisableTextureUnit disable texture unit for this texture (e.g. glEnable(GL_TEXTURE_2D)) }
  866. procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
  867. { upload texture data from given data object to video card
  868. @param aData texture data object that contains the actual data
  869. @param aCheckSize check size before upload and throw exception if something is wrong }
  870. procedure UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean = true); virtual;
  871. {$IFNDEF OPENGL_ES}
  872. { download texture data from video card and store it into given data object
  873. @returns @true when download was successfull, @false otherwise }
  874. function DownloadData(const aDataObj: TglBitmapData): Boolean; virtual;
  875. {$ENDIF}
  876. public
  877. { constructor - creates an empty texture }
  878. constructor Create; overload;
  879. { constructor - creates an texture object and uploads the given data }
  880. constructor Create(const aData: TglBitmapData); overload;
  881. end;
  882. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  883. {$IF NOT DEFINED(OPENGL_ES)}
  884. { wrapper class for 1-dimensional textures (OpenGL target = GL_TEXTURE_1D
  885. all operations on a bitmap object must be done from the render thread }
  886. TglBitmap1D = class(TglBitmap)
  887. protected
  888. { upload the texture data to video card
  889. @param aDataObj texture data object that contains the actual data
  890. @param aBuildWithGlu use glu functions to build mipmaps }
  891. procedure UploadDataIntern(const aDataObj: TglBitmapData; const aBuildWithGlu: Boolean);
  892. public
  893. property Width; //< actual with of the texture
  894. { this method is called after constructor and initializes the object }
  895. procedure AfterConstruction; override;
  896. { upload texture data from given data object to video card
  897. @param aData texture data object that contains the actual data
  898. @param aCheckSize check size before upload and throw exception if something is wrong }
  899. procedure UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean = true); override;
  900. end;
  901. {$IFEND}
  902. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  903. { wrapper class for 2-dimensional textures (OpenGL target = GL_TEXTURE_2D)
  904. all operations on a bitmap object must be done from the render thread }
  905. TglBitmap2D = class(TglBitmap)
  906. protected
  907. { upload the texture data to video card
  908. @param aDataObj texture data object that contains the actual data
  909. @param aTarget target o upload data to (e.g. GL_TEXTURE_2D)
  910. @param aBuildWithGlu use glu functions to build mipmaps }
  911. procedure UploadDataIntern(const aDataObj: TglBitmapData; const aTarget: GLenum
  912. {$IFNDEF OPENGL_ES}; const aBuildWithGlu: Boolean{$ENDIF});
  913. public
  914. property Width; //< actual width of the texture
  915. property Height; //< actual height of the texture
  916. { this method is called after constructor and initializes the object }
  917. procedure AfterConstruction; override;
  918. { upload texture data from given data object to video card
  919. @param aData texture data object that contains the actual data
  920. @param aCheckSize check size before upload and throw exception if something is wrong }
  921. procedure UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean = true); override;
  922. public
  923. { copy a part of the frame buffer to the texture
  924. @param aTop topmost pixel to copy
  925. @param aLeft leftmost pixel to copy
  926. @param aRight rightmost pixel to copy
  927. @param aBottom bottommost pixel to copy
  928. @param aFormat format to store data in
  929. @param aDataObj texture data object to store the data in }
  930. class procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat; const aDataObj: TglBitmapData);
  931. end;
  932. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  933. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  934. { wrapper class for cube maps (OpenGL target = GL_TEXTURE_CUBE_MAP)
  935. all operations on a bitmap object must be done from the render thread }
  936. TglBitmapCubeMap = class(TglBitmap2D)
  937. protected
  938. {$IFNDEF OPENGL_ES}
  939. fGenMode: Integer; //< generation mode for the cube map (e.g. GL_REFLECTION_MAP)
  940. {$ENDIF}
  941. public
  942. { this method is called after constructor and initializes the object }
  943. procedure AfterConstruction; override;
  944. { upload texture data from given data object to video card
  945. @param aData texture data object that contains the actual data
  946. @param aCheckSize check size before upload and throw exception if something is wrong }
  947. procedure UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean = true); override;
  948. { upload texture data from given data object to video card
  949. @param aData texture data object that contains the actual data
  950. @param aCubeTarget cube map target to upload data to (e.g. GL_TEXTURE_CUBE_MAP_POSITIVE_X)
  951. @param aCheckSize check size before upload and throw exception if something is wrong }
  952. procedure UploadCubeMap(const aDataObj: TglBitmapData; const aCubeTarget: Cardinal; const aCheckSize: Boolean);
  953. { bind texture
  954. @param aEnableTexCoordsGen enable cube map generator
  955. @param aEnableTextureUnit enable texture unit }
  956. procedure Bind({$IFNDEF OPENGL_ES}const aEnableTexCoordsGen: Boolean = true;{$ENDIF} const aEnableTextureUnit: Boolean = true); reintroduce; virtual;
  957. { unbind texture
  958. @param aDisableTexCoordsGen disable cube map generator
  959. @param aDisableTextureUnit disable texture unit }
  960. procedure Unbind({$IFNDEF OPENGL_ES}const aDisableTexCoordsGen: Boolean = true;{$ENDIF} const aDisableTextureUnit: Boolean = true); reintroduce; virtual;
  961. end;
  962. {$IFEND}
  963. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  964. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  965. { wrapper class for cube normal maps
  966. all operations on a bitmap object must be done from the render thread }
  967. TglBitmapNormalMap = class(TglBitmapCubeMap)
  968. public
  969. { this method is called after constructor and initializes the object }
  970. procedure AfterConstruction; override;
  971. { create cube normal map from texture data and upload it to video card
  972. @param aSize size of each cube map texture
  973. @param aCheckSize check size before upload and throw exception if something is wrong }
  974. procedure GenerateNormalMap(const aSize: Integer = 32; const aCheckSize: Boolean = true);
  975. end;
  976. {$IFEND}
  977. const
  978. NULL_SIZE: TglBitmapSize = (Fields: []; X: 0; Y: 0);
  979. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  980. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  981. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  982. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  983. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  984. procedure glBitmapSetDefaultWrap(
  985. const S: Cardinal = GL_CLAMP_TO_EDGE;
  986. const T: Cardinal = GL_CLAMP_TO_EDGE;
  987. const R: Cardinal = GL_CLAMP_TO_EDGE);
  988. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  989. procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
  990. {$IFEND}
  991. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  992. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  993. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  994. function glBitmapGetDefaultFormat: TglBitmapFormat;
  995. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  996. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  997. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  998. procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
  999. {$IFEND}
  1000. function glBitmapSize(X: Integer = -1; Y: Integer = -1): TglBitmapSize;
  1001. function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
  1002. function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
  1003. function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
  1004. function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
  1005. function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
  1006. function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
  1007. function glBitmapCreateTestData(const aFormat: TglBitmapFormat): TglBitmapData;
  1008. {$IFDEF GLB_DELPHI}
  1009. function CreateGrayPalette: HPALETTE;
  1010. {$ENDIF}
  1011. implementation
  1012. uses
  1013. Math, syncobjs, typinfo
  1014. {$IF DEFINED(GLB_SUPPORT_JPEG_READ) AND DEFINED(GLB_LAZ_JPEG)}, FPReadJPEG{$IFEND};
  1015. var
  1016. glBitmapDefaultDeleteTextureOnFree: Boolean;
  1017. glBitmapDefaultFreeDataAfterGenTextures: Boolean;
  1018. glBitmapDefaultFormat: TglBitmapFormat;
  1019. glBitmapDefaultMipmap: TglBitmapMipMap;
  1020. glBitmapDefaultFilterMin: Cardinal;
  1021. glBitmapDefaultFilterMag: Cardinal;
  1022. glBitmapDefaultWrapS: Cardinal;
  1023. glBitmapDefaultWrapT: Cardinal;
  1024. glBitmapDefaultWrapR: Cardinal;
  1025. glDefaultSwizzle: array[0..3] of GLenum;
  1026. ////////////////////////////////////////////////////////////////////////////////////////////////////
  1027. type
  1028. TFormatDescriptor = class(TglBitmapFormatDescriptor)
  1029. public
  1030. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
  1031. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
  1032. function CreateMappingData: Pointer; virtual;
  1033. procedure FreeMappingData(var aMappingData: Pointer); virtual;
  1034. function IsEmpty: Boolean; virtual;
  1035. function MaskMatch(const aMask: TglBitmapRec4ul): Boolean; virtual;
  1036. procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
  1037. constructor Create; virtual;
  1038. public
  1039. class procedure Init;
  1040. class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1041. class function GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1042. class function GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer = 0): TFormatDescriptor;
  1043. class function GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
  1044. class procedure Clear;
  1045. class procedure Finalize;
  1046. end;
  1047. TFormatDescriptorClass = class of TFormatDescriptor;
  1048. TfdEmpty = class(TFormatDescriptor);
  1049. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1050. TfdAlphaUB1 = class(TFormatDescriptor) //1* unsigned byte
  1051. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1052. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1053. end;
  1054. TfdLuminanceUB1 = class(TFormatDescriptor) //1* unsigned byte
  1055. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1056. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1057. end;
  1058. TfdUniversalUB1 = class(TFormatDescriptor) //1* unsigned byte
  1059. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1060. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1061. end;
  1062. TfdLuminanceAlphaUB2 = class(TfdLuminanceUB1) //2* unsigned byte
  1063. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1064. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1065. end;
  1066. TfdRGBub3 = class(TFormatDescriptor) //3* unsigned byte
  1067. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1068. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1069. end;
  1070. TfdBGRub3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
  1071. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1072. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1073. end;
  1074. TfdRGBAub4 = class(TfdRGBub3) //3* unsigned byte
  1075. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1076. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1077. end;
  1078. TfdBGRAub4 = class(TfdBGRub3) //3* unsigned byte (inverse)
  1079. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1080. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1081. end;
  1082. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1083. TfdAlphaUS1 = class(TFormatDescriptor) //1* unsigned short
  1084. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1085. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1086. end;
  1087. TfdLuminanceUS1 = class(TFormatDescriptor) //1* unsigned short
  1088. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1089. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1090. end;
  1091. TfdUniversalUS1 = class(TFormatDescriptor) //1* unsigned short
  1092. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1093. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1094. end;
  1095. TfdDepthUS1 = class(TFormatDescriptor) //1* unsigned short
  1096. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1097. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1098. end;
  1099. TfdLuminanceAlphaUS2 = class(TfdLuminanceUS1) //2* unsigned short
  1100. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1101. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1102. end;
  1103. TfdRGBus3 = class(TFormatDescriptor) //3* unsigned short
  1104. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1105. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1106. end;
  1107. TfdBGRus3 = class(TFormatDescriptor) //3* unsigned short (inverse)
  1108. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1109. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1110. end;
  1111. TfdRGBAus4 = class(TfdRGBus3) //4* unsigned short
  1112. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1113. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1114. end;
  1115. TfdARGBus4 = class(TfdRGBus3) //4* unsigned short
  1116. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1117. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1118. end;
  1119. TfdBGRAus4 = class(TfdBGRus3) //4* unsigned short (inverse)
  1120. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1121. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1122. end;
  1123. TfdABGRus4 = class(TfdBGRus3) //4* unsigned short (inverse)
  1124. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1125. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1126. end;
  1127. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1128. TfdUniversalUI1 = class(TFormatDescriptor) //1* unsigned int
  1129. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1130. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1131. end;
  1132. TfdDepthUI1 = class(TFormatDescriptor) //1* unsigned int
  1133. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1134. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1135. end;
  1136. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1137. TfdAlpha4ub1 = class(TfdAlphaUB1)
  1138. procedure SetValues; override;
  1139. end;
  1140. TfdAlpha8ub1 = class(TfdAlphaUB1)
  1141. procedure SetValues; override;
  1142. end;
  1143. TfdAlpha16us1 = class(TfdAlphaUS1)
  1144. procedure SetValues; override;
  1145. end;
  1146. TfdLuminance4ub1 = class(TfdLuminanceUB1)
  1147. procedure SetValues; override;
  1148. end;
  1149. TfdLuminance8ub1 = class(TfdLuminanceUB1)
  1150. procedure SetValues; override;
  1151. end;
  1152. TfdLuminance16us1 = class(TfdLuminanceUS1)
  1153. procedure SetValues; override;
  1154. end;
  1155. TfdLuminance4Alpha4ub2 = class(TfdLuminanceAlphaUB2)
  1156. procedure SetValues; override;
  1157. end;
  1158. TfdLuminance6Alpha2ub2 = class(TfdLuminanceAlphaUB2)
  1159. procedure SetValues; override;
  1160. end;
  1161. TfdLuminance8Alpha8ub2 = class(TfdLuminanceAlphaUB2)
  1162. procedure SetValues; override;
  1163. end;
  1164. TfdLuminance12Alpha4us2 = class(TfdLuminanceAlphaUS2)
  1165. procedure SetValues; override;
  1166. end;
  1167. TfdLuminance16Alpha16us2 = class(TfdLuminanceAlphaUS2)
  1168. procedure SetValues; override;
  1169. end;
  1170. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1171. TfdR3G3B2ub1 = class(TfdUniversalUB1)
  1172. procedure SetValues; override;
  1173. end;
  1174. TfdRGBX4us1 = class(TfdUniversalUS1)
  1175. procedure SetValues; override;
  1176. end;
  1177. TfdXRGB4us1 = class(TfdUniversalUS1)
  1178. procedure SetValues; override;
  1179. end;
  1180. TfdR5G6B5us1 = class(TfdUniversalUS1)
  1181. procedure SetValues; override;
  1182. end;
  1183. TfdRGB5X1us1 = class(TfdUniversalUS1)
  1184. procedure SetValues; override;
  1185. end;
  1186. TfdX1RGB5us1 = class(TfdUniversalUS1)
  1187. procedure SetValues; override;
  1188. end;
  1189. TfdRGB8ub3 = class(TfdRGBub3)
  1190. procedure SetValues; override;
  1191. end;
  1192. TfdRGBX8ui1 = class(TfdUniversalUI1)
  1193. procedure SetValues; override;
  1194. end;
  1195. TfdXRGB8ui1 = class(TfdUniversalUI1)
  1196. procedure SetValues; override;
  1197. end;
  1198. TfdRGB10X2ui1 = class(TfdUniversalUI1)
  1199. procedure SetValues; override;
  1200. end;
  1201. TfdX2RGB10ui1 = class(TfdUniversalUI1)
  1202. procedure SetValues; override;
  1203. end;
  1204. TfdRGB16us3 = class(TfdRGBus3)
  1205. procedure SetValues; override;
  1206. end;
  1207. TfdRGBA4us1 = class(TfdUniversalUS1)
  1208. procedure SetValues; override;
  1209. end;
  1210. TfdARGB4us1 = class(TfdUniversalUS1)
  1211. procedure SetValues; override;
  1212. end;
  1213. TfdRGB5A1us1 = class(TfdUniversalUS1)
  1214. procedure SetValues; override;
  1215. end;
  1216. TfdA1RGB5us1 = class(TfdUniversalUS1)
  1217. procedure SetValues; override;
  1218. end;
  1219. TfdRGBA8ui1 = class(TfdUniversalUI1)
  1220. procedure SetValues; override;
  1221. end;
  1222. TfdARGB8ui1 = class(TfdUniversalUI1)
  1223. procedure SetValues; override;
  1224. end;
  1225. TfdRGBA8ub4 = class(TfdRGBAub4)
  1226. procedure SetValues; override;
  1227. end;
  1228. TfdRGB10A2ui1 = class(TfdUniversalUI1)
  1229. procedure SetValues; override;
  1230. end;
  1231. TfdA2RGB10ui1 = class(TfdUniversalUI1)
  1232. procedure SetValues; override;
  1233. end;
  1234. TfdRGBA16us4 = class(TfdRGBAus4)
  1235. procedure SetValues; override;
  1236. end;
  1237. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1238. TfdBGRX4us1 = class(TfdUniversalUS1)
  1239. procedure SetValues; override;
  1240. end;
  1241. TfdXBGR4us1 = class(TfdUniversalUS1)
  1242. procedure SetValues; override;
  1243. end;
  1244. TfdB5G6R5us1 = class(TfdUniversalUS1)
  1245. procedure SetValues; override;
  1246. end;
  1247. TfdBGR5X1us1 = class(TfdUniversalUS1)
  1248. procedure SetValues; override;
  1249. end;
  1250. TfdX1BGR5us1 = class(TfdUniversalUS1)
  1251. procedure SetValues; override;
  1252. end;
  1253. TfdBGR8ub3 = class(TfdBGRub3)
  1254. procedure SetValues; override;
  1255. end;
  1256. TfdBGRX8ui1 = class(TfdUniversalUI1)
  1257. procedure SetValues; override;
  1258. end;
  1259. TfdXBGR8ui1 = class(TfdUniversalUI1)
  1260. procedure SetValues; override;
  1261. end;
  1262. TfdBGR10X2ui1 = class(TfdUniversalUI1)
  1263. procedure SetValues; override;
  1264. end;
  1265. TfdX2BGR10ui1 = class(TfdUniversalUI1)
  1266. procedure SetValues; override;
  1267. end;
  1268. TfdBGR16us3 = class(TfdBGRus3)
  1269. procedure SetValues; override;
  1270. end;
  1271. TfdBGRA4us1 = class(TfdUniversalUS1)
  1272. procedure SetValues; override;
  1273. end;
  1274. TfdABGR4us1 = class(TfdUniversalUS1)
  1275. procedure SetValues; override;
  1276. end;
  1277. TfdBGR5A1us1 = class(TfdUniversalUS1)
  1278. procedure SetValues; override;
  1279. end;
  1280. TfdA1BGR5us1 = class(TfdUniversalUS1)
  1281. procedure SetValues; override;
  1282. end;
  1283. TfdBGRA8ui1 = class(TfdUniversalUI1)
  1284. procedure SetValues; override;
  1285. end;
  1286. TfdABGR8ui1 = class(TfdUniversalUI1)
  1287. procedure SetValues; override;
  1288. end;
  1289. TfdBGRA8ub4 = class(TfdBGRAub4)
  1290. procedure SetValues; override;
  1291. end;
  1292. TfdBGR10A2ui1 = class(TfdUniversalUI1)
  1293. procedure SetValues; override;
  1294. end;
  1295. TfdA2BGR10ui1 = class(TfdUniversalUI1)
  1296. procedure SetValues; override;
  1297. end;
  1298. TfdBGRA16us4 = class(TfdBGRAus4)
  1299. procedure SetValues; override;
  1300. end;
  1301. TfdDepth16us1 = class(TfdDepthUS1)
  1302. procedure SetValues; override;
  1303. end;
  1304. TfdDepth24ui1 = class(TfdDepthUI1)
  1305. procedure SetValues; override;
  1306. end;
  1307. TfdDepth32ui1 = class(TfdDepthUI1)
  1308. procedure SetValues; override;
  1309. end;
  1310. TfdS3tcDtx1RGBA = class(TFormatDescriptor)
  1311. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1312. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1313. procedure SetValues; override;
  1314. end;
  1315. TfdS3tcDtx3RGBA = class(TFormatDescriptor)
  1316. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1317. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1318. procedure SetValues; override;
  1319. end;
  1320. TfdS3tcDtx5RGBA = class(TFormatDescriptor)
  1321. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1322. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1323. procedure SetValues; override;
  1324. end;
  1325. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1326. TbmpBitfieldFormat = class(TFormatDescriptor)
  1327. public
  1328. procedure SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul); overload;
  1329. procedure SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
  1330. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1331. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1332. end;
  1333. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1334. TbmpColorTableEnty = packed record
  1335. b, g, r, a: Byte;
  1336. end;
  1337. TbmpColorTable = array of TbmpColorTableEnty;
  1338. TbmpColorTableFormat = class(TFormatDescriptor)
  1339. private
  1340. fColorTable: TbmpColorTable;
  1341. protected
  1342. procedure SetValues; override;
  1343. public
  1344. property ColorTable: TbmpColorTable read fColorTable write fColorTable;
  1345. procedure SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
  1346. procedure CalcValues;
  1347. procedure CreateColorTable;
  1348. function CreateMappingData: Pointer; override;
  1349. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1350. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1351. destructor Destroy; override;
  1352. end;
  1353. const
  1354. LUMINANCE_WEIGHT_R = 0.30;
  1355. LUMINANCE_WEIGHT_G = 0.59;
  1356. LUMINANCE_WEIGHT_B = 0.11;
  1357. ALPHA_WEIGHT_R = 0.30;
  1358. ALPHA_WEIGHT_G = 0.59;
  1359. ALPHA_WEIGHT_B = 0.11;
  1360. DEPTH_WEIGHT_R = 0.333333333;
  1361. DEPTH_WEIGHT_G = 0.333333333;
  1362. DEPTH_WEIGHT_B = 0.333333333;
  1363. FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
  1364. TfdEmpty,
  1365. TfdAlpha4ub1,
  1366. TfdAlpha8ub1,
  1367. TfdAlpha16us1,
  1368. TfdLuminance4ub1,
  1369. TfdLuminance8ub1,
  1370. TfdLuminance16us1,
  1371. TfdLuminance4Alpha4ub2,
  1372. TfdLuminance6Alpha2ub2,
  1373. TfdLuminance8Alpha8ub2,
  1374. TfdLuminance12Alpha4us2,
  1375. TfdLuminance16Alpha16us2,
  1376. TfdR3G3B2ub1,
  1377. TfdRGBX4us1,
  1378. TfdXRGB4us1,
  1379. TfdR5G6B5us1,
  1380. TfdRGB5X1us1,
  1381. TfdX1RGB5us1,
  1382. TfdRGB8ub3,
  1383. TfdRGBX8ui1,
  1384. TfdXRGB8ui1,
  1385. TfdRGB10X2ui1,
  1386. TfdX2RGB10ui1,
  1387. TfdRGB16us3,
  1388. TfdRGBA4us1,
  1389. TfdARGB4us1,
  1390. TfdRGB5A1us1,
  1391. TfdA1RGB5us1,
  1392. TfdRGBA8ui1,
  1393. TfdARGB8ui1,
  1394. TfdRGBA8ub4,
  1395. TfdRGB10A2ui1,
  1396. TfdA2RGB10ui1,
  1397. TfdRGBA16us4,
  1398. TfdBGRX4us1,
  1399. TfdXBGR4us1,
  1400. TfdB5G6R5us1,
  1401. TfdBGR5X1us1,
  1402. TfdX1BGR5us1,
  1403. TfdBGR8ub3,
  1404. TfdBGRX8ui1,
  1405. TfdXBGR8ui1,
  1406. TfdBGR10X2ui1,
  1407. TfdX2BGR10ui1,
  1408. TfdBGR16us3,
  1409. TfdBGRA4us1,
  1410. TfdABGR4us1,
  1411. TfdBGR5A1us1,
  1412. TfdA1BGR5us1,
  1413. TfdBGRA8ui1,
  1414. TfdABGR8ui1,
  1415. TfdBGRA8ub4,
  1416. TfdBGR10A2ui1,
  1417. TfdA2BGR10ui1,
  1418. TfdBGRA16us4,
  1419. TfdDepth16us1,
  1420. TfdDepth24ui1,
  1421. TfdDepth32ui1,
  1422. TfdS3tcDtx1RGBA,
  1423. TfdS3tcDtx3RGBA,
  1424. TfdS3tcDtx5RGBA
  1425. );
  1426. var
  1427. FormatDescriptorCS: TCriticalSection;
  1428. FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
  1429. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1430. constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
  1431. begin
  1432. inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1433. end;
  1434. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1435. constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
  1436. begin
  1437. inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1438. end;
  1439. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1440. function glBitmapSize(X: Integer; Y: Integer): TglBitmapSize;
  1441. begin
  1442. result.Fields := [];
  1443. if (X >= 0) then
  1444. result.Fields := result.Fields + [ffX];
  1445. if (Y >= 0) then
  1446. result.Fields := result.Fields + [ffY];
  1447. result.X := Max(0, X);
  1448. result.Y := Max(0, Y);
  1449. end;
  1450. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1451. function glBitmapPosition(X: Integer; Y: Integer): TglBitmapPixelPosition;
  1452. begin
  1453. result := glBitmapSize(X, Y);
  1454. end;
  1455. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1456. function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
  1457. begin
  1458. result.r := r;
  1459. result.g := g;
  1460. result.b := b;
  1461. result.a := a;
  1462. end;
  1463. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1464. function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
  1465. begin
  1466. result.r := r;
  1467. result.g := g;
  1468. result.b := b;
  1469. result.a := a;
  1470. end;
  1471. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1472. function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
  1473. begin
  1474. result.r := r;
  1475. result.g := g;
  1476. result.b := b;
  1477. result.a := a;
  1478. end;
  1479. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1480. function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
  1481. var
  1482. i: Integer;
  1483. begin
  1484. result := false;
  1485. for i := 0 to high(r1.arr) do
  1486. if (r1.arr[i] <> r2.arr[i]) then
  1487. exit;
  1488. result := true;
  1489. end;
  1490. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1491. function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
  1492. var
  1493. i: Integer;
  1494. begin
  1495. result := false;
  1496. for i := 0 to high(r1.arr) do
  1497. if (r1.arr[i] <> r2.arr[i]) then
  1498. exit;
  1499. result := true;
  1500. end;
  1501. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1502. function glBitmapCreateTestData(const aFormat: TglBitmapFormat): TglBitmapData;
  1503. var
  1504. desc: TFormatDescriptor;
  1505. p, tmp: PByte;
  1506. x, y, i: Integer;
  1507. md: Pointer;
  1508. px: TglBitmapPixelData;
  1509. begin
  1510. result := nil;
  1511. desc := TFormatDescriptor.Get(aFormat);
  1512. if (desc.IsCompressed) or (desc.glFormat = 0) then
  1513. exit;
  1514. p := GetMemory(ceil(25 * desc.BytesPerPixel)); // 5 x 5 pixel
  1515. md := desc.CreateMappingData;
  1516. try
  1517. tmp := p;
  1518. desc.PreparePixel(px);
  1519. for y := 0 to 4 do
  1520. for x := 0 to 4 do begin
  1521. px.Data := glBitmapRec4ui(0, 0, 0, 0);
  1522. for i := 0 to 3 do begin
  1523. if ((y < 3) and (y = i)) or
  1524. ((y = 3) and (i < 3)) or
  1525. ((y = 4) and (i = 3))
  1526. then
  1527. px.Data.arr[i] := Trunc(px.Range.arr[i] / 4 * x)
  1528. else if ((y < 4) and (i = 3)) or
  1529. ((y = 4) and (i < 3))
  1530. then
  1531. px.Data.arr[i] := px.Range.arr[i]
  1532. else
  1533. px.Data.arr[i] := 0; //px.Range.arr[i];
  1534. end;
  1535. desc.Map(px, tmp, md);
  1536. end;
  1537. finally
  1538. desc.FreeMappingData(md);
  1539. end;
  1540. result := TglBitmapData.Create(glBitmapPosition(5, 5), aFormat, p);
  1541. end;
  1542. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1543. function glBitmapShiftRec(const r, g, b, a: Byte): TglBitmapRec4ub;
  1544. begin
  1545. result.r := r;
  1546. result.g := g;
  1547. result.b := b;
  1548. result.a := a;
  1549. end;
  1550. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1551. function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
  1552. begin
  1553. result := [];
  1554. if (aFormat in [
  1555. //8bpp
  1556. tfAlpha4ub1, tfAlpha8ub1,
  1557. tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1,
  1558. //16bpp
  1559. tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
  1560. tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
  1561. tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1,
  1562. //24bpp
  1563. tfBGR8ub3, tfRGB8ub3,
  1564. //32bpp
  1565. tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
  1566. tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1])
  1567. then
  1568. result := result + [ ftBMP ];
  1569. if (aFormat in [
  1570. //8bbp
  1571. tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1,
  1572. //16bbp
  1573. tfAlpha16us1, tfLuminance16us1,
  1574. tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
  1575. tfX1RGB5us1, tfARGB4us1, tfA1RGB5us1, tfDepth16us1,
  1576. //24bbp
  1577. tfBGR8ub3,
  1578. //32bbp
  1579. tfX2RGB10ui1, tfARGB8ui1, tfBGRA8ub4, tfA2RGB10ui1,
  1580. tfDepth24ui1, tfDepth32ui1])
  1581. then
  1582. result := result + [ftTGA];
  1583. if not (aFormat in [tfEmpty, tfRGB16us3, tfBGR16us3]) then
  1584. result := result + [ftDDS];
  1585. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  1586. if aFormat in [
  1587. tfAlpha8ub1, tfLuminance8ub1, tfLuminance8Alpha8ub2,
  1588. tfRGB8ub3, tfRGBA8ui1,
  1589. tfBGR8ub3, tfBGRA8ui1] then
  1590. result := result + [ftPNG];
  1591. {$ENDIF}
  1592. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  1593. if aFormat in [tfAlpha8ub1, tfLuminance8ub1, tfRGB8ub3, tfBGR8ub3] then
  1594. result := result + [ftJPEG];
  1595. {$ENDIF}
  1596. end;
  1597. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1598. function IsPowerOfTwo(aNumber: Integer): Boolean;
  1599. begin
  1600. while (aNumber and 1) = 0 do
  1601. aNumber := aNumber shr 1;
  1602. result := aNumber = 1;
  1603. end;
  1604. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1605. function GetTopMostBit(aBitSet: QWord): Integer;
  1606. begin
  1607. result := 0;
  1608. while aBitSet > 0 do begin
  1609. inc(result);
  1610. aBitSet := aBitSet shr 1;
  1611. end;
  1612. end;
  1613. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1614. function CountSetBits(aBitSet: QWord): Integer;
  1615. begin
  1616. result := 0;
  1617. while aBitSet > 0 do begin
  1618. if (aBitSet and 1) = 1 then
  1619. inc(result);
  1620. aBitSet := aBitSet shr 1;
  1621. end;
  1622. end;
  1623. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1624. function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1625. begin
  1626. result := Trunc(
  1627. LUMINANCE_WEIGHT_R * aPixel.Data.r +
  1628. LUMINANCE_WEIGHT_G * aPixel.Data.g +
  1629. LUMINANCE_WEIGHT_B * aPixel.Data.b);
  1630. end;
  1631. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1632. function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1633. begin
  1634. result := Trunc(
  1635. DEPTH_WEIGHT_R * aPixel.Data.r +
  1636. DEPTH_WEIGHT_G * aPixel.Data.g +
  1637. DEPTH_WEIGHT_B * aPixel.Data.b);
  1638. end;
  1639. {$IFDEF GLB_SDL_IMAGE}
  1640. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1641. // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1642. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1643. function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
  1644. begin
  1645. result := TStream(context^.unknown.data1).Seek(offset, whence);
  1646. end;
  1647. function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
  1648. begin
  1649. result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
  1650. end;
  1651. function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
  1652. begin
  1653. result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
  1654. end;
  1655. function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
  1656. begin
  1657. result := 0;
  1658. end;
  1659. function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
  1660. begin
  1661. result := SDL_AllocRW;
  1662. if result = nil then
  1663. raise EglBitmap.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
  1664. result^.seek := glBitmapRWseek;
  1665. result^.read := glBitmapRWread;
  1666. result^.write := glBitmapRWwrite;
  1667. result^.close := glBitmapRWclose;
  1668. result^.unknown.data1 := Stream;
  1669. end;
  1670. {$ENDIF}
  1671. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1672. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1673. begin
  1674. glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
  1675. end;
  1676. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1677. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1678. begin
  1679. glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
  1680. end;
  1681. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1682. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1683. begin
  1684. glBitmapDefaultMipmap := aValue;
  1685. end;
  1686. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1687. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1688. begin
  1689. glBitmapDefaultFormat := aFormat;
  1690. end;
  1691. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1692. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1693. begin
  1694. glBitmapDefaultFilterMin := aMin;
  1695. glBitmapDefaultFilterMag := aMag;
  1696. end;
  1697. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1698. procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
  1699. begin
  1700. glBitmapDefaultWrapS := S;
  1701. glBitmapDefaultWrapT := T;
  1702. glBitmapDefaultWrapR := R;
  1703. end;
  1704. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1705. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  1706. procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
  1707. begin
  1708. glDefaultSwizzle[0] := r;
  1709. glDefaultSwizzle[1] := g;
  1710. glDefaultSwizzle[2] := b;
  1711. glDefaultSwizzle[3] := a;
  1712. end;
  1713. {$IFEND}
  1714. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1715. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1716. begin
  1717. result := glBitmapDefaultDeleteTextureOnFree;
  1718. end;
  1719. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1720. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1721. begin
  1722. result := glBitmapDefaultFreeDataAfterGenTextures;
  1723. end;
  1724. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1725. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1726. begin
  1727. result := glBitmapDefaultMipmap;
  1728. end;
  1729. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1730. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1731. begin
  1732. result := glBitmapDefaultFormat;
  1733. end;
  1734. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1735. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  1736. begin
  1737. aMin := glBitmapDefaultFilterMin;
  1738. aMag := glBitmapDefaultFilterMag;
  1739. end;
  1740. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1741. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  1742. begin
  1743. S := glBitmapDefaultWrapS;
  1744. T := glBitmapDefaultWrapT;
  1745. R := glBitmapDefaultWrapR;
  1746. end;
  1747. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  1748. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1749. procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
  1750. begin
  1751. r := glDefaultSwizzle[0];
  1752. g := glDefaultSwizzle[1];
  1753. b := glDefaultSwizzle[2];
  1754. a := glDefaultSwizzle[3];
  1755. end;
  1756. {$IFEND}
  1757. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1758. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1759. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1760. function TFormatDescriptor.CreateMappingData: Pointer;
  1761. begin
  1762. result := nil;
  1763. end;
  1764. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1765. procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
  1766. begin
  1767. //DUMMY
  1768. end;
  1769. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1770. function TFormatDescriptor.IsEmpty: Boolean;
  1771. begin
  1772. result := (fFormat = tfEmpty);
  1773. end;
  1774. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1775. function TFormatDescriptor.MaskMatch(const aMask: TglBitmapRec4ul): Boolean;
  1776. var
  1777. i: Integer;
  1778. m: TglBitmapRec4ul;
  1779. begin
  1780. result := false;
  1781. if (aMask.r = 0) and (aMask.g = 0) and (aMask.b = 0) and (aMask.a = 0) then
  1782. raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
  1783. m := Mask;
  1784. for i := 0 to 3 do
  1785. if (aMask.arr[i] <> m.arr[i]) then
  1786. exit;
  1787. result := true;
  1788. end;
  1789. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1790. procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
  1791. begin
  1792. FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
  1793. aPixel.Data := Range;
  1794. aPixel.Format := fFormat;
  1795. aPixel.Range := Range;
  1796. end;
  1797. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1798. constructor TFormatDescriptor.Create;
  1799. begin
  1800. inherited Create;
  1801. end;
  1802. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1803. //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1804. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1805. procedure TfdAlphaUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1806. begin
  1807. aData^ := aPixel.Data.a;
  1808. inc(aData);
  1809. end;
  1810. procedure TfdAlphaUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1811. begin
  1812. aPixel.Data.r := 0;
  1813. aPixel.Data.g := 0;
  1814. aPixel.Data.b := 0;
  1815. aPixel.Data.a := aData^;
  1816. inc(aData);
  1817. end;
  1818. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1819. //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1820. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1821. procedure TfdLuminanceUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1822. begin
  1823. aData^ := LuminanceWeight(aPixel);
  1824. inc(aData);
  1825. end;
  1826. procedure TfdLuminanceUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1827. begin
  1828. aPixel.Data.r := aData^;
  1829. aPixel.Data.g := aData^;
  1830. aPixel.Data.b := aData^;
  1831. aPixel.Data.a := 0;
  1832. inc(aData);
  1833. end;
  1834. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1835. //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1836. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1837. procedure TfdUniversalUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1838. var
  1839. i: Integer;
  1840. begin
  1841. aData^ := 0;
  1842. for i := 0 to 3 do
  1843. if (Range.arr[i] > 0) then
  1844. aData^ := aData^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
  1845. inc(aData);
  1846. end;
  1847. procedure TfdUniversalUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1848. var
  1849. i: Integer;
  1850. begin
  1851. for i := 0 to 3 do
  1852. aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and Range.arr[i];
  1853. inc(aData);
  1854. end;
  1855. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1856. //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1857. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1858. procedure TfdLuminanceAlphaUB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1859. begin
  1860. inherited Map(aPixel, aData, aMapData);
  1861. aData^ := aPixel.Data.a;
  1862. inc(aData);
  1863. end;
  1864. procedure TfdLuminanceAlphaUB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1865. begin
  1866. inherited Unmap(aData, aPixel, aMapData);
  1867. aPixel.Data.a := aData^;
  1868. inc(aData);
  1869. end;
  1870. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1871. //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1872. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1873. procedure TfdRGBub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1874. begin
  1875. aData^ := aPixel.Data.r;
  1876. inc(aData);
  1877. aData^ := aPixel.Data.g;
  1878. inc(aData);
  1879. aData^ := aPixel.Data.b;
  1880. inc(aData);
  1881. end;
  1882. procedure TfdRGBub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1883. begin
  1884. aPixel.Data.r := aData^;
  1885. inc(aData);
  1886. aPixel.Data.g := aData^;
  1887. inc(aData);
  1888. aPixel.Data.b := aData^;
  1889. inc(aData);
  1890. aPixel.Data.a := 0;
  1891. end;
  1892. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1893. //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1894. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1895. procedure TfdBGRub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1896. begin
  1897. aData^ := aPixel.Data.b;
  1898. inc(aData);
  1899. aData^ := aPixel.Data.g;
  1900. inc(aData);
  1901. aData^ := aPixel.Data.r;
  1902. inc(aData);
  1903. end;
  1904. procedure TfdBGRub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1905. begin
  1906. aPixel.Data.b := aData^;
  1907. inc(aData);
  1908. aPixel.Data.g := aData^;
  1909. inc(aData);
  1910. aPixel.Data.r := aData^;
  1911. inc(aData);
  1912. aPixel.Data.a := 0;
  1913. end;
  1914. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1915. //TfdRGBA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1916. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1917. procedure TfdRGBAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1918. begin
  1919. inherited Map(aPixel, aData, aMapData);
  1920. aData^ := aPixel.Data.a;
  1921. inc(aData);
  1922. end;
  1923. procedure TfdRGBAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1924. begin
  1925. inherited Unmap(aData, aPixel, aMapData);
  1926. aPixel.Data.a := aData^;
  1927. inc(aData);
  1928. end;
  1929. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1930. //TfdBGRA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1931. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1932. procedure TfdBGRAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1933. begin
  1934. inherited Map(aPixel, aData, aMapData);
  1935. aData^ := aPixel.Data.a;
  1936. inc(aData);
  1937. end;
  1938. procedure TfdBGRAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1939. begin
  1940. inherited Unmap(aData, aPixel, aMapData);
  1941. aPixel.Data.a := aData^;
  1942. inc(aData);
  1943. end;
  1944. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1945. //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1946. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1947. procedure TfdAlphaUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1948. begin
  1949. PWord(aData)^ := aPixel.Data.a;
  1950. inc(aData, 2);
  1951. end;
  1952. procedure TfdAlphaUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1953. begin
  1954. aPixel.Data.r := 0;
  1955. aPixel.Data.g := 0;
  1956. aPixel.Data.b := 0;
  1957. aPixel.Data.a := PWord(aData)^;
  1958. inc(aData, 2);
  1959. end;
  1960. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1961. //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1962. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1963. procedure TfdLuminanceUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1964. begin
  1965. PWord(aData)^ := LuminanceWeight(aPixel);
  1966. inc(aData, 2);
  1967. end;
  1968. procedure TfdLuminanceUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1969. begin
  1970. aPixel.Data.r := PWord(aData)^;
  1971. aPixel.Data.g := PWord(aData)^;
  1972. aPixel.Data.b := PWord(aData)^;
  1973. aPixel.Data.a := 0;
  1974. inc(aData, 2);
  1975. end;
  1976. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1977. //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1978. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1979. procedure TfdUniversalUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1980. var
  1981. i: Integer;
  1982. begin
  1983. PWord(aData)^ := 0;
  1984. for i := 0 to 3 do
  1985. if (Range.arr[i] > 0) then
  1986. PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
  1987. inc(aData, 2);
  1988. end;
  1989. procedure TfdUniversalUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1990. var
  1991. i: Integer;
  1992. begin
  1993. for i := 0 to 3 do
  1994. aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and Range.arr[i];
  1995. inc(aData, 2);
  1996. end;
  1997. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1998. //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1999. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2000. procedure TfdDepthUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2001. begin
  2002. PWord(aData)^ := DepthWeight(aPixel);
  2003. inc(aData, 2);
  2004. end;
  2005. procedure TfdDepthUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2006. begin
  2007. aPixel.Data.r := PWord(aData)^;
  2008. aPixel.Data.g := PWord(aData)^;
  2009. aPixel.Data.b := PWord(aData)^;
  2010. aPixel.Data.a := PWord(aData)^;;
  2011. inc(aData, 2);
  2012. end;
  2013. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2014. //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2015. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2016. procedure TfdLuminanceAlphaUS2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2017. begin
  2018. inherited Map(aPixel, aData, aMapData);
  2019. PWord(aData)^ := aPixel.Data.a;
  2020. inc(aData, 2);
  2021. end;
  2022. procedure TfdLuminanceAlphaUS2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2023. begin
  2024. inherited Unmap(aData, aPixel, aMapData);
  2025. aPixel.Data.a := PWord(aData)^;
  2026. inc(aData, 2);
  2027. end;
  2028. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2029. //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2030. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2031. procedure TfdRGBus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2032. begin
  2033. PWord(aData)^ := aPixel.Data.r;
  2034. inc(aData, 2);
  2035. PWord(aData)^ := aPixel.Data.g;
  2036. inc(aData, 2);
  2037. PWord(aData)^ := aPixel.Data.b;
  2038. inc(aData, 2);
  2039. end;
  2040. procedure TfdRGBus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2041. begin
  2042. aPixel.Data.r := PWord(aData)^;
  2043. inc(aData, 2);
  2044. aPixel.Data.g := PWord(aData)^;
  2045. inc(aData, 2);
  2046. aPixel.Data.b := PWord(aData)^;
  2047. inc(aData, 2);
  2048. aPixel.Data.a := 0;
  2049. end;
  2050. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2051. //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2052. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2053. procedure TfdBGRus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2054. begin
  2055. PWord(aData)^ := aPixel.Data.b;
  2056. inc(aData, 2);
  2057. PWord(aData)^ := aPixel.Data.g;
  2058. inc(aData, 2);
  2059. PWord(aData)^ := aPixel.Data.r;
  2060. inc(aData, 2);
  2061. end;
  2062. procedure TfdBGRus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2063. begin
  2064. aPixel.Data.b := PWord(aData)^;
  2065. inc(aData, 2);
  2066. aPixel.Data.g := PWord(aData)^;
  2067. inc(aData, 2);
  2068. aPixel.Data.r := PWord(aData)^;
  2069. inc(aData, 2);
  2070. aPixel.Data.a := 0;
  2071. end;
  2072. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2073. //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2074. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2075. procedure TfdRGBAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2076. begin
  2077. inherited Map(aPixel, aData, aMapData);
  2078. PWord(aData)^ := aPixel.Data.a;
  2079. inc(aData, 2);
  2080. end;
  2081. procedure TfdRGBAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2082. begin
  2083. inherited Unmap(aData, aPixel, aMapData);
  2084. aPixel.Data.a := PWord(aData)^;
  2085. inc(aData, 2);
  2086. end;
  2087. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2088. //TfdARGB_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2089. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2090. procedure TfdARGBus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2091. begin
  2092. PWord(aData)^ := aPixel.Data.a;
  2093. inc(aData, 2);
  2094. inherited Map(aPixel, aData, aMapData);
  2095. end;
  2096. procedure TfdARGBus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2097. begin
  2098. aPixel.Data.a := PWord(aData)^;
  2099. inc(aData, 2);
  2100. inherited Unmap(aData, aPixel, aMapData);
  2101. end;
  2102. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2103. //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2104. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2105. procedure TfdBGRAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2106. begin
  2107. inherited Map(aPixel, aData, aMapData);
  2108. PWord(aData)^ := aPixel.Data.a;
  2109. inc(aData, 2);
  2110. end;
  2111. procedure TfdBGRAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2112. begin
  2113. inherited Unmap(aData, aPixel, aMapData);
  2114. aPixel.Data.a := PWord(aData)^;
  2115. inc(aData, 2);
  2116. end;
  2117. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2118. //TfdABGR_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2119. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2120. procedure TfdABGRus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2121. begin
  2122. PWord(aData)^ := aPixel.Data.a;
  2123. inc(aData, 2);
  2124. inherited Map(aPixel, aData, aMapData);
  2125. end;
  2126. procedure TfdABGRus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2127. begin
  2128. aPixel.Data.a := PWord(aData)^;
  2129. inc(aData, 2);
  2130. inherited Unmap(aData, aPixel, aMapData);
  2131. end;
  2132. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2133. //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2134. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2135. procedure TfdUniversalUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2136. var
  2137. i: Integer;
  2138. begin
  2139. PCardinal(aData)^ := 0;
  2140. for i := 0 to 3 do
  2141. if (Range.arr[i] > 0) then
  2142. PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
  2143. inc(aData, 4);
  2144. end;
  2145. procedure TfdUniversalUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2146. var
  2147. i: Integer;
  2148. begin
  2149. for i := 0 to 3 do
  2150. aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and Range.arr[i];
  2151. inc(aData, 2);
  2152. end;
  2153. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2154. //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2155. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2156. procedure TfdDepthUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2157. begin
  2158. PCardinal(aData)^ := DepthWeight(aPixel);
  2159. inc(aData, 4);
  2160. end;
  2161. procedure TfdDepthUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2162. begin
  2163. aPixel.Data.r := PCardinal(aData)^;
  2164. aPixel.Data.g := PCardinal(aData)^;
  2165. aPixel.Data.b := PCardinal(aData)^;
  2166. aPixel.Data.a := PCardinal(aData)^;
  2167. inc(aData, 4);
  2168. end;
  2169. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2170. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2171. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2172. procedure TfdAlpha4ub1.SetValues;
  2173. begin
  2174. inherited SetValues;
  2175. fBitsPerPixel := 8;
  2176. fFormat := tfAlpha4ub1;
  2177. fWithAlpha := tfAlpha4ub1;
  2178. fPrecision := glBitmapRec4ub(0, 0, 0, 8);
  2179. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2180. {$IFNDEF OPENGL_ES}
  2181. fOpenGLFormat := tfAlpha4ub1;
  2182. fglFormat := GL_ALPHA;
  2183. fglInternalFormat := GL_ALPHA4;
  2184. fglDataFormat := GL_UNSIGNED_BYTE;
  2185. {$ELSE}
  2186. fOpenGLFormat := tfAlpha8ub1;
  2187. {$ENDIF}
  2188. end;
  2189. procedure TfdAlpha8ub1.SetValues;
  2190. begin
  2191. inherited SetValues;
  2192. fBitsPerPixel := 8;
  2193. fFormat := tfAlpha8ub1;
  2194. fWithAlpha := tfAlpha8ub1;
  2195. fPrecision := glBitmapRec4ub(0, 0, 0, 8);
  2196. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2197. fOpenGLFormat := tfAlpha8ub1;
  2198. fglFormat := GL_ALPHA;
  2199. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_ALPHA8{$ELSE}GL_ALPHA{$ENDIF};
  2200. fglDataFormat := GL_UNSIGNED_BYTE;
  2201. end;
  2202. procedure TfdAlpha16us1.SetValues;
  2203. begin
  2204. inherited SetValues;
  2205. fBitsPerPixel := 16;
  2206. fFormat := tfAlpha16us1;
  2207. fWithAlpha := tfAlpha16us1;
  2208. fPrecision := glBitmapRec4ub(0, 0, 0, 16);
  2209. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2210. {$IFNDEF OPENGL_ES}
  2211. fOpenGLFormat := tfAlpha16us1;
  2212. fglFormat := GL_ALPHA;
  2213. fglInternalFormat := GL_ALPHA16;
  2214. fglDataFormat := GL_UNSIGNED_SHORT;
  2215. {$ELSE}
  2216. fOpenGLFormat := tfAlpha8ub1;
  2217. {$ENDIF}
  2218. end;
  2219. procedure TfdLuminance4ub1.SetValues;
  2220. begin
  2221. inherited SetValues;
  2222. fBitsPerPixel := 8;
  2223. fFormat := tfLuminance4ub1;
  2224. fWithAlpha := tfLuminance4Alpha4ub2;
  2225. fWithoutAlpha := tfLuminance4ub1;
  2226. fPrecision := glBitmapRec4ub(8, 8, 8, 0);
  2227. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2228. {$IFNDEF OPENGL_ES}
  2229. fOpenGLFormat := tfLuminance4ub1;
  2230. fglFormat := GL_LUMINANCE;
  2231. fglInternalFormat := GL_LUMINANCE4;
  2232. fglDataFormat := GL_UNSIGNED_BYTE;
  2233. {$ELSE}
  2234. fOpenGLFormat := tfLuminance8ub1;
  2235. {$ENDIF}
  2236. end;
  2237. procedure TfdLuminance8ub1.SetValues;
  2238. begin
  2239. inherited SetValues;
  2240. fBitsPerPixel := 8;
  2241. fFormat := tfLuminance8ub1;
  2242. fWithAlpha := tfLuminance8Alpha8ub2;
  2243. fWithoutAlpha := tfLuminance8ub1;
  2244. fOpenGLFormat := tfLuminance8ub1;
  2245. fPrecision := glBitmapRec4ub(8, 8, 8, 0);
  2246. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2247. fglFormat := GL_LUMINANCE;
  2248. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8{$ELSE}GL_LUMINANCE{$ENDIF};
  2249. fglDataFormat := GL_UNSIGNED_BYTE;
  2250. end;
  2251. procedure TfdLuminance16us1.SetValues;
  2252. begin
  2253. inherited SetValues;
  2254. fBitsPerPixel := 16;
  2255. fFormat := tfLuminance16us1;
  2256. fWithAlpha := tfLuminance16Alpha16us2;
  2257. fWithoutAlpha := tfLuminance16us1;
  2258. fPrecision := glBitmapRec4ub(16, 16, 16, 0);
  2259. fShift := glBitmapRec4ub( 0, 0, 0, 0);
  2260. {$IFNDEF OPENGL_ES}
  2261. fOpenGLFormat := tfLuminance16us1;
  2262. fglFormat := GL_LUMINANCE;
  2263. fglInternalFormat := GL_LUMINANCE16;
  2264. fglDataFormat := GL_UNSIGNED_SHORT;
  2265. {$ELSE}
  2266. fOpenGLFormat := tfLuminance8ub1;
  2267. {$ENDIF}
  2268. end;
  2269. procedure TfdLuminance4Alpha4ub2.SetValues;
  2270. begin
  2271. inherited SetValues;
  2272. fBitsPerPixel := 16;
  2273. fFormat := tfLuminance4Alpha4ub2;
  2274. fWithAlpha := tfLuminance4Alpha4ub2;
  2275. fWithoutAlpha := tfLuminance4ub1;
  2276. fPrecision := glBitmapRec4ub(8, 8, 8, 8);
  2277. fShift := glBitmapRec4ub(0, 0, 0, 8);
  2278. {$IFNDEF OPENGL_ES}
  2279. fOpenGLFormat := tfLuminance4Alpha4ub2;
  2280. fglFormat := GL_LUMINANCE_ALPHA;
  2281. fglInternalFormat := GL_LUMINANCE4_ALPHA4;
  2282. fglDataFormat := GL_UNSIGNED_BYTE;
  2283. {$ELSE}
  2284. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2285. {$ENDIF}
  2286. end;
  2287. procedure TfdLuminance6Alpha2ub2.SetValues;
  2288. begin
  2289. inherited SetValues;
  2290. fBitsPerPixel := 16;
  2291. fFormat := tfLuminance6Alpha2ub2;
  2292. fWithAlpha := tfLuminance6Alpha2ub2;
  2293. fWithoutAlpha := tfLuminance8ub1;
  2294. fPrecision := glBitmapRec4ub(8, 8, 8, 8);
  2295. fShift := glBitmapRec4ub(0, 0, 0, 8);
  2296. {$IFNDEF OPENGL_ES}
  2297. fOpenGLFormat := tfLuminance6Alpha2ub2;
  2298. fglFormat := GL_LUMINANCE_ALPHA;
  2299. fglInternalFormat := GL_LUMINANCE6_ALPHA2;
  2300. fglDataFormat := GL_UNSIGNED_BYTE;
  2301. {$ELSE}
  2302. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2303. {$ENDIF}
  2304. end;
  2305. procedure TfdLuminance8Alpha8ub2.SetValues;
  2306. begin
  2307. inherited SetValues;
  2308. fBitsPerPixel := 16;
  2309. fFormat := tfLuminance8Alpha8ub2;
  2310. fWithAlpha := tfLuminance8Alpha8ub2;
  2311. fWithoutAlpha := tfLuminance8ub1;
  2312. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2313. fPrecision := glBitmapRec4ub(8, 8, 8, 8);
  2314. fShift := glBitmapRec4ub(0, 0, 0, 8);
  2315. fglFormat := GL_LUMINANCE_ALPHA;
  2316. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8_ALPHA8{$ELSE}GL_LUMINANCE_ALPHA{$ENDIF};
  2317. fglDataFormat := GL_UNSIGNED_BYTE;
  2318. end;
  2319. procedure TfdLuminance12Alpha4us2.SetValues;
  2320. begin
  2321. inherited SetValues;
  2322. fBitsPerPixel := 32;
  2323. fFormat := tfLuminance12Alpha4us2;
  2324. fWithAlpha := tfLuminance12Alpha4us2;
  2325. fWithoutAlpha := tfLuminance16us1;
  2326. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  2327. fShift := glBitmapRec4ub( 0, 0, 0, 16);
  2328. {$IFNDEF OPENGL_ES}
  2329. fOpenGLFormat := tfLuminance12Alpha4us2;
  2330. fglFormat := GL_LUMINANCE_ALPHA;
  2331. fglInternalFormat := GL_LUMINANCE12_ALPHA4;
  2332. fglDataFormat := GL_UNSIGNED_SHORT;
  2333. {$ELSE}
  2334. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2335. {$ENDIF}
  2336. end;
  2337. procedure TfdLuminance16Alpha16us2.SetValues;
  2338. begin
  2339. inherited SetValues;
  2340. fBitsPerPixel := 32;
  2341. fFormat := tfLuminance16Alpha16us2;
  2342. fWithAlpha := tfLuminance16Alpha16us2;
  2343. fWithoutAlpha := tfLuminance16us1;
  2344. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  2345. fShift := glBitmapRec4ub( 0, 0, 0, 16);
  2346. {$IFNDEF OPENGL_ES}
  2347. fOpenGLFormat := tfLuminance16Alpha16us2;
  2348. fglFormat := GL_LUMINANCE_ALPHA;
  2349. fglInternalFormat := GL_LUMINANCE16_ALPHA16;
  2350. fglDataFormat := GL_UNSIGNED_SHORT;
  2351. {$ELSE}
  2352. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2353. {$ENDIF}
  2354. end;
  2355. procedure TfdR3G3B2ub1.SetValues;
  2356. begin
  2357. inherited SetValues;
  2358. fBitsPerPixel := 8;
  2359. fFormat := tfR3G3B2ub1;
  2360. fWithAlpha := tfRGBA4us1;
  2361. fWithoutAlpha := tfR3G3B2ub1;
  2362. fRGBInverted := tfEmpty;
  2363. fPrecision := glBitmapRec4ub(3, 3, 2, 0);
  2364. fShift := glBitmapRec4ub(5, 2, 0, 0);
  2365. {$IFNDEF OPENGL_ES}
  2366. fOpenGLFormat := tfR3G3B2ub1;
  2367. fglFormat := GL_RGB;
  2368. fglInternalFormat := GL_R3_G3_B2;
  2369. fglDataFormat := GL_UNSIGNED_BYTE_3_3_2;
  2370. {$ELSE}
  2371. fOpenGLFormat := tfR5G6B5us1;
  2372. {$ENDIF}
  2373. end;
  2374. procedure TfdRGBX4us1.SetValues;
  2375. begin
  2376. inherited SetValues;
  2377. fBitsPerPixel := 16;
  2378. fFormat := tfRGBX4us1;
  2379. fWithAlpha := tfRGBA4us1;
  2380. fWithoutAlpha := tfRGBX4us1;
  2381. fRGBInverted := tfBGRX4us1;
  2382. fPrecision := glBitmapRec4ub( 4, 4, 4, 0);
  2383. fShift := glBitmapRec4ub(12, 8, 4, 0);
  2384. {$IFNDEF OPENGL_ES}
  2385. fOpenGLFormat := tfRGBX4us1;
  2386. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2387. fglInternalFormat := GL_RGB4;
  2388. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  2389. {$ELSE}
  2390. fOpenGLFormat := tfR5G6B5us1;
  2391. {$ENDIF}
  2392. end;
  2393. procedure TfdXRGB4us1.SetValues;
  2394. begin
  2395. inherited SetValues;
  2396. fBitsPerPixel := 16;
  2397. fFormat := tfXRGB4us1;
  2398. fWithAlpha := tfARGB4us1;
  2399. fWithoutAlpha := tfXRGB4us1;
  2400. fRGBInverted := tfXBGR4us1;
  2401. fPrecision := glBitmapRec4ub(4, 4, 4, 0);
  2402. fShift := glBitmapRec4ub(8, 4, 0, 0);
  2403. {$IFNDEF OPENGL_ES}
  2404. fOpenGLFormat := tfXRGB4us1;
  2405. fglFormat := GL_BGRA;
  2406. fglInternalFormat := GL_RGB4;
  2407. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2408. {$ELSE}
  2409. fOpenGLFormat := tfR5G6B5us1;
  2410. {$ENDIF}
  2411. end;
  2412. procedure TfdR5G6B5us1.SetValues;
  2413. begin
  2414. inherited SetValues;
  2415. fBitsPerPixel := 16;
  2416. fFormat := tfR5G6B5us1;
  2417. fWithAlpha := tfRGB5A1us1;
  2418. fWithoutAlpha := tfR5G6B5us1;
  2419. fRGBInverted := tfB5G6R5us1;
  2420. fPrecision := glBitmapRec4ub( 5, 6, 5, 0);
  2421. fShift := glBitmapRec4ub(11, 5, 0, 0);
  2422. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  2423. fOpenGLFormat := tfR5G6B5us1;
  2424. fglFormat := GL_RGB;
  2425. fglInternalFormat := GL_RGB565;
  2426. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5;
  2427. {$ELSE}
  2428. fOpenGLFormat := tfRGB8ub3;
  2429. {$IFEND}
  2430. end;
  2431. procedure TfdRGB5X1us1.SetValues;
  2432. begin
  2433. inherited SetValues;
  2434. fBitsPerPixel := 16;
  2435. fFormat := tfRGB5X1us1;
  2436. fWithAlpha := tfRGB5A1us1;
  2437. fWithoutAlpha := tfRGB5X1us1;
  2438. fRGBInverted := tfBGR5X1us1;
  2439. fPrecision := glBitmapRec4ub( 5, 5, 5, 0);
  2440. fShift := glBitmapRec4ub(11, 6, 1, 0);
  2441. {$IFNDEF OPENGL_ES}
  2442. fOpenGLFormat := tfRGB5X1us1;
  2443. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2444. fglInternalFormat := GL_RGB5;
  2445. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  2446. {$ELSE}
  2447. fOpenGLFormat := tfR5G6B5us1;
  2448. {$ENDIF}
  2449. end;
  2450. procedure TfdX1RGB5us1.SetValues;
  2451. begin
  2452. inherited SetValues;
  2453. fBitsPerPixel := 16;
  2454. fFormat := tfX1RGB5us1;
  2455. fWithAlpha := tfA1RGB5us1;
  2456. fWithoutAlpha := tfX1RGB5us1;
  2457. fRGBInverted := tfX1BGR5us1;
  2458. fPrecision := glBitmapRec4ub( 5, 5, 5, 0);
  2459. fShift := glBitmapRec4ub(10, 5, 0, 0);
  2460. {$IFNDEF OPENGL_ES}
  2461. fOpenGLFormat := tfX1RGB5us1;
  2462. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2463. fglInternalFormat := GL_RGB5;
  2464. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2465. {$ELSE}
  2466. fOpenGLFormat := tfR5G6B5us1;
  2467. {$ENDIF}
  2468. end;
  2469. procedure TfdRGB8ub3.SetValues;
  2470. begin
  2471. inherited SetValues;
  2472. fBitsPerPixel := 24;
  2473. fFormat := tfRGB8ub3;
  2474. fWithAlpha := tfRGBA8ub4;
  2475. fWithoutAlpha := tfRGB8ub3;
  2476. fRGBInverted := tfBGR8ub3;
  2477. fPrecision := glBitmapRec4ub(8, 8, 8, 0);
  2478. fShift := glBitmapRec4ub(0, 8, 16, 0);
  2479. fOpenGLFormat := tfRGB8ub3;
  2480. fglFormat := GL_RGB;
  2481. fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGB8{$ELSE}GL_RGB{$IFEND};
  2482. fglDataFormat := GL_UNSIGNED_BYTE;
  2483. end;
  2484. procedure TfdRGBX8ui1.SetValues;
  2485. begin
  2486. inherited SetValues;
  2487. fBitsPerPixel := 32;
  2488. fFormat := tfRGBX8ui1;
  2489. fWithAlpha := tfRGBA8ui1;
  2490. fWithoutAlpha := tfRGBX8ui1;
  2491. fRGBInverted := tfBGRX8ui1;
  2492. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  2493. fShift := glBitmapRec4ub(24, 16, 8, 0);
  2494. {$IFNDEF OPENGL_ES}
  2495. fOpenGLFormat := tfRGBX8ui1;
  2496. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2497. fglInternalFormat := GL_RGB8;
  2498. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  2499. {$ELSE}
  2500. fOpenGLFormat := tfRGB8ub3;
  2501. {$ENDIF}
  2502. end;
  2503. procedure TfdXRGB8ui1.SetValues;
  2504. begin
  2505. inherited SetValues;
  2506. fBitsPerPixel := 32;
  2507. fFormat := tfXRGB8ui1;
  2508. fWithAlpha := tfXRGB8ui1;
  2509. fWithoutAlpha := tfXRGB8ui1;
  2510. fOpenGLFormat := tfXRGB8ui1;
  2511. fRGBInverted := tfXBGR8ui1;
  2512. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  2513. fShift := glBitmapRec4ub(16, 8, 0, 0);
  2514. {$IFNDEF OPENGL_ES}
  2515. fOpenGLFormat := tfXRGB8ui1;
  2516. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2517. fglInternalFormat := GL_RGB8;
  2518. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  2519. {$ELSE}
  2520. fOpenGLFormat := tfRGB8ub3;
  2521. {$ENDIF}
  2522. end;
  2523. procedure TfdRGB10X2ui1.SetValues;
  2524. begin
  2525. inherited SetValues;
  2526. fBitsPerPixel := 32;
  2527. fFormat := tfRGB10X2ui1;
  2528. fWithAlpha := tfRGB10A2ui1;
  2529. fWithoutAlpha := tfRGB10X2ui1;
  2530. fRGBInverted := tfBGR10X2ui1;
  2531. fPrecision := glBitmapRec4ub(10, 10, 10, 0);
  2532. fShift := glBitmapRec4ub(22, 12, 2, 0);
  2533. {$IFNDEF OPENGL_ES}
  2534. fOpenGLFormat := tfRGB10X2ui1;
  2535. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2536. fglInternalFormat := GL_RGB10;
  2537. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  2538. {$ELSE}
  2539. fOpenGLFormat := tfRGB16us3;
  2540. {$ENDIF}
  2541. end;
  2542. procedure TfdX2RGB10ui1.SetValues;
  2543. begin
  2544. inherited SetValues;
  2545. fBitsPerPixel := 32;
  2546. fFormat := tfX2RGB10ui1;
  2547. fWithAlpha := tfA2RGB10ui1;
  2548. fWithoutAlpha := tfX2RGB10ui1;
  2549. fRGBInverted := tfX2BGR10ui1;
  2550. fPrecision := glBitmapRec4ub(10, 10, 10, 0);
  2551. fShift := glBitmapRec4ub(20, 10, 0, 0);
  2552. {$IFNDEF OPENGL_ES}
  2553. fOpenGLFormat := tfX2RGB10ui1;
  2554. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2555. fglInternalFormat := GL_RGB10;
  2556. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2557. {$ELSE}
  2558. fOpenGLFormat := tfRGB16us3;
  2559. {$ENDIF}
  2560. end;
  2561. procedure TfdRGB16us3.SetValues;
  2562. begin
  2563. inherited SetValues;
  2564. fBitsPerPixel := 48;
  2565. fFormat := tfRGB16us3;
  2566. fWithAlpha := tfRGBA16us4;
  2567. fWithoutAlpha := tfRGB16us3;
  2568. fRGBInverted := tfBGR16us3;
  2569. fPrecision := glBitmapRec4ub(16, 16, 16, 0);
  2570. fShift := glBitmapRec4ub( 0, 16, 32, 0);
  2571. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  2572. fOpenGLFormat := tfRGB16us3;
  2573. fglFormat := GL_RGB;
  2574. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGB16{$ELSE}GL_RGB16UI{$ENDIF};
  2575. fglDataFormat := GL_UNSIGNED_SHORT;
  2576. {$ELSE}
  2577. fOpenGLFormat := tfRGB8ub3;
  2578. {$IFEND}
  2579. end;
  2580. procedure TfdRGBA4us1.SetValues;
  2581. begin
  2582. inherited SetValues;
  2583. fBitsPerPixel := 16;
  2584. fFormat := tfRGBA4us1;
  2585. fWithAlpha := tfRGBA4us1;
  2586. fWithoutAlpha := tfRGBX4us1;
  2587. fOpenGLFormat := tfRGBA4us1;
  2588. fRGBInverted := tfBGRA4us1;
  2589. fPrecision := glBitmapRec4ub( 4, 4, 4, 4);
  2590. fShift := glBitmapRec4ub(12, 8, 4, 0);
  2591. fglFormat := GL_RGBA;
  2592. fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA8{$ELSE}GL_RGBA{$IFEND};
  2593. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  2594. end;
  2595. procedure TfdARGB4us1.SetValues;
  2596. begin
  2597. inherited SetValues;
  2598. fBitsPerPixel := 16;
  2599. fFormat := tfARGB4us1;
  2600. fWithAlpha := tfARGB4us1;
  2601. fWithoutAlpha := tfXRGB4us1;
  2602. fRGBInverted := tfABGR4us1;
  2603. fPrecision := glBitmapRec4ub( 4, 4, 4, 4);
  2604. fShift := glBitmapRec4ub( 8, 4, 0, 12);
  2605. {$IFNDEF OPENGL_ES}
  2606. fOpenGLFormat := tfARGB4us1;
  2607. fglFormat := GL_BGRA;
  2608. fglInternalFormat := GL_RGBA4;
  2609. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2610. {$ELSE}
  2611. fOpenGLFormat := tfRGBA4us1;
  2612. {$ENDIF}
  2613. end;
  2614. procedure TfdRGB5A1us1.SetValues;
  2615. begin
  2616. inherited SetValues;
  2617. fBitsPerPixel := 16;
  2618. fFormat := tfRGB5A1us1;
  2619. fWithAlpha := tfRGB5A1us1;
  2620. fWithoutAlpha := tfRGB5X1us1;
  2621. fOpenGLFormat := tfRGB5A1us1;
  2622. fRGBInverted := tfBGR5A1us1;
  2623. fPrecision := glBitmapRec4ub( 5, 5, 5, 1);
  2624. fShift := glBitmapRec4ub(11, 6, 1, 0);
  2625. fglFormat := GL_RGBA;
  2626. fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}GL_RGB5_A1{$ELSE}GL_RGBA{$IFEND};
  2627. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  2628. end;
  2629. procedure TfdA1RGB5us1.SetValues;
  2630. begin
  2631. inherited SetValues;
  2632. fBitsPerPixel := 16;
  2633. fFormat := tfA1RGB5us1;
  2634. fWithAlpha := tfA1RGB5us1;
  2635. fWithoutAlpha := tfX1RGB5us1;
  2636. fRGBInverted := tfA1BGR5us1;
  2637. fPrecision := glBitmapRec4ub( 5, 5, 5, 1);
  2638. fShift := glBitmapRec4ub(10, 5, 0, 15);
  2639. {$IFNDEF OPENGL_ES}
  2640. fOpenGLFormat := tfA1RGB5us1;
  2641. fglFormat := GL_BGRA;
  2642. fglInternalFormat := GL_RGB5_A1;
  2643. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2644. {$ELSE}
  2645. fOpenGLFormat := tfRGB5A1us1;
  2646. {$ENDIF}
  2647. end;
  2648. procedure TfdRGBA8ui1.SetValues;
  2649. begin
  2650. inherited SetValues;
  2651. fBitsPerPixel := 32;
  2652. fFormat := tfRGBA8ui1;
  2653. fWithAlpha := tfRGBA8ui1;
  2654. fWithoutAlpha := tfRGBX8ui1;
  2655. fRGBInverted := tfBGRA8ui1;
  2656. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  2657. fShift := glBitmapRec4ub(24, 16, 8, 0);
  2658. {$IFNDEF OPENGL_ES}
  2659. fOpenGLFormat := tfRGBA8ui1;
  2660. fglFormat := GL_RGBA;
  2661. fglInternalFormat := GL_RGBA8;
  2662. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  2663. {$ELSE}
  2664. fOpenGLFormat := tfRGBA8ub4;
  2665. {$ENDIF}
  2666. end;
  2667. procedure TfdARGB8ui1.SetValues;
  2668. begin
  2669. inherited SetValues;
  2670. fBitsPerPixel := 32;
  2671. fFormat := tfARGB8ui1;
  2672. fWithAlpha := tfARGB8ui1;
  2673. fWithoutAlpha := tfXRGB8ui1;
  2674. fRGBInverted := tfABGR8ui1;
  2675. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  2676. fShift := glBitmapRec4ub(16, 8, 0, 24);
  2677. {$IFNDEF OPENGL_ES}
  2678. fOpenGLFormat := tfARGB8ui1;
  2679. fglFormat := GL_BGRA;
  2680. fglInternalFormat := GL_RGBA8;
  2681. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  2682. {$ELSE}
  2683. fOpenGLFormat := tfRGBA8ub4;
  2684. {$ENDIF}
  2685. end;
  2686. procedure TfdRGBA8ub4.SetValues;
  2687. begin
  2688. inherited SetValues;
  2689. fBitsPerPixel := 32;
  2690. fFormat := tfRGBA8ub4;
  2691. fWithAlpha := tfRGBA8ub4;
  2692. fWithoutAlpha := tfRGB8ub3;
  2693. fOpenGLFormat := tfRGBA8ub4;
  2694. fRGBInverted := tfBGRA8ub4;
  2695. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  2696. fShift := glBitmapRec4ub( 0, 8, 16, 24);
  2697. fglFormat := GL_RGBA;
  2698. fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA8{$ELSE}GL_RGBA{$IFEND};
  2699. fglDataFormat := GL_UNSIGNED_BYTE;
  2700. end;
  2701. procedure TfdRGB10A2ui1.SetValues;
  2702. begin
  2703. inherited SetValues;
  2704. fBitsPerPixel := 32;
  2705. fFormat := tfRGB10A2ui1;
  2706. fWithAlpha := tfRGB10A2ui1;
  2707. fWithoutAlpha := tfRGB10X2ui1;
  2708. fRGBInverted := tfBGR10A2ui1;
  2709. fPrecision := glBitmapRec4ub(10, 10, 10, 2);
  2710. fShift := glBitmapRec4ub(22, 12, 2, 0);
  2711. {$IFNDEF OPENGL_ES}
  2712. fOpenGLFormat := tfRGB10A2ui1;
  2713. fglFormat := GL_RGBA;
  2714. fglInternalFormat := GL_RGB10_A2;
  2715. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  2716. {$ELSE}
  2717. fOpenGLFormat := tfA2RGB10ui1;
  2718. {$ENDIF}
  2719. end;
  2720. procedure TfdA2RGB10ui1.SetValues;
  2721. begin
  2722. inherited SetValues;
  2723. fBitsPerPixel := 32;
  2724. fFormat := tfA2RGB10ui1;
  2725. fWithAlpha := tfA2RGB10ui1;
  2726. fWithoutAlpha := tfX2RGB10ui1;
  2727. fRGBInverted := tfA2BGR10ui1;
  2728. fPrecision := glBitmapRec4ub(10, 10, 10, 2);
  2729. fShift := glBitmapRec4ub(20, 10, 0, 30);
  2730. {$IF NOT DEFINED(OPENGL_ES)}
  2731. fOpenGLFormat := tfA2RGB10ui1;
  2732. fglFormat := GL_BGRA;
  2733. fglInternalFormat := GL_RGB10_A2;
  2734. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2735. {$ELSEIF DEFINED(OPENGL_ES_3_0)}
  2736. fOpenGLFormat := tfA2RGB10ui1;
  2737. fglFormat := GL_RGBA;
  2738. fglInternalFormat := GL_RGB10_A2;
  2739. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2740. {$ELSE}
  2741. fOpenGLFormat := tfRGBA8ui1;
  2742. {$IFEND}
  2743. end;
  2744. procedure TfdRGBA16us4.SetValues;
  2745. begin
  2746. inherited SetValues;
  2747. fBitsPerPixel := 64;
  2748. fFormat := tfRGBA16us4;
  2749. fWithAlpha := tfRGBA16us4;
  2750. fWithoutAlpha := tfRGB16us3;
  2751. fRGBInverted := tfBGRA16us4;
  2752. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  2753. fShift := glBitmapRec4ub( 0, 16, 32, 48);
  2754. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  2755. fOpenGLFormat := tfRGBA16us4;
  2756. fglFormat := GL_RGBA;
  2757. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGBA16{$ELSE}GL_RGBA16UI{$ENDIF};
  2758. fglDataFormat := GL_UNSIGNED_SHORT;
  2759. {$ELSE}
  2760. fOpenGLFormat := tfRGBA8ub4;
  2761. {$IFEND}
  2762. end;
  2763. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2764. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2765. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2766. procedure TfdBGRX4us1.SetValues;
  2767. begin
  2768. inherited SetValues;
  2769. fBitsPerPixel := 16;
  2770. fFormat := tfBGRX4us1;
  2771. fWithAlpha := tfBGRA4us1;
  2772. fWithoutAlpha := tfBGRX4us1;
  2773. fRGBInverted := tfRGBX4us1;
  2774. fPrecision := glBitmapRec4ub( 4, 4, 4, 0);
  2775. fShift := glBitmapRec4ub( 4, 8, 12, 0);
  2776. {$IFNDEF OPENGL_ES}
  2777. fOpenGLFormat := tfBGRX4us1;
  2778. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2779. fglInternalFormat := GL_RGB4;
  2780. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  2781. {$ELSE}
  2782. fOpenGLFormat := tfR5G6B5us1;
  2783. {$ENDIF}
  2784. end;
  2785. procedure TfdXBGR4us1.SetValues;
  2786. begin
  2787. inherited SetValues;
  2788. fBitsPerPixel := 16;
  2789. fFormat := tfXBGR4us1;
  2790. fWithAlpha := tfABGR4us1;
  2791. fWithoutAlpha := tfXBGR4us1;
  2792. fRGBInverted := tfXRGB4us1;
  2793. fPrecision := glBitmapRec4ub( 4, 4, 4, 0);
  2794. fShift := glBitmapRec4ub( 0, 4, 8, 0);
  2795. {$IFNDEF OPENGL_ES}
  2796. fOpenGLFormat := tfXBGR4us1;
  2797. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2798. fglInternalFormat := GL_RGB4;
  2799. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2800. {$ELSE}
  2801. fOpenGLFormat := tfR5G6B5us1;
  2802. {$ENDIF}
  2803. end;
  2804. procedure TfdB5G6R5us1.SetValues;
  2805. begin
  2806. inherited SetValues;
  2807. fBitsPerPixel := 16;
  2808. fFormat := tfB5G6R5us1;
  2809. fWithAlpha := tfBGR5A1us1;
  2810. fWithoutAlpha := tfB5G6R5us1;
  2811. fRGBInverted := tfR5G6B5us1;
  2812. fPrecision := glBitmapRec4ub( 5, 6, 5, 0);
  2813. fShift := glBitmapRec4ub( 0, 5, 11, 0);
  2814. {$IFNDEF OPENGL_ES}
  2815. fOpenGLFormat := tfB5G6R5us1;
  2816. fglFormat := GL_RGB;
  2817. fglInternalFormat := GL_RGB565;
  2818. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5_REV;
  2819. {$ELSE}
  2820. fOpenGLFormat := tfR5G6B5us1;
  2821. {$ENDIF}
  2822. end;
  2823. procedure TfdBGR5X1us1.SetValues;
  2824. begin
  2825. inherited SetValues;
  2826. fBitsPerPixel := 16;
  2827. fFormat := tfBGR5X1us1;
  2828. fWithAlpha := tfBGR5A1us1;
  2829. fWithoutAlpha := tfBGR5X1us1;
  2830. fRGBInverted := tfRGB5X1us1;
  2831. fPrecision := glBitmapRec4ub( 5, 5, 5, 0);
  2832. fShift := glBitmapRec4ub( 1, 6, 11, 0);
  2833. {$IFNDEF OPENGL_ES}
  2834. fOpenGLFormat := tfBGR5X1us1;
  2835. fglFormat := GL_BGRA;
  2836. fglInternalFormat := GL_RGB5;
  2837. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  2838. {$ELSE}
  2839. fOpenGLFormat := tfR5G6B5us1;
  2840. {$ENDIF}
  2841. end;
  2842. procedure TfdX1BGR5us1.SetValues;
  2843. begin
  2844. inherited SetValues;
  2845. fBitsPerPixel := 16;
  2846. fFormat := tfX1BGR5us1;
  2847. fWithAlpha := tfA1BGR5us1;
  2848. fWithoutAlpha := tfX1BGR5us1;
  2849. fRGBInverted := tfX1RGB5us1;
  2850. fPrecision := glBitmapRec4ub( 5, 5, 5, 0);
  2851. fShift := glBitmapRec4ub( 0, 5, 10, 0);
  2852. {$IFNDEF OPENGL_ES}
  2853. fOpenGLFormat := tfX1BGR5us1;
  2854. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2855. fglInternalFormat := GL_RGB5;
  2856. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2857. {$ELSE}
  2858. fOpenGLFormat := tfR5G6B5us1;
  2859. {$ENDIF}
  2860. end;
  2861. procedure TfdBGR8ub3.SetValues;
  2862. begin
  2863. inherited SetValues;
  2864. fBitsPerPixel := 24;
  2865. fFormat := tfBGR8ub3;
  2866. fWithAlpha := tfBGRA8ub4;
  2867. fWithoutAlpha := tfBGR8ub3;
  2868. fRGBInverted := tfRGB8ub3;
  2869. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  2870. fShift := glBitmapRec4ub(16, 8, 0, 0);
  2871. {$IFNDEF OPENGL_ES}
  2872. fOpenGLFormat := tfBGR8ub3;
  2873. fglFormat := GL_BGR;
  2874. fglInternalFormat := GL_RGB8;
  2875. fglDataFormat := GL_UNSIGNED_BYTE;
  2876. {$ELSE}
  2877. fOpenGLFormat := tfRGB8ub3;
  2878. {$ENDIF}
  2879. end;
  2880. procedure TfdBGRX8ui1.SetValues;
  2881. begin
  2882. inherited SetValues;
  2883. fBitsPerPixel := 32;
  2884. fFormat := tfBGRX8ui1;
  2885. fWithAlpha := tfBGRA8ui1;
  2886. fWithoutAlpha := tfBGRX8ui1;
  2887. fRGBInverted := tfRGBX8ui1;
  2888. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  2889. fShift := glBitmapRec4ub( 8, 16, 24, 0);
  2890. {$IFNDEF OPENGL_ES}
  2891. fOpenGLFormat := tfBGRX8ui1;
  2892. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2893. fglInternalFormat := GL_RGB8;
  2894. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  2895. {$ELSE}
  2896. fOpenGLFormat := tfRGB8ub3;
  2897. {$ENDIF}
  2898. end;
  2899. procedure TfdXBGR8ui1.SetValues;
  2900. begin
  2901. inherited SetValues;
  2902. fBitsPerPixel := 32;
  2903. fFormat := tfXBGR8ui1;
  2904. fWithAlpha := tfABGR8ui1;
  2905. fWithoutAlpha := tfXBGR8ui1;
  2906. fRGBInverted := tfXRGB8ui1;
  2907. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  2908. fShift := glBitmapRec4ub( 0, 8, 16, 0);
  2909. {$IFNDEF OPENGL_ES}
  2910. fOpenGLFormat := tfXBGR8ui1;
  2911. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2912. fglInternalFormat := GL_RGB8;
  2913. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  2914. {$ELSE}
  2915. fOpenGLFormat := tfRGB8ub3;
  2916. {$ENDIF}
  2917. end;
  2918. procedure TfdBGR10X2ui1.SetValues;
  2919. begin
  2920. inherited SetValues;
  2921. fBitsPerPixel := 32;
  2922. fFormat := tfBGR10X2ui1;
  2923. fWithAlpha := tfBGR10A2ui1;
  2924. fWithoutAlpha := tfBGR10X2ui1;
  2925. fRGBInverted := tfRGB10X2ui1;
  2926. fPrecision := glBitmapRec4ub(10, 10, 10, 0);
  2927. fShift := glBitmapRec4ub( 2, 12, 22, 0);
  2928. {$IFNDEF OPENGL_ES}
  2929. fOpenGLFormat := tfBGR10X2ui1;
  2930. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2931. fglInternalFormat := GL_RGB10;
  2932. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  2933. {$ELSE}
  2934. fOpenGLFormat := tfRGB16us3;
  2935. {$ENDIF}
  2936. end;
  2937. procedure TfdX2BGR10ui1.SetValues;
  2938. begin
  2939. inherited SetValues;
  2940. fBitsPerPixel := 32;
  2941. fFormat := tfX2BGR10ui1;
  2942. fWithAlpha := tfA2BGR10ui1;
  2943. fWithoutAlpha := tfX2BGR10ui1;
  2944. fRGBInverted := tfX2RGB10ui1;
  2945. fPrecision := glBitmapRec4ub(10, 10, 10, 0);
  2946. fShift := glBitmapRec4ub( 0, 10, 20, 0);
  2947. {$IFNDEF OPENGL_ES}
  2948. fOpenGLFormat := tfX2BGR10ui1;
  2949. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2950. fglInternalFormat := GL_RGB10;
  2951. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2952. {$ELSE}
  2953. fOpenGLFormat := tfRGB16us3;
  2954. {$ENDIF}
  2955. end;
  2956. procedure TfdBGR16us3.SetValues;
  2957. begin
  2958. inherited SetValues;
  2959. fBitsPerPixel := 48;
  2960. fFormat := tfBGR16us3;
  2961. fWithAlpha := tfBGRA16us4;
  2962. fWithoutAlpha := tfBGR16us3;
  2963. fRGBInverted := tfRGB16us3;
  2964. fPrecision := glBitmapRec4ub(16, 16, 16, 0);
  2965. fShift := glBitmapRec4ub(32, 16, 0, 0);
  2966. {$IFNDEF OPENGL_ES}
  2967. fOpenGLFormat := tfBGR16us3;
  2968. fglFormat := GL_BGR;
  2969. fglInternalFormat := GL_RGB16;
  2970. fglDataFormat := GL_UNSIGNED_SHORT;
  2971. {$ELSE}
  2972. fOpenGLFormat := tfRGB16us3;
  2973. {$ENDIF}
  2974. end;
  2975. procedure TfdBGRA4us1.SetValues;
  2976. begin
  2977. inherited SetValues;
  2978. fBitsPerPixel := 16;
  2979. fFormat := tfBGRA4us1;
  2980. fWithAlpha := tfBGRA4us1;
  2981. fWithoutAlpha := tfBGRX4us1;
  2982. fRGBInverted := tfRGBA4us1;
  2983. fPrecision := glBitmapRec4ub( 4, 4, 4, 4);
  2984. fShift := glBitmapRec4ub( 4, 8, 12, 0);
  2985. {$IFNDEF OPENGL_ES}
  2986. fOpenGLFormat := tfBGRA4us1;
  2987. fglFormat := GL_BGRA;
  2988. fglInternalFormat := GL_RGBA4;
  2989. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  2990. {$ELSE}
  2991. fOpenGLFormat := tfRGBA4us1;
  2992. {$ENDIF}
  2993. end;
  2994. procedure TfdABGR4us1.SetValues;
  2995. begin
  2996. inherited SetValues;
  2997. fBitsPerPixel := 16;
  2998. fFormat := tfABGR4us1;
  2999. fWithAlpha := tfABGR4us1;
  3000. fWithoutAlpha := tfXBGR4us1;
  3001. fRGBInverted := tfARGB4us1;
  3002. fPrecision := glBitmapRec4ub( 4, 4, 4, 4);
  3003. fShift := glBitmapRec4ub( 0, 4, 8, 12);
  3004. {$IFNDEF OPENGL_ES}
  3005. fOpenGLFormat := tfABGR4us1;
  3006. fglFormat := GL_RGBA;
  3007. fglInternalFormat := GL_RGBA4;
  3008. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  3009. {$ELSE}
  3010. fOpenGLFormat := tfRGBA4us1;
  3011. {$ENDIF}
  3012. end;
  3013. procedure TfdBGR5A1us1.SetValues;
  3014. begin
  3015. inherited SetValues;
  3016. fBitsPerPixel := 16;
  3017. fFormat := tfBGR5A1us1;
  3018. fWithAlpha := tfBGR5A1us1;
  3019. fWithoutAlpha := tfBGR5X1us1;
  3020. fRGBInverted := tfRGB5A1us1;
  3021. fPrecision := glBitmapRec4ub( 5, 5, 5, 1);
  3022. fShift := glBitmapRec4ub( 1, 6, 11, 0);
  3023. {$IFNDEF OPENGL_ES}
  3024. fOpenGLFormat := tfBGR5A1us1;
  3025. fglFormat := GL_BGRA;
  3026. fglInternalFormat := GL_RGB5_A1;
  3027. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  3028. {$ELSE}
  3029. fOpenGLFormat := tfRGB5A1us1;
  3030. {$ENDIF}
  3031. end;
  3032. procedure TfdA1BGR5us1.SetValues;
  3033. begin
  3034. inherited SetValues;
  3035. fBitsPerPixel := 16;
  3036. fFormat := tfA1BGR5us1;
  3037. fWithAlpha := tfA1BGR5us1;
  3038. fWithoutAlpha := tfX1BGR5us1;
  3039. fRGBInverted := tfA1RGB5us1;
  3040. fPrecision := glBitmapRec4ub( 5, 5, 5, 1);
  3041. fShift := glBitmapRec4ub( 0, 5, 10, 15);
  3042. {$IFNDEF OPENGL_ES}
  3043. fOpenGLFormat := tfA1BGR5us1;
  3044. fglFormat := GL_RGBA;
  3045. fglInternalFormat := GL_RGB5_A1;
  3046. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  3047. {$ELSE}
  3048. fOpenGLFormat := tfRGB5A1us1;
  3049. {$ENDIF}
  3050. end;
  3051. procedure TfdBGRA8ui1.SetValues;
  3052. begin
  3053. inherited SetValues;
  3054. fBitsPerPixel := 32;
  3055. fFormat := tfBGRA8ui1;
  3056. fWithAlpha := tfBGRA8ui1;
  3057. fWithoutAlpha := tfBGRX8ui1;
  3058. fRGBInverted := tfRGBA8ui1;
  3059. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  3060. fShift := glBitmapRec4ub( 8, 16, 24, 0);
  3061. {$IFNDEF OPENGL_ES}
  3062. fOpenGLFormat := tfBGRA8ui1;
  3063. fglFormat := GL_BGRA;
  3064. fglInternalFormat := GL_RGBA8;
  3065. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  3066. {$ELSE}
  3067. fOpenGLFormat := tfRGBA8ub4;
  3068. {$ENDIF}
  3069. end;
  3070. procedure TfdABGR8ui1.SetValues;
  3071. begin
  3072. inherited SetValues;
  3073. fBitsPerPixel := 32;
  3074. fFormat := tfABGR8ui1;
  3075. fWithAlpha := tfABGR8ui1;
  3076. fWithoutAlpha := tfXBGR8ui1;
  3077. fRGBInverted := tfARGB8ui1;
  3078. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  3079. fShift := glBitmapRec4ub( 0, 8, 16, 24);
  3080. {$IFNDEF OPENGL_ES}
  3081. fOpenGLFormat := tfABGR8ui1;
  3082. fglFormat := GL_RGBA;
  3083. fglInternalFormat := GL_RGBA8;
  3084. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  3085. {$ELSE}
  3086. fOpenGLFormat := tfRGBA8ub4
  3087. {$ENDIF}
  3088. end;
  3089. procedure TfdBGRA8ub4.SetValues;
  3090. begin
  3091. inherited SetValues;
  3092. fBitsPerPixel := 32;
  3093. fFormat := tfBGRA8ub4;
  3094. fWithAlpha := tfBGRA8ub4;
  3095. fWithoutAlpha := tfBGR8ub3;
  3096. fRGBInverted := tfRGBA8ub4;
  3097. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  3098. fShift := glBitmapRec4ub(16, 8, 0, 24);
  3099. {$IFNDEF OPENGL_ES}
  3100. fOpenGLFormat := tfBGRA8ub4;
  3101. fglFormat := GL_BGRA;
  3102. fglInternalFormat := GL_RGBA8;
  3103. fglDataFormat := GL_UNSIGNED_BYTE;
  3104. {$ELSE}
  3105. fOpenGLFormat := tfRGBA8ub4;
  3106. {$ENDIF}
  3107. end;
  3108. procedure TfdBGR10A2ui1.SetValues;
  3109. begin
  3110. inherited SetValues;
  3111. fBitsPerPixel := 32;
  3112. fFormat := tfBGR10A2ui1;
  3113. fWithAlpha := tfBGR10A2ui1;
  3114. fWithoutAlpha := tfBGR10X2ui1;
  3115. fRGBInverted := tfRGB10A2ui1;
  3116. fPrecision := glBitmapRec4ub(10, 10, 10, 2);
  3117. fShift := glBitmapRec4ub( 2, 12, 22, 0);
  3118. {$IFNDEF OPENGL_ES}
  3119. fOpenGLFormat := tfBGR10A2ui1;
  3120. fglFormat := GL_BGRA;
  3121. fglInternalFormat := GL_RGB10_A2;
  3122. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  3123. {$ELSE}
  3124. fOpenGLFormat := tfA2RGB10ui1;
  3125. {$ENDIF}
  3126. end;
  3127. procedure TfdA2BGR10ui1.SetValues;
  3128. begin
  3129. inherited SetValues;
  3130. fBitsPerPixel := 32;
  3131. fFormat := tfA2BGR10ui1;
  3132. fWithAlpha := tfA2BGR10ui1;
  3133. fWithoutAlpha := tfX2BGR10ui1;
  3134. fRGBInverted := tfA2RGB10ui1;
  3135. fPrecision := glBitmapRec4ub(10, 10, 10, 2);
  3136. fShift := glBitmapRec4ub( 0, 10, 20, 30);
  3137. {$IFNDEF OPENGL_ES}
  3138. fOpenGLFormat := tfA2BGR10ui1;
  3139. fglFormat := GL_RGBA;
  3140. fglInternalFormat := GL_RGB10_A2;
  3141. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3142. {$ELSE}
  3143. fOpenGLFormat := tfA2RGB10ui1;
  3144. {$ENDIF}
  3145. end;
  3146. procedure TfdBGRA16us4.SetValues;
  3147. begin
  3148. inherited SetValues;
  3149. fBitsPerPixel := 64;
  3150. fFormat := tfBGRA16us4;
  3151. fWithAlpha := tfBGRA16us4;
  3152. fWithoutAlpha := tfBGR16us3;
  3153. fRGBInverted := tfRGBA16us4;
  3154. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  3155. fShift := glBitmapRec4ub(32, 16, 0, 48);
  3156. {$IFNDEF OPENGL_ES}
  3157. fOpenGLFormat := tfBGRA16us4;
  3158. fglFormat := GL_BGRA;
  3159. fglInternalFormat := GL_RGBA16;
  3160. fglDataFormat := GL_UNSIGNED_SHORT;
  3161. {$ELSE}
  3162. fOpenGLFormat := tfRGBA16us4;
  3163. {$ENDIF}
  3164. end;
  3165. procedure TfdDepth16us1.SetValues;
  3166. begin
  3167. inherited SetValues;
  3168. fBitsPerPixel := 16;
  3169. fFormat := tfDepth16us1;
  3170. fWithoutAlpha := tfDepth16us1;
  3171. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  3172. fShift := glBitmapRec4ub( 0, 0, 0, 0);
  3173. {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  3174. fOpenGLFormat := tfDepth16us1;
  3175. fglFormat := GL_DEPTH_COMPONENT;
  3176. fglInternalFormat := GL_DEPTH_COMPONENT16;
  3177. fglDataFormat := GL_UNSIGNED_SHORT;
  3178. {$IFEND}
  3179. end;
  3180. procedure TfdDepth24ui1.SetValues;
  3181. begin
  3182. inherited SetValues;
  3183. fBitsPerPixel := 32;
  3184. fFormat := tfDepth24ui1;
  3185. fWithoutAlpha := tfDepth24ui1;
  3186. fOpenGLFormat := tfDepth24ui1;
  3187. fPrecision := glBitmapRec4ub(32, 32, 32, 32);
  3188. fShift := glBitmapRec4ub( 0, 0, 0, 0);
  3189. {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  3190. fOpenGLFormat := tfDepth24ui1;
  3191. fglFormat := GL_DEPTH_COMPONENT;
  3192. fglInternalFormat := GL_DEPTH_COMPONENT24;
  3193. fglDataFormat := GL_UNSIGNED_INT;
  3194. {$IFEND}
  3195. end;
  3196. procedure TfdDepth32ui1.SetValues;
  3197. begin
  3198. inherited SetValues;
  3199. fBitsPerPixel := 32;
  3200. fFormat := tfDepth32ui1;
  3201. fWithoutAlpha := tfDepth32ui1;
  3202. fPrecision := glBitmapRec4ub(32, 32, 32, 32);
  3203. fShift := glBitmapRec4ub( 0, 0, 0, 0);
  3204. {$IF NOT DEFINED(OPENGL_ES)}
  3205. fOpenGLFormat := tfDepth32ui1;
  3206. fglFormat := GL_DEPTH_COMPONENT;
  3207. fglInternalFormat := GL_DEPTH_COMPONENT32;
  3208. fglDataFormat := GL_UNSIGNED_INT;
  3209. {$ELSEIF DEFINED(OPENGL_ES_3_0)}
  3210. fOpenGLFormat := tfDepth24ui1;
  3211. {$ELSEIF DEFINED(OPENGL_ES_2_0)}
  3212. fOpenGLFormat := tfDepth16us1;
  3213. {$IFEND}
  3214. end;
  3215. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3216. //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3217. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3218. procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3219. begin
  3220. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3221. end;
  3222. procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3223. begin
  3224. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3225. end;
  3226. procedure TfdS3tcDtx1RGBA.SetValues;
  3227. begin
  3228. inherited SetValues;
  3229. fFormat := tfS3tcDtx1RGBA;
  3230. fWithAlpha := tfS3tcDtx1RGBA;
  3231. fUncompressed := tfRGB5A1us1;
  3232. fBitsPerPixel := 4;
  3233. fIsCompressed := true;
  3234. {$IFNDEF OPENGL_ES}
  3235. fOpenGLFormat := tfS3tcDtx1RGBA;
  3236. fglFormat := GL_COMPRESSED_RGBA;
  3237. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
  3238. fglDataFormat := GL_UNSIGNED_BYTE;
  3239. {$ELSE}
  3240. fOpenGLFormat := fUncompressed;
  3241. {$ENDIF}
  3242. end;
  3243. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3244. //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3245. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3246. procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3247. begin
  3248. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3249. end;
  3250. procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3251. begin
  3252. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3253. end;
  3254. procedure TfdS3tcDtx3RGBA.SetValues;
  3255. begin
  3256. inherited SetValues;
  3257. fFormat := tfS3tcDtx3RGBA;
  3258. fWithAlpha := tfS3tcDtx3RGBA;
  3259. fUncompressed := tfRGBA8ub4;
  3260. fBitsPerPixel := 8;
  3261. fIsCompressed := true;
  3262. {$IFNDEF OPENGL_ES}
  3263. fOpenGLFormat := tfS3tcDtx3RGBA;
  3264. fglFormat := GL_COMPRESSED_RGBA;
  3265. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
  3266. fglDataFormat := GL_UNSIGNED_BYTE;
  3267. {$ELSE}
  3268. fOpenGLFormat := fUncompressed;
  3269. {$ENDIF}
  3270. end;
  3271. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3272. //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3273. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3274. procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3275. begin
  3276. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3277. end;
  3278. procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3279. begin
  3280. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3281. end;
  3282. procedure TfdS3tcDtx5RGBA.SetValues;
  3283. begin
  3284. inherited SetValues;
  3285. fFormat := tfS3tcDtx3RGBA;
  3286. fWithAlpha := tfS3tcDtx3RGBA;
  3287. fUncompressed := tfRGBA8ub4;
  3288. fBitsPerPixel := 8;
  3289. fIsCompressed := true;
  3290. {$IFNDEF OPENGL_ES}
  3291. fOpenGLFormat := tfS3tcDtx3RGBA;
  3292. fglFormat := GL_COMPRESSED_RGBA;
  3293. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
  3294. fglDataFormat := GL_UNSIGNED_BYTE;
  3295. {$ELSE}
  3296. fOpenGLFormat := fUncompressed;
  3297. {$ENDIF}
  3298. end;
  3299. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3300. //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3301. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3302. function TglBitmapFormatDescriptor.GetHasRed: Boolean;
  3303. begin
  3304. result := (fPrecision.r > 0);
  3305. end;
  3306. function TglBitmapFormatDescriptor.GetHasGreen: Boolean;
  3307. begin
  3308. result := (fPrecision.g > 0);
  3309. end;
  3310. function TglBitmapFormatDescriptor.GetHasBlue: Boolean;
  3311. begin
  3312. result := (fPrecision.b > 0);
  3313. end;
  3314. function TglBitmapFormatDescriptor.GetHasAlpha: Boolean;
  3315. begin
  3316. result := (fPrecision.a > 0);
  3317. end;
  3318. function TglBitmapFormatDescriptor.GetHasColor: Boolean;
  3319. begin
  3320. result := HasRed or HasGreen or HasBlue;
  3321. end;
  3322. function TglBitmapFormatDescriptor.GetIsGrayscale: Boolean;
  3323. begin
  3324. result := (Mask.r = Mask.g) and (Mask.g = Mask.b) and (Mask.r > 0);
  3325. end;
  3326. procedure TglBitmapFormatDescriptor.SetValues;
  3327. begin
  3328. fFormat := tfEmpty;
  3329. fWithAlpha := tfEmpty;
  3330. fWithoutAlpha := tfEmpty;
  3331. fOpenGLFormat := tfEmpty;
  3332. fRGBInverted := tfEmpty;
  3333. fUncompressed := tfEmpty;
  3334. fBitsPerPixel := 0;
  3335. fIsCompressed := false;
  3336. fglFormat := 0;
  3337. fglInternalFormat := 0;
  3338. fglDataFormat := 0;
  3339. FillChar(fPrecision, 0, SizeOf(fPrecision));
  3340. FillChar(fShift, 0, SizeOf(fShift));
  3341. end;
  3342. procedure TglBitmapFormatDescriptor.CalcValues;
  3343. var
  3344. i: Integer;
  3345. begin
  3346. fBytesPerPixel := fBitsPerPixel / 8;
  3347. fChannelCount := 0;
  3348. for i := 0 to 3 do begin
  3349. if (fPrecision.arr[i] > 0) then
  3350. inc(fChannelCount);
  3351. fRange.arr[i] := (1 shl fPrecision.arr[i]) - 1;
  3352. fMask.arr[i] := fRange.arr[i] shl fShift.arr[i];
  3353. end;
  3354. end;
  3355. function TglBitmapFormatDescriptor.GetSize(const aSize: TglBitmapSize): Integer;
  3356. var
  3357. w, h: Integer;
  3358. begin
  3359. if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
  3360. w := Max(1, aSize.X);
  3361. h := Max(1, aSize.Y);
  3362. result := GetSize(w, h);
  3363. end else
  3364. result := 0;
  3365. end;
  3366. function TglBitmapFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
  3367. begin
  3368. result := 0;
  3369. if (aWidth <= 0) or (aHeight <= 0) then
  3370. exit;
  3371. result := Ceil(aWidth * aHeight * BytesPerPixel);
  3372. end;
  3373. constructor TglBitmapFormatDescriptor.Create;
  3374. begin
  3375. inherited Create;
  3376. SetValues;
  3377. CalcValues;
  3378. end;
  3379. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3380. class function TglBitmapFormatDescriptor.GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
  3381. var
  3382. f: TglBitmapFormat;
  3383. begin
  3384. for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
  3385. result := TFormatDescriptor.Get(f);
  3386. if (result.glInternalFormat = aInternalFormat) then
  3387. exit;
  3388. end;
  3389. result := TFormatDescriptor.Get(tfEmpty);
  3390. end;
  3391. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3392. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3393. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3394. class procedure TFormatDescriptor.Init;
  3395. begin
  3396. if not Assigned(FormatDescriptorCS) then
  3397. FormatDescriptorCS := TCriticalSection.Create;
  3398. end;
  3399. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3400. class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3401. begin
  3402. FormatDescriptorCS.Enter;
  3403. try
  3404. result := FormatDescriptors[aFormat];
  3405. if not Assigned(result) then begin
  3406. result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
  3407. FormatDescriptors[aFormat] := result;
  3408. end;
  3409. finally
  3410. FormatDescriptorCS.Leave;
  3411. end;
  3412. end;
  3413. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3414. class function TFormatDescriptor.GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3415. begin
  3416. result := Get(Get(aFormat).WithAlpha);
  3417. end;
  3418. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3419. class function TFormatDescriptor.GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer): TFormatDescriptor;
  3420. var
  3421. ft: TglBitmapFormat;
  3422. begin
  3423. // find matching format with OpenGL support
  3424. for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  3425. result := Get(ft);
  3426. if (result.MaskMatch(aMask)) and
  3427. (result.glFormat <> 0) and
  3428. (result.glInternalFormat <> 0) and
  3429. ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
  3430. then
  3431. exit;
  3432. end;
  3433. // find matching format without OpenGL Support
  3434. for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  3435. result := Get(ft);
  3436. if result.MaskMatch(aMask) and ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
  3437. exit;
  3438. end;
  3439. result := TFormatDescriptor.Get(tfEmpty);
  3440. end;
  3441. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3442. class function TFormatDescriptor.GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
  3443. var
  3444. ft: TglBitmapFormat;
  3445. begin
  3446. // find matching format with OpenGL support
  3447. for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  3448. result := Get(ft);
  3449. if glBitmapRec4ubCompare(result.Shift, aShift) and
  3450. glBitmapRec4ubCompare(result.Precision, aPrec) and
  3451. (result.glFormat <> 0) and
  3452. (result.glInternalFormat <> 0) and
  3453. ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
  3454. then
  3455. exit;
  3456. end;
  3457. // find matching format without OpenGL Support
  3458. for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  3459. result := Get(ft);
  3460. if glBitmapRec4ubCompare(result.Shift, aShift) and
  3461. glBitmapRec4ubCompare(result.Precision, aPrec) and
  3462. ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
  3463. exit;
  3464. end;
  3465. result := TFormatDescriptor.Get(tfEmpty);
  3466. end;
  3467. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3468. class procedure TFormatDescriptor.Clear;
  3469. var
  3470. f: TglBitmapFormat;
  3471. begin
  3472. FormatDescriptorCS.Enter;
  3473. try
  3474. for f := low(FormatDescriptors) to high(FormatDescriptors) do
  3475. FreeAndNil(FormatDescriptors[f]);
  3476. finally
  3477. FormatDescriptorCS.Leave;
  3478. end;
  3479. end;
  3480. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3481. class procedure TFormatDescriptor.Finalize;
  3482. begin
  3483. Clear;
  3484. FreeAndNil(FormatDescriptorCS);
  3485. end;
  3486. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3487. //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3488. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3489. procedure TbmpBitfieldFormat.SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul);
  3490. var
  3491. i: Integer;
  3492. begin
  3493. for i := 0 to 3 do begin
  3494. fShift.arr[i] := 0;
  3495. while (aMask.arr[i] > 0) and ((aMask.arr[i] and 1) = 0) do begin
  3496. aMask.arr[i] := aMask.arr[i] shr 1;
  3497. inc(fShift.arr[i]);
  3498. end;
  3499. fPrecision.arr[i] := CountSetBits(aMask.arr[i]);
  3500. end;
  3501. fBitsPerPixel := aBPP;
  3502. CalcValues;
  3503. end;
  3504. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3505. procedure TbmpBitfieldFormat.SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub);
  3506. begin
  3507. fBitsPerPixel := aBBP;
  3508. fPrecision := aPrec;
  3509. fShift := aShift;
  3510. CalcValues;
  3511. end;
  3512. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3513. procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3514. var
  3515. data: QWord;
  3516. begin
  3517. data :=
  3518. ((aPixel.Data.r and Range.r) shl Shift.r) or
  3519. ((aPixel.Data.g and Range.g) shl Shift.g) or
  3520. ((aPixel.Data.b and Range.b) shl Shift.b) or
  3521. ((aPixel.Data.a and Range.a) shl Shift.a);
  3522. case BitsPerPixel of
  3523. 8: aData^ := data;
  3524. 16: PWord(aData)^ := data;
  3525. 32: PCardinal(aData)^ := data;
  3526. 64: PQWord(aData)^ := data;
  3527. else
  3528. raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
  3529. end;
  3530. inc(aData, Round(BytesPerPixel));
  3531. end;
  3532. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3533. procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3534. var
  3535. data: QWord;
  3536. i: Integer;
  3537. begin
  3538. case BitsPerPixel of
  3539. 8: data := aData^;
  3540. 16: data := PWord(aData)^;
  3541. 32: data := PCardinal(aData)^;
  3542. 64: data := PQWord(aData)^;
  3543. else
  3544. raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
  3545. end;
  3546. for i := 0 to 3 do
  3547. aPixel.Data.arr[i] := (data shr fShift.arr[i]) and Range.arr[i];
  3548. inc(aData, Round(BytesPerPixel));
  3549. end;
  3550. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3551. //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3552. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3553. procedure TbmpColorTableFormat.SetValues;
  3554. begin
  3555. inherited SetValues;
  3556. fShift := glBitmapRec4ub(8, 8, 8, 0);
  3557. end;
  3558. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3559. procedure TbmpColorTableFormat.SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub);
  3560. begin
  3561. fFormat := aFormat;
  3562. fBitsPerPixel := aBPP;
  3563. fPrecision := aPrec;
  3564. fShift := aShift;
  3565. CalcValues;
  3566. end;
  3567. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3568. procedure TbmpColorTableFormat.CalcValues;
  3569. begin
  3570. inherited CalcValues;
  3571. end;
  3572. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3573. procedure TbmpColorTableFormat.CreateColorTable;
  3574. var
  3575. i: Integer;
  3576. begin
  3577. SetLength(fColorTable, 256);
  3578. if not HasColor then begin
  3579. // alpha
  3580. for i := 0 to High(fColorTable) do begin
  3581. fColorTable[i].r := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
  3582. fColorTable[i].g := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
  3583. fColorTable[i].b := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
  3584. fColorTable[i].a := 0;
  3585. end;
  3586. end else begin
  3587. // normal
  3588. for i := 0 to High(fColorTable) do begin
  3589. fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
  3590. fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
  3591. fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
  3592. fColorTable[i].a := 0;
  3593. end;
  3594. end;
  3595. end;
  3596. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3597. function TbmpColorTableFormat.CreateMappingData: Pointer;
  3598. begin
  3599. result := Pointer(0);
  3600. end;
  3601. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3602. procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3603. begin
  3604. if (BitsPerPixel <> 8) then
  3605. raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
  3606. if not HasColor then
  3607. // alpha
  3608. aData^ := aPixel.Data.a
  3609. else
  3610. // normal
  3611. aData^ := Round(
  3612. ((aPixel.Data.r shr Shift.r) and Range.r) * LUMINANCE_WEIGHT_R +
  3613. ((aPixel.Data.g shr Shift.g) and Range.g) * LUMINANCE_WEIGHT_G +
  3614. ((aPixel.Data.b shr Shift.b) and Range.b) * LUMINANCE_WEIGHT_B);
  3615. inc(aData);
  3616. end;
  3617. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3618. procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3619. function ReadValue: Byte;
  3620. var
  3621. i: PtrUInt;
  3622. begin
  3623. if (BitsPerPixel = 8) then begin
  3624. result := aData^;
  3625. inc(aData);
  3626. end else begin
  3627. i := {%H-}PtrUInt(aMapData);
  3628. if (BitsPerPixel > 1) then
  3629. result := (aData^ shr i) and ((1 shl BitsPerPixel) - 1)
  3630. else
  3631. result := (aData^ shr (7-i)) and ((1 shl BitsPerPixel) - 1);
  3632. inc(i, BitsPerPixel);
  3633. while (i >= 8) do begin
  3634. inc(aData);
  3635. dec(i, 8);
  3636. end;
  3637. aMapData := {%H-}Pointer(i);
  3638. end;
  3639. end;
  3640. begin
  3641. if (BitsPerPixel > 8) then
  3642. raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
  3643. with fColorTable[ReadValue] do begin
  3644. aPixel.Data.r := r;
  3645. aPixel.Data.g := g;
  3646. aPixel.Data.b := b;
  3647. aPixel.Data.a := a;
  3648. end;
  3649. end;
  3650. destructor TbmpColorTableFormat.Destroy;
  3651. begin
  3652. SetLength(fColorTable, 0);
  3653. inherited Destroy;
  3654. end;
  3655. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3656. //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3657. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3658. procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
  3659. var
  3660. i: Integer;
  3661. begin
  3662. for i := 0 to 3 do begin
  3663. if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
  3664. if (aSourceFD.Range.arr[i] > 0) then
  3665. aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
  3666. else
  3667. aPixel.Data.arr[i] := 0;
  3668. end;
  3669. end;
  3670. end;
  3671. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3672. procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
  3673. begin
  3674. with aFuncRec do begin
  3675. if (Source.Range.r > 0) then
  3676. Dest.Data.r := Source.Data.r;
  3677. if (Source.Range.g > 0) then
  3678. Dest.Data.g := Source.Data.g;
  3679. if (Source.Range.b > 0) then
  3680. Dest.Data.b := Source.Data.b;
  3681. if (Source.Range.a > 0) then
  3682. Dest.Data.a := Source.Data.a;
  3683. end;
  3684. end;
  3685. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3686. procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3687. var
  3688. i: Integer;
  3689. begin
  3690. with aFuncRec do begin
  3691. for i := 0 to 3 do
  3692. if (Source.Range.arr[i] > 0) then
  3693. Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
  3694. end;
  3695. end;
  3696. type
  3697. TShiftData = packed record
  3698. case Integer of
  3699. 0: (r, g, b, a: SmallInt);
  3700. 1: (arr: array[0..3] of SmallInt);
  3701. end;
  3702. PShiftData = ^TShiftData;
  3703. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3704. procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3705. var
  3706. i: Integer;
  3707. begin
  3708. with aFuncRec do
  3709. for i := 0 to 3 do
  3710. if (Source.Range.arr[i] > 0) then
  3711. Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
  3712. end;
  3713. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3714. procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
  3715. var
  3716. i: Integer;
  3717. begin
  3718. with aFuncRec do begin
  3719. Dest.Data := Source.Data;
  3720. for i := 0 to 3 do
  3721. if ({%H-}PtrUInt(Args) and (1 shl i) > 0) then
  3722. Dest.Data.arr[i] := Dest.Data.arr[i] xor Dest.Range.arr[i];
  3723. end;
  3724. end;
  3725. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3726. procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
  3727. var
  3728. i: Integer;
  3729. begin
  3730. with aFuncRec do begin
  3731. for i := 0 to 3 do
  3732. Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
  3733. end;
  3734. end;
  3735. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3736. procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3737. var
  3738. Temp: Single;
  3739. begin
  3740. with FuncRec do begin
  3741. if (FuncRec.Args = nil) then begin //source has no alpha
  3742. Temp :=
  3743. Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
  3744. Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
  3745. Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
  3746. Dest.Data.a := Round(Dest.Range.a * Temp);
  3747. end else
  3748. Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
  3749. end;
  3750. end;
  3751. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3752. procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3753. type
  3754. PglBitmapPixelData = ^TglBitmapPixelData;
  3755. begin
  3756. with FuncRec do begin
  3757. Dest.Data.r := Source.Data.r;
  3758. Dest.Data.g := Source.Data.g;
  3759. Dest.Data.b := Source.Data.b;
  3760. with PglBitmapPixelData(Args)^ do
  3761. if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
  3762. (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
  3763. (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
  3764. Dest.Data.a := 0
  3765. else
  3766. Dest.Data.a := Dest.Range.a;
  3767. end;
  3768. end;
  3769. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3770. procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3771. begin
  3772. with FuncRec do begin
  3773. Dest.Data.r := Source.Data.r;
  3774. Dest.Data.g := Source.Data.g;
  3775. Dest.Data.b := Source.Data.b;
  3776. Dest.Data.a := PCardinal(Args)^;
  3777. end;
  3778. end;
  3779. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3780. procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
  3781. type
  3782. PRGBPix = ^TRGBPix;
  3783. TRGBPix = array [0..2] of byte;
  3784. var
  3785. Temp: Byte;
  3786. begin
  3787. while aWidth > 0 do begin
  3788. Temp := PRGBPix(aData)^[0];
  3789. PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
  3790. PRGBPix(aData)^[2] := Temp;
  3791. if aHasAlpha then
  3792. Inc(aData, 4)
  3793. else
  3794. Inc(aData, 3);
  3795. dec(aWidth);
  3796. end;
  3797. end;
  3798. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3799. //TglBitmapData///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3800. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3801. function TglBitmapData.GetFormatDescriptor: TglBitmapFormatDescriptor;
  3802. begin
  3803. result := TFormatDescriptor.Get(fFormat);
  3804. end;
  3805. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3806. function TglBitmapData.GetWidth: Integer;
  3807. begin
  3808. if (ffX in fDimension.Fields) then
  3809. result := fDimension.X
  3810. else
  3811. result := -1;
  3812. end;
  3813. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3814. function TglBitmapData.GetHeight: Integer;
  3815. begin
  3816. if (ffY in fDimension.Fields) then
  3817. result := fDimension.Y
  3818. else
  3819. result := -1;
  3820. end;
  3821. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3822. function TglBitmapData.GetScanlines(const aIndex: Integer): PByte;
  3823. begin
  3824. if fHasScanlines and (aIndex >= Low(fScanlines)) and (aIndex <= High(fScanlines)) then
  3825. result := fScanlines[aIndex]
  3826. else
  3827. result := nil;
  3828. end;
  3829. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3830. procedure TglBitmapData.SetFormat(const aValue: TglBitmapFormat);
  3831. begin
  3832. if fFormat = aValue then
  3833. exit;
  3834. if TFormatDescriptor.Get(Format).BitsPerPixel <> TFormatDescriptor.Get(aValue).BitsPerPixel then
  3835. raise EglBitmapUnsupportedFormat.Create(Format);
  3836. SetData(fData, aValue, Width, Height);
  3837. end;
  3838. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3839. procedure TglBitmapData.PrepareResType(var aResource: String; var aResType: PChar);
  3840. var
  3841. TempPos: Integer;
  3842. begin
  3843. if not Assigned(aResType) then begin
  3844. TempPos := Pos('.', aResource);
  3845. aResType := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
  3846. aResource := UpperCase(Copy(aResource, 0, TempPos -1));
  3847. end;
  3848. end;
  3849. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3850. procedure TglBitmapData.UpdateScanlines;
  3851. var
  3852. w, h, i, LineWidth: Integer;
  3853. begin
  3854. w := Width;
  3855. h := Height;
  3856. fHasScanlines := Assigned(fData) and (w > 0) and (h > 0);
  3857. if fHasScanlines then begin
  3858. SetLength(fScanlines, h);
  3859. LineWidth := Trunc(w * FormatDescriptor.BytesPerPixel);
  3860. for i := 0 to h-1 do begin
  3861. fScanlines[i] := fData;
  3862. Inc(fScanlines[i], i * LineWidth);
  3863. end;
  3864. end else
  3865. SetLength(fScanlines, 0);
  3866. end;
  3867. {$IFDEF GLB_SUPPORT_PNG_READ}
  3868. {$IF DEFINED(GLB_LAZ_PNG)}
  3869. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3870. //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3871. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3872. function TglBitmapData.LoadPNG(const aStream: TStream): Boolean;
  3873. const
  3874. MAGIC_LEN = 8;
  3875. PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
  3876. var
  3877. reader: TLazReaderPNG;
  3878. intf: TLazIntfImage;
  3879. StreamPos: Int64;
  3880. magic: String[MAGIC_LEN];
  3881. begin
  3882. result := true;
  3883. StreamPos := aStream.Position;
  3884. SetLength(magic, MAGIC_LEN);
  3885. aStream.Read(magic[1], MAGIC_LEN);
  3886. aStream.Position := StreamPos;
  3887. if (magic <> PNG_MAGIC) then begin
  3888. result := false;
  3889. exit;
  3890. end;
  3891. intf := TLazIntfImage.Create(0, 0);
  3892. reader := TLazReaderPNG.Create;
  3893. try try
  3894. reader.UpdateDescription := true;
  3895. reader.ImageRead(aStream, intf);
  3896. AssignFromLazIntfImage(intf);
  3897. except
  3898. result := false;
  3899. aStream.Position := StreamPos;
  3900. exit;
  3901. end;
  3902. finally
  3903. reader.Free;
  3904. intf.Free;
  3905. end;
  3906. end;
  3907. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
  3908. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3909. function TglBitmapData.LoadPNG(const aStream: TStream): Boolean;
  3910. var
  3911. Surface: PSDL_Surface;
  3912. RWops: PSDL_RWops;
  3913. begin
  3914. result := false;
  3915. RWops := glBitmapCreateRWops(aStream);
  3916. try
  3917. if IMG_isPNG(RWops) > 0 then begin
  3918. Surface := IMG_LoadPNG_RW(RWops);
  3919. try
  3920. AssignFromSurface(Surface);
  3921. result := true;
  3922. finally
  3923. SDL_FreeSurface(Surface);
  3924. end;
  3925. end;
  3926. finally
  3927. SDL_FreeRW(RWops);
  3928. end;
  3929. end;
  3930. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  3931. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3932. procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  3933. begin
  3934. TStream(png_get_io_ptr(png)).Read(buffer^, size);
  3935. end;
  3936. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3937. function TglBitmapData.LoadPNG(const aStream: TStream): Boolean;
  3938. var
  3939. StreamPos: Int64;
  3940. signature: array [0..7] of byte;
  3941. png: png_structp;
  3942. png_info: png_infop;
  3943. TempHeight, TempWidth: Integer;
  3944. Format: TglBitmapFormat;
  3945. png_data: pByte;
  3946. png_rows: array of pByte;
  3947. Row, LineSize: Integer;
  3948. begin
  3949. result := false;
  3950. if not init_libPNG then
  3951. raise Exception.Create('LoadPNG - unable to initialize libPNG.');
  3952. try
  3953. // signature
  3954. StreamPos := aStream.Position;
  3955. aStream.Read(signature{%H-}, 8);
  3956. aStream.Position := StreamPos;
  3957. if png_check_sig(@signature, 8) <> 0 then begin
  3958. // png read struct
  3959. png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  3960. if png = nil then
  3961. raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
  3962. // png info
  3963. png_info := png_create_info_struct(png);
  3964. if png_info = nil then begin
  3965. png_destroy_read_struct(@png, nil, nil);
  3966. raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
  3967. end;
  3968. // set read callback
  3969. png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
  3970. // read informations
  3971. png_read_info(png, png_info);
  3972. // size
  3973. TempHeight := png_get_image_height(png, png_info);
  3974. TempWidth := png_get_image_width(png, png_info);
  3975. // format
  3976. case png_get_color_type(png, png_info) of
  3977. PNG_COLOR_TYPE_GRAY:
  3978. Format := tfLuminance8ub1;
  3979. PNG_COLOR_TYPE_GRAY_ALPHA:
  3980. Format := tfLuminance8Alpha8us1;
  3981. PNG_COLOR_TYPE_RGB:
  3982. Format := tfRGB8ub3;
  3983. PNG_COLOR_TYPE_RGB_ALPHA:
  3984. Format := tfRGBA8ub4;
  3985. else
  3986. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  3987. end;
  3988. // cut upper 8 bit from 16 bit formats
  3989. if png_get_bit_depth(png, png_info) > 8 then
  3990. png_set_strip_16(png);
  3991. // expand bitdepth smaller than 8
  3992. if png_get_bit_depth(png, png_info) < 8 then
  3993. png_set_expand(png);
  3994. // allocating mem for scanlines
  3995. LineSize := png_get_rowbytes(png, png_info);
  3996. GetMem(png_data, TempHeight * LineSize);
  3997. try
  3998. SetLength(png_rows, TempHeight);
  3999. for Row := Low(png_rows) to High(png_rows) do begin
  4000. png_rows[Row] := png_data;
  4001. Inc(png_rows[Row], Row * LineSize);
  4002. end;
  4003. // read complete image into scanlines
  4004. png_read_image(png, @png_rows[0]);
  4005. // read end
  4006. png_read_end(png, png_info);
  4007. // destroy read struct
  4008. png_destroy_read_struct(@png, @png_info, nil);
  4009. SetLength(png_rows, 0);
  4010. // set new data
  4011. SetData(png_data, Format, TempWidth, TempHeight);
  4012. result := true;
  4013. except
  4014. if Assigned(png_data) then
  4015. FreeMem(png_data);
  4016. raise;
  4017. end;
  4018. end;
  4019. finally
  4020. quit_libPNG;
  4021. end;
  4022. end;
  4023. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  4024. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4025. function TglBitmapData.LoadPNG(const aStream: TStream): Boolean;
  4026. var
  4027. StreamPos: Int64;
  4028. Png: TPNGObject;
  4029. Header: String[8];
  4030. Row, Col, PixSize, LineSize: Integer;
  4031. NewImage, pSource, pDest, pAlpha: pByte;
  4032. PngFormat: TglBitmapFormat;
  4033. FormatDesc: TFormatDescriptor;
  4034. const
  4035. PngHeader: String[8] = #137#80#78#71#13#10#26#10;
  4036. begin
  4037. result := false;
  4038. StreamPos := aStream.Position;
  4039. aStream.Read(Header[0], SizeOf(Header));
  4040. aStream.Position := StreamPos;
  4041. {Test if the header matches}
  4042. if Header = PngHeader then begin
  4043. Png := TPNGObject.Create;
  4044. try
  4045. Png.LoadFromStream(aStream);
  4046. case Png.Header.ColorType of
  4047. COLOR_GRAYSCALE:
  4048. PngFormat := tfLuminance8ub1;
  4049. COLOR_GRAYSCALEALPHA:
  4050. PngFormat := tfLuminance8Alpha8us1;
  4051. COLOR_RGB:
  4052. PngFormat := tfBGR8ub3;
  4053. COLOR_RGBALPHA:
  4054. PngFormat := tfBGRA8ub4;
  4055. else
  4056. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  4057. end;
  4058. FormatDesc := TFormatDescriptor.Get(PngFormat);
  4059. PixSize := Round(FormatDesc.PixelSize);
  4060. LineSize := FormatDesc.GetSize(Png.Header.Width, 1);
  4061. GetMem(NewImage, LineSize * Integer(Png.Header.Height));
  4062. try
  4063. pDest := NewImage;
  4064. case Png.Header.ColorType of
  4065. COLOR_RGB, COLOR_GRAYSCALE:
  4066. begin
  4067. for Row := 0 to Png.Height -1 do begin
  4068. Move (Png.Scanline[Row]^, pDest^, LineSize);
  4069. Inc(pDest, LineSize);
  4070. end;
  4071. end;
  4072. COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
  4073. begin
  4074. PixSize := PixSize -1;
  4075. for Row := 0 to Png.Height -1 do begin
  4076. pSource := Png.Scanline[Row];
  4077. pAlpha := pByte(Png.AlphaScanline[Row]);
  4078. for Col := 0 to Png.Width -1 do begin
  4079. Move (pSource^, pDest^, PixSize);
  4080. Inc(pSource, PixSize);
  4081. Inc(pDest, PixSize);
  4082. pDest^ := pAlpha^;
  4083. inc(pAlpha);
  4084. Inc(pDest);
  4085. end;
  4086. end;
  4087. end;
  4088. else
  4089. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  4090. end;
  4091. SetData(NewImage, PngFormat, Png.Header.Width, Png.Header.Height);
  4092. result := true;
  4093. except
  4094. if Assigned(NewImage) then
  4095. FreeMem(NewImage);
  4096. raise;
  4097. end;
  4098. finally
  4099. Png.Free;
  4100. end;
  4101. end;
  4102. end;
  4103. {$IFEND}
  4104. {$ENDIF}
  4105. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  4106. {$IFDEF GLB_LIB_PNG}
  4107. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4108. procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  4109. begin
  4110. TStream(png_get_io_ptr(png)).Write(buffer^, size);
  4111. end;
  4112. {$ENDIF}
  4113. {$IF DEFINED(GLB_LAZ_PNG)}
  4114. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4115. procedure TglBitmapData.SavePNG(const aStream: TStream);
  4116. var
  4117. png: TPortableNetworkGraphic;
  4118. intf: TLazIntfImage;
  4119. raw: TRawImage;
  4120. begin
  4121. png := TPortableNetworkGraphic.Create;
  4122. intf := TLazIntfImage.Create(0, 0);
  4123. try
  4124. if not AssignToLazIntfImage(intf) then
  4125. raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
  4126. intf.GetRawImage(raw);
  4127. png.LoadFromRawImage(raw, false);
  4128. png.SaveToStream(aStream);
  4129. finally
  4130. png.Free;
  4131. intf.Free;
  4132. end;
  4133. end;
  4134. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  4135. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4136. procedure TglBitmapData.SavePNG(const aStream: TStream);
  4137. var
  4138. png: png_structp;
  4139. png_info: png_infop;
  4140. png_rows: array of pByte;
  4141. LineSize: Integer;
  4142. ColorType: Integer;
  4143. Row: Integer;
  4144. FormatDesc: TFormatDescriptor;
  4145. begin
  4146. if not (ftPNG in FormatGetSupportedFiles(Format)) then
  4147. raise EglBitmapUnsupportedFormat.Create(Format);
  4148. if not init_libPNG then
  4149. raise Exception.Create('unable to initialize libPNG.');
  4150. try
  4151. case Format of
  4152. tfAlpha8ub1, tfLuminance8ub1:
  4153. ColorType := PNG_COLOR_TYPE_GRAY;
  4154. tfLuminance8Alpha8us1:
  4155. ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
  4156. tfBGR8ub3, tfRGB8ub3:
  4157. ColorType := PNG_COLOR_TYPE_RGB;
  4158. tfBGRA8ub4, tfRGBA8ub4:
  4159. ColorType := PNG_COLOR_TYPE_RGBA;
  4160. else
  4161. raise EglBitmapUnsupportedFormat.Create(Format);
  4162. end;
  4163. FormatDesc := TFormatDescriptor.Get(Format);
  4164. LineSize := FormatDesc.GetSize(Width, 1);
  4165. // creating array for scanline
  4166. SetLength(png_rows, Height);
  4167. try
  4168. for Row := 0 to Height - 1 do begin
  4169. png_rows[Row] := Data;
  4170. Inc(png_rows[Row], Row * LineSize)
  4171. end;
  4172. // write struct
  4173. png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  4174. if png = nil then
  4175. raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
  4176. // create png info
  4177. png_info := png_create_info_struct(png);
  4178. if png_info = nil then begin
  4179. png_destroy_write_struct(@png, nil);
  4180. raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
  4181. end;
  4182. // set read callback
  4183. png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
  4184. // set compression
  4185. png_set_compression_level(png, 6);
  4186. if Format in [tfBGR8ub3, tfBGRA8ub4] then
  4187. png_set_bgr(png);
  4188. png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
  4189. png_write_info(png, png_info);
  4190. png_write_image(png, @png_rows[0]);
  4191. png_write_end(png, png_info);
  4192. png_destroy_write_struct(@png, @png_info);
  4193. finally
  4194. SetLength(png_rows, 0);
  4195. end;
  4196. finally
  4197. quit_libPNG;
  4198. end;
  4199. end;
  4200. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  4201. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4202. procedure TglBitmapData.SavePNG(const aStream: TStream);
  4203. var
  4204. Png: TPNGObject;
  4205. pSource, pDest: pByte;
  4206. X, Y, PixSize: Integer;
  4207. ColorType: Cardinal;
  4208. Alpha: Boolean;
  4209. pTemp: pByte;
  4210. Temp: Byte;
  4211. begin
  4212. if not (ftPNG in FormatGetSupportedFiles (Format)) then
  4213. raise EglBitmapUnsupportedFormat.Create(Format);
  4214. case Format of
  4215. tfAlpha8ub1, tfLuminance8ub1: begin
  4216. ColorType := COLOR_GRAYSCALE;
  4217. PixSize := 1;
  4218. Alpha := false;
  4219. end;
  4220. tfLuminance8Alpha8us1: begin
  4221. ColorType := COLOR_GRAYSCALEALPHA;
  4222. PixSize := 1;
  4223. Alpha := true;
  4224. end;
  4225. tfBGR8ub3, tfRGB8ub3: begin
  4226. ColorType := COLOR_RGB;
  4227. PixSize := 3;
  4228. Alpha := false;
  4229. end;
  4230. tfBGRA8ub4, tfRGBA8ub4: begin
  4231. ColorType := COLOR_RGBALPHA;
  4232. PixSize := 3;
  4233. Alpha := true
  4234. end;
  4235. else
  4236. raise EglBitmapUnsupportedFormat.Create(Format);
  4237. end;
  4238. Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
  4239. try
  4240. // Copy ImageData
  4241. pSource := Data;
  4242. for Y := 0 to Height -1 do begin
  4243. pDest := png.ScanLine[Y];
  4244. for X := 0 to Width -1 do begin
  4245. Move(pSource^, pDest^, PixSize);
  4246. Inc(pDest, PixSize);
  4247. Inc(pSource, PixSize);
  4248. if Alpha then begin
  4249. png.AlphaScanline[Y]^[X] := pSource^;
  4250. Inc(pSource);
  4251. end;
  4252. end;
  4253. // convert RGB line to BGR
  4254. if Format in [tfRGB8ub3, tfRGBA8ub4] then begin
  4255. pTemp := png.ScanLine[Y];
  4256. for X := 0 to Width -1 do begin
  4257. Temp := pByteArray(pTemp)^[0];
  4258. pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
  4259. pByteArray(pTemp)^[2] := Temp;
  4260. Inc(pTemp, 3);
  4261. end;
  4262. end;
  4263. end;
  4264. // Save to Stream
  4265. Png.CompressionLevel := 6;
  4266. Png.SaveToStream(aStream);
  4267. finally
  4268. FreeAndNil(Png);
  4269. end;
  4270. end;
  4271. {$IFEND}
  4272. {$ENDIF}
  4273. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4274. //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4275. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4276. {$IFDEF GLB_LIB_JPEG}
  4277. type
  4278. glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
  4279. glBitmap_libJPEG_source_mgr = record
  4280. pub: jpeg_source_mgr;
  4281. SrcStream: TStream;
  4282. SrcBuffer: array [1..4096] of byte;
  4283. end;
  4284. glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
  4285. glBitmap_libJPEG_dest_mgr = record
  4286. pub: jpeg_destination_mgr;
  4287. DestStream: TStream;
  4288. DestBuffer: array [1..4096] of byte;
  4289. end;
  4290. procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
  4291. begin
  4292. //DUMMY
  4293. end;
  4294. procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
  4295. begin
  4296. //DUMMY
  4297. end;
  4298. procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
  4299. begin
  4300. //DUMMY
  4301. end;
  4302. procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
  4303. begin
  4304. //DUMMY
  4305. end;
  4306. procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
  4307. begin
  4308. //DUMMY
  4309. end;
  4310. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4311. function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
  4312. var
  4313. src: glBitmap_libJPEG_source_mgr_ptr;
  4314. bytes: integer;
  4315. begin
  4316. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  4317. bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
  4318. if (bytes <= 0) then begin
  4319. src^.SrcBuffer[1] := $FF;
  4320. src^.SrcBuffer[2] := JPEG_EOI;
  4321. bytes := 2;
  4322. end;
  4323. src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
  4324. src^.pub.bytes_in_buffer := bytes;
  4325. result := true;
  4326. end;
  4327. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4328. procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
  4329. var
  4330. src: glBitmap_libJPEG_source_mgr_ptr;
  4331. begin
  4332. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  4333. if num_bytes > 0 then begin
  4334. // wanted byte isn't in buffer so set stream position and read buffer
  4335. if num_bytes > src^.pub.bytes_in_buffer then begin
  4336. src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
  4337. src^.pub.fill_input_buffer(cinfo);
  4338. end else begin
  4339. // wanted byte is in buffer so only skip
  4340. inc(src^.pub.next_input_byte, num_bytes);
  4341. dec(src^.pub.bytes_in_buffer, num_bytes);
  4342. end;
  4343. end;
  4344. end;
  4345. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4346. function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
  4347. var
  4348. dest: glBitmap_libJPEG_dest_mgr_ptr;
  4349. begin
  4350. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  4351. if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
  4352. // write complete buffer
  4353. dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
  4354. // reset buffer
  4355. dest^.pub.next_output_byte := @dest^.DestBuffer[1];
  4356. dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
  4357. end;
  4358. result := true;
  4359. end;
  4360. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4361. procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
  4362. var
  4363. Idx: Integer;
  4364. dest: glBitmap_libJPEG_dest_mgr_ptr;
  4365. begin
  4366. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  4367. for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
  4368. // check for endblock
  4369. if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
  4370. // write endblock
  4371. dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
  4372. // leave
  4373. break;
  4374. end else
  4375. dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
  4376. end;
  4377. end;
  4378. {$ENDIF}
  4379. {$IFDEF GLB_SUPPORT_JPEG_READ}
  4380. {$IF DEFINED(GLB_LAZ_JPEG)}
  4381. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4382. function TglBitmapData.LoadJPEG(const aStream: TStream): Boolean;
  4383. const
  4384. MAGIC_LEN = 2;
  4385. JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
  4386. var
  4387. intf: TLazIntfImage;
  4388. reader: TFPReaderJPEG;
  4389. StreamPos: Int64;
  4390. magic: String[MAGIC_LEN];
  4391. begin
  4392. result := true;
  4393. StreamPos := aStream.Position;
  4394. SetLength(magic, MAGIC_LEN);
  4395. aStream.Read(magic[1], MAGIC_LEN);
  4396. aStream.Position := StreamPos;
  4397. if (magic <> JPEG_MAGIC) then begin
  4398. result := false;
  4399. exit;
  4400. end;
  4401. reader := TFPReaderJPEG.Create;
  4402. intf := TLazIntfImage.Create(0, 0);
  4403. try try
  4404. intf.DataDescription := GetDescriptionFromDevice(0, 0, 0);
  4405. reader.ImageRead(aStream, intf);
  4406. AssignFromLazIntfImage(intf);
  4407. except
  4408. result := false;
  4409. aStream.Position := StreamPos;
  4410. exit;
  4411. end;
  4412. finally
  4413. reader.Free;
  4414. intf.Free;
  4415. end;
  4416. end;
  4417. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
  4418. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4419. function TglBitmapData.LoadJPEG(const aStream: TStream): Boolean;
  4420. var
  4421. Surface: PSDL_Surface;
  4422. RWops: PSDL_RWops;
  4423. begin
  4424. result := false;
  4425. RWops := glBitmapCreateRWops(aStream);
  4426. try
  4427. if IMG_isJPG(RWops) > 0 then begin
  4428. Surface := IMG_LoadJPG_RW(RWops);
  4429. try
  4430. AssignFromSurface(Surface);
  4431. result := true;
  4432. finally
  4433. SDL_FreeSurface(Surface);
  4434. end;
  4435. end;
  4436. finally
  4437. SDL_FreeRW(RWops);
  4438. end;
  4439. end;
  4440. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  4441. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4442. function TglBitmapData.LoadJPEG(const aStream: TStream): Boolean;
  4443. var
  4444. StreamPos: Int64;
  4445. Temp: array[0..1]of Byte;
  4446. jpeg: jpeg_decompress_struct;
  4447. jpeg_err: jpeg_error_mgr;
  4448. IntFormat: TglBitmapFormat;
  4449. pImage: pByte;
  4450. TempHeight, TempWidth: Integer;
  4451. pTemp: pByte;
  4452. Row: Integer;
  4453. FormatDesc: TFormatDescriptor;
  4454. begin
  4455. result := false;
  4456. if not init_libJPEG then
  4457. raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
  4458. try
  4459. // reading first two bytes to test file and set cursor back to begin
  4460. StreamPos := aStream.Position;
  4461. aStream.Read({%H-}Temp[0], 2);
  4462. aStream.Position := StreamPos;
  4463. // if Bitmap then read file.
  4464. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  4465. FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
  4466. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  4467. // error managment
  4468. jpeg.err := jpeg_std_error(@jpeg_err);
  4469. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  4470. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  4471. // decompression struct
  4472. jpeg_create_decompress(@jpeg);
  4473. // allocation space for streaming methods
  4474. jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
  4475. // seeting up custom functions
  4476. with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
  4477. pub.init_source := glBitmap_libJPEG_init_source;
  4478. pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
  4479. pub.skip_input_data := glBitmap_libJPEG_skip_input_data;
  4480. pub.resync_to_restart := jpeg_resync_to_restart; // use default method
  4481. pub.term_source := glBitmap_libJPEG_term_source;
  4482. pub.bytes_in_buffer := 0; // forces fill_input_buffer on first read
  4483. pub.next_input_byte := nil; // until buffer loaded
  4484. SrcStream := aStream;
  4485. end;
  4486. // set global decoding state
  4487. jpeg.global_state := DSTATE_START;
  4488. // read header of jpeg
  4489. jpeg_read_header(@jpeg, false);
  4490. // setting output parameter
  4491. case jpeg.jpeg_color_space of
  4492. JCS_GRAYSCALE:
  4493. begin
  4494. jpeg.out_color_space := JCS_GRAYSCALE;
  4495. IntFormat := tfLuminance8ub1;
  4496. end;
  4497. else
  4498. jpeg.out_color_space := JCS_RGB;
  4499. IntFormat := tfRGB8ub3;
  4500. end;
  4501. // reading image
  4502. jpeg_start_decompress(@jpeg);
  4503. TempHeight := jpeg.output_height;
  4504. TempWidth := jpeg.output_width;
  4505. FormatDesc := TFormatDescriptor.Get(IntFormat);
  4506. // creating new image
  4507. GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
  4508. try
  4509. pTemp := pImage;
  4510. for Row := 0 to TempHeight -1 do begin
  4511. jpeg_read_scanlines(@jpeg, @pTemp, 1);
  4512. Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
  4513. end;
  4514. // finish decompression
  4515. jpeg_finish_decompress(@jpeg);
  4516. // destroy decompression
  4517. jpeg_destroy_decompress(@jpeg);
  4518. SetData(pImage, IntFormat, TempWidth, TempHeight);
  4519. result := true;
  4520. except
  4521. if Assigned(pImage) then
  4522. FreeMem(pImage);
  4523. raise;
  4524. end;
  4525. end;
  4526. finally
  4527. quit_libJPEG;
  4528. end;
  4529. end;
  4530. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  4531. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4532. function TglBitmapData.LoadJPEG(const aStream: TStream): Boolean;
  4533. var
  4534. bmp: TBitmap;
  4535. jpg: TJPEGImage;
  4536. StreamPos: Int64;
  4537. Temp: array[0..1]of Byte;
  4538. begin
  4539. result := false;
  4540. // reading first two bytes to test file and set cursor back to begin
  4541. StreamPos := aStream.Position;
  4542. aStream.Read(Temp[0], 2);
  4543. aStream.Position := StreamPos;
  4544. // if Bitmap then read file.
  4545. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  4546. bmp := TBitmap.Create;
  4547. try
  4548. jpg := TJPEGImage.Create;
  4549. try
  4550. jpg.LoadFromStream(aStream);
  4551. bmp.Assign(jpg);
  4552. result := AssignFromBitmap(bmp);
  4553. finally
  4554. jpg.Free;
  4555. end;
  4556. finally
  4557. bmp.Free;
  4558. end;
  4559. end;
  4560. end;
  4561. {$IFEND}
  4562. {$ENDIF}
  4563. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  4564. {$IF DEFINED(GLB_LAZ_JPEG)}
  4565. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4566. procedure TglBitmapData.SaveJPEG(const aStream: TStream);
  4567. var
  4568. jpeg: TJPEGImage;
  4569. intf: TLazIntfImage;
  4570. raw: TRawImage;
  4571. begin
  4572. jpeg := TJPEGImage.Create;
  4573. intf := TLazIntfImage.Create(0, 0);
  4574. try
  4575. if not AssignToLazIntfImage(intf) then
  4576. raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
  4577. intf.GetRawImage(raw);
  4578. jpeg.LoadFromRawImage(raw, false);
  4579. jpeg.SaveToStream(aStream);
  4580. finally
  4581. intf.Free;
  4582. jpeg.Free;
  4583. end;
  4584. end;
  4585. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  4586. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4587. procedure TglBitmapData.SaveJPEG(const aStream: TStream);
  4588. var
  4589. jpeg: jpeg_compress_struct;
  4590. jpeg_err: jpeg_error_mgr;
  4591. Row: Integer;
  4592. pTemp, pTemp2: pByte;
  4593. procedure CopyRow(pDest, pSource: pByte);
  4594. var
  4595. X: Integer;
  4596. begin
  4597. for X := 0 to Width - 1 do begin
  4598. pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
  4599. pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
  4600. pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
  4601. Inc(pDest, 3);
  4602. Inc(pSource, 3);
  4603. end;
  4604. end;
  4605. begin
  4606. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  4607. raise EglBitmapUnsupportedFormat.Create(Format);
  4608. if not init_libJPEG then
  4609. raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
  4610. try
  4611. FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
  4612. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  4613. // error managment
  4614. jpeg.err := jpeg_std_error(@jpeg_err);
  4615. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  4616. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  4617. // compression struct
  4618. jpeg_create_compress(@jpeg);
  4619. // allocation space for streaming methods
  4620. jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
  4621. // seeting up custom functions
  4622. with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
  4623. pub.init_destination := glBitmap_libJPEG_init_destination;
  4624. pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
  4625. pub.term_destination := glBitmap_libJPEG_term_destination;
  4626. pub.next_output_byte := @DestBuffer[1];
  4627. pub.free_in_buffer := Length(DestBuffer);
  4628. DestStream := aStream;
  4629. end;
  4630. // very important state
  4631. jpeg.global_state := CSTATE_START;
  4632. jpeg.image_width := Width;
  4633. jpeg.image_height := Height;
  4634. case Format of
  4635. tfAlpha8ub1, tfLuminance8ub1: begin
  4636. jpeg.input_components := 1;
  4637. jpeg.in_color_space := JCS_GRAYSCALE;
  4638. end;
  4639. tfRGB8ub3, tfBGR8ub3: begin
  4640. jpeg.input_components := 3;
  4641. jpeg.in_color_space := JCS_RGB;
  4642. end;
  4643. end;
  4644. jpeg_set_defaults(@jpeg);
  4645. jpeg_set_quality(@jpeg, 95, true);
  4646. jpeg_start_compress(@jpeg, true);
  4647. pTemp := Data;
  4648. if Format = tfBGR8ub3 then
  4649. GetMem(pTemp2, fRowSize)
  4650. else
  4651. pTemp2 := pTemp;
  4652. try
  4653. for Row := 0 to jpeg.image_height -1 do begin
  4654. // prepare row
  4655. if Format = tfBGR8ub3 then
  4656. CopyRow(pTemp2, pTemp)
  4657. else
  4658. pTemp2 := pTemp;
  4659. // write row
  4660. jpeg_write_scanlines(@jpeg, @pTemp2, 1);
  4661. inc(pTemp, fRowSize);
  4662. end;
  4663. finally
  4664. // free memory
  4665. if Format = tfBGR8ub3 then
  4666. FreeMem(pTemp2);
  4667. end;
  4668. jpeg_finish_compress(@jpeg);
  4669. jpeg_destroy_compress(@jpeg);
  4670. finally
  4671. quit_libJPEG;
  4672. end;
  4673. end;
  4674. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  4675. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4676. procedure TglBitmapData.SaveJPEG(const aStream: TStream);
  4677. var
  4678. Bmp: TBitmap;
  4679. Jpg: TJPEGImage;
  4680. begin
  4681. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  4682. raise EglBitmapUnsupportedFormat.Create(Format);
  4683. Bmp := TBitmap.Create;
  4684. try
  4685. Jpg := TJPEGImage.Create;
  4686. try
  4687. AssignToBitmap(Bmp);
  4688. if (Format in [tfAlpha8ub1, tfLuminance8ub1]) then begin
  4689. Jpg.Grayscale := true;
  4690. Jpg.PixelFormat := jf8Bit;
  4691. end;
  4692. Jpg.Assign(Bmp);
  4693. Jpg.SaveToStream(aStream);
  4694. finally
  4695. FreeAndNil(Jpg);
  4696. end;
  4697. finally
  4698. FreeAndNil(Bmp);
  4699. end;
  4700. end;
  4701. {$IFEND}
  4702. {$ENDIF}
  4703. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4704. //RAW/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4705. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4706. type
  4707. RawHeader = packed record
  4708. Magic: String[5];
  4709. Version: Byte;
  4710. Width: Integer;
  4711. Height: Integer;
  4712. DataSize: Integer;
  4713. BitsPerPixel: Integer;
  4714. Precision: TglBitmapRec4ub;
  4715. Shift: TglBitmapRec4ub;
  4716. end;
  4717. function TglBitmapData.LoadRAW(const aStream: TStream): Boolean;
  4718. var
  4719. header: RawHeader;
  4720. StartPos: Int64;
  4721. fd: TFormatDescriptor;
  4722. buf: PByte;
  4723. begin
  4724. result := false;
  4725. StartPos := aStream.Position;
  4726. aStream.Read(header{%H-}, SizeOf(header));
  4727. if (header.Magic <> 'glBMP') then begin
  4728. aStream.Position := StartPos;
  4729. exit;
  4730. end;
  4731. fd := TFormatDescriptor.GetFromPrecShift(header.Precision, header.Shift, header.BitsPerPixel);
  4732. if (fd.Format = tfEmpty) then
  4733. raise EglBitmapUnsupportedFormat.Create('no supported format found');
  4734. buf := GetMemory(header.DataSize);
  4735. aStream.Read(buf^, header.DataSize);
  4736. SetData(buf, fd.Format, header.Width, header.Height);
  4737. result := true;
  4738. end;
  4739. procedure TglBitmapData.SaveRAW(const aStream: TStream);
  4740. var
  4741. header: RawHeader;
  4742. fd: TFormatDescriptor;
  4743. begin
  4744. fd := TFormatDescriptor.Get(Format);
  4745. header.Magic := 'glBMP';
  4746. header.Version := 1;
  4747. header.Width := Width;
  4748. header.Height := Height;
  4749. header.DataSize := fd.GetSize(fDimension);
  4750. header.BitsPerPixel := fd.BitsPerPixel;
  4751. header.Precision := fd.Precision;
  4752. header.Shift := fd.Shift;
  4753. aStream.Write(header, SizeOf(header));
  4754. aStream.Write(Data^, header.DataSize);
  4755. end;
  4756. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4757. //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4758. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4759. const
  4760. BMP_MAGIC = $4D42;
  4761. BMP_COMP_RGB = 0;
  4762. BMP_COMP_RLE8 = 1;
  4763. BMP_COMP_RLE4 = 2;
  4764. BMP_COMP_BITFIELDS = 3;
  4765. type
  4766. TBMPHeader = packed record
  4767. bfType: Word;
  4768. bfSize: Cardinal;
  4769. bfReserved1: Word;
  4770. bfReserved2: Word;
  4771. bfOffBits: Cardinal;
  4772. end;
  4773. TBMPInfo = packed record
  4774. biSize: Cardinal;
  4775. biWidth: Longint;
  4776. biHeight: Longint;
  4777. biPlanes: Word;
  4778. biBitCount: Word;
  4779. biCompression: Cardinal;
  4780. biSizeImage: Cardinal;
  4781. biXPelsPerMeter: Longint;
  4782. biYPelsPerMeter: Longint;
  4783. biClrUsed: Cardinal;
  4784. biClrImportant: Cardinal;
  4785. end;
  4786. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4787. function TglBitmapData.LoadBMP(const aStream: TStream): Boolean;
  4788. //////////////////////////////////////////////////////////////////////////////////////////////////
  4789. function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapRec4ul): TglBitmapFormat;
  4790. var
  4791. tmp, i: Cardinal;
  4792. begin
  4793. result := tfEmpty;
  4794. aStream.Read(aInfo{%H-}, SizeOf(aInfo));
  4795. FillChar(aMask{%H-}, SizeOf(aMask), 0);
  4796. //Read Compression
  4797. case aInfo.biCompression of
  4798. BMP_COMP_RLE4,
  4799. BMP_COMP_RLE8: begin
  4800. raise EglBitmap.Create('RLE compression is not supported');
  4801. end;
  4802. BMP_COMP_BITFIELDS: begin
  4803. if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
  4804. for i := 0 to 2 do begin
  4805. aStream.Read(tmp{%H-}, SizeOf(tmp));
  4806. aMask.arr[i] := tmp;
  4807. end;
  4808. end else
  4809. raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
  4810. end;
  4811. end;
  4812. //get suitable format
  4813. case aInfo.biBitCount of
  4814. 8: result := tfLuminance8ub1;
  4815. 16: result := tfX1RGB5us1;
  4816. 24: result := tfBGR8ub3;
  4817. 32: result := tfXRGB8ui1;
  4818. end;
  4819. end;
  4820. function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
  4821. var
  4822. i, c: Integer;
  4823. fd: TFormatDescriptor;
  4824. ColorTable: TbmpColorTable;
  4825. begin
  4826. result := nil;
  4827. if (aInfo.biBitCount >= 16) then
  4828. exit;
  4829. aFormat := tfLuminance8ub1;
  4830. c := aInfo.biClrUsed;
  4831. if (c = 0) then
  4832. c := 1 shl aInfo.biBitCount;
  4833. SetLength(ColorTable, c);
  4834. for i := 0 to c-1 do begin
  4835. aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
  4836. if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
  4837. aFormat := tfRGB8ub3;
  4838. end;
  4839. fd := TFormatDescriptor.Get(aFormat);
  4840. result := TbmpColorTableFormat.Create;
  4841. result.ColorTable := ColorTable;
  4842. result.SetCustomValues(aFormat, aInfo.biBitCount, fd.Precision, fd.Shift);
  4843. end;
  4844. //////////////////////////////////////////////////////////////////////////////////////////////////
  4845. function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapRec4ul; const aInfo: TBMPInfo): TbmpBitfieldFormat;
  4846. var
  4847. fd: TFormatDescriptor;
  4848. begin
  4849. result := nil;
  4850. if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
  4851. // find suitable format ...
  4852. fd := TFormatDescriptor.GetFromMask(aMask);
  4853. if (fd.Format <> tfEmpty) then begin
  4854. aFormat := fd.Format;
  4855. exit;
  4856. end;
  4857. // or create custom bitfield format
  4858. result := TbmpBitfieldFormat.Create;
  4859. result.SetCustomValues(aInfo.biBitCount, aMask);
  4860. end;
  4861. end;
  4862. var
  4863. //simple types
  4864. StartPos: Int64;
  4865. ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
  4866. PaddingBuff: Cardinal;
  4867. LineBuf, ImageData, TmpData: PByte;
  4868. SourceMD, DestMD: Pointer;
  4869. BmpFormat: TglBitmapFormat;
  4870. //records
  4871. Mask: TglBitmapRec4ul;
  4872. Header: TBMPHeader;
  4873. Info: TBMPInfo;
  4874. //classes
  4875. SpecialFormat: TFormatDescriptor;
  4876. FormatDesc: TFormatDescriptor;
  4877. //////////////////////////////////////////////////////////////////////////////////////////////////
  4878. procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
  4879. var
  4880. i: Integer;
  4881. Pixel: TglBitmapPixelData;
  4882. begin
  4883. aStream.Read(aLineBuf^, rbLineSize);
  4884. SpecialFormat.PreparePixel(Pixel);
  4885. for i := 0 to Info.biWidth-1 do begin
  4886. SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
  4887. glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
  4888. FormatDesc.Map(Pixel, aData, DestMD);
  4889. end;
  4890. end;
  4891. begin
  4892. result := false;
  4893. BmpFormat := tfEmpty;
  4894. SpecialFormat := nil;
  4895. LineBuf := nil;
  4896. SourceMD := nil;
  4897. DestMD := nil;
  4898. // Header
  4899. StartPos := aStream.Position;
  4900. aStream.Read(Header{%H-}, SizeOf(Header));
  4901. if Header.bfType = BMP_MAGIC then begin
  4902. try try
  4903. BmpFormat := ReadInfo(Info, Mask);
  4904. SpecialFormat := ReadColorTable(BmpFormat, Info);
  4905. if not Assigned(SpecialFormat) then
  4906. SpecialFormat := CheckBitfields(BmpFormat, Mask, Info);
  4907. aStream.Position := StartPos + Header.bfOffBits;
  4908. if (BmpFormat <> tfEmpty) then begin
  4909. FormatDesc := TFormatDescriptor.Get(BmpFormat);
  4910. rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
  4911. wbLineSize := Trunc(Info.biWidth * FormatDesc.BytesPerPixel);
  4912. Padding := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
  4913. //get Memory
  4914. DestMD := FormatDesc.CreateMappingData;
  4915. ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
  4916. GetMem(ImageData, ImageSize);
  4917. if Assigned(SpecialFormat) then begin
  4918. GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
  4919. SourceMD := SpecialFormat.CreateMappingData;
  4920. end;
  4921. //read Data
  4922. try try
  4923. FillChar(ImageData^, ImageSize, $FF);
  4924. TmpData := ImageData;
  4925. if (Info.biHeight > 0) then
  4926. Inc(TmpData, wbLineSize * (Info.biHeight-1));
  4927. for i := 0 to Abs(Info.biHeight)-1 do begin
  4928. if Assigned(SpecialFormat) then
  4929. SpecialFormatReadLine(TmpData, LineBuf) //if is special format read and convert data
  4930. else
  4931. aStream.Read(TmpData^, wbLineSize); //else only read data
  4932. if (Info.biHeight > 0) then
  4933. dec(TmpData, wbLineSize)
  4934. else
  4935. inc(TmpData, wbLineSize);
  4936. aStream.Read(PaddingBuff{%H-}, Padding);
  4937. end;
  4938. SetData(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight));
  4939. result := true;
  4940. finally
  4941. if Assigned(LineBuf) then
  4942. FreeMem(LineBuf);
  4943. if Assigned(SourceMD) then
  4944. SpecialFormat.FreeMappingData(SourceMD);
  4945. FormatDesc.FreeMappingData(DestMD);
  4946. end;
  4947. except
  4948. if Assigned(ImageData) then
  4949. FreeMem(ImageData);
  4950. raise;
  4951. end;
  4952. end else
  4953. raise EglBitmap.Create('LoadBMP - No suitable format found');
  4954. except
  4955. aStream.Position := StartPos;
  4956. raise;
  4957. end;
  4958. finally
  4959. FreeAndNil(SpecialFormat);
  4960. end;
  4961. end
  4962. else aStream.Position := StartPos;
  4963. end;
  4964. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4965. procedure TglBitmapData.SaveBMP(const aStream: TStream);
  4966. var
  4967. Header: TBMPHeader;
  4968. Info: TBMPInfo;
  4969. Converter: TFormatDescriptor;
  4970. FormatDesc: TFormatDescriptor;
  4971. SourceFD, DestFD: Pointer;
  4972. pData, srcData, dstData, ConvertBuffer: pByte;
  4973. Pixel: TglBitmapPixelData;
  4974. ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
  4975. RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
  4976. PaddingBuff: Cardinal;
  4977. function GetLineWidth : Integer;
  4978. begin
  4979. result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
  4980. end;
  4981. begin
  4982. if not (ftBMP in FormatGetSupportedFiles(Format)) then
  4983. raise EglBitmapUnsupportedFormat.Create(Format);
  4984. Converter := nil;
  4985. FormatDesc := TFormatDescriptor.Get(Format);
  4986. ImageSize := FormatDesc.GetSize(Dimension);
  4987. FillChar(Header{%H-}, SizeOf(Header), 0);
  4988. Header.bfType := BMP_MAGIC;
  4989. Header.bfSize := SizeOf(Header) + SizeOf(Info) + ImageSize;
  4990. Header.bfReserved1 := 0;
  4991. Header.bfReserved2 := 0;
  4992. Header.bfOffBits := SizeOf(Header) + SizeOf(Info);
  4993. FillChar(Info{%H-}, SizeOf(Info), 0);
  4994. Info.biSize := SizeOf(Info);
  4995. Info.biWidth := Width;
  4996. Info.biHeight := Height;
  4997. Info.biPlanes := 1;
  4998. Info.biCompression := BMP_COMP_RGB;
  4999. Info.biSizeImage := ImageSize;
  5000. try
  5001. case Format of
  5002. tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1:
  5003. begin
  5004. Info.biBitCount := 8;
  5005. Header.bfSize := Header.bfSize + 256 * SizeOf(Cardinal);
  5006. Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
  5007. Converter := TbmpColorTableFormat.Create;
  5008. with (Converter as TbmpColorTableFormat) do begin
  5009. SetCustomValues(fFormat, 8, FormatDesc.Precision, FormatDesc.Shift);
  5010. CreateColorTable;
  5011. end;
  5012. end;
  5013. tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
  5014. tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
  5015. tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1:
  5016. begin
  5017. Info.biBitCount := 16;
  5018. Info.biCompression := BMP_COMP_BITFIELDS;
  5019. end;
  5020. tfBGR8ub3, tfRGB8ub3:
  5021. begin
  5022. Info.biBitCount := 24;
  5023. if (Format = tfRGB8ub3) then
  5024. Converter := TfdBGR8ub3.Create; //use BGR8 Format Descriptor to Swap RGB Values
  5025. end;
  5026. tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
  5027. tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1:
  5028. begin
  5029. Info.biBitCount := 32;
  5030. Info.biCompression := BMP_COMP_BITFIELDS;
  5031. end;
  5032. else
  5033. raise EglBitmapUnsupportedFormat.Create(Format);
  5034. end;
  5035. Info.biXPelsPerMeter := 2835;
  5036. Info.biYPelsPerMeter := 2835;
  5037. // prepare bitmasks
  5038. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  5039. Header.bfSize := Header.bfSize + 4 * SizeOf(Cardinal);
  5040. Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
  5041. RedMask := FormatDesc.Mask.r;
  5042. GreenMask := FormatDesc.Mask.g;
  5043. BlueMask := FormatDesc.Mask.b;
  5044. AlphaMask := FormatDesc.Mask.a;
  5045. end;
  5046. // headers
  5047. aStream.Write(Header, SizeOf(Header));
  5048. aStream.Write(Info, SizeOf(Info));
  5049. // colortable
  5050. if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
  5051. with (Converter as TbmpColorTableFormat) do
  5052. aStream.Write(ColorTable[0].b,
  5053. SizeOf(TbmpColorTableEnty) * Length(ColorTable));
  5054. // bitmasks
  5055. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  5056. aStream.Write(RedMask, SizeOf(Cardinal));
  5057. aStream.Write(GreenMask, SizeOf(Cardinal));
  5058. aStream.Write(BlueMask, SizeOf(Cardinal));
  5059. aStream.Write(AlphaMask, SizeOf(Cardinal));
  5060. end;
  5061. // image data
  5062. rbLineSize := Round(Info.biWidth * FormatDesc.BytesPerPixel);
  5063. wbLineSize := Round(Info.biWidth * Info.biBitCount / 8);
  5064. Padding := GetLineWidth - wbLineSize;
  5065. PaddingBuff := 0;
  5066. pData := Data;
  5067. inc(pData, (Height-1) * rbLineSize);
  5068. // prepare row buffer. But only for RGB because RGBA supports color masks
  5069. // so it's possible to change color within the image.
  5070. if Assigned(Converter) then begin
  5071. FormatDesc.PreparePixel(Pixel);
  5072. GetMem(ConvertBuffer, wbLineSize);
  5073. SourceFD := FormatDesc.CreateMappingData;
  5074. DestFD := Converter.CreateMappingData;
  5075. end else
  5076. ConvertBuffer := nil;
  5077. try
  5078. for LineIdx := 0 to Height - 1 do begin
  5079. // preparing row
  5080. if Assigned(Converter) then begin
  5081. srcData := pData;
  5082. dstData := ConvertBuffer;
  5083. for PixelIdx := 0 to Info.biWidth-1 do begin
  5084. FormatDesc.Unmap(srcData, Pixel, SourceFD);
  5085. glBitmapConvertPixel(Pixel, FormatDesc, Converter);
  5086. Converter.Map(Pixel, dstData, DestFD);
  5087. end;
  5088. aStream.Write(ConvertBuffer^, wbLineSize);
  5089. end else begin
  5090. aStream.Write(pData^, rbLineSize);
  5091. end;
  5092. dec(pData, rbLineSize);
  5093. if (Padding > 0) then
  5094. aStream.Write(PaddingBuff, Padding);
  5095. end;
  5096. finally
  5097. // destroy row buffer
  5098. if Assigned(ConvertBuffer) then begin
  5099. FormatDesc.FreeMappingData(SourceFD);
  5100. Converter.FreeMappingData(DestFD);
  5101. FreeMem(ConvertBuffer);
  5102. end;
  5103. end;
  5104. finally
  5105. if Assigned(Converter) then
  5106. Converter.Free;
  5107. end;
  5108. end;
  5109. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5110. //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5111. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5112. type
  5113. TTGAHeader = packed record
  5114. ImageID: Byte;
  5115. ColorMapType: Byte;
  5116. ImageType: Byte;
  5117. //ColorMapSpec: Array[0..4] of Byte;
  5118. ColorMapStart: Word;
  5119. ColorMapLength: Word;
  5120. ColorMapEntrySize: Byte;
  5121. OrigX: Word;
  5122. OrigY: Word;
  5123. Width: Word;
  5124. Height: Word;
  5125. Bpp: Byte;
  5126. ImageDesc: Byte;
  5127. end;
  5128. const
  5129. TGA_UNCOMPRESSED_RGB = 2;
  5130. TGA_UNCOMPRESSED_GRAY = 3;
  5131. TGA_COMPRESSED_RGB = 10;
  5132. TGA_COMPRESSED_GRAY = 11;
  5133. TGA_NONE_COLOR_TABLE = 0;
  5134. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5135. function TglBitmapData.LoadTGA(const aStream: TStream): Boolean;
  5136. var
  5137. Header: TTGAHeader;
  5138. ImageData: System.PByte;
  5139. StartPosition: Int64;
  5140. PixelSize, LineSize: Integer;
  5141. tgaFormat: TglBitmapFormat;
  5142. FormatDesc: TFormatDescriptor;
  5143. Counter: packed record
  5144. X, Y: packed record
  5145. low, high, dir: Integer;
  5146. end;
  5147. end;
  5148. const
  5149. CACHE_SIZE = $4000;
  5150. ////////////////////////////////////////////////////////////////////////////////////////
  5151. procedure ReadUncompressed;
  5152. var
  5153. i, j: Integer;
  5154. buf, tmp1, tmp2: System.PByte;
  5155. begin
  5156. buf := nil;
  5157. if (Counter.X.dir < 0) then
  5158. GetMem(buf, LineSize);
  5159. try
  5160. while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
  5161. tmp1 := ImageData;
  5162. inc(tmp1, (Counter.Y.low * LineSize)); //pointer to LineStart
  5163. if (Counter.X.dir < 0) then begin //flip X
  5164. aStream.Read(buf^, LineSize);
  5165. tmp2 := buf;
  5166. inc(tmp2, LineSize - PixelSize); //pointer to last pixel in line
  5167. for i := 0 to Header.Width-1 do begin //for all pixels in line
  5168. for j := 0 to PixelSize-1 do begin //for all bytes in pixel
  5169. tmp1^ := tmp2^;
  5170. inc(tmp1);
  5171. inc(tmp2);
  5172. end;
  5173. dec(tmp2, 2*PixelSize); //move 2 backwards, because j-loop moved 1 forward
  5174. end;
  5175. end else
  5176. aStream.Read(tmp1^, LineSize);
  5177. inc(Counter.Y.low, Counter.Y.dir); //move to next line index
  5178. end;
  5179. finally
  5180. if Assigned(buf) then
  5181. FreeMem(buf);
  5182. end;
  5183. end;
  5184. ////////////////////////////////////////////////////////////////////////////////////////
  5185. procedure ReadCompressed;
  5186. /////////////////////////////////////////////////////////////////
  5187. var
  5188. TmpData: System.PByte;
  5189. LinePixelsRead: Integer;
  5190. procedure CheckLine;
  5191. begin
  5192. if (LinePixelsRead >= Header.Width) then begin
  5193. LinePixelsRead := 0;
  5194. inc(Counter.Y.low, Counter.Y.dir); //next line index
  5195. TmpData := ImageData;
  5196. inc(TmpData, Counter.Y.low * LineSize); //set line
  5197. if (Counter.X.dir < 0) then //if x flipped then
  5198. inc(TmpData, LineSize - PixelSize); //set last pixel
  5199. end;
  5200. end;
  5201. /////////////////////////////////////////////////////////////////
  5202. var
  5203. Cache: PByte;
  5204. CacheSize, CachePos: Integer;
  5205. procedure CachedRead(out Buffer; Count: Integer);
  5206. var
  5207. BytesRead: Integer;
  5208. begin
  5209. if (CachePos + Count > CacheSize) then begin
  5210. //if buffer overflow save non read bytes
  5211. BytesRead := 0;
  5212. if (CacheSize - CachePos > 0) then begin
  5213. BytesRead := CacheSize - CachePos;
  5214. Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
  5215. inc(CachePos, BytesRead);
  5216. end;
  5217. //load cache from file
  5218. CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
  5219. aStream.Read(Cache^, CacheSize);
  5220. CachePos := 0;
  5221. //read rest of requested bytes
  5222. if (Count - BytesRead > 0) then begin
  5223. Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
  5224. inc(CachePos, Count - BytesRead);
  5225. end;
  5226. end else begin
  5227. //if no buffer overflow just read the data
  5228. Move(PByteArray(Cache)^[CachePos], Buffer, Count);
  5229. inc(CachePos, Count);
  5230. end;
  5231. end;
  5232. procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
  5233. begin
  5234. case PixelSize of
  5235. 1: begin
  5236. aBuffer^ := aData^;
  5237. inc(aBuffer, Counter.X.dir);
  5238. end;
  5239. 2: begin
  5240. PWord(aBuffer)^ := PWord(aData)^;
  5241. inc(aBuffer, 2 * Counter.X.dir);
  5242. end;
  5243. 3: begin
  5244. PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
  5245. PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
  5246. PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
  5247. inc(aBuffer, 3 * Counter.X.dir);
  5248. end;
  5249. 4: begin
  5250. PCardinal(aBuffer)^ := PCardinal(aData)^;
  5251. inc(aBuffer, 4 * Counter.X.dir);
  5252. end;
  5253. end;
  5254. end;
  5255. var
  5256. TotalPixelsToRead, TotalPixelsRead: Integer;
  5257. Temp: Byte;
  5258. buf: array [0..3] of Byte; //1 pixel is max 32bit long
  5259. PixelRepeat: Boolean;
  5260. PixelsToRead, PixelCount: Integer;
  5261. begin
  5262. CacheSize := 0;
  5263. CachePos := 0;
  5264. TotalPixelsToRead := Header.Width * Header.Height;
  5265. TotalPixelsRead := 0;
  5266. LinePixelsRead := 0;
  5267. GetMem(Cache, CACHE_SIZE);
  5268. try
  5269. TmpData := ImageData;
  5270. inc(TmpData, Counter.Y.low * LineSize); //set line
  5271. if (Counter.X.dir < 0) then //if x flipped then
  5272. inc(TmpData, LineSize - PixelSize); //set last pixel
  5273. repeat
  5274. //read CommandByte
  5275. CachedRead(Temp, 1);
  5276. PixelRepeat := (Temp and $80) > 0;
  5277. PixelsToRead := (Temp and $7F) + 1;
  5278. inc(TotalPixelsRead, PixelsToRead);
  5279. if PixelRepeat then
  5280. CachedRead(buf[0], PixelSize);
  5281. while (PixelsToRead > 0) do begin
  5282. CheckLine;
  5283. PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
  5284. while (PixelCount > 0) do begin
  5285. if not PixelRepeat then
  5286. CachedRead(buf[0], PixelSize);
  5287. PixelToBuffer(@buf[0], TmpData);
  5288. inc(LinePixelsRead);
  5289. dec(PixelsToRead);
  5290. dec(PixelCount);
  5291. end;
  5292. end;
  5293. until (TotalPixelsRead >= TotalPixelsToRead);
  5294. finally
  5295. FreeMem(Cache);
  5296. end;
  5297. end;
  5298. function IsGrayFormat: Boolean;
  5299. begin
  5300. result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
  5301. end;
  5302. begin
  5303. result := false;
  5304. // reading header to test file and set cursor back to begin
  5305. StartPosition := aStream.Position;
  5306. aStream.Read(Header{%H-}, SizeOf(Header));
  5307. // no colormapped files
  5308. if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
  5309. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
  5310. begin
  5311. try
  5312. if Header.ImageID <> 0 then // skip image ID
  5313. aStream.Position := aStream.Position + Header.ImageID;
  5314. tgaFormat := tfEmpty;
  5315. case Header.Bpp of
  5316. 8: if IsGrayFormat then case (Header.ImageDesc and $F) of
  5317. 0: tgaFormat := tfLuminance8ub1;
  5318. 8: tgaFormat := tfAlpha8ub1;
  5319. end;
  5320. 16: if IsGrayFormat then case (Header.ImageDesc and $F) of
  5321. 0: tgaFormat := tfLuminance16us1;
  5322. 8: tgaFormat := tfLuminance8Alpha8ub2;
  5323. end else case (Header.ImageDesc and $F) of
  5324. 0: tgaFormat := tfX1RGB5us1;
  5325. 1: tgaFormat := tfA1RGB5us1;
  5326. 4: tgaFormat := tfARGB4us1;
  5327. end;
  5328. 24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  5329. 0: tgaFormat := tfBGR8ub3;
  5330. end;
  5331. 32: if IsGrayFormat then case (Header.ImageDesc and $F) of
  5332. 0: tgaFormat := tfDepth32ui1;
  5333. end else case (Header.ImageDesc and $F) of
  5334. 0: tgaFormat := tfX2RGB10ui1;
  5335. 2: tgaFormat := tfA2RGB10ui1;
  5336. 8: tgaFormat := tfARGB8ui1;
  5337. end;
  5338. end;
  5339. if (tgaFormat = tfEmpty) then
  5340. raise EglBitmap.Create('LoadTga - unsupported format');
  5341. FormatDesc := TFormatDescriptor.Get(tgaFormat);
  5342. PixelSize := FormatDesc.GetSize(1, 1);
  5343. LineSize := FormatDesc.GetSize(Header.Width, 1);
  5344. GetMem(ImageData, LineSize * Header.Height);
  5345. try
  5346. //column direction
  5347. if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
  5348. Counter.X.low := Header.Height-1;;
  5349. Counter.X.high := 0;
  5350. Counter.X.dir := -1;
  5351. end else begin
  5352. Counter.X.low := 0;
  5353. Counter.X.high := Header.Height-1;
  5354. Counter.X.dir := 1;
  5355. end;
  5356. // Row direction
  5357. if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
  5358. Counter.Y.low := 0;
  5359. Counter.Y.high := Header.Height-1;
  5360. Counter.Y.dir := 1;
  5361. end else begin
  5362. Counter.Y.low := Header.Height-1;;
  5363. Counter.Y.high := 0;
  5364. Counter.Y.dir := -1;
  5365. end;
  5366. // Read Image
  5367. case Header.ImageType of
  5368. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
  5369. ReadUncompressed;
  5370. TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
  5371. ReadCompressed;
  5372. end;
  5373. SetData(ImageData, tgaFormat, Header.Width, Header.Height);
  5374. result := true;
  5375. except
  5376. if Assigned(ImageData) then
  5377. FreeMem(ImageData);
  5378. raise;
  5379. end;
  5380. finally
  5381. aStream.Position := StartPosition;
  5382. end;
  5383. end
  5384. else aStream.Position := StartPosition;
  5385. end;
  5386. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5387. procedure TglBitmapData.SaveTGA(const aStream: TStream);
  5388. var
  5389. Header: TTGAHeader;
  5390. Size: Integer;
  5391. FormatDesc: TFormatDescriptor;
  5392. begin
  5393. if not (ftTGA in FormatGetSupportedFiles(Format)) then
  5394. raise EglBitmapUnsupportedFormat.Create(Format);
  5395. //prepare header
  5396. FormatDesc := TFormatDescriptor.Get(Format);
  5397. FillChar(Header{%H-}, SizeOf(Header), 0);
  5398. Header.ImageDesc := CountSetBits(FormatDesc.Range.a) and $F;
  5399. Header.Bpp := FormatDesc.BitsPerPixel;
  5400. Header.Width := Width;
  5401. Header.Height := Height;
  5402. Header.ImageDesc := Header.ImageDesc or $20; //flip y
  5403. if FormatDesc.IsGrayscale or (not FormatDesc.IsGrayscale and not FormatDesc.HasRed and FormatDesc.HasAlpha) then
  5404. Header.ImageType := TGA_UNCOMPRESSED_GRAY
  5405. else
  5406. Header.ImageType := TGA_UNCOMPRESSED_RGB;
  5407. aStream.Write(Header, SizeOf(Header));
  5408. // write Data
  5409. Size := FormatDesc.GetSize(Dimension);
  5410. aStream.Write(Data^, Size);
  5411. end;
  5412. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5413. //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5414. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5415. const
  5416. DDS_MAGIC: Cardinal = $20534444;
  5417. // DDS_header.dwFlags
  5418. DDSD_CAPS = $00000001;
  5419. DDSD_HEIGHT = $00000002;
  5420. DDSD_WIDTH = $00000004;
  5421. DDSD_PIXELFORMAT = $00001000;
  5422. // DDS_header.sPixelFormat.dwFlags
  5423. DDPF_ALPHAPIXELS = $00000001;
  5424. DDPF_ALPHA = $00000002;
  5425. DDPF_FOURCC = $00000004;
  5426. DDPF_RGB = $00000040;
  5427. DDPF_LUMINANCE = $00020000;
  5428. // DDS_header.sCaps.dwCaps1
  5429. DDSCAPS_TEXTURE = $00001000;
  5430. // DDS_header.sCaps.dwCaps2
  5431. DDSCAPS2_CUBEMAP = $00000200;
  5432. D3DFMT_DXT1 = $31545844;
  5433. D3DFMT_DXT3 = $33545844;
  5434. D3DFMT_DXT5 = $35545844;
  5435. type
  5436. TDDSPixelFormat = packed record
  5437. dwSize: Cardinal;
  5438. dwFlags: Cardinal;
  5439. dwFourCC: Cardinal;
  5440. dwRGBBitCount: Cardinal;
  5441. dwRBitMask: Cardinal;
  5442. dwGBitMask: Cardinal;
  5443. dwBBitMask: Cardinal;
  5444. dwABitMask: Cardinal;
  5445. end;
  5446. TDDSCaps = packed record
  5447. dwCaps1: Cardinal;
  5448. dwCaps2: Cardinal;
  5449. dwDDSX: Cardinal;
  5450. dwReserved: Cardinal;
  5451. end;
  5452. TDDSHeader = packed record
  5453. dwSize: Cardinal;
  5454. dwFlags: Cardinal;
  5455. dwHeight: Cardinal;
  5456. dwWidth: Cardinal;
  5457. dwPitchOrLinearSize: Cardinal;
  5458. dwDepth: Cardinal;
  5459. dwMipMapCount: Cardinal;
  5460. dwReserved: array[0..10] of Cardinal;
  5461. PixelFormat: TDDSPixelFormat;
  5462. Caps: TDDSCaps;
  5463. dwReserved2: Cardinal;
  5464. end;
  5465. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5466. function TglBitmapData.LoadDDS(const aStream: TStream): Boolean;
  5467. var
  5468. Header: TDDSHeader;
  5469. Converter: TbmpBitfieldFormat;
  5470. function GetDDSFormat: TglBitmapFormat;
  5471. var
  5472. fd: TFormatDescriptor;
  5473. i: Integer;
  5474. Mask: TglBitmapRec4ul;
  5475. Range: TglBitmapRec4ui;
  5476. match: Boolean;
  5477. begin
  5478. result := tfEmpty;
  5479. with Header.PixelFormat do begin
  5480. // Compresses
  5481. if ((dwFlags and DDPF_FOURCC) > 0) then begin
  5482. case Header.PixelFormat.dwFourCC of
  5483. D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
  5484. D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
  5485. D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
  5486. end;
  5487. end else if ((dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE or DDPF_ALPHA)) > 0) then begin
  5488. // prepare masks
  5489. if ((dwFlags and DDPF_LUMINANCE) = 0) then begin
  5490. Mask.r := dwRBitMask;
  5491. Mask.g := dwGBitMask;
  5492. Mask.b := dwBBitMask;
  5493. end else begin
  5494. Mask.r := dwRBitMask;
  5495. Mask.g := dwRBitMask;
  5496. Mask.b := dwRBitMask;
  5497. end;
  5498. if (dwFlags and DDPF_ALPHAPIXELS > 0) then
  5499. Mask.a := dwABitMask
  5500. else
  5501. Mask.a := 0;;
  5502. //find matching format
  5503. fd := TFormatDescriptor.GetFromMask(Mask, dwRGBBitCount);
  5504. result := fd.Format;
  5505. if (result <> tfEmpty) then
  5506. exit;
  5507. //find format with same Range
  5508. for i := 0 to 3 do
  5509. Range.arr[i] := (2 shl CountSetBits(Mask.arr[i])) - 1;
  5510. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  5511. fd := TFormatDescriptor.Get(result);
  5512. match := true;
  5513. for i := 0 to 3 do
  5514. if (fd.Range.arr[i] <> Range.arr[i]) then begin
  5515. match := false;
  5516. break;
  5517. end;
  5518. if match then
  5519. break;
  5520. end;
  5521. //no format with same range found -> use default
  5522. if (result = tfEmpty) then begin
  5523. if (dwABitMask > 0) then
  5524. result := tfRGBA8ui1
  5525. else
  5526. result := tfRGB8ub3;
  5527. end;
  5528. Converter := TbmpBitfieldFormat.Create;
  5529. Converter.SetCustomValues(dwRGBBitCount, glBitmapRec4ul(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask));
  5530. end;
  5531. end;
  5532. end;
  5533. var
  5534. StreamPos: Int64;
  5535. x, y, LineSize, RowSize, Magic: Cardinal;
  5536. NewImage, TmpData, RowData, SrcData: System.PByte;
  5537. SourceMD, DestMD: Pointer;
  5538. Pixel: TglBitmapPixelData;
  5539. ddsFormat: TglBitmapFormat;
  5540. FormatDesc: TFormatDescriptor;
  5541. begin
  5542. result := false;
  5543. Converter := nil;
  5544. StreamPos := aStream.Position;
  5545. // Magic
  5546. aStream.Read(Magic{%H-}, sizeof(Magic));
  5547. if (Magic <> DDS_MAGIC) then begin
  5548. aStream.Position := StreamPos;
  5549. exit;
  5550. end;
  5551. //Header
  5552. aStream.Read(Header{%H-}, sizeof(Header));
  5553. if (Header.dwSize <> SizeOf(Header)) or
  5554. ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
  5555. (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
  5556. begin
  5557. aStream.Position := StreamPos;
  5558. exit;
  5559. end;
  5560. if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
  5561. raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
  5562. ddsFormat := GetDDSFormat;
  5563. try
  5564. if (ddsFormat = tfEmpty) then
  5565. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  5566. FormatDesc := TFormatDescriptor.Get(ddsFormat);
  5567. LineSize := Trunc(Header.dwWidth * FormatDesc.BytesPerPixel);
  5568. GetMem(NewImage, Header.dwHeight * LineSize);
  5569. try
  5570. TmpData := NewImage;
  5571. //Converter needed
  5572. if Assigned(Converter) then begin
  5573. RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
  5574. GetMem(RowData, RowSize);
  5575. SourceMD := Converter.CreateMappingData;
  5576. DestMD := FormatDesc.CreateMappingData;
  5577. try
  5578. for y := 0 to Header.dwHeight-1 do begin
  5579. TmpData := NewImage;
  5580. inc(TmpData, y * LineSize);
  5581. SrcData := RowData;
  5582. aStream.Read(SrcData^, RowSize);
  5583. for x := 0 to Header.dwWidth-1 do begin
  5584. Converter.Unmap(SrcData, Pixel, SourceMD);
  5585. glBitmapConvertPixel(Pixel, Converter, FormatDesc);
  5586. FormatDesc.Map(Pixel, TmpData, DestMD);
  5587. end;
  5588. end;
  5589. finally
  5590. Converter.FreeMappingData(SourceMD);
  5591. FormatDesc.FreeMappingData(DestMD);
  5592. FreeMem(RowData);
  5593. end;
  5594. end else
  5595. // Compressed
  5596. if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
  5597. RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
  5598. for Y := 0 to Header.dwHeight-1 do begin
  5599. aStream.Read(TmpData^, RowSize);
  5600. Inc(TmpData, LineSize);
  5601. end;
  5602. end else
  5603. // Uncompressed
  5604. if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
  5605. RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
  5606. for Y := 0 to Header.dwHeight-1 do begin
  5607. aStream.Read(TmpData^, RowSize);
  5608. Inc(TmpData, LineSize);
  5609. end;
  5610. end else
  5611. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  5612. SetData(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight);
  5613. result := true;
  5614. except
  5615. if Assigned(NewImage) then
  5616. FreeMem(NewImage);
  5617. raise;
  5618. end;
  5619. finally
  5620. FreeAndNil(Converter);
  5621. end;
  5622. end;
  5623. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5624. procedure TglBitmapData.SaveDDS(const aStream: TStream);
  5625. var
  5626. Header: TDDSHeader;
  5627. FormatDesc: TFormatDescriptor;
  5628. begin
  5629. if not (ftDDS in FormatGetSupportedFiles(Format)) then
  5630. raise EglBitmapUnsupportedFormat.Create(Format);
  5631. FormatDesc := TFormatDescriptor.Get(Format);
  5632. // Generell
  5633. FillChar(Header{%H-}, SizeOf(Header), 0);
  5634. Header.dwSize := SizeOf(Header);
  5635. Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
  5636. Header.dwWidth := Max(1, Width);
  5637. Header.dwHeight := Max(1, Height);
  5638. // Caps
  5639. Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
  5640. // Pixelformat
  5641. Header.PixelFormat.dwSize := sizeof(Header);
  5642. if (FormatDesc.IsCompressed) then begin
  5643. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
  5644. case Format of
  5645. tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
  5646. tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
  5647. tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
  5648. end;
  5649. end else if not FormatDesc.HasColor and FormatDesc.HasAlpha then begin
  5650. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHA;
  5651. Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
  5652. Header.PixelFormat.dwABitMask := FormatDesc.Mask.a;
  5653. end else if FormatDesc.IsGrayscale then begin
  5654. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
  5655. Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
  5656. Header.PixelFormat.dwRBitMask := FormatDesc.Mask.r;
  5657. Header.PixelFormat.dwABitMask := FormatDesc.Mask.a;
  5658. end else begin
  5659. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
  5660. Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
  5661. Header.PixelFormat.dwRBitMask := FormatDesc.Mask.r;
  5662. Header.PixelFormat.dwGBitMask := FormatDesc.Mask.g;
  5663. Header.PixelFormat.dwBBitMask := FormatDesc.Mask.b;
  5664. Header.PixelFormat.dwABitMask := FormatDesc.Mask.a;
  5665. end;
  5666. if (FormatDesc.HasAlpha) then
  5667. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
  5668. aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
  5669. aStream.Write(Header, SizeOf(Header));
  5670. aStream.Write(Data^, FormatDesc.GetSize(Dimension));
  5671. end;
  5672. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5673. function TglBitmapData.FlipHorz: Boolean;
  5674. var
  5675. fd: TglBitmapFormatDescriptor;
  5676. Col, RowSize, PixelSize: Integer;
  5677. pTempDest, pDest, pSource: PByte;
  5678. begin
  5679. result := false;
  5680. fd := FormatDescriptor;
  5681. PixelSize := Ceil(fd.BytesPerPixel);
  5682. RowSize := fd.GetSize(Width, 1);
  5683. if Assigned(Data) and not fd.IsCompressed then begin
  5684. pSource := Data;
  5685. GetMem(pDest, RowSize);
  5686. try
  5687. pTempDest := pDest;
  5688. Inc(pTempDest, RowSize);
  5689. for Col := 0 to Width-1 do begin
  5690. dec(pTempDest, PixelSize); //dec before, because ptr is behind last byte of data
  5691. Move(pSource^, pTempDest^, PixelSize);
  5692. Inc(pSource, PixelSize);
  5693. end;
  5694. SetData(pDest, Format, Width);
  5695. result := true;
  5696. except
  5697. if Assigned(pDest) then
  5698. FreeMem(pDest);
  5699. raise;
  5700. end;
  5701. end;
  5702. end;
  5703. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5704. function TglBitmapData.FlipVert: Boolean;
  5705. var
  5706. fd: TglBitmapFormatDescriptor;
  5707. Row, RowSize, PixelSize: Integer;
  5708. TempDestData, DestData, SourceData: PByte;
  5709. begin
  5710. result := false;
  5711. fd := FormatDescriptor;
  5712. PixelSize := Ceil(fd.BytesPerPixel);
  5713. RowSize := fd.GetSize(Width, 1);
  5714. if Assigned(Data) then begin
  5715. SourceData := Data;
  5716. GetMem(DestData, Height * RowSize);
  5717. try
  5718. TempDestData := DestData;
  5719. Inc(TempDestData, Width * (Height -1) * PixelSize);
  5720. for Row := 0 to Height -1 do begin
  5721. Move(SourceData^, TempDestData^, RowSize);
  5722. Dec(TempDestData, RowSize);
  5723. Inc(SourceData, RowSize);
  5724. end;
  5725. SetData(DestData, Format, Width, Height);
  5726. result := true;
  5727. except
  5728. if Assigned(DestData) then
  5729. FreeMem(DestData);
  5730. raise;
  5731. end;
  5732. end;
  5733. end;
  5734. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5735. procedure TglBitmapData.LoadFromFile(const aFilename: String);
  5736. var
  5737. fs: TFileStream;
  5738. begin
  5739. if not FileExists(aFilename) then
  5740. raise EglBitmap.Create('file does not exist: ' + aFilename);
  5741. fs := TFileStream.Create(aFilename, fmOpenRead);
  5742. try
  5743. fs.Position := 0;
  5744. LoadFromStream(fs);
  5745. fFilename := aFilename;
  5746. finally
  5747. fs.Free;
  5748. end;
  5749. end;
  5750. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5751. procedure TglBitmapData.LoadFromStream(const aStream: TStream);
  5752. begin
  5753. {$IFDEF GLB_SUPPORT_PNG_READ}
  5754. if not LoadPNG(aStream) then
  5755. {$ENDIF}
  5756. {$IFDEF GLB_SUPPORT_JPEG_READ}
  5757. if not LoadJPEG(aStream) then
  5758. {$ENDIF}
  5759. if not LoadDDS(aStream) then
  5760. if not LoadTGA(aStream) then
  5761. if not LoadBMP(aStream) then
  5762. if not LoadRAW(aStream) then
  5763. raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
  5764. end;
  5765. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5766. procedure TglBitmapData.LoadFromFunc(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat;
  5767. const aFunc: TglBitmapFunction; const aArgs: Pointer);
  5768. var
  5769. tmpData: PByte;
  5770. size: Integer;
  5771. begin
  5772. size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  5773. GetMem(tmpData, size);
  5774. try
  5775. FillChar(tmpData^, size, #$FF);
  5776. SetData(tmpData, aFormat, aSize.X, aSize.Y);
  5777. except
  5778. if Assigned(tmpData) then
  5779. FreeMem(tmpData);
  5780. raise;
  5781. end;
  5782. Convert(Self, aFunc, false, aFormat, aArgs);
  5783. end;
  5784. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5785. procedure TglBitmapData.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
  5786. var
  5787. rs: TResourceStream;
  5788. begin
  5789. PrepareResType(aResource, aResType);
  5790. rs := TResourceStream.Create(aInstance, aResource, aResType);
  5791. try
  5792. LoadFromStream(rs);
  5793. finally
  5794. rs.Free;
  5795. end;
  5796. end;
  5797. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5798. procedure TglBitmapData.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  5799. var
  5800. rs: TResourceStream;
  5801. begin
  5802. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  5803. try
  5804. LoadFromStream(rs);
  5805. finally
  5806. rs.Free;
  5807. end;
  5808. end;
  5809. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5810. procedure TglBitmapData.SaveToFile(const aFilename: String; const aFileType: TglBitmapFileType);
  5811. var
  5812. fs: TFileStream;
  5813. begin
  5814. fs := TFileStream.Create(aFileName, fmCreate);
  5815. try
  5816. fs.Position := 0;
  5817. SaveToStream(fs, aFileType);
  5818. finally
  5819. fs.Free;
  5820. end;
  5821. end;
  5822. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5823. procedure TglBitmapData.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
  5824. begin
  5825. case aFileType of
  5826. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  5827. ftPNG: SavePNG(aStream);
  5828. {$ENDIF}
  5829. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  5830. ftJPEG: SaveJPEG(aStream);
  5831. {$ENDIF}
  5832. ftDDS: SaveDDS(aStream);
  5833. ftTGA: SaveTGA(aStream);
  5834. ftBMP: SaveBMP(aStream);
  5835. ftRAW: SaveRAW(aStream);
  5836. end;
  5837. end;
  5838. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5839. function TglBitmapData.Convert(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
  5840. begin
  5841. result := Convert(Self, aFunc, aCreateTemp, Format, aArgs);
  5842. end;
  5843. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5844. function TglBitmapData.Convert(const aSource: TglBitmapData; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  5845. const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
  5846. var
  5847. DestData, TmpData, SourceData: pByte;
  5848. TempHeight, TempWidth: Integer;
  5849. SourceFD, DestFD: TFormatDescriptor;
  5850. SourceMD, DestMD: Pointer;
  5851. FuncRec: TglBitmapFunctionRec;
  5852. begin
  5853. Assert(Assigned(Data));
  5854. Assert(Assigned(aSource));
  5855. Assert(Assigned(aSource.Data));
  5856. result := false;
  5857. if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
  5858. SourceFD := TFormatDescriptor.Get(aSource.Format);
  5859. DestFD := TFormatDescriptor.Get(aFormat);
  5860. if (SourceFD.IsCompressed) then
  5861. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
  5862. if (DestFD.IsCompressed) then
  5863. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
  5864. // inkompatible Formats so CreateTemp
  5865. if (SourceFD.BitsPerPixel <> DestFD.BitsPerPixel) then
  5866. aCreateTemp := true;
  5867. // Values
  5868. TempHeight := Max(1, aSource.Height);
  5869. TempWidth := Max(1, aSource.Width);
  5870. FuncRec.Sender := Self;
  5871. FuncRec.Args := aArgs;
  5872. TmpData := nil;
  5873. if aCreateTemp then begin
  5874. GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
  5875. DestData := TmpData;
  5876. end else
  5877. DestData := Data;
  5878. try
  5879. SourceFD.PreparePixel(FuncRec.Source);
  5880. DestFD.PreparePixel (FuncRec.Dest);
  5881. SourceMD := SourceFD.CreateMappingData;
  5882. DestMD := DestFD.CreateMappingData;
  5883. FuncRec.Size := aSource.Dimension;
  5884. FuncRec.Position.Fields := FuncRec.Size.Fields;
  5885. try
  5886. SourceData := aSource.Data;
  5887. FuncRec.Position.Y := 0;
  5888. while FuncRec.Position.Y < TempHeight do begin
  5889. FuncRec.Position.X := 0;
  5890. while FuncRec.Position.X < TempWidth do begin
  5891. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  5892. aFunc(FuncRec);
  5893. DestFD.Map(FuncRec.Dest, DestData, DestMD);
  5894. inc(FuncRec.Position.X);
  5895. end;
  5896. inc(FuncRec.Position.Y);
  5897. end;
  5898. // Updating Image or InternalFormat
  5899. if aCreateTemp then
  5900. SetData(TmpData, aFormat, aSource.Width, aSource.Height)
  5901. else if (aFormat <> fFormat) then
  5902. Format := aFormat;
  5903. result := true;
  5904. finally
  5905. SourceFD.FreeMappingData(SourceMD);
  5906. DestFD.FreeMappingData(DestMD);
  5907. end;
  5908. except
  5909. if aCreateTemp and Assigned(TmpData) then
  5910. FreeMem(TmpData);
  5911. raise;
  5912. end;
  5913. end;
  5914. end;
  5915. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5916. function TglBitmapData.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
  5917. var
  5918. SourceFD, DestFD: TFormatDescriptor;
  5919. SourcePD, DestPD: TglBitmapPixelData;
  5920. ShiftData: TShiftData;
  5921. function DataIsIdentical: Boolean;
  5922. begin
  5923. result := SourceFD.MaskMatch(DestFD.Mask);
  5924. end;
  5925. function CanCopyDirect: Boolean;
  5926. begin
  5927. result :=
  5928. ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  5929. ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  5930. ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  5931. ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  5932. end;
  5933. function CanShift: Boolean;
  5934. begin
  5935. result :=
  5936. ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  5937. ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  5938. ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  5939. ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  5940. end;
  5941. function GetShift(aSource, aDest: Cardinal) : ShortInt;
  5942. begin
  5943. result := 0;
  5944. while (aSource > aDest) and (aSource > 0) do begin
  5945. inc(result);
  5946. aSource := aSource shr 1;
  5947. end;
  5948. end;
  5949. begin
  5950. if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
  5951. SourceFD := TFormatDescriptor.Get(Format);
  5952. DestFD := TFormatDescriptor.Get(aFormat);
  5953. if DataIsIdentical then begin
  5954. result := true;
  5955. Format := aFormat;
  5956. exit;
  5957. end;
  5958. SourceFD.PreparePixel(SourcePD);
  5959. DestFD.PreparePixel (DestPD);
  5960. if CanCopyDirect then
  5961. result := Convert(Self, glBitmapConvertCopyFunc, false, aFormat)
  5962. else if CanShift then begin
  5963. ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
  5964. ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
  5965. ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
  5966. ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
  5967. result := Convert(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
  5968. end else
  5969. result := Convert(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
  5970. end else
  5971. result := true;
  5972. end;
  5973. {$IFDEF GLB_SDL}
  5974. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5975. function TglBitmapData.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  5976. var
  5977. Row, RowSize: Integer;
  5978. SourceData, TmpData: PByte;
  5979. TempDepth: Integer;
  5980. FormatDesc: TFormatDescriptor;
  5981. function GetRowPointer(Row: Integer): pByte;
  5982. begin
  5983. result := aSurface.pixels;
  5984. Inc(result, Row * RowSize);
  5985. end;
  5986. begin
  5987. result := false;
  5988. FormatDesc := TFormatDescriptor.Get(Format);
  5989. if FormatDesc.IsCompressed then
  5990. raise EglBitmapUnsupportedFormat.Create(Format);
  5991. if Assigned(Data) then begin
  5992. case Trunc(FormatDesc.PixelSize) of
  5993. 1: TempDepth := 8;
  5994. 2: TempDepth := 16;
  5995. 3: TempDepth := 24;
  5996. 4: TempDepth := 32;
  5997. else
  5998. raise EglBitmapUnsupportedFormat.Create(Format);
  5999. end;
  6000. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
  6001. FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
  6002. SourceData := Data;
  6003. RowSize := FormatDesc.GetSize(FileWidth, 1);
  6004. for Row := 0 to FileHeight-1 do begin
  6005. TmpData := GetRowPointer(Row);
  6006. if Assigned(TmpData) then begin
  6007. Move(SourceData^, TmpData^, RowSize);
  6008. inc(SourceData, RowSize);
  6009. end;
  6010. end;
  6011. result := true;
  6012. end;
  6013. end;
  6014. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6015. function TglBitmapData.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  6016. var
  6017. pSource, pData, pTempData: PByte;
  6018. Row, RowSize, TempWidth, TempHeight: Integer;
  6019. IntFormat: TglBitmapFormat;
  6020. fd: TFormatDescriptor;
  6021. Mask: TglBitmapMask;
  6022. function GetRowPointer(Row: Integer): pByte;
  6023. begin
  6024. result := aSurface^.pixels;
  6025. Inc(result, Row * RowSize);
  6026. end;
  6027. begin
  6028. result := false;
  6029. if (Assigned(aSurface)) then begin
  6030. with aSurface^.format^ do begin
  6031. Mask.r := RMask;
  6032. Mask.g := GMask;
  6033. Mask.b := BMask;
  6034. Mask.a := AMask;
  6035. IntFormat := TFormatDescriptor.GetFromMask(Mask).Format;
  6036. if (IntFormat = tfEmpty) then
  6037. raise EglBitmap.Create('AssignFromSurface - Invalid Pixelformat.');
  6038. end;
  6039. fd := TFormatDescriptor.Get(IntFormat);
  6040. TempWidth := aSurface^.w;
  6041. TempHeight := aSurface^.h;
  6042. RowSize := fd.GetSize(TempWidth, 1);
  6043. GetMem(pData, TempHeight * RowSize);
  6044. try
  6045. pTempData := pData;
  6046. for Row := 0 to TempHeight -1 do begin
  6047. pSource := GetRowPointer(Row);
  6048. if (Assigned(pSource)) then begin
  6049. Move(pSource^, pTempData^, RowSize);
  6050. Inc(pTempData, RowSize);
  6051. end;
  6052. end;
  6053. SetData(pData, IntFormat, TempWidth, TempHeight);
  6054. result := true;
  6055. except
  6056. if Assigned(pData) then
  6057. FreeMem(pData);
  6058. raise;
  6059. end;
  6060. end;
  6061. end;
  6062. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6063. function TglBitmapData.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  6064. var
  6065. Row, Col, AlphaInterleave: Integer;
  6066. pSource, pDest: PByte;
  6067. function GetRowPointer(Row: Integer): pByte;
  6068. begin
  6069. result := aSurface.pixels;
  6070. Inc(result, Row * Width);
  6071. end;
  6072. begin
  6073. result := false;
  6074. if Assigned(Data) then begin
  6075. if Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfBGRA8ub4, tfRGBA8ub4] then begin
  6076. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
  6077. AlphaInterleave := 0;
  6078. case Format of
  6079. tfLuminance8Alpha8ub2:
  6080. AlphaInterleave := 1;
  6081. tfBGRA8ub4, tfRGBA8ub4:
  6082. AlphaInterleave := 3;
  6083. end;
  6084. pSource := Data;
  6085. for Row := 0 to Height -1 do begin
  6086. pDest := GetRowPointer(Row);
  6087. if Assigned(pDest) then begin
  6088. for Col := 0 to Width -1 do begin
  6089. Inc(pSource, AlphaInterleave);
  6090. pDest^ := pSource^;
  6091. Inc(pDest);
  6092. Inc(pSource);
  6093. end;
  6094. end;
  6095. end;
  6096. result := true;
  6097. end;
  6098. end;
  6099. end;
  6100. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6101. function TglBitmapData.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  6102. var
  6103. bmp: TglBitmap2D;
  6104. begin
  6105. bmp := TglBitmap2D.Create;
  6106. try
  6107. bmp.AssignFromSurface(aSurface);
  6108. result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
  6109. finally
  6110. bmp.Free;
  6111. end;
  6112. end;
  6113. {$ENDIF}
  6114. {$IFDEF GLB_DELPHI}
  6115. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6116. function CreateGrayPalette: HPALETTE;
  6117. var
  6118. Idx: Integer;
  6119. Pal: PLogPalette;
  6120. begin
  6121. GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
  6122. Pal.palVersion := $300;
  6123. Pal.palNumEntries := 256;
  6124. for Idx := 0 to Pal.palNumEntries - 1 do begin
  6125. Pal.palPalEntry[Idx].peRed := Idx;
  6126. Pal.palPalEntry[Idx].peGreen := Idx;
  6127. Pal.palPalEntry[Idx].peBlue := Idx;
  6128. Pal.palPalEntry[Idx].peFlags := 0;
  6129. end;
  6130. Result := CreatePalette(Pal^);
  6131. FreeMem(Pal);
  6132. end;
  6133. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6134. function TglBitmapData.AssignToBitmap(const aBitmap: TBitmap): Boolean;
  6135. var
  6136. Row, RowSize: Integer;
  6137. pSource, pData: PByte;
  6138. begin
  6139. result := false;
  6140. if Assigned(Data) then begin
  6141. if Assigned(aBitmap) then begin
  6142. aBitmap.Width := Width;
  6143. aBitmap.Height := Height;
  6144. case Format of
  6145. tfAlpha8ub1, tfLuminance8ub1: begin
  6146. aBitmap.PixelFormat := pf8bit;
  6147. aBitmap.Palette := CreateGrayPalette;
  6148. end;
  6149. tfRGB5A1us1:
  6150. aBitmap.PixelFormat := pf15bit;
  6151. tfR5G6B5us1:
  6152. aBitmap.PixelFormat := pf16bit;
  6153. tfRGB8ub3, tfBGR8ub3:
  6154. aBitmap.PixelFormat := pf24bit;
  6155. tfRGBA8ub4, tfBGRA8ub4:
  6156. aBitmap.PixelFormat := pf32bit;
  6157. else
  6158. raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
  6159. end;
  6160. RowSize := FormatDescriptor.GetSize(Width, 1);
  6161. pSource := Data;
  6162. for Row := 0 to Height-1 do begin
  6163. pData := aBitmap.Scanline[Row];
  6164. Move(pSource^, pData^, RowSize);
  6165. Inc(pSource, RowSize);
  6166. if (Format in [tfRGB8ub3, tfRGBA8ub4]) then // swap RGB(A) to BGR(A)
  6167. SwapRGB(pData, Width, Format = tfRGBA8ub4);
  6168. end;
  6169. result := true;
  6170. end;
  6171. end;
  6172. end;
  6173. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6174. function TglBitmapData.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  6175. var
  6176. pSource, pData, pTempData: PByte;
  6177. Row, RowSize, TempWidth, TempHeight: Integer;
  6178. IntFormat: TglBitmapFormat;
  6179. begin
  6180. result := false;
  6181. if (Assigned(aBitmap)) then begin
  6182. case aBitmap.PixelFormat of
  6183. pf8bit:
  6184. IntFormat := tfLuminance8ub1;
  6185. pf15bit:
  6186. IntFormat := tfRGB5A1us1;
  6187. pf16bit:
  6188. IntFormat := tfR5G6B5us1;
  6189. pf24bit:
  6190. IntFormat := tfBGR8ub3;
  6191. pf32bit:
  6192. IntFormat := tfBGRA8ub4;
  6193. else
  6194. raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
  6195. end;
  6196. TempWidth := aBitmap.Width;
  6197. TempHeight := aBitmap.Height;
  6198. RowSize := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
  6199. GetMem(pData, TempHeight * RowSize);
  6200. try
  6201. pTempData := pData;
  6202. for Row := 0 to TempHeight -1 do begin
  6203. pSource := aBitmap.Scanline[Row];
  6204. if (Assigned(pSource)) then begin
  6205. Move(pSource^, pTempData^, RowSize);
  6206. Inc(pTempData, RowSize);
  6207. end;
  6208. end;
  6209. SetData(pData, IntFormat, TempWidth, TempHeight);
  6210. result := true;
  6211. except
  6212. if Assigned(pData) then
  6213. FreeMem(pData);
  6214. raise;
  6215. end;
  6216. end;
  6217. end;
  6218. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6219. function TglBitmapData.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  6220. var
  6221. Row, Col, AlphaInterleave: Integer;
  6222. pSource, pDest: PByte;
  6223. begin
  6224. result := false;
  6225. if Assigned(Data) then begin
  6226. if (Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfRGBA8ub4, tfBGRA8ub4]) then begin
  6227. if Assigned(aBitmap) then begin
  6228. aBitmap.PixelFormat := pf8bit;
  6229. aBitmap.Palette := CreateGrayPalette;
  6230. aBitmap.Width := Width;
  6231. aBitmap.Height := Height;
  6232. case Format of
  6233. tfLuminance8Alpha8ub2:
  6234. AlphaInterleave := 1;
  6235. tfRGBA8ub4, tfBGRA8ub4:
  6236. AlphaInterleave := 3;
  6237. else
  6238. AlphaInterleave := 0;
  6239. end;
  6240. // Copy Data
  6241. pSource := Data;
  6242. for Row := 0 to Height -1 do begin
  6243. pDest := aBitmap.Scanline[Row];
  6244. if Assigned(pDest) then begin
  6245. for Col := 0 to Width -1 do begin
  6246. Inc(pSource, AlphaInterleave);
  6247. pDest^ := pSource^;
  6248. Inc(pDest);
  6249. Inc(pSource);
  6250. end;
  6251. end;
  6252. end;
  6253. result := true;
  6254. end;
  6255. end;
  6256. end;
  6257. end;
  6258. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6259. function TglBitmapData.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  6260. var
  6261. data: TglBitmapData;
  6262. begin
  6263. data := TglBitmapData.Create;
  6264. try
  6265. data.AssignFromBitmap(aBitmap);
  6266. result := AddAlphaFromDataObj(data, aFunc, aArgs);
  6267. finally
  6268. data.Free;
  6269. end;
  6270. end;
  6271. {$ENDIF}
  6272. {$IFDEF GLB_LAZARUS}
  6273. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6274. function TglBitmapData.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  6275. var
  6276. rid: TRawImageDescription;
  6277. FormatDesc: TFormatDescriptor;
  6278. begin
  6279. if not Assigned(Data) then
  6280. raise EglBitmap.Create('no pixel data assigned. load data before save');
  6281. result := false;
  6282. if not Assigned(aImage) or (Format = tfEmpty) then
  6283. exit;
  6284. FormatDesc := TFormatDescriptor.Get(Format);
  6285. if FormatDesc.IsCompressed then
  6286. exit;
  6287. FillChar(rid{%H-}, SizeOf(rid), 0);
  6288. if FormatDesc.IsGrayscale then
  6289. rid.Format := ricfGray
  6290. else
  6291. rid.Format := ricfRGBA;
  6292. rid.Width := Width;
  6293. rid.Height := Height;
  6294. rid.Depth := FormatDesc.BitsPerPixel;
  6295. rid.BitOrder := riboBitsInOrder;
  6296. rid.ByteOrder := riboLSBFirst;
  6297. rid.LineOrder := riloTopToBottom;
  6298. rid.LineEnd := rileTight;
  6299. rid.BitsPerPixel := FormatDesc.BitsPerPixel;
  6300. rid.RedPrec := CountSetBits(FormatDesc.Range.r);
  6301. rid.GreenPrec := CountSetBits(FormatDesc.Range.g);
  6302. rid.BluePrec := CountSetBits(FormatDesc.Range.b);
  6303. rid.AlphaPrec := CountSetBits(FormatDesc.Range.a);
  6304. rid.RedShift := FormatDesc.Shift.r;
  6305. rid.GreenShift := FormatDesc.Shift.g;
  6306. rid.BlueShift := FormatDesc.Shift.b;
  6307. rid.AlphaShift := FormatDesc.Shift.a;
  6308. rid.MaskBitsPerPixel := 0;
  6309. rid.PaletteColorCount := 0;
  6310. aImage.DataDescription := rid;
  6311. aImage.CreateData;
  6312. if not Assigned(aImage.PixelData) then
  6313. raise EglBitmap.Create('error while creating LazIntfImage');
  6314. Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
  6315. result := true;
  6316. end;
  6317. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6318. function TglBitmapData.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  6319. var
  6320. f: TglBitmapFormat;
  6321. FormatDesc: TFormatDescriptor;
  6322. ImageData: PByte;
  6323. ImageSize: Integer;
  6324. CanCopy: Boolean;
  6325. Mask: TglBitmapRec4ul;
  6326. procedure CopyConvert;
  6327. var
  6328. bfFormat: TbmpBitfieldFormat;
  6329. pSourceLine, pDestLine: PByte;
  6330. pSourceMD, pDestMD: Pointer;
  6331. Shift, Prec: TglBitmapRec4ub;
  6332. x, y: Integer;
  6333. pixel: TglBitmapPixelData;
  6334. begin
  6335. bfFormat := TbmpBitfieldFormat.Create;
  6336. with aImage.DataDescription do begin
  6337. Prec.r := RedPrec;
  6338. Prec.g := GreenPrec;
  6339. Prec.b := BluePrec;
  6340. Prec.a := AlphaPrec;
  6341. Shift.r := RedShift;
  6342. Shift.g := GreenShift;
  6343. Shift.b := BlueShift;
  6344. Shift.a := AlphaShift;
  6345. bfFormat.SetCustomValues(BitsPerPixel, Prec, Shift);
  6346. end;
  6347. pSourceMD := bfFormat.CreateMappingData;
  6348. pDestMD := FormatDesc.CreateMappingData;
  6349. try
  6350. for y := 0 to aImage.Height-1 do begin
  6351. pSourceLine := aImage.PixelData + y {%H-}* aImage.DataDescription.BytesPerLine;
  6352. pDestLine := ImageData + y * Round(FormatDesc.BytesPerPixel * aImage.Width);
  6353. for x := 0 to aImage.Width-1 do begin
  6354. bfFormat.Unmap(pSourceLine, pixel, pSourceMD);
  6355. FormatDesc.Map(pixel, pDestLine, pDestMD);
  6356. end;
  6357. end;
  6358. finally
  6359. FormatDesc.FreeMappingData(pDestMD);
  6360. bfFormat.FreeMappingData(pSourceMD);
  6361. bfFormat.Free;
  6362. end;
  6363. end;
  6364. begin
  6365. result := false;
  6366. if not Assigned(aImage) then
  6367. exit;
  6368. with aImage.DataDescription do begin
  6369. Mask.r := (QWord(1 shl RedPrec )-1) shl RedShift;
  6370. Mask.g := (QWord(1 shl GreenPrec)-1) shl GreenShift;
  6371. Mask.b := (QWord(1 shl BluePrec )-1) shl BlueShift;
  6372. Mask.a := (QWord(1 shl AlphaPrec)-1) shl AlphaShift;
  6373. end;
  6374. FormatDesc := TFormatDescriptor.GetFromMask(Mask);
  6375. f := FormatDesc.Format;
  6376. if (f = tfEmpty) then
  6377. exit;
  6378. CanCopy :=
  6379. (FormatDesc.BitsPerPixel = aImage.DataDescription.Depth) and
  6380. (aImage.DataDescription.BitsPerPixel = aImage.DataDescription.Depth);
  6381. ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
  6382. ImageData := GetMem(ImageSize);
  6383. try
  6384. if CanCopy then
  6385. Move(aImage.PixelData^, ImageData^, ImageSize)
  6386. else
  6387. CopyConvert;
  6388. SetData(ImageData, f, aImage.Width, aImage.Height);
  6389. except
  6390. if Assigned(ImageData) then
  6391. FreeMem(ImageData);
  6392. raise;
  6393. end;
  6394. result := true;
  6395. end;
  6396. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6397. function TglBitmapData.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  6398. var
  6399. rid: TRawImageDescription;
  6400. FormatDesc: TFormatDescriptor;
  6401. Pixel: TglBitmapPixelData;
  6402. x, y: Integer;
  6403. srcMD: Pointer;
  6404. src, dst: PByte;
  6405. begin
  6406. result := false;
  6407. if not Assigned(aImage) or (Format = tfEmpty) then
  6408. exit;
  6409. FormatDesc := TFormatDescriptor.Get(Format);
  6410. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  6411. exit;
  6412. FillChar(rid{%H-}, SizeOf(rid), 0);
  6413. rid.Format := ricfGray;
  6414. rid.Width := Width;
  6415. rid.Height := Height;
  6416. rid.Depth := CountSetBits(FormatDesc.Range.a);
  6417. rid.BitOrder := riboBitsInOrder;
  6418. rid.ByteOrder := riboLSBFirst;
  6419. rid.LineOrder := riloTopToBottom;
  6420. rid.LineEnd := rileTight;
  6421. rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
  6422. rid.RedPrec := CountSetBits(FormatDesc.Range.a);
  6423. rid.GreenPrec := 0;
  6424. rid.BluePrec := 0;
  6425. rid.AlphaPrec := 0;
  6426. rid.RedShift := 0;
  6427. rid.GreenShift := 0;
  6428. rid.BlueShift := 0;
  6429. rid.AlphaShift := 0;
  6430. rid.MaskBitsPerPixel := 0;
  6431. rid.PaletteColorCount := 0;
  6432. aImage.DataDescription := rid;
  6433. aImage.CreateData;
  6434. srcMD := FormatDesc.CreateMappingData;
  6435. try
  6436. FormatDesc.PreparePixel(Pixel);
  6437. src := Data;
  6438. dst := aImage.PixelData;
  6439. for y := 0 to Height-1 do
  6440. for x := 0 to Width-1 do begin
  6441. FormatDesc.Unmap(src, Pixel, srcMD);
  6442. case rid.BitsPerPixel of
  6443. 8: begin
  6444. dst^ := Pixel.Data.a;
  6445. inc(dst);
  6446. end;
  6447. 16: begin
  6448. PWord(dst)^ := Pixel.Data.a;
  6449. inc(dst, 2);
  6450. end;
  6451. 24: begin
  6452. PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
  6453. PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
  6454. PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
  6455. inc(dst, 3);
  6456. end;
  6457. 32: begin
  6458. PCardinal(dst)^ := Pixel.Data.a;
  6459. inc(dst, 4);
  6460. end;
  6461. else
  6462. raise EglBitmapUnsupportedFormat.Create(Format);
  6463. end;
  6464. end;
  6465. finally
  6466. FormatDesc.FreeMappingData(srcMD);
  6467. end;
  6468. result := true;
  6469. end;
  6470. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6471. function TglBitmapData.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  6472. var
  6473. data: TglBitmapData;
  6474. begin
  6475. data := TglBitmapData.Create;
  6476. try
  6477. data.AssignFromLazIntfImage(aImage);
  6478. result := AddAlphaFromDataObj(data, aFunc, aArgs);
  6479. finally
  6480. data.Free;
  6481. end;
  6482. end;
  6483. {$ENDIF}
  6484. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6485. function TglBitmapData.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
  6486. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  6487. var
  6488. rs: TResourceStream;
  6489. begin
  6490. PrepareResType(aResource, aResType);
  6491. rs := TResourceStream.Create(aInstance, aResource, aResType);
  6492. try
  6493. result := AddAlphaFromStream(rs, aFunc, aArgs);
  6494. finally
  6495. rs.Free;
  6496. end;
  6497. end;
  6498. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6499. function TglBitmapData.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  6500. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  6501. var
  6502. rs: TResourceStream;
  6503. begin
  6504. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  6505. try
  6506. result := AddAlphaFromStream(rs, aFunc, aArgs);
  6507. finally
  6508. rs.Free;
  6509. end;
  6510. end;
  6511. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6512. function TglBitmapData.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  6513. begin
  6514. if TFormatDescriptor.Get(Format).IsCompressed then
  6515. raise EglBitmapUnsupportedFormat.Create(Format);
  6516. result := Convert(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
  6517. end;
  6518. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6519. function TglBitmapData.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  6520. var
  6521. FS: TFileStream;
  6522. begin
  6523. FS := TFileStream.Create(aFileName, fmOpenRead);
  6524. try
  6525. result := AddAlphaFromStream(FS, aFunc, aArgs);
  6526. finally
  6527. FS.Free;
  6528. end;
  6529. end;
  6530. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6531. function TglBitmapData.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  6532. var
  6533. data: TglBitmapData;
  6534. begin
  6535. data := TglBitmapData.Create(aStream);
  6536. try
  6537. result := AddAlphaFromDataObj(data, aFunc, aArgs);
  6538. finally
  6539. data.Free;
  6540. end;
  6541. end;
  6542. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6543. function TglBitmapData.AddAlphaFromDataObj(const aDataObj: TglBitmapData; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  6544. var
  6545. DestData, DestData2, SourceData: pByte;
  6546. TempHeight, TempWidth: Integer;
  6547. SourceFD, DestFD: TFormatDescriptor;
  6548. SourceMD, DestMD, DestMD2: Pointer;
  6549. FuncRec: TglBitmapFunctionRec;
  6550. begin
  6551. result := false;
  6552. Assert(Assigned(Data));
  6553. Assert(Assigned(aDataObj));
  6554. Assert(Assigned(aDataObj.Data));
  6555. if ((aDataObj.Width = Width) and (aDataObj.Height = Height)) then begin
  6556. result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
  6557. SourceFD := TFormatDescriptor.Get(aDataObj.Format);
  6558. DestFD := TFormatDescriptor.Get(Format);
  6559. if not Assigned(aFunc) then begin
  6560. aFunc := glBitmapAlphaFunc;
  6561. FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
  6562. end else
  6563. FuncRec.Args := aArgs;
  6564. // Values
  6565. TempWidth := aDataObj.Width;
  6566. TempHeight := aDataObj.Height;
  6567. if (TempWidth <= 0) or (TempHeight <= 0) then
  6568. exit;
  6569. FuncRec.Sender := Self;
  6570. FuncRec.Size := Dimension;
  6571. FuncRec.Position.Fields := FuncRec.Size.Fields;
  6572. DestData := Data;
  6573. DestData2 := Data;
  6574. SourceData := aDataObj.Data;
  6575. // Mapping
  6576. SourceFD.PreparePixel(FuncRec.Source);
  6577. DestFD.PreparePixel (FuncRec.Dest);
  6578. SourceMD := SourceFD.CreateMappingData;
  6579. DestMD := DestFD.CreateMappingData;
  6580. DestMD2 := DestFD.CreateMappingData;
  6581. try
  6582. FuncRec.Position.Y := 0;
  6583. while FuncRec.Position.Y < TempHeight do begin
  6584. FuncRec.Position.X := 0;
  6585. while FuncRec.Position.X < TempWidth do begin
  6586. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  6587. DestFD.Unmap (DestData, FuncRec.Dest, DestMD);
  6588. aFunc(FuncRec);
  6589. DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
  6590. inc(FuncRec.Position.X);
  6591. end;
  6592. inc(FuncRec.Position.Y);
  6593. end;
  6594. finally
  6595. SourceFD.FreeMappingData(SourceMD);
  6596. DestFD.FreeMappingData(DestMD);
  6597. DestFD.FreeMappingData(DestMD2);
  6598. end;
  6599. end;
  6600. end;
  6601. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6602. function TglBitmapData.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
  6603. begin
  6604. result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
  6605. end;
  6606. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6607. function TglBitmapData.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
  6608. var
  6609. PixelData: TglBitmapPixelData;
  6610. begin
  6611. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  6612. result := AddAlphaFromColorKeyFloat(
  6613. aRed / PixelData.Range.r,
  6614. aGreen / PixelData.Range.g,
  6615. aBlue / PixelData.Range.b,
  6616. aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
  6617. end;
  6618. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6619. function TglBitmapData.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
  6620. var
  6621. values: array[0..2] of Single;
  6622. tmp: Cardinal;
  6623. i: Integer;
  6624. PixelData: TglBitmapPixelData;
  6625. begin
  6626. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  6627. with PixelData do begin
  6628. values[0] := aRed;
  6629. values[1] := aGreen;
  6630. values[2] := aBlue;
  6631. for i := 0 to 2 do begin
  6632. tmp := Trunc(Range.arr[i] * aDeviation);
  6633. Data.arr[i] := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
  6634. Range.arr[i] := Max(0, Trunc(Range.arr[i] * values[i] - tmp));
  6635. end;
  6636. Data.a := 0;
  6637. Range.a := 0;
  6638. end;
  6639. result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
  6640. end;
  6641. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6642. function TglBitmapData.AddAlphaFromValue(const aAlpha: Byte): Boolean;
  6643. begin
  6644. result := AddAlphaFromValueFloat(aAlpha / $FF);
  6645. end;
  6646. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6647. function TglBitmapData.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  6648. var
  6649. PixelData: TglBitmapPixelData;
  6650. begin
  6651. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  6652. result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
  6653. end;
  6654. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6655. function TglBitmapData.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  6656. var
  6657. PixelData: TglBitmapPixelData;
  6658. begin
  6659. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  6660. with PixelData do
  6661. Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
  6662. result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
  6663. end;
  6664. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6665. function TglBitmapData.RemoveAlpha: Boolean;
  6666. var
  6667. FormatDesc: TFormatDescriptor;
  6668. begin
  6669. result := false;
  6670. FormatDesc := TFormatDescriptor.Get(Format);
  6671. if Assigned(Data) then begin
  6672. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  6673. raise EglBitmapUnsupportedFormat.Create(Format);
  6674. result := ConvertTo(FormatDesc.WithoutAlpha);
  6675. end;
  6676. end;
  6677. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6678. procedure TglBitmapData.FillWithColor(const aRed, aGreen, aBlue: Byte;
  6679. const aAlpha: Byte);
  6680. begin
  6681. FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
  6682. end;
  6683. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6684. procedure TglBitmapData.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
  6685. var
  6686. PixelData: TglBitmapPixelData;
  6687. begin
  6688. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  6689. FillWithColorFloat(
  6690. aRed / PixelData.Range.r,
  6691. aGreen / PixelData.Range.g,
  6692. aBlue / PixelData.Range.b,
  6693. aAlpha / PixelData.Range.a);
  6694. end;
  6695. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6696. procedure TglBitmapData.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
  6697. var
  6698. PixelData: TglBitmapPixelData;
  6699. begin
  6700. TFormatDescriptor.Get(Format).PreparePixel(PixelData);
  6701. with PixelData do begin
  6702. Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
  6703. Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
  6704. Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
  6705. Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
  6706. end;
  6707. Convert(glBitmapFillWithColorFunc, false, @PixelData);
  6708. end;
  6709. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6710. procedure TglBitmapData.SetData(const aData: PByte; const aFormat: TglBitmapFormat; const aWidth: Integer; const aHeight: Integer);
  6711. begin
  6712. if (Data <> aData) then begin
  6713. if (Assigned(Data)) then
  6714. FreeMem(Data);
  6715. fData := aData;
  6716. end;
  6717. if Assigned(fData) then begin
  6718. FillChar(fDimension, SizeOf(fDimension), 0);
  6719. if aWidth <> -1 then begin
  6720. fDimension.Fields := fDimension.Fields + [ffX];
  6721. fDimension.X := aWidth;
  6722. end;
  6723. if aHeight <> -1 then begin
  6724. fDimension.Fields := fDimension.Fields + [ffY];
  6725. fDimension.Y := aHeight;
  6726. end;
  6727. fFormat := aFormat;
  6728. end else
  6729. fFormat := tfEmpty;
  6730. UpdateScanlines;
  6731. end;
  6732. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6733. function TglBitmapData.Clone: TglBitmapData;
  6734. var
  6735. Temp: TglBitmapData;
  6736. TempPtr: PByte;
  6737. Size: Integer;
  6738. begin
  6739. result := nil;
  6740. Temp := (ClassType.Create as TglBitmapData);
  6741. try
  6742. // copy texture data if assigned
  6743. if Assigned(Data) then begin
  6744. Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
  6745. GetMem(TempPtr, Size);
  6746. try
  6747. Move(Data^, TempPtr^, Size);
  6748. Temp.SetData(TempPtr, Format, Width, Height);
  6749. except
  6750. if Assigned(TempPtr) then
  6751. FreeMem(TempPtr);
  6752. raise;
  6753. end;
  6754. end else begin
  6755. TempPtr := nil;
  6756. Temp.SetData(TempPtr, Format, Width, Height);
  6757. end;
  6758. // copy properties
  6759. Temp.fFormat := Format;
  6760. result := Temp;
  6761. except
  6762. FreeAndNil(Temp);
  6763. raise;
  6764. end;
  6765. end;
  6766. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6767. procedure TglBitmapData.Invert(const aRed, aGreen, aBlue, aAlpha: Boolean);
  6768. var
  6769. mask: PtrInt;
  6770. begin
  6771. mask :=
  6772. (Byte(aRed) and 1) or
  6773. ((Byte(aGreen) and 1) shl 1) or
  6774. ((Byte(aBlue) and 1) shl 2) or
  6775. ((Byte(aAlpha) and 1) shl 3);
  6776. if (mask > 0) then
  6777. Convert(glBitmapInvertFunc, false, {%H-}Pointer(mask));
  6778. end;
  6779. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6780. type
  6781. TMatrixItem = record
  6782. X, Y: Integer;
  6783. W: Single;
  6784. end;
  6785. PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
  6786. TglBitmapToNormalMapRec = Record
  6787. Scale: Single;
  6788. Heights: array of Single;
  6789. MatrixU : array of TMatrixItem;
  6790. MatrixV : array of TMatrixItem;
  6791. end;
  6792. const
  6793. ONE_OVER_255 = 1 / 255;
  6794. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6795. procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
  6796. var
  6797. Val: Single;
  6798. begin
  6799. with FuncRec do begin
  6800. Val :=
  6801. Source.Data.r * LUMINANCE_WEIGHT_R +
  6802. Source.Data.g * LUMINANCE_WEIGHT_G +
  6803. Source.Data.b * LUMINANCE_WEIGHT_B;
  6804. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
  6805. end;
  6806. end;
  6807. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6808. procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  6809. begin
  6810. with FuncRec do
  6811. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
  6812. end;
  6813. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6814. procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
  6815. type
  6816. TVec = Array[0..2] of Single;
  6817. var
  6818. Idx: Integer;
  6819. du, dv: Double;
  6820. Len: Single;
  6821. Vec: TVec;
  6822. function GetHeight(X, Y: Integer): Single;
  6823. begin
  6824. with FuncRec do begin
  6825. X := Max(0, Min(Size.X -1, X));
  6826. Y := Max(0, Min(Size.Y -1, Y));
  6827. result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
  6828. end;
  6829. end;
  6830. begin
  6831. with FuncRec do begin
  6832. with PglBitmapToNormalMapRec(Args)^ do begin
  6833. du := 0;
  6834. for Idx := Low(MatrixU) to High(MatrixU) do
  6835. du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
  6836. dv := 0;
  6837. for Idx := Low(MatrixU) to High(MatrixU) do
  6838. dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
  6839. Vec[0] := -du * Scale;
  6840. Vec[1] := -dv * Scale;
  6841. Vec[2] := 1;
  6842. end;
  6843. // Normalize
  6844. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  6845. if Len <> 0 then begin
  6846. Vec[0] := Vec[0] * Len;
  6847. Vec[1] := Vec[1] * Len;
  6848. Vec[2] := Vec[2] * Len;
  6849. end;
  6850. // Farbe zuweisem
  6851. Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
  6852. Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
  6853. Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
  6854. end;
  6855. end;
  6856. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6857. procedure TglBitmapData.GenerateNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
  6858. var
  6859. Rec: TglBitmapToNormalMapRec;
  6860. procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
  6861. begin
  6862. if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
  6863. Matrix[Index].X := X;
  6864. Matrix[Index].Y := Y;
  6865. Matrix[Index].W := W;
  6866. end;
  6867. end;
  6868. begin
  6869. if TFormatDescriptor.Get(Format).IsCompressed then
  6870. raise EglBitmapUnsupportedFormat.Create(Format);
  6871. if aScale > 100 then
  6872. Rec.Scale := 100
  6873. else if aScale < -100 then
  6874. Rec.Scale := -100
  6875. else
  6876. Rec.Scale := aScale;
  6877. SetLength(Rec.Heights, Width * Height);
  6878. try
  6879. case aFunc of
  6880. nm4Samples: begin
  6881. SetLength(Rec.MatrixU, 2);
  6882. SetEntry(Rec.MatrixU, 0, -1, 0, -0.5);
  6883. SetEntry(Rec.MatrixU, 1, 1, 0, 0.5);
  6884. SetLength(Rec.MatrixV, 2);
  6885. SetEntry(Rec.MatrixV, 0, 0, 1, 0.5);
  6886. SetEntry(Rec.MatrixV, 1, 0, -1, -0.5);
  6887. end;
  6888. nmSobel: begin
  6889. SetLength(Rec.MatrixU, 6);
  6890. SetEntry(Rec.MatrixU, 0, -1, 1, -1.0);
  6891. SetEntry(Rec.MatrixU, 1, -1, 0, -2.0);
  6892. SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
  6893. SetEntry(Rec.MatrixU, 3, 1, 1, 1.0);
  6894. SetEntry(Rec.MatrixU, 4, 1, 0, 2.0);
  6895. SetEntry(Rec.MatrixU, 5, 1, -1, 1.0);
  6896. SetLength(Rec.MatrixV, 6);
  6897. SetEntry(Rec.MatrixV, 0, -1, 1, 1.0);
  6898. SetEntry(Rec.MatrixV, 1, 0, 1, 2.0);
  6899. SetEntry(Rec.MatrixV, 2, 1, 1, 1.0);
  6900. SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
  6901. SetEntry(Rec.MatrixV, 4, 0, -1, -2.0);
  6902. SetEntry(Rec.MatrixV, 5, 1, -1, -1.0);
  6903. end;
  6904. nm3x3: begin
  6905. SetLength(Rec.MatrixU, 6);
  6906. SetEntry(Rec.MatrixU, 0, -1, 1, -1/6);
  6907. SetEntry(Rec.MatrixU, 1, -1, 0, -1/6);
  6908. SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
  6909. SetEntry(Rec.MatrixU, 3, 1, 1, 1/6);
  6910. SetEntry(Rec.MatrixU, 4, 1, 0, 1/6);
  6911. SetEntry(Rec.MatrixU, 5, 1, -1, 1/6);
  6912. SetLength(Rec.MatrixV, 6);
  6913. SetEntry(Rec.MatrixV, 0, -1, 1, 1/6);
  6914. SetEntry(Rec.MatrixV, 1, 0, 1, 1/6);
  6915. SetEntry(Rec.MatrixV, 2, 1, 1, 1/6);
  6916. SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
  6917. SetEntry(Rec.MatrixV, 4, 0, -1, -1/6);
  6918. SetEntry(Rec.MatrixV, 5, 1, -1, -1/6);
  6919. end;
  6920. nm5x5: begin
  6921. SetLength(Rec.MatrixU, 20);
  6922. SetEntry(Rec.MatrixU, 0, -2, 2, -1 / 16);
  6923. SetEntry(Rec.MatrixU, 1, -1, 2, -1 / 10);
  6924. SetEntry(Rec.MatrixU, 2, 1, 2, 1 / 10);
  6925. SetEntry(Rec.MatrixU, 3, 2, 2, 1 / 16);
  6926. SetEntry(Rec.MatrixU, 4, -2, 1, -1 / 10);
  6927. SetEntry(Rec.MatrixU, 5, -1, 1, -1 / 8);
  6928. SetEntry(Rec.MatrixU, 6, 1, 1, 1 / 8);
  6929. SetEntry(Rec.MatrixU, 7, 2, 1, 1 / 10);
  6930. SetEntry(Rec.MatrixU, 8, -2, 0, -1 / 2.8);
  6931. SetEntry(Rec.MatrixU, 9, -1, 0, -0.5);
  6932. SetEntry(Rec.MatrixU, 10, 1, 0, 0.5);
  6933. SetEntry(Rec.MatrixU, 11, 2, 0, 1 / 2.8);
  6934. SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
  6935. SetEntry(Rec.MatrixU, 13, -1, -1, -1 / 8);
  6936. SetEntry(Rec.MatrixU, 14, 1, -1, 1 / 8);
  6937. SetEntry(Rec.MatrixU, 15, 2, -1, 1 / 10);
  6938. SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
  6939. SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
  6940. SetEntry(Rec.MatrixU, 18, 1, -2, 1 / 10);
  6941. SetEntry(Rec.MatrixU, 19, 2, -2, 1 / 16);
  6942. SetLength(Rec.MatrixV, 20);
  6943. SetEntry(Rec.MatrixV, 0, -2, 2, 1 / 16);
  6944. SetEntry(Rec.MatrixV, 1, -1, 2, 1 / 10);
  6945. SetEntry(Rec.MatrixV, 2, 0, 2, 0.25);
  6946. SetEntry(Rec.MatrixV, 3, 1, 2, 1 / 10);
  6947. SetEntry(Rec.MatrixV, 4, 2, 2, 1 / 16);
  6948. SetEntry(Rec.MatrixV, 5, -2, 1, 1 / 10);
  6949. SetEntry(Rec.MatrixV, 6, -1, 1, 1 / 8);
  6950. SetEntry(Rec.MatrixV, 7, 0, 1, 0.5);
  6951. SetEntry(Rec.MatrixV, 8, 1, 1, 1 / 8);
  6952. SetEntry(Rec.MatrixV, 9, 2, 1, 1 / 16);
  6953. SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
  6954. SetEntry(Rec.MatrixV, 11, -1, -1, -1 / 8);
  6955. SetEntry(Rec.MatrixV, 12, 0, -1, -0.5);
  6956. SetEntry(Rec.MatrixV, 13, 1, -1, -1 / 8);
  6957. SetEntry(Rec.MatrixV, 14, 2, -1, -1 / 10);
  6958. SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
  6959. SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
  6960. SetEntry(Rec.MatrixV, 17, 0, -2, -0.25);
  6961. SetEntry(Rec.MatrixV, 18, 1, -2, -1 / 10);
  6962. SetEntry(Rec.MatrixV, 19, 2, -2, -1 / 16);
  6963. end;
  6964. end;
  6965. // Daten Sammeln
  6966. if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
  6967. Convert(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
  6968. else
  6969. Convert(glBitmapToNormalMapPrepareFunc, false, @Rec);
  6970. Convert(glBitmapToNormalMapFunc, false, @Rec);
  6971. finally
  6972. SetLength(Rec.Heights, 0);
  6973. end;
  6974. end;
  6975. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6976. constructor TglBitmapData.Create;
  6977. begin
  6978. inherited Create;
  6979. fFormat := glBitmapDefaultFormat;
  6980. end;
  6981. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6982. constructor TglBitmapData.Create(const aFileName: String);
  6983. begin
  6984. Create;
  6985. LoadFromFile(aFileName);
  6986. end;
  6987. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6988. constructor TglBitmapData.Create(const aStream: TStream);
  6989. begin
  6990. Create;
  6991. LoadFromStream(aStream);
  6992. end;
  6993. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6994. constructor TglBitmapData.Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; aData: PByte);
  6995. var
  6996. ImageSize: Integer;
  6997. begin
  6998. Create;
  6999. if not Assigned(aData) then begin
  7000. ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  7001. GetMem(aData, ImageSize);
  7002. try
  7003. FillChar(aData^, ImageSize, #$FF);
  7004. SetData(aData, aFormat, aSize.X, aSize.Y);
  7005. except
  7006. if Assigned(aData) then
  7007. FreeMem(aData);
  7008. raise;
  7009. end;
  7010. end else begin
  7011. SetData(aData, aFormat, aSize.X, aSize.Y);
  7012. end;
  7013. end;
  7014. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7015. constructor TglBitmapData.Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer);
  7016. begin
  7017. Create;
  7018. LoadFromFunc(aSize, aFormat, aFunc, aArgs);
  7019. end;
  7020. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7021. constructor TglBitmapData.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
  7022. begin
  7023. Create;
  7024. LoadFromResource(aInstance, aResource, aResType);
  7025. end;
  7026. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7027. constructor TglBitmapData.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  7028. begin
  7029. Create;
  7030. LoadFromResourceID(aInstance, aResourceID, aResType);
  7031. end;
  7032. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7033. destructor TglBitmapData.Destroy;
  7034. begin
  7035. SetData(nil, tfEmpty);
  7036. inherited Destroy;
  7037. end;
  7038. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7039. //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7040. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7041. function TglBitmap.GetWidth: Integer;
  7042. begin
  7043. if (ffX in fDimension.Fields) then
  7044. result := fDimension.X
  7045. else
  7046. result := -1;
  7047. end;
  7048. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7049. function TglBitmap.GetHeight: Integer;
  7050. begin
  7051. if (ffY in fDimension.Fields) then
  7052. result := fDimension.Y
  7053. else
  7054. result := -1;
  7055. end;
  7056. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7057. procedure TglBitmap.SetCustomData(const aValue: Pointer);
  7058. begin
  7059. if fCustomData = aValue then
  7060. exit;
  7061. fCustomData := aValue;
  7062. end;
  7063. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7064. procedure TglBitmap.SetCustomName(const aValue: String);
  7065. begin
  7066. if fCustomName = aValue then
  7067. exit;
  7068. fCustomName := aValue;
  7069. end;
  7070. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7071. procedure TglBitmap.SetCustomNameW(const aValue: WideString);
  7072. begin
  7073. if fCustomNameW = aValue then
  7074. exit;
  7075. fCustomNameW := aValue;
  7076. end;
  7077. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7078. procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
  7079. begin
  7080. if fDeleteTextureOnFree = aValue then
  7081. exit;
  7082. fDeleteTextureOnFree := aValue;
  7083. end;
  7084. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7085. procedure TglBitmap.SetID(const aValue: Cardinal);
  7086. begin
  7087. if fID = aValue then
  7088. exit;
  7089. fID := aValue;
  7090. end;
  7091. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7092. procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
  7093. begin
  7094. if fMipMap = aValue then
  7095. exit;
  7096. fMipMap := aValue;
  7097. end;
  7098. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7099. procedure TglBitmap.SetTarget(const aValue: Cardinal);
  7100. begin
  7101. if fTarget = aValue then
  7102. exit;
  7103. fTarget := aValue;
  7104. end;
  7105. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7106. procedure TglBitmap.SetAnisotropic(const aValue: Integer);
  7107. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)}
  7108. var
  7109. MaxAnisotropic: Integer;
  7110. {$IFEND}
  7111. begin
  7112. fAnisotropic := aValue;
  7113. if (ID > 0) then begin
  7114. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)}
  7115. if GL_EXT_texture_filter_anisotropic then begin
  7116. if fAnisotropic > 0 then begin
  7117. Bind(false);
  7118. glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
  7119. if aValue > MaxAnisotropic then
  7120. fAnisotropic := MaxAnisotropic;
  7121. glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
  7122. end;
  7123. end else begin
  7124. fAnisotropic := 0;
  7125. end;
  7126. {$ELSE}
  7127. fAnisotropic := 0;
  7128. {$IFEND}
  7129. end;
  7130. end;
  7131. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7132. procedure TglBitmap.CreateID;
  7133. begin
  7134. if (ID <> 0) then
  7135. glDeleteTextures(1, @fID);
  7136. glGenTextures(1, @fID);
  7137. Bind(false);
  7138. end;
  7139. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7140. procedure TglBitmap.SetupParameters({$IFNDEF OPENGL_ES}out aBuildWithGlu: Boolean{$ENDIF});
  7141. begin
  7142. // Set Up Parameters
  7143. SetWrap(fWrapS, fWrapT, fWrapR);
  7144. SetFilter(fFilterMin, fFilterMag);
  7145. SetAnisotropic(fAnisotropic);
  7146. {$IFNDEF OPENGL_ES}
  7147. SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
  7148. if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  7149. SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  7150. {$ENDIF}
  7151. {$IFNDEF OPENGL_ES}
  7152. // Mip Maps Generation Mode
  7153. aBuildWithGlu := false;
  7154. if (MipMap = mmMipmap) then begin
  7155. if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
  7156. glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
  7157. else
  7158. aBuildWithGlu := true;
  7159. end else if (MipMap = mmMipmapGlu) then
  7160. aBuildWithGlu := true;
  7161. {$ELSE}
  7162. if (MipMap = mmMipmap) then
  7163. glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE);
  7164. {$ENDIF}
  7165. end;
  7166. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7167. //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7168. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7169. procedure TglBitmap.AfterConstruction;
  7170. begin
  7171. inherited AfterConstruction;
  7172. fID := 0;
  7173. fTarget := 0;
  7174. {$IFNDEF OPENGL_ES}
  7175. fIsResident := false;
  7176. {$ENDIF}
  7177. fMipMap := glBitmapDefaultMipmap;
  7178. fDeleteTextureOnFree := glBitmapGetDefaultDeleteTextureOnFree;
  7179. glBitmapGetDefaultFilter (fFilterMin, fFilterMag);
  7180. glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
  7181. {$IFNDEF OPENGL_ES}
  7182. glBitmapGetDefaultSwizzle (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  7183. {$ENDIF}
  7184. end;
  7185. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7186. procedure TglBitmap.BeforeDestruction;
  7187. begin
  7188. if (fID > 0) and fDeleteTextureOnFree then
  7189. glDeleteTextures(1, @fID);
  7190. inherited BeforeDestruction;
  7191. end;
  7192. {$IFNDEF OPENGL_ES}
  7193. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7194. procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  7195. begin
  7196. fBorderColor[0] := aRed;
  7197. fBorderColor[1] := aGreen;
  7198. fBorderColor[2] := aBlue;
  7199. fBorderColor[3] := aAlpha;
  7200. if (ID > 0) then begin
  7201. Bind(false);
  7202. glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
  7203. end;
  7204. end;
  7205. {$ENDIF}
  7206. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7207. procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
  7208. begin
  7209. //check MIN filter
  7210. case aMin of
  7211. GL_NEAREST:
  7212. fFilterMin := GL_NEAREST;
  7213. GL_LINEAR:
  7214. fFilterMin := GL_LINEAR;
  7215. GL_NEAREST_MIPMAP_NEAREST:
  7216. fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
  7217. GL_LINEAR_MIPMAP_NEAREST:
  7218. fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
  7219. GL_NEAREST_MIPMAP_LINEAR:
  7220. fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
  7221. GL_LINEAR_MIPMAP_LINEAR:
  7222. fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
  7223. else
  7224. raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
  7225. end;
  7226. //check MAG filter
  7227. case aMag of
  7228. GL_NEAREST:
  7229. fFilterMag := GL_NEAREST;
  7230. GL_LINEAR:
  7231. fFilterMag := GL_LINEAR;
  7232. else
  7233. raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
  7234. end;
  7235. //apply filter
  7236. if (ID > 0) then begin
  7237. Bind(false);
  7238. glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
  7239. if (MipMap = mmNone) {$IFNDEF OPENGL_ES}or (Target = GL_TEXTURE_RECTANGLE){$ENDIF} then begin
  7240. case fFilterMin of
  7241. GL_NEAREST, GL_LINEAR:
  7242. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  7243. GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
  7244. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
  7245. GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
  7246. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
  7247. end;
  7248. end else
  7249. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  7250. end;
  7251. end;
  7252. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7253. procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
  7254. procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
  7255. begin
  7256. case aValue of
  7257. {$IFNDEF OPENGL_ES}
  7258. GL_CLAMP:
  7259. aTarget := GL_CLAMP;
  7260. {$ENDIF}
  7261. GL_REPEAT:
  7262. aTarget := GL_REPEAT;
  7263. GL_CLAMP_TO_EDGE: begin
  7264. {$IFNDEF OPENGL_ES}
  7265. if not GL_VERSION_1_2 and not GL_EXT_texture_edge_clamp then
  7266. aTarget := GL_CLAMP
  7267. else
  7268. {$ENDIF}
  7269. aTarget := GL_CLAMP_TO_EDGE;
  7270. end;
  7271. {$IFNDEF OPENGL_ES}
  7272. GL_CLAMP_TO_BORDER: begin
  7273. if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
  7274. aTarget := GL_CLAMP_TO_BORDER
  7275. else
  7276. aTarget := GL_CLAMP;
  7277. end;
  7278. {$ENDIF}
  7279. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  7280. GL_MIRRORED_REPEAT: begin
  7281. {$IFNDEF OPENGL_ES}
  7282. if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
  7283. {$ELSE}
  7284. if GL_VERSION_2_0 then
  7285. {$ENDIF}
  7286. aTarget := GL_MIRRORED_REPEAT
  7287. else
  7288. raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
  7289. end;
  7290. {$IFEND}
  7291. else
  7292. raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
  7293. end;
  7294. end;
  7295. begin
  7296. CheckAndSetWrap(S, fWrapS);
  7297. CheckAndSetWrap(T, fWrapT);
  7298. CheckAndSetWrap(R, fWrapR);
  7299. if (ID > 0) then begin
  7300. Bind(false);
  7301. glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
  7302. glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
  7303. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  7304. {$IFDEF OPENGL_ES} if GL_VERSION_3_0 then{$ENDIF}
  7305. glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
  7306. {$IFEND}
  7307. end;
  7308. end;
  7309. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  7310. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7311. procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
  7312. procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
  7313. begin
  7314. if (aValue = GL_ZERO) or (aValue = GL_ONE) or (aValue = GL_ALPHA) or
  7315. (aValue = GL_RED) or (aValue = GL_GREEN) or (aValue = GL_BLUE) then
  7316. fSwizzle[aIndex] := aValue
  7317. else
  7318. raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
  7319. end;
  7320. begin
  7321. {$IFNDEF OPENGL_ES}
  7322. if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  7323. raise EglBitmapNotSupported.Create('texture swizzle is not supported');
  7324. {$ELSE}
  7325. if not GL_VERSION_3_0 then
  7326. raise EglBitmapNotSupported.Create('texture swizzle is not supported');
  7327. {$ENDIF}
  7328. CheckAndSetValue(r, 0);
  7329. CheckAndSetValue(g, 1);
  7330. CheckAndSetValue(b, 2);
  7331. CheckAndSetValue(a, 3);
  7332. if (ID > 0) then begin
  7333. Bind(false);
  7334. {$IFNDEF OPENGL_ES}
  7335. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, PGLint(@fSwizzle[0]));
  7336. {$ELSE}
  7337. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_R, PGLint(@fSwizzle[0]));
  7338. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_G, PGLint(@fSwizzle[1]));
  7339. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_B, PGLint(@fSwizzle[2]));
  7340. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_A, PGLint(@fSwizzle[3]));
  7341. {$ENDIF}
  7342. end;
  7343. end;
  7344. {$IFEND}
  7345. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7346. procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
  7347. begin
  7348. if aEnableTextureUnit then
  7349. glEnable(Target);
  7350. if (ID > 0) then
  7351. glBindTexture(Target, ID);
  7352. end;
  7353. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7354. procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
  7355. begin
  7356. if aDisableTextureUnit then
  7357. glDisable(Target);
  7358. glBindTexture(Target, 0);
  7359. end;
  7360. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7361. procedure TglBitmap.UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean);
  7362. var
  7363. w, h: Integer;
  7364. begin
  7365. w := aDataObj.Width;
  7366. h := aDataObj.Height;
  7367. fDimension.Fields := [];
  7368. if (w > 0) then
  7369. fDimension.Fields := fDimension.Fields + [ffX];
  7370. if (h > 0) then
  7371. fDimension.Fields := fDimension.Fields + [ffY];
  7372. fDimension.X := w;
  7373. fDimension.Y := h;
  7374. end;
  7375. {$IFNDEF OPENGL_ES}
  7376. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7377. function TglBitmap.DownloadData(const aDataObj: TglBitmapData): Boolean;
  7378. var
  7379. Temp: PByte;
  7380. TempWidth, TempHeight: Integer;
  7381. TempIntFormat: GLint;
  7382. IntFormat: TglBitmapFormat;
  7383. FormatDesc: TFormatDescriptor;
  7384. begin
  7385. result := false;
  7386. Bind;
  7387. // Request Data
  7388. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH, @TempWidth);
  7389. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT, @TempHeight);
  7390. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
  7391. FormatDesc := (TglBitmapFormatDescriptor.GetByFormat(TempIntFormat) as TFormatDescriptor);
  7392. IntFormat := FormatDesc.Format;
  7393. // Getting data from OpenGL
  7394. FormatDesc := TFormatDescriptor.Get(IntFormat);
  7395. GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
  7396. try
  7397. if FormatDesc.IsCompressed then begin
  7398. if not Assigned(glGetCompressedTexImage) then
  7399. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7400. glGetCompressedTexImage(Target, 0, Temp)
  7401. end else
  7402. glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  7403. aDataObj.SetData(Temp, IntFormat, TempWidth, TempHeight);
  7404. result := true;
  7405. except
  7406. if Assigned(Temp) then
  7407. FreeMem(Temp);
  7408. raise;
  7409. end;
  7410. end;
  7411. {$ENDIF}
  7412. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7413. constructor TglBitmap.Create;
  7414. begin
  7415. if (ClassType = TglBitmap) then
  7416. raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
  7417. inherited Create;
  7418. end;
  7419. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7420. constructor TglBitmap.Create(const aData: TglBitmapData);
  7421. begin
  7422. Create;
  7423. UploadData(aData);
  7424. end;
  7425. {$IFNDEF OPENGL_ES}
  7426. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7427. //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7428. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7429. procedure TglBitmap1D.UploadDataIntern(const aDataObj: TglBitmapData; const aBuildWithGlu: Boolean);
  7430. var
  7431. fd: TglBitmapFormatDescriptor;
  7432. begin
  7433. // Upload data
  7434. fd := aDataObj.FormatDescriptor;
  7435. if (fd.glFormat = 0) or (fd.glInternalFormat = 0) or (fd.glDataFormat = 0) then
  7436. raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data');
  7437. if fd.IsCompressed then begin
  7438. if not Assigned(glCompressedTexImage1D) then
  7439. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7440. glCompressedTexImage1D(Target, 0, fd.glInternalFormat, aDataObj.Width, 0, fd.GetSize(aDataObj.Width, 1), aDataObj.Data)
  7441. end else if aBuildWithGlu then
  7442. gluBuild1DMipmaps(Target, fd.glInternalFormat, aDataObj.Width, fd.glFormat, fd.glDataFormat, aDataObj.Data)
  7443. else
  7444. glTexImage1D(Target, 0, fd.glInternalFormat, aDataObj.Width, 0, fd.glFormat, fd.glDataFormat, aDataObj.Data);
  7445. end;
  7446. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7447. procedure TglBitmap1D.AfterConstruction;
  7448. begin
  7449. inherited;
  7450. Target := GL_TEXTURE_1D;
  7451. end;
  7452. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7453. procedure TglBitmap1D.UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean);
  7454. var
  7455. BuildWithGlu, TexRec: Boolean;
  7456. TexSize: Integer;
  7457. begin
  7458. if not Assigned(aDataObj) then
  7459. exit;
  7460. // Check Texture Size
  7461. if (aCheckSize) then begin
  7462. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  7463. if (aDataObj.Width > TexSize) then
  7464. raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  7465. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
  7466. (Target = GL_TEXTURE_RECTANGLE);
  7467. if not (IsPowerOfTwo(aDataObj.Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  7468. raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7469. end;
  7470. if (fID = 0) then
  7471. CreateID;
  7472. SetupParameters(BuildWithGlu);
  7473. UploadDataIntern(aDataObj, BuildWithGlu);
  7474. glAreTexturesResident(1, @fID, @fIsResident);
  7475. inherited UploadData(aDataObj, aCheckSize);
  7476. end;
  7477. {$ENDIF}
  7478. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7479. //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7480. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7481. procedure TglBitmap2D.UploadDataIntern(const aDataObj: TglBitmapData; const aTarget: GLenum; const aBuildWithGlu: Boolean);
  7482. var
  7483. fd: TglBitmapFormatDescriptor;
  7484. begin
  7485. fd := aDataObj.FormatDescriptor;
  7486. if (fd.glFormat = 0) or (fd.glInternalFormat = 0) or (fd.glDataFormat = 0) then
  7487. raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data');
  7488. glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
  7489. if fd.IsCompressed then begin
  7490. if not Assigned(glCompressedTexImage2D) then
  7491. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7492. glCompressedTexImage2D(aTarget, 0, fd.glInternalFormat, aDataObj.Width, aDataObj.Height, 0, fd.GetSize(fDimension), aDataObj.Data)
  7493. {$IFNDEF OPENGL_ES}
  7494. end else if aBuildWithGlu then begin
  7495. gluBuild2DMipmaps(aTarget, fd.ChannelCount, aDataObj.Width, aDataObj.Height, fd.glFormat, fd.glDataFormat, aDataObj.Data)
  7496. {$ENDIF}
  7497. end else begin
  7498. glTexImage2D(aTarget, 0, fd.glInternalFormat, aDataObj.Width, aDataObj.Height, 0, fd.glFormat, fd.glDataFormat, aDataObj.Data);
  7499. end;
  7500. end;
  7501. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7502. procedure TglBitmap2D.AfterConstruction;
  7503. begin
  7504. inherited;
  7505. Target := GL_TEXTURE_2D;
  7506. end;
  7507. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7508. procedure TglBitmap2D.UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean);
  7509. var
  7510. {$IFNDEF OPENGL_ES}
  7511. BuildWithGlu, TexRec: Boolean;
  7512. {$ENDIF}
  7513. PotTex: Boolean;
  7514. TexSize: Integer;
  7515. begin
  7516. if not Assigned(aDataObj) then
  7517. exit;
  7518. // Check Texture Size
  7519. if (aCheckSize) then begin
  7520. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  7521. if ((aDataObj.Width > TexSize) or (aDataObj.Height > TexSize)) then
  7522. raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  7523. PotTex := IsPowerOfTwo(aDataObj.Width) and IsPowerOfTwo(aDataObj.Height);
  7524. {$IF NOT DEFINED(OPENGL_ES)}
  7525. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
  7526. if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  7527. raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7528. {$ELSEIF DEFINED(OPENGL_ES_EXT)}
  7529. if not PotTex and not GL_OES_texture_npot then
  7530. raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7531. {$ELSE}
  7532. if not PotTex then
  7533. raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7534. {$IFEND}
  7535. end;
  7536. if (fID = 0) then
  7537. CreateID;
  7538. SetupParameters({$IFNDEF OPENGL_ES}BuildWithGlu{$ENDIF});
  7539. UploadDataIntern(aDataObj, Target{$IFNDEF OPENGL_ES}, BuildWithGlu{$ENDIF});
  7540. {$IFNDEF OPENGL_ES}
  7541. glAreTexturesResident(1, @fID, @fIsResident);
  7542. {$ENDIF}
  7543. inherited UploadData(aDataObj, aCheckSize);
  7544. end;
  7545. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7546. class procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat; const aDataObj: TglBitmapData);
  7547. var
  7548. Temp: pByte;
  7549. Size, w, h: Integer;
  7550. FormatDesc: TFormatDescriptor;
  7551. begin
  7552. FormatDesc := TFormatDescriptor.Get(aFormat);
  7553. if FormatDesc.IsCompressed then
  7554. raise EglBitmapUnsupportedFormat.Create(aFormat);
  7555. w := aRight - aLeft;
  7556. h := aBottom - aTop;
  7557. Size := FormatDesc.GetSize(w, h);
  7558. GetMem(Temp, Size);
  7559. try
  7560. glPixelStorei(GL_PACK_ALIGNMENT, 1);
  7561. glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  7562. aDataObj.SetData(Temp, aFormat, w, h);
  7563. aDataObj.FlipVert;
  7564. except
  7565. if Assigned(Temp) then
  7566. FreeMem(Temp);
  7567. raise;
  7568. end;
  7569. end;
  7570. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  7571. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7572. //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7573. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7574. procedure TglBitmapCubeMap.AfterConstruction;
  7575. begin
  7576. inherited;
  7577. {$IFNDEF OPENGL_ES}
  7578. if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
  7579. raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
  7580. {$ELSE}
  7581. if not (GL_VERSION_2_0) then
  7582. raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
  7583. {$ENDIF}
  7584. SetWrap;
  7585. Target := GL_TEXTURE_CUBE_MAP;
  7586. {$IFNDEF OPENGL_ES}
  7587. fGenMode := GL_REFLECTION_MAP;
  7588. {$ENDIF}
  7589. end;
  7590. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7591. procedure TglBitmapCubeMap.UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean);
  7592. begin
  7593. Assert(false, 'TglBitmapCubeMap.UploadData - Don''t call UploadData directly, use UploadCubeMap instead');
  7594. end;
  7595. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7596. procedure TglBitmapCubeMap.UploadCubeMap(const aDataObj: TglBitmapData; const aCubeTarget: Cardinal; const aCheckSize: Boolean);
  7597. var
  7598. {$IFNDEF OPENGL_ES}
  7599. BuildWithGlu: Boolean;
  7600. {$ENDIF}
  7601. TexSize: Integer;
  7602. begin
  7603. if (aCheckSize) then begin
  7604. glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
  7605. if (aDataObj.Width > TexSize) or (aDataObj.Height > TexSize) then
  7606. raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenerateCubeMap - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
  7607. {$IF NOT DEFINED(OPENGL_ES)}
  7608. if not ((IsPowerOfTwo(aDataObj.Width) and IsPowerOfTwo(aDataObj.Height)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
  7609. raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
  7610. {$ELSEIF DEFINED(OPENGL_ES_EXT)}
  7611. if not (IsPowerOfTwo(aDataObj.Width) and IsPowerOfTwo(aDataObj.Height)) and not GL_OES_texture_npot then
  7612. raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
  7613. {$ELSE}
  7614. if not (IsPowerOfTwo(aDataObj.Width) and IsPowerOfTwo(aDataObj.Height)) then
  7615. raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
  7616. {$IFEND}
  7617. end;
  7618. if (fID = 0) then
  7619. CreateID;
  7620. SetupParameters({$IFNDEF OPENGL_ES}BuildWithGlu{$ENDIF});
  7621. UploadDataIntern(aDataObj, aCubeTarget{$IFNDEF OPENGL_ES}, BuildWithGlu{$ENDIF});
  7622. inherited UploadData(aDataObj, aCheckSize);
  7623. end;
  7624. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7625. procedure TglBitmapCubeMap.Bind({$IFNDEF OPENGL_ES}const aEnableTexCoordsGen: Boolean;{$ENDIF} const aEnableTextureUnit: Boolean);
  7626. begin
  7627. inherited Bind (aEnableTextureUnit);
  7628. {$IFNDEF OPENGL_ES}
  7629. if aEnableTexCoordsGen then begin
  7630. glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
  7631. glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
  7632. glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
  7633. glEnable(GL_TEXTURE_GEN_S);
  7634. glEnable(GL_TEXTURE_GEN_T);
  7635. glEnable(GL_TEXTURE_GEN_R);
  7636. end;
  7637. {$ENDIF}
  7638. end;
  7639. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7640. procedure TglBitmapCubeMap.Unbind({$IFNDEF OPENGL_ES}const aDisableTexCoordsGen: Boolean;{$ENDIF} const aDisableTextureUnit: Boolean);
  7641. begin
  7642. inherited Unbind(aDisableTextureUnit);
  7643. {$IFNDEF OPENGL_ES}
  7644. if aDisableTexCoordsGen then begin
  7645. glDisable(GL_TEXTURE_GEN_S);
  7646. glDisable(GL_TEXTURE_GEN_T);
  7647. glDisable(GL_TEXTURE_GEN_R);
  7648. end;
  7649. {$ENDIF}
  7650. end;
  7651. {$IFEND}
  7652. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  7653. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7654. //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7655. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7656. type
  7657. TVec = Array[0..2] of Single;
  7658. TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7659. PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
  7660. TglBitmapNormalMapRec = record
  7661. HalfSize : Integer;
  7662. Func: TglBitmapNormalMapGetVectorFunc;
  7663. end;
  7664. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7665. procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7666. begin
  7667. aVec[0] := aHalfSize;
  7668. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7669. aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
  7670. end;
  7671. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7672. procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7673. begin
  7674. aVec[0] := - aHalfSize;
  7675. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7676. aVec[2] := aPosition.X + 0.5 - aHalfSize;
  7677. end;
  7678. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7679. procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7680. begin
  7681. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7682. aVec[1] := aHalfSize;
  7683. aVec[2] := aPosition.Y + 0.5 - aHalfSize;
  7684. end;
  7685. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7686. procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7687. begin
  7688. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7689. aVec[1] := - aHalfSize;
  7690. aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
  7691. end;
  7692. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7693. procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7694. begin
  7695. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7696. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7697. aVec[2] := aHalfSize;
  7698. end;
  7699. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7700. procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7701. begin
  7702. aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
  7703. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7704. aVec[2] := - aHalfSize;
  7705. end;
  7706. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7707. procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
  7708. var
  7709. i: Integer;
  7710. Vec: TVec;
  7711. Len: Single;
  7712. begin
  7713. with FuncRec do begin
  7714. with PglBitmapNormalMapRec(Args)^ do begin
  7715. Func(Vec, Position, HalfSize);
  7716. // Normalize
  7717. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  7718. if Len <> 0 then begin
  7719. Vec[0] := Vec[0] * Len;
  7720. Vec[1] := Vec[1] * Len;
  7721. Vec[2] := Vec[2] * Len;
  7722. end;
  7723. // Scale Vector and AddVectro
  7724. Vec[0] := Vec[0] * 0.5 + 0.5;
  7725. Vec[1] := Vec[1] * 0.5 + 0.5;
  7726. Vec[2] := Vec[2] * 0.5 + 0.5;
  7727. end;
  7728. // Set Color
  7729. for i := 0 to 2 do
  7730. Dest.Data.arr[i] := Round(Vec[i] * 255);
  7731. end;
  7732. end;
  7733. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7734. procedure TglBitmapNormalMap.AfterConstruction;
  7735. begin
  7736. inherited;
  7737. {$IFNDEF OPENGL_ES}
  7738. fGenMode := GL_NORMAL_MAP;
  7739. {$ENDIF}
  7740. end;
  7741. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7742. procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aCheckSize: Boolean);
  7743. var
  7744. Rec: TglBitmapNormalMapRec;
  7745. SizeRec: TglBitmapSize;
  7746. DataObj: TglBitmapData;
  7747. begin
  7748. Rec.HalfSize := aSize div 2;
  7749. SizeRec.Fields := [ffX, ffY];
  7750. SizeRec.X := aSize;
  7751. SizeRec.Y := aSize;
  7752. DataObj := TglBitmapData.Create;
  7753. try
  7754. // Positive X
  7755. Rec.Func := glBitmapNormalMapPosX;
  7756. DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
  7757. UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_POSITIVE_X, aCheckSize);
  7758. // Negative X
  7759. Rec.Func := glBitmapNormalMapNegX;
  7760. DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
  7761. UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aCheckSize);
  7762. // Positive Y
  7763. Rec.Func := glBitmapNormalMapPosY;
  7764. DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
  7765. UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aCheckSize);
  7766. // Negative Y
  7767. Rec.Func := glBitmapNormalMapNegY;
  7768. DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
  7769. UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aCheckSize);
  7770. // Positive Z
  7771. Rec.Func := glBitmapNormalMapPosZ;
  7772. DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
  7773. UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aCheckSize);
  7774. // Negative Z
  7775. Rec.Func := glBitmapNormalMapNegZ;
  7776. DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
  7777. UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aCheckSize);
  7778. finally
  7779. FreeAndNil(DataObj);
  7780. end;
  7781. end;
  7782. {$IFEND}
  7783. initialization
  7784. glBitmapSetDefaultFormat (tfEmpty);
  7785. glBitmapSetDefaultMipmap (mmMipmap);
  7786. glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
  7787. glBitmapSetDefaultWrap (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
  7788. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  7789. glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
  7790. {$IFEND}
  7791. glBitmapSetDefaultFreeDataAfterGenTexture(true);
  7792. glBitmapSetDefaultDeleteTextureOnFree (true);
  7793. TFormatDescriptor.Init;
  7794. finalization
  7795. TFormatDescriptor.Finalize;
  7796. end.