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.

8888 lines
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. { @return @true if the format is supported by OpenGL, @false otherwise }
  325. function GetHasOpenGLSupport: Boolean;
  326. protected
  327. fFormat: TglBitmapFormat; //< format this descriptor belongs to
  328. fWithAlpha: TglBitmapFormat; //< suitable format with alpha channel
  329. fWithoutAlpha: TglBitmapFormat; //< suitable format without alpha channel
  330. fOpenGLFormat: TglBitmapFormat; //< suitable format that is supported by OpenGL
  331. fRGBInverted: TglBitmapFormat; //< suitable format with inverted RGB channels
  332. fUncompressed: TglBitmapFormat; //< suitable format with uncompressed data
  333. fBitsPerPixel: Integer; //< number of bits per pixel
  334. fIsCompressed: Boolean; //< @true if the format is compressed, @false otherwise
  335. fPrecision: TglBitmapRec4ub; //< number of bits for each color channel
  336. fShift: TglBitmapRec4ub; //< bit offset for each color channel
  337. fglFormat: GLenum; //< OpenGL format enum (e.g. GL_RGB)
  338. fglInternalFormat: GLenum; //< OpenGL internal format enum (e.g. GL_RGB8)
  339. fglDataFormat: GLenum; //< OpenGL data format enum (e.g. GL_UNSIGNED_BYTE)
  340. { set values for this format descriptor }
  341. procedure SetValues; virtual;
  342. { calculate cached values }
  343. procedure CalcValues;
  344. public
  345. property Format: TglBitmapFormat read fFormat; //< format this descriptor belongs to
  346. property ChannelCount: Integer read fChannelCount; //< number of color channels
  347. property IsCompressed: Boolean read fIsCompressed; //< @true if the format is compressed, @false otherwise
  348. property BitsPerPixel: Integer read fBitsPerPixel; //< number of bytes per pixel
  349. property BytesPerPixel: Single read fBytesPerPixel; //< number of bits per pixel
  350. property Precision: TglBitmapRec4ub read fPrecision; //< number of bits for each color channel
  351. property Shift: TglBitmapRec4ub read fShift; //< bit offset for each color channel
  352. property Range: TglBitmapRec4ui read fRange; //< maximal value of each color channel
  353. property Mask: TglBitmapRec4ul read fMask; //< bitmask for each color channel
  354. property RGBInverted: TglBitmapFormat read fRGBInverted; //< suitable format with inverted RGB channels
  355. property WithAlpha: TglBitmapFormat read fWithAlpha; //< suitable format with alpha channel
  356. property WithoutAlpha: TglBitmapFormat read fWithAlpha; //< suitable format without alpha channel
  357. property OpenGLFormat: TglBitmapFormat read fOpenGLFormat; //< suitable format that is supported by OpenGL
  358. property Uncompressed: TglBitmapFormat read fUncompressed; //< suitable format with uncompressed data
  359. property glFormat: GLenum read fglFormat; //< OpenGL format enum (e.g. GL_RGB)
  360. property glInternalFormat: GLenum read fglInternalFormat; //< OpenGL internal format enum (e.g. GL_RGB8)
  361. property glDataFormat: GLenum read fglDataFormat; //< OpenGL data format enum (e.g. GL_UNSIGNED_BYTE)
  362. property HasRed: Boolean read GetHasRed; //< @true if the format has a red color channel, @false otherwise
  363. property HasGreen: Boolean read GetHasGreen; //< @true if the format has a green color channel, @false otherwise
  364. property HasBlue: Boolean read GetHasBlue; //< @true if the format has a blue color channel, @false otherwise
  365. property HasAlpha: Boolean read GetHasAlpha; //< @true if the format has a alpha color channel, @false otherwise
  366. property HasColor: Boolean read GetHasColor; //< @true if the format has any color color channel, @false otherwise
  367. property IsGrayscale: Boolean read GetIsGrayscale; //< @true if the format is a grayscale format, @false otherwise
  368. property HasOpenGLSupport: Boolean read GetHasOpenGLSupport; //< @true if the format is supported by OpenGL, @false otherwise
  369. function GetSize(const aSize: TglBitmapSize): Integer; overload; virtual;
  370. function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
  371. { constructor }
  372. constructor Create;
  373. public
  374. { get the format descriptor by a given OpenGL internal format
  375. @param aInternalFormat OpenGL internal format to get format descriptor for
  376. @returns suitable format descriptor or tfEmpty-Descriptor }
  377. class function GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
  378. end;
  379. ////////////////////////////////////////////////////////////////////////////////////////////////////
  380. TglBitmapData = class;
  381. { structure to store data for converting in }
  382. TglBitmapFunctionRec = record
  383. Sender: TglBitmapData; //< texture object that stores the data to convert
  384. Size: TglBitmapSize; //< size of the texture
  385. Position: TglBitmapPixelPosition; //< position of the currently pixel
  386. Source: TglBitmapPixelData; //< pixel data of the current pixel
  387. Dest: TglBitmapPixelData; //< new data of the pixel (must be filled in)
  388. Args: Pointer; //< user defined args that was passed to the convert function
  389. end;
  390. { callback to use for converting texture data }
  391. TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
  392. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  393. { class to store texture data in. used to load, save and
  394. manipulate data before assigned to texture object
  395. all operations on a data object can be done from a background thread }
  396. TglBitmapData = class
  397. private { fields }
  398. fData: PByte; //< texture data
  399. fDimension: TglBitmapSize; //< pixel size of the data
  400. fFormat: TglBitmapFormat; //< format the texture data is stored in
  401. fFilename: String; //< file the data was load from
  402. fScanlines: array of PByte; //< pointer to begin of each line
  403. fHasScanlines: Boolean; //< @true if scanlines are initialized, @false otherwise
  404. private { getter / setter }
  405. { @returns the format descriptor suitable to the texture data format }
  406. function GetFormatDescriptor: TglBitmapFormatDescriptor;
  407. { @returns the width of the texture data (in pixel) or -1 if no data is set }
  408. function GetWidth: Integer;
  409. { @returns the height of the texture data (in pixel) or -1 if no data is set }
  410. function GetHeight: Integer;
  411. { get scanline at index aIndex
  412. @returns Pointer to start of line or @nil }
  413. function GetScanlines(const aIndex: Integer): PByte;
  414. { set new value for the data format. only possible if new format has the same pixel size.
  415. if you want to convert the texture data, see ConvertTo function }
  416. procedure SetFormat(const aValue: TglBitmapFormat);
  417. private { internal misc }
  418. { splits a resource identifier into the resource and it's type
  419. @param aResource resource identifier to split and store name in
  420. @param aResType type of the resource }
  421. procedure PrepareResType(var aResource: String; var aResType: PChar);
  422. { updates scanlines array }
  423. procedure UpdateScanlines;
  424. private { internal load and save }
  425. {$IFDEF GLB_SUPPORT_PNG_READ}
  426. { try to load a PNG from a stream
  427. @param aStream stream to load PNG from
  428. @returns @true on success, @false otherwise }
  429. function LoadPNG(const aStream: TStream): Boolean; virtual;
  430. {$ENDIF}
  431. {$ifdef GLB_SUPPORT_PNG_WRITE}
  432. { save texture data as PNG to stream
  433. @param aStream stream to save data to}
  434. procedure SavePNG(const aStream: TStream); virtual;
  435. {$ENDIF}
  436. {$IFDEF GLB_SUPPORT_JPEG_READ}
  437. { try to load a JPEG from a stream
  438. @param aStream stream to load JPEG from
  439. @returns @true on success, @false otherwise }
  440. function LoadJPEG(const aStream: TStream): Boolean; virtual;
  441. {$ENDIF}
  442. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  443. { save texture data as JPEG to stream
  444. @param aStream stream to save data to}
  445. procedure SaveJPEG(const aStream: TStream); virtual;
  446. {$ENDIF}
  447. { try to load a RAW image from a stream
  448. @param aStream stream to load RAW image from
  449. @returns @true on success, @false otherwise }
  450. function LoadRAW(const aStream: TStream): Boolean;
  451. { save texture data as RAW image to stream
  452. @param aStream stream to save data to}
  453. procedure SaveRAW(const aStream: TStream);
  454. { try to load a BMP from a stream
  455. @param aStream stream to load BMP from
  456. @returns @true on success, @false otherwise }
  457. function LoadBMP(const aStream: TStream): Boolean;
  458. { save texture data as BMP to stream
  459. @param aStream stream to save data to}
  460. procedure SaveBMP(const aStream: TStream);
  461. { try to load a TGA from a stream
  462. @param aStream stream to load TGA from
  463. @returns @true on success, @false otherwise }
  464. function LoadTGA(const aStream: TStream): Boolean;
  465. { save texture data as TGA to stream
  466. @param aStream stream to save data to}
  467. procedure SaveTGA(const aStream: TStream);
  468. { try to load a DDS from a stream
  469. @param aStream stream to load DDS from
  470. @returns @true on success, @false otherwise }
  471. function LoadDDS(const aStream: TStream): Boolean;
  472. { save texture data as DDS to stream
  473. @param aStream stream to save data to}
  474. procedure SaveDDS(const aStream: TStream);
  475. public { properties }
  476. property Data: PByte read fData; //< texture data (be carefull with this!)
  477. property Dimension: TglBitmapSize read fDimension; //< size of the texture data (in pixel)
  478. property Filename: String read fFilename; //< file the data was loaded from
  479. property Width: Integer read GetWidth; //< width of the texture data (in pixel)
  480. property Height: Integer read GetHeight; //< height of the texture data (in pixel)
  481. property Format: TglBitmapFormat read fFormat write SetFormat; //< format the texture data is stored in
  482. property Scanlines[const aIndex: Integer]: PByte read GetScanlines; //< pointer to begin of line at given index or @nil
  483. property FormatDescriptor: TglBitmapFormatDescriptor read GetFormatDescriptor; //< descriptor object that describes the format of the stored data
  484. public { flip }
  485. { flip texture horizontal
  486. @returns @true in success, @false otherwise }
  487. function FlipHorz: Boolean; virtual;
  488. { flip texture vertical
  489. @returns @true in success, @false otherwise }
  490. function FlipVert: Boolean; virtual;
  491. public { load }
  492. { load a texture from a file
  493. @param aFilename file to load texuture from }
  494. procedure LoadFromFile(const aFilename: String);
  495. { load a texture from a stream
  496. @param aStream stream to load texture from }
  497. procedure LoadFromStream(const aStream: TStream); virtual;
  498. { use a function to generate texture data
  499. @param aSize size of the texture
  500. @param aFormat format of the texture data
  501. @param aFunc callback to use for generation
  502. @param aArgs user defined paramaters (use at will) }
  503. procedure LoadFromFunc(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil);
  504. { load a texture from a resource
  505. @param aInstance resource handle
  506. @param aResource resource indentifier
  507. @param aResType resource type (if known) }
  508. procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
  509. { load a texture from a resource id
  510. @param aInstance resource handle
  511. @param aResource resource ID
  512. @param aResType resource type }
  513. procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  514. public { save }
  515. { save texture data to a file
  516. @param aFilename filename to store texture in
  517. @param aFileType file type to store data into }
  518. procedure SaveToFile(const aFilename: String; const aFileType: TglBitmapFileType);
  519. { save texture data to a stream
  520. @param aFilename filename to store texture in
  521. @param aFileType file type to store data into }
  522. procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
  523. public { convert }
  524. { convert texture data using a user defined callback
  525. @param aFunc callback to use for converting
  526. @param aCreateTemp create a temporary buffer to use for converting
  527. @param aArgs user defined paramters (use at will)
  528. @returns @true if converting was successful, @false otherwise }
  529. function Convert(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
  530. { convert texture data using a user defined callback
  531. @param aSource glBitmap to read data from
  532. @param aFunc callback to use for converting
  533. @param aCreateTemp create a temporary buffer to use for converting
  534. @param aFormat format of the new data
  535. @param aArgs user defined paramters (use at will)
  536. @returns @true if converting was successful, @false otherwise }
  537. function Convert(const aSource: TglBitmapData; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  538. const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
  539. { convert texture data using a specific format
  540. @param aFormat new format of texture data
  541. @returns @true if converting was successful, @false otherwise }
  542. function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
  543. {$IFDEF GLB_SDL}
  544. public { SDL }
  545. { assign texture data to SDL surface
  546. @param aSurface SDL surface to write data to
  547. @returns @true on success, @false otherwise }
  548. function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  549. { assign texture data from SDL surface
  550. @param aSurface SDL surface to read data from
  551. @returns @true on success, @false otherwise }
  552. function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  553. { assign alpha channel data to SDL surface
  554. @param aSurface SDL surface to write alpha channel data to
  555. @returns @true on success, @false otherwise }
  556. function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  557. { assign alpha channel data from SDL surface
  558. @param aSurface SDL surface to read data from
  559. @param aFunc callback to use for converting
  560. @param aArgs user defined parameters (use at will)
  561. @returns @true on success, @false otherwise }
  562. function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  563. {$ENDIF}
  564. {$IFDEF GLB_DELPHI}
  565. public { Delphi }
  566. { assign texture data to TBitmap object
  567. @param aBitmap TBitmap to write data to
  568. @returns @true on success, @false otherwise }
  569. function AssignToBitmap(const aBitmap: TBitmap): Boolean;
  570. { assign texture data from TBitmap object
  571. @param aBitmap TBitmap to read data from
  572. @returns @true on success, @false otherwise }
  573. function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  574. { assign alpha channel data to TBitmap object
  575. @param aBitmap TBitmap to write data to
  576. @returns @true on success, @false otherwise }
  577. function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  578. { assign alpha channel data from TBitmap object
  579. @param aBitmap TBitmap to read data from
  580. @param aFunc callback to use for converting
  581. @param aArgs user defined parameters (use at will)
  582. @returns @true on success, @false otherwise }
  583. function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  584. {$ENDIF}
  585. {$IFDEF GLB_LAZARUS}
  586. public { Lazarus }
  587. { assign texture data to TLazIntfImage object
  588. @param aImage TLazIntfImage to write data to
  589. @returns @true on success, @false otherwise }
  590. function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  591. { assign texture data from TLazIntfImage object
  592. @param aImage TLazIntfImage to read data from
  593. @returns @true on success, @false otherwise }
  594. function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  595. { assign alpha channel data to TLazIntfImage object
  596. @param aImage TLazIntfImage to write data to
  597. @returns @true on success, @false otherwise }
  598. function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  599. { assign alpha channel data from TLazIntfImage object
  600. @param aImage TLazIntfImage to read data from
  601. @param aFunc callback to use for converting
  602. @param aArgs user defined parameters (use at will)
  603. @returns @true on success, @false otherwise }
  604. function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  605. {$ENDIF}
  606. public { Alpha }
  607. { load alpha channel data from resource
  608. @param aInstance resource handle
  609. @param aResource resource ID
  610. @param aResType resource type
  611. @param aFunc callback to use for converting
  612. @param aArgs user defined parameters (use at will)
  613. @returns @true on success, @false otherwise }
  614. function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  615. { load alpha channel data from resource ID
  616. @param aInstance resource handle
  617. @param aResourceID resource ID
  618. @param aResType resource type
  619. @param aFunc callback to use for converting
  620. @param aArgs user defined parameters (use at will)
  621. @returns @true on success, @false otherwise }
  622. function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  623. { add alpha channel data from function
  624. @param aFunc callback to get data from
  625. @param aArgs user defined parameters (use at will)
  626. @returns @true on success, @false otherwise }
  627. function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
  628. { add alpha channel data from file (macro for: new glBitmap, LoadFromFile, AddAlphaFromGlBitmap)
  629. @param aFilename file to load alpha channel data from
  630. @param aFunc callback to use for converting
  631. @param aArgs SetFormat user defined parameters (use at will)
  632. @returns @true on success, @false otherwise }
  633. function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  634. { add alpha channel data from stream (macro for: new glBitmap, LoadFromStream, AddAlphaFromGlBitmap)
  635. @param aStream stream to load alpha channel data from
  636. @param aFunc callback to use for converting
  637. @param aArgs user defined parameters (use at will)
  638. @returns @true on success, @false otherwise }
  639. function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  640. { add alpha channel data from existing glBitmap object
  641. @param aBitmap TglBitmap to copy alpha channel data from
  642. @param aFunc callback to use for converting
  643. @param aArgs user defined parameters (use at will)
  644. @returns @true on success, @false otherwise }
  645. function AddAlphaFromDataObj(const aDataObj: TglBitmapData; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  646. { add alpha to pixel if the pixels color is greter than the given color value
  647. @param aRed red threshold (0-255)
  648. @param aGreen green threshold (0-255)
  649. @param aBlue blue threshold (0-255)
  650. @param aDeviatation accepted deviatation (0-255)
  651. @returns @true on success, @false otherwise }
  652. function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
  653. { add alpha to pixel if the pixels color is greter than the given color value
  654. @param aRed red threshold (0-Range.r)
  655. @param aGreen green threshold (0-Range.g)
  656. @param aBlue blue threshold (0-Range.b)
  657. @param aDeviatation accepted deviatation (0-max(Range.rgb))
  658. @returns @true on success, @false otherwise }
  659. function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
  660. { add alpha to pixel if the pixels color is greter than the given color value
  661. @param aRed red threshold (0.0-1.0)
  662. @param aGreen green threshold (0.0-1.0)
  663. @param aBlue blue threshold (0.0-1.0)
  664. @param aDeviatation accepted deviatation (0.0-1.0)
  665. @returns @true on success, @false otherwise }
  666. function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
  667. { add a constand alpha value to all pixels
  668. @param aAlpha alpha value to add (0-255)
  669. @returns @true on success, @false otherwise }
  670. function AddAlphaFromValue(const aAlpha: Byte): Boolean;
  671. { add a constand alpha value to all pixels
  672. @param aAlpha alpha value to add (0-max(Range.rgb))
  673. @returns @true on success, @false otherwise }
  674. function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  675. { add a constand alpha value to all pixels
  676. @param aAlpha alpha value to add (0.0-1.0)
  677. @returns @true on success, @false otherwise }
  678. function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  679. { remove alpha channel
  680. @returns @true on success, @false otherwise }
  681. function RemoveAlpha: Boolean; virtual;
  682. public { fill }
  683. { fill complete texture with one color
  684. @param aRed red color for border (0-255)
  685. @param aGreen green color for border (0-255)
  686. @param aBlue blue color for border (0-255)
  687. @param aAlpha alpha color for border (0-255) }
  688. procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
  689. { fill complete texture with one color
  690. @param aRed red color for border (0-Range.r)
  691. @param aGreen green color for border (0-Range.g)
  692. @param aBlue blue color for border (0-Range.b)
  693. @param aAlpha alpha color for border (0-Range.a) }
  694. procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
  695. { fill complete texture with one color
  696. @param aRed red color for border (0.0-1.0)
  697. @param aGreen green color for border (0.0-1.0)
  698. @param aBlue blue color for border (0.0-1.0)
  699. @param aAlpha alpha color for border (0.0-1.0) }
  700. procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single = 1.0);
  701. public { Misc }
  702. { set data pointer of texture data
  703. @param aData pointer to new texture data
  704. @param aFormat format of the data stored at aData
  705. @param aWidth width of the texture data
  706. @param aHeight height of the texture data }
  707. procedure SetData(const aData: PByte; const aFormat: TglBitmapFormat;
  708. const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;
  709. { create a clone of the current object
  710. @returns clone of this object}
  711. function Clone: TglBitmapData;
  712. { invert color data (bitwise not)
  713. @param aRed invert red channel
  714. @param aGreen invert green channel
  715. @param aBlue invert blue channel
  716. @param aAlpha invert alpha channel }
  717. procedure Invert(const aRed, aGreen, aBlue, aAlpha: Boolean);
  718. { create normal map from texture data
  719. @param aFunc normal map function to generate normalmap with
  720. @param aScale scale of the normale stored in the normal map
  721. @param aUseAlpha generate normalmap from alpha channel data (if present) }
  722. procedure GenerateNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
  723. const aScale: Single = 2; const aUseAlpha: Boolean = false);
  724. public { constructor }
  725. { constructor - creates a texutre data object }
  726. constructor Create; overload;
  727. { constructor - creates a texture data object and loads it from a file
  728. @param aFilename file to load texture from }
  729. constructor Create(const aFileName: String); overload;
  730. { constructor - creates a texture data object and loads it from a stream
  731. @param aStream stream to load texture from }
  732. constructor Create(const aStream: TStream); overload;
  733. { constructor - creates a texture data object with the given size, format and data
  734. @param aSize size of the texture
  735. @param aFormat format of the given data
  736. @param aData texture data - be carefull: the data will now be managed by the texture data object }
  737. constructor Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; aData: PByte = nil); overload;
  738. { constructor - creates a texture data object with the given size and format and uses the given callback to create the data
  739. @param aSize size of the texture
  740. @param aFormat format of the given data
  741. @param aFunc callback to use for generating the data
  742. @param aArgs user defined parameters (use at will) }
  743. constructor Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
  744. { constructor - creates a texture data object and loads it from a resource
  745. @param aInstance resource handle
  746. @param aResource resource indentifier
  747. @param aResType resource type (if known) }
  748. constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
  749. { constructor - creates a texture data object and loads it from a resource
  750. @param aInstance resource handle
  751. @param aResourceID resource ID
  752. @param aResType resource type (if known) }
  753. constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
  754. { destructor }
  755. destructor Destroy; override;
  756. end;
  757. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  758. { base class for all glBitmap classes. used to manage OpenGL texture objects
  759. all operations on a bitmap object must be done from the render thread }
  760. TglBitmap = class
  761. protected
  762. fID: GLuint; //< name of the OpenGL texture object
  763. fTarget: GLuint; //< texture target (e.g. GL_TEXTURE_2D)
  764. fDeleteTextureOnFree: Boolean; //< delete OpenGL texture object when this object is destroyed
  765. // texture properties
  766. fFilterMin: GLenum; //< min filter to apply to the texture
  767. fFilterMag: GLenum; //< mag filter to apply to the texture
  768. fWrapS: GLenum; //< texture wrapping for x axis
  769. fWrapT: GLenum; //< texture wrapping for y axis
  770. fWrapR: GLenum; //< texture wrapping for z axis
  771. fAnisotropic: Integer; //< anisotropic level
  772. fBorderColor: array[0..3] of Single; //< color of the texture border
  773. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  774. //Swizzle
  775. fSwizzle: array[0..3] of GLenum; //< color channel swizzle
  776. {$IFEND}
  777. {$IFNDEF OPENGL_ES}
  778. fIsResident: GLboolean; //< @true if OpenGL texture object has data, @false otherwise
  779. {$ENDIF}
  780. fDimension: TglBitmapSize; //< size of this texture
  781. fMipMap: TglBitmapMipMap; //< mipmap type
  782. // CustomData
  783. fCustomData: Pointer; //< user defined data
  784. fCustomName: String; //< user defined name
  785. fCustomNameW: WideString; //< user defined name
  786. protected
  787. { @returns the actual width of the texture }
  788. function GetWidth: Integer; virtual;
  789. { @returns the actual height of the texture }
  790. function GetHeight: Integer; virtual;
  791. protected
  792. { set a new value for fCustomData }
  793. procedure SetCustomData(const aValue: Pointer);
  794. { set a new value for fCustomName }
  795. procedure SetCustomName(const aValue: String);
  796. { set a new value for fCustomNameW }
  797. procedure SetCustomNameW(const aValue: WideString);
  798. { set new value for fDeleteTextureOnFree }
  799. procedure SetDeleteTextureOnFree(const aValue: Boolean);
  800. { set name of OpenGL texture object }
  801. procedure SetID(const aValue: Cardinal);
  802. { set new value for fMipMap }
  803. procedure SetMipMap(const aValue: TglBitmapMipMap);
  804. { set new value for target }
  805. procedure SetTarget(const aValue: Cardinal);
  806. { set new value for fAnisotrophic }
  807. procedure SetAnisotropic(const aValue: Integer);
  808. protected
  809. { create OpenGL texture object (delete exisiting object if exists) }
  810. procedure CreateID;
  811. { setup texture parameters }
  812. procedure SetupParameters({$IFNDEF OPENGL_ES}out aBuildWithGlu: Boolean{$ENDIF});
  813. protected
  814. property Width: Integer read GetWidth; //< the actual width of the texture
  815. property Height: Integer read GetHeight; //< the actual height of the texture
  816. public
  817. property ID: Cardinal read fID write SetID; //< name of the OpenGL texture object
  818. property Target: Cardinal read fTarget write SetTarget; //< texture target (e.g. GL_TEXTURE_2D)
  819. property DeleteTextureOnFree: Boolean read fDeleteTextureOnFree write SetDeleteTextureOnFree; //< delete texture object when this object is destroyed
  820. property MipMap: TglBitmapMipMap read fMipMap write SetMipMap; //< mipmap type
  821. property Anisotropic: Integer read fAnisotropic write SetAnisotropic; //< anisotropic level
  822. property CustomData: Pointer read fCustomData write SetCustomData; //< user defined data (use at will)
  823. property CustomName: String read fCustomName write SetCustomName; //< user defined name (use at will)
  824. property CustomNameW: WideString read fCustomNameW write SetCustomNameW; //< user defined name (as WideString; use at will)
  825. property Dimension: TglBitmapSize read fDimension; //< size of the texture
  826. {$IFNDEF OPENGL_ES}
  827. property IsResident: GLboolean read fIsResident; //< @true if OpenGL texture object has data, @false otherwise
  828. {$ENDIF}
  829. { this method is called after the constructor and sets the default values of this object }
  830. procedure AfterConstruction; override;
  831. { this method is called before the destructor and does some cleanup }
  832. procedure BeforeDestruction; override;
  833. public
  834. {$IFNDEF OPENGL_ES}
  835. { set the new value for texture border color
  836. @param aRed red color for border (0.0-1.0)
  837. @param aGreen green color for border (0.0-1.0)
  838. @param aBlue blue color for border (0.0-1.0)
  839. @param aAlpha alpha color for border (0.0-1.0) }
  840. procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  841. {$ENDIF}
  842. public
  843. { set new texture filer
  844. @param aMin min filter
  845. @param aMag mag filter }
  846. procedure SetFilter(const aMin, aMag: GLenum);
  847. { set new texture wrapping
  848. @param S texture wrapping for x axis
  849. @param T texture wrapping for y axis
  850. @param R texture wrapping for z axis }
  851. procedure SetWrap(
  852. const S: GLenum = GL_CLAMP_TO_EDGE;
  853. const T: GLenum = GL_CLAMP_TO_EDGE;
  854. const R: GLenum = GL_CLAMP_TO_EDGE);
  855. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  856. { set new swizzle
  857. @param r swizzle for red channel
  858. @param g swizzle for green channel
  859. @param b swizzle for blue channel
  860. @param a swizzle for alpha channel }
  861. procedure SetSwizzle(const r, g, b, a: GLenum);
  862. {$IFEND}
  863. public
  864. { bind texture
  865. @param aEnableTextureUnit enable texture unit for this texture (e.g. glEnable(GL_TEXTURE_2D)) }
  866. procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;
  867. { bind texture
  868. @param aDisableTextureUnit disable texture unit for this texture (e.g. glEnable(GL_TEXTURE_2D)) }
  869. procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;
  870. { upload texture data from given data object to video card
  871. @param aData texture data object that contains the actual data
  872. @param aCheckSize check size before upload and throw exception if something is wrong }
  873. procedure UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean = true); virtual;
  874. {$IFNDEF OPENGL_ES}
  875. { download texture data from video card and store it into given data object
  876. @returns @true when download was successfull, @false otherwise }
  877. function DownloadData(const aDataObj: TglBitmapData): Boolean; virtual;
  878. {$ENDIF}
  879. public
  880. { constructor - creates an empty texture }
  881. constructor Create; overload;
  882. { constructor - creates an texture object and uploads the given data }
  883. constructor Create(const aData: TglBitmapData); overload;
  884. end;
  885. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  886. {$IF NOT DEFINED(OPENGL_ES)}
  887. { wrapper class for 1-dimensional textures (OpenGL target = GL_TEXTURE_1D
  888. all operations on a bitmap object must be done from the render thread }
  889. TglBitmap1D = class(TglBitmap)
  890. protected
  891. { upload the texture data to video card
  892. @param aDataObj texture data object that contains the actual data
  893. @param aBuildWithGlu use glu functions to build mipmaps }
  894. procedure UploadDataIntern(const aDataObj: TglBitmapData; const aBuildWithGlu: Boolean);
  895. public
  896. property Width; //< actual with of the texture
  897. { this method is called after constructor and initializes the object }
  898. procedure AfterConstruction; override;
  899. { upload texture data from given data object to video card
  900. @param aData texture data object that contains the actual data
  901. @param aCheckSize check size before upload and throw exception if something is wrong }
  902. procedure UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean = true); override;
  903. end;
  904. {$IFEND}
  905. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  906. { wrapper class for 2-dimensional textures (OpenGL target = GL_TEXTURE_2D)
  907. all operations on a bitmap object must be done from the render thread }
  908. TglBitmap2D = class(TglBitmap)
  909. protected
  910. { upload the texture data to video card
  911. @param aDataObj texture data object that contains the actual data
  912. @param aTarget target o upload data to (e.g. GL_TEXTURE_2D)
  913. @param aBuildWithGlu use glu functions to build mipmaps }
  914. procedure UploadDataIntern(const aDataObj: TglBitmapData; const aTarget: GLenum
  915. {$IFNDEF OPENGL_ES}; const aBuildWithGlu: Boolean{$ENDIF});
  916. public
  917. property Width; //< actual width of the texture
  918. property Height; //< actual height of the texture
  919. { this method is called after constructor and initializes the object }
  920. procedure AfterConstruction; override;
  921. { upload texture data from given data object to video card
  922. @param aData texture data object that contains the actual data
  923. @param aCheckSize check size before upload and throw exception if something is wrong }
  924. procedure UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean = true); override;
  925. public
  926. { copy a part of the frame buffer to the texture
  927. @param aTop topmost pixel to copy
  928. @param aLeft leftmost pixel to copy
  929. @param aRight rightmost pixel to copy
  930. @param aBottom bottommost pixel to copy
  931. @param aFormat format to store data in
  932. @param aDataObj texture data object to store the data in }
  933. class procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat; const aDataObj: TglBitmapData);
  934. end;
  935. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  936. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  937. { wrapper class for cube maps (OpenGL target = GL_TEXTURE_CUBE_MAP)
  938. all operations on a bitmap object must be done from the render thread }
  939. TglBitmapCubeMap = class(TglBitmap2D)
  940. protected
  941. {$IFNDEF OPENGL_ES}
  942. fGenMode: Integer; //< generation mode for the cube map (e.g. GL_REFLECTION_MAP)
  943. {$ENDIF}
  944. public
  945. { this method is called after constructor and initializes the object }
  946. procedure AfterConstruction; override;
  947. { upload texture data from given data object to video card
  948. @param aData texture data object that contains the actual data
  949. @param aCheckSize check size before upload and throw exception if something is wrong }
  950. procedure UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean = true); override;
  951. { upload texture data from given data object to video card
  952. @param aData texture data object that contains the actual data
  953. @param aCubeTarget cube map target to upload data to (e.g. GL_TEXTURE_CUBE_MAP_POSITIVE_X)
  954. @param aCheckSize check size before upload and throw exception if something is wrong }
  955. procedure UploadCubeMap(const aDataObj: TglBitmapData; const aCubeTarget: Cardinal; const aCheckSize: Boolean);
  956. { bind texture
  957. @param aEnableTexCoordsGen enable cube map generator
  958. @param aEnableTextureUnit enable texture unit }
  959. procedure Bind({$IFNDEF OPENGL_ES}const aEnableTexCoordsGen: Boolean = true;{$ENDIF} const aEnableTextureUnit: Boolean = true); reintroduce; virtual;
  960. { unbind texture
  961. @param aDisableTexCoordsGen disable cube map generator
  962. @param aDisableTextureUnit disable texture unit }
  963. procedure Unbind({$IFNDEF OPENGL_ES}const aDisableTexCoordsGen: Boolean = true;{$ENDIF} const aDisableTextureUnit: Boolean = true); reintroduce; virtual;
  964. end;
  965. {$IFEND}
  966. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  967. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  968. { wrapper class for cube normal maps
  969. all operations on a bitmap object must be done from the render thread }
  970. TglBitmapNormalMap = class(TglBitmapCubeMap)
  971. public
  972. { this method is called after constructor and initializes the object }
  973. procedure AfterConstruction; override;
  974. { create cube normal map from texture data and upload it to video card
  975. @param aSize size of each cube map texture
  976. @param aCheckSize check size before upload and throw exception if something is wrong }
  977. procedure GenerateNormalMap(const aSize: Integer = 32; const aCheckSize: Boolean = true);
  978. end;
  979. {$IFEND}
  980. const
  981. NULL_SIZE: TglBitmapSize = (Fields: []; X: 0; Y: 0);
  982. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  983. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  984. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  985. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  986. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  987. procedure glBitmapSetDefaultWrap(
  988. const S: Cardinal = GL_CLAMP_TO_EDGE;
  989. const T: Cardinal = GL_CLAMP_TO_EDGE;
  990. const R: Cardinal = GL_CLAMP_TO_EDGE);
  991. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  992. procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
  993. {$IFEND}
  994. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  995. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  996. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  997. function glBitmapGetDefaultFormat: TglBitmapFormat;
  998. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  999. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  1000. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  1001. procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
  1002. {$IFEND}
  1003. function glBitmapSize(X: Integer = -1; Y: Integer = -1): TglBitmapSize;
  1004. function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
  1005. function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
  1006. function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
  1007. function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
  1008. function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
  1009. function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
  1010. function glBitmapCreateTestData(const aFormat: TglBitmapFormat): TglBitmapData;
  1011. {$IFDEF GLB_DELPHI}
  1012. function CreateGrayPalette: HPALETTE;
  1013. {$ENDIF}
  1014. implementation
  1015. uses
  1016. Math, syncobjs, typinfo
  1017. {$IF DEFINED(GLB_SUPPORT_JPEG_READ) AND DEFINED(GLB_LAZ_JPEG)}, FPReadJPEG{$IFEND};
  1018. var
  1019. glBitmapDefaultDeleteTextureOnFree: Boolean;
  1020. glBitmapDefaultFreeDataAfterGenTextures: Boolean;
  1021. glBitmapDefaultFormat: TglBitmapFormat;
  1022. glBitmapDefaultMipmap: TglBitmapMipMap;
  1023. glBitmapDefaultFilterMin: Cardinal;
  1024. glBitmapDefaultFilterMag: Cardinal;
  1025. glBitmapDefaultWrapS: Cardinal;
  1026. glBitmapDefaultWrapT: Cardinal;
  1027. glBitmapDefaultWrapR: Cardinal;
  1028. glDefaultSwizzle: array[0..3] of GLenum;
  1029. ////////////////////////////////////////////////////////////////////////////////////////////////////
  1030. type
  1031. TFormatDescriptor = class(TglBitmapFormatDescriptor)
  1032. public
  1033. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
  1034. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
  1035. function CreateMappingData: Pointer; virtual;
  1036. procedure FreeMappingData(var aMappingData: Pointer); virtual;
  1037. function IsEmpty: Boolean; virtual;
  1038. function MaskMatch(const aMask: TglBitmapRec4ul): Boolean; virtual;
  1039. procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
  1040. constructor Create; virtual;
  1041. public
  1042. class procedure Init;
  1043. class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1044. class function GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1045. class function GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer = 0): TFormatDescriptor;
  1046. class function GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
  1047. class procedure Clear;
  1048. class procedure Finalize;
  1049. end;
  1050. TFormatDescriptorClass = class of TFormatDescriptor;
  1051. TfdEmpty = class(TFormatDescriptor);
  1052. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1053. TfdAlphaUB1 = class(TFormatDescriptor) //1* unsigned byte
  1054. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1055. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1056. end;
  1057. TfdLuminanceUB1 = class(TFormatDescriptor) //1* unsigned byte
  1058. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1059. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1060. end;
  1061. TfdUniversalUB1 = class(TFormatDescriptor) //1* unsigned byte
  1062. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1063. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1064. end;
  1065. TfdLuminanceAlphaUB2 = class(TfdLuminanceUB1) //2* unsigned byte
  1066. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1067. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1068. end;
  1069. TfdRGBub3 = class(TFormatDescriptor) //3* unsigned byte
  1070. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1071. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1072. end;
  1073. TfdBGRub3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
  1074. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1075. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1076. end;
  1077. TfdRGBAub4 = class(TfdRGBub3) //3* unsigned byte
  1078. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1079. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1080. end;
  1081. TfdBGRAub4 = class(TfdBGRub3) //3* unsigned byte (inverse)
  1082. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1083. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1084. end;
  1085. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1086. TfdAlphaUS1 = class(TFormatDescriptor) //1* unsigned short
  1087. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1088. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1089. end;
  1090. TfdLuminanceUS1 = class(TFormatDescriptor) //1* unsigned short
  1091. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1092. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1093. end;
  1094. TfdUniversalUS1 = class(TFormatDescriptor) //1* unsigned short
  1095. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1096. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1097. end;
  1098. TfdDepthUS1 = class(TFormatDescriptor) //1* unsigned short
  1099. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1100. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1101. end;
  1102. TfdLuminanceAlphaUS2 = class(TfdLuminanceUS1) //2* unsigned short
  1103. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1104. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1105. end;
  1106. TfdRGBus3 = class(TFormatDescriptor) //3* unsigned short
  1107. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1108. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1109. end;
  1110. TfdBGRus3 = class(TFormatDescriptor) //3* unsigned short (inverse)
  1111. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1112. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1113. end;
  1114. TfdRGBAus4 = class(TfdRGBus3) //4* unsigned short
  1115. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1116. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1117. end;
  1118. TfdARGBus4 = class(TfdRGBus3) //4* unsigned short
  1119. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1120. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1121. end;
  1122. TfdBGRAus4 = class(TfdBGRus3) //4* unsigned short (inverse)
  1123. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1124. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1125. end;
  1126. TfdABGRus4 = class(TfdBGRus3) //4* unsigned short (inverse)
  1127. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1128. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1129. end;
  1130. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1131. TfdUniversalUI1 = class(TFormatDescriptor) //1* unsigned int
  1132. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1133. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1134. end;
  1135. TfdDepthUI1 = class(TFormatDescriptor) //1* unsigned int
  1136. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1137. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1138. end;
  1139. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1140. TfdAlpha4ub1 = class(TfdAlphaUB1)
  1141. procedure SetValues; override;
  1142. end;
  1143. TfdAlpha8ub1 = class(TfdAlphaUB1)
  1144. procedure SetValues; override;
  1145. end;
  1146. TfdAlpha16us1 = class(TfdAlphaUS1)
  1147. procedure SetValues; override;
  1148. end;
  1149. TfdLuminance4ub1 = class(TfdLuminanceUB1)
  1150. procedure SetValues; override;
  1151. end;
  1152. TfdLuminance8ub1 = class(TfdLuminanceUB1)
  1153. procedure SetValues; override;
  1154. end;
  1155. TfdLuminance16us1 = class(TfdLuminanceUS1)
  1156. procedure SetValues; override;
  1157. end;
  1158. TfdLuminance4Alpha4ub2 = class(TfdLuminanceAlphaUB2)
  1159. procedure SetValues; override;
  1160. end;
  1161. TfdLuminance6Alpha2ub2 = class(TfdLuminanceAlphaUB2)
  1162. procedure SetValues; override;
  1163. end;
  1164. TfdLuminance8Alpha8ub2 = class(TfdLuminanceAlphaUB2)
  1165. procedure SetValues; override;
  1166. end;
  1167. TfdLuminance12Alpha4us2 = class(TfdLuminanceAlphaUS2)
  1168. procedure SetValues; override;
  1169. end;
  1170. TfdLuminance16Alpha16us2 = class(TfdLuminanceAlphaUS2)
  1171. procedure SetValues; override;
  1172. end;
  1173. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1174. TfdR3G3B2ub1 = class(TfdUniversalUB1)
  1175. procedure SetValues; override;
  1176. end;
  1177. TfdRGBX4us1 = class(TfdUniversalUS1)
  1178. procedure SetValues; override;
  1179. end;
  1180. TfdXRGB4us1 = class(TfdUniversalUS1)
  1181. procedure SetValues; override;
  1182. end;
  1183. TfdR5G6B5us1 = class(TfdUniversalUS1)
  1184. procedure SetValues; override;
  1185. end;
  1186. TfdRGB5X1us1 = class(TfdUniversalUS1)
  1187. procedure SetValues; override;
  1188. end;
  1189. TfdX1RGB5us1 = class(TfdUniversalUS1)
  1190. procedure SetValues; override;
  1191. end;
  1192. TfdRGB8ub3 = class(TfdRGBub3)
  1193. procedure SetValues; override;
  1194. end;
  1195. TfdRGBX8ui1 = class(TfdUniversalUI1)
  1196. procedure SetValues; override;
  1197. end;
  1198. TfdXRGB8ui1 = class(TfdUniversalUI1)
  1199. procedure SetValues; override;
  1200. end;
  1201. TfdRGB10X2ui1 = class(TfdUniversalUI1)
  1202. procedure SetValues; override;
  1203. end;
  1204. TfdX2RGB10ui1 = class(TfdUniversalUI1)
  1205. procedure SetValues; override;
  1206. end;
  1207. TfdRGB16us3 = class(TfdRGBus3)
  1208. procedure SetValues; override;
  1209. end;
  1210. TfdRGBA4us1 = class(TfdUniversalUS1)
  1211. procedure SetValues; override;
  1212. end;
  1213. TfdARGB4us1 = class(TfdUniversalUS1)
  1214. procedure SetValues; override;
  1215. end;
  1216. TfdRGB5A1us1 = class(TfdUniversalUS1)
  1217. procedure SetValues; override;
  1218. end;
  1219. TfdA1RGB5us1 = class(TfdUniversalUS1)
  1220. procedure SetValues; override;
  1221. end;
  1222. TfdRGBA8ui1 = class(TfdUniversalUI1)
  1223. procedure SetValues; override;
  1224. end;
  1225. TfdARGB8ui1 = class(TfdUniversalUI1)
  1226. procedure SetValues; override;
  1227. end;
  1228. TfdRGBA8ub4 = class(TfdRGBAub4)
  1229. procedure SetValues; override;
  1230. end;
  1231. TfdRGB10A2ui1 = class(TfdUniversalUI1)
  1232. procedure SetValues; override;
  1233. end;
  1234. TfdA2RGB10ui1 = class(TfdUniversalUI1)
  1235. procedure SetValues; override;
  1236. end;
  1237. TfdRGBA16us4 = class(TfdRGBAus4)
  1238. procedure SetValues; override;
  1239. end;
  1240. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1241. TfdBGRX4us1 = class(TfdUniversalUS1)
  1242. procedure SetValues; override;
  1243. end;
  1244. TfdXBGR4us1 = class(TfdUniversalUS1)
  1245. procedure SetValues; override;
  1246. end;
  1247. TfdB5G6R5us1 = class(TfdUniversalUS1)
  1248. procedure SetValues; override;
  1249. end;
  1250. TfdBGR5X1us1 = class(TfdUniversalUS1)
  1251. procedure SetValues; override;
  1252. end;
  1253. TfdX1BGR5us1 = class(TfdUniversalUS1)
  1254. procedure SetValues; override;
  1255. end;
  1256. TfdBGR8ub3 = class(TfdBGRub3)
  1257. procedure SetValues; override;
  1258. end;
  1259. TfdBGRX8ui1 = class(TfdUniversalUI1)
  1260. procedure SetValues; override;
  1261. end;
  1262. TfdXBGR8ui1 = class(TfdUniversalUI1)
  1263. procedure SetValues; override;
  1264. end;
  1265. TfdBGR10X2ui1 = class(TfdUniversalUI1)
  1266. procedure SetValues; override;
  1267. end;
  1268. TfdX2BGR10ui1 = class(TfdUniversalUI1)
  1269. procedure SetValues; override;
  1270. end;
  1271. TfdBGR16us3 = class(TfdBGRus3)
  1272. procedure SetValues; override;
  1273. end;
  1274. TfdBGRA4us1 = class(TfdUniversalUS1)
  1275. procedure SetValues; override;
  1276. end;
  1277. TfdABGR4us1 = class(TfdUniversalUS1)
  1278. procedure SetValues; override;
  1279. end;
  1280. TfdBGR5A1us1 = class(TfdUniversalUS1)
  1281. procedure SetValues; override;
  1282. end;
  1283. TfdA1BGR5us1 = class(TfdUniversalUS1)
  1284. procedure SetValues; override;
  1285. end;
  1286. TfdBGRA8ui1 = class(TfdUniversalUI1)
  1287. procedure SetValues; override;
  1288. end;
  1289. TfdABGR8ui1 = class(TfdUniversalUI1)
  1290. procedure SetValues; override;
  1291. end;
  1292. TfdBGRA8ub4 = class(TfdBGRAub4)
  1293. procedure SetValues; override;
  1294. end;
  1295. TfdBGR10A2ui1 = class(TfdUniversalUI1)
  1296. procedure SetValues; override;
  1297. end;
  1298. TfdA2BGR10ui1 = class(TfdUniversalUI1)
  1299. procedure SetValues; override;
  1300. end;
  1301. TfdBGRA16us4 = class(TfdBGRAus4)
  1302. procedure SetValues; override;
  1303. end;
  1304. TfdDepth16us1 = class(TfdDepthUS1)
  1305. procedure SetValues; override;
  1306. end;
  1307. TfdDepth24ui1 = class(TfdDepthUI1)
  1308. procedure SetValues; override;
  1309. end;
  1310. TfdDepth32ui1 = class(TfdDepthUI1)
  1311. procedure SetValues; override;
  1312. end;
  1313. TfdS3tcDtx1RGBA = class(TFormatDescriptor)
  1314. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1315. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1316. procedure SetValues; override;
  1317. end;
  1318. TfdS3tcDtx3RGBA = class(TFormatDescriptor)
  1319. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1320. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1321. procedure SetValues; override;
  1322. end;
  1323. TfdS3tcDtx5RGBA = class(TFormatDescriptor)
  1324. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1325. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1326. procedure SetValues; override;
  1327. end;
  1328. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1329. TbmpBitfieldFormat = class(TFormatDescriptor)
  1330. public
  1331. procedure SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul); overload;
  1332. procedure SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
  1333. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1334. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1335. end;
  1336. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1337. TbmpColorTableEnty = packed record
  1338. b, g, r, a: Byte;
  1339. end;
  1340. TbmpColorTable = array of TbmpColorTableEnty;
  1341. TbmpColorTableFormat = class(TFormatDescriptor)
  1342. private
  1343. fColorTable: TbmpColorTable;
  1344. protected
  1345. procedure SetValues; override;
  1346. public
  1347. property ColorTable: TbmpColorTable read fColorTable write fColorTable;
  1348. procedure SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
  1349. procedure CalcValues;
  1350. procedure CreateColorTable;
  1351. function CreateMappingData: Pointer; override;
  1352. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1353. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1354. destructor Destroy; override;
  1355. end;
  1356. const
  1357. LUMINANCE_WEIGHT_R = 0.30;
  1358. LUMINANCE_WEIGHT_G = 0.59;
  1359. LUMINANCE_WEIGHT_B = 0.11;
  1360. ALPHA_WEIGHT_R = 0.30;
  1361. ALPHA_WEIGHT_G = 0.59;
  1362. ALPHA_WEIGHT_B = 0.11;
  1363. DEPTH_WEIGHT_R = 0.333333333;
  1364. DEPTH_WEIGHT_G = 0.333333333;
  1365. DEPTH_WEIGHT_B = 0.333333333;
  1366. FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
  1367. TfdEmpty,
  1368. TfdAlpha4ub1,
  1369. TfdAlpha8ub1,
  1370. TfdAlpha16us1,
  1371. TfdLuminance4ub1,
  1372. TfdLuminance8ub1,
  1373. TfdLuminance16us1,
  1374. TfdLuminance4Alpha4ub2,
  1375. TfdLuminance6Alpha2ub2,
  1376. TfdLuminance8Alpha8ub2,
  1377. TfdLuminance12Alpha4us2,
  1378. TfdLuminance16Alpha16us2,
  1379. TfdR3G3B2ub1,
  1380. TfdRGBX4us1,
  1381. TfdXRGB4us1,
  1382. TfdR5G6B5us1,
  1383. TfdRGB5X1us1,
  1384. TfdX1RGB5us1,
  1385. TfdRGB8ub3,
  1386. TfdRGBX8ui1,
  1387. TfdXRGB8ui1,
  1388. TfdRGB10X2ui1,
  1389. TfdX2RGB10ui1,
  1390. TfdRGB16us3,
  1391. TfdRGBA4us1,
  1392. TfdARGB4us1,
  1393. TfdRGB5A1us1,
  1394. TfdA1RGB5us1,
  1395. TfdRGBA8ui1,
  1396. TfdARGB8ui1,
  1397. TfdRGBA8ub4,
  1398. TfdRGB10A2ui1,
  1399. TfdA2RGB10ui1,
  1400. TfdRGBA16us4,
  1401. TfdBGRX4us1,
  1402. TfdXBGR4us1,
  1403. TfdB5G6R5us1,
  1404. TfdBGR5X1us1,
  1405. TfdX1BGR5us1,
  1406. TfdBGR8ub3,
  1407. TfdBGRX8ui1,
  1408. TfdXBGR8ui1,
  1409. TfdBGR10X2ui1,
  1410. TfdX2BGR10ui1,
  1411. TfdBGR16us3,
  1412. TfdBGRA4us1,
  1413. TfdABGR4us1,
  1414. TfdBGR5A1us1,
  1415. TfdA1BGR5us1,
  1416. TfdBGRA8ui1,
  1417. TfdABGR8ui1,
  1418. TfdBGRA8ub4,
  1419. TfdBGR10A2ui1,
  1420. TfdA2BGR10ui1,
  1421. TfdBGRA16us4,
  1422. TfdDepth16us1,
  1423. TfdDepth24ui1,
  1424. TfdDepth32ui1,
  1425. TfdS3tcDtx1RGBA,
  1426. TfdS3tcDtx3RGBA,
  1427. TfdS3tcDtx5RGBA
  1428. );
  1429. var
  1430. FormatDescriptorCS: TCriticalSection;
  1431. FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
  1432. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1433. constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
  1434. begin
  1435. inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1436. end;
  1437. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1438. constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
  1439. begin
  1440. inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1441. end;
  1442. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1443. function glBitmapSize(X: Integer; Y: Integer): TglBitmapSize;
  1444. begin
  1445. result.Fields := [];
  1446. if (X >= 0) then
  1447. result.Fields := result.Fields + [ffX];
  1448. if (Y >= 0) then
  1449. result.Fields := result.Fields + [ffY];
  1450. result.X := Max(0, X);
  1451. result.Y := Max(0, Y);
  1452. end;
  1453. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1454. function glBitmapPosition(X: Integer; Y: Integer): TglBitmapPixelPosition;
  1455. begin
  1456. result := glBitmapSize(X, Y);
  1457. end;
  1458. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1459. function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
  1460. begin
  1461. result.r := r;
  1462. result.g := g;
  1463. result.b := b;
  1464. result.a := a;
  1465. end;
  1466. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1467. function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
  1468. begin
  1469. result.r := r;
  1470. result.g := g;
  1471. result.b := b;
  1472. result.a := a;
  1473. end;
  1474. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1475. function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
  1476. begin
  1477. result.r := r;
  1478. result.g := g;
  1479. result.b := b;
  1480. result.a := a;
  1481. end;
  1482. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1483. function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
  1484. var
  1485. i: Integer;
  1486. begin
  1487. result := false;
  1488. for i := 0 to high(r1.arr) do
  1489. if (r1.arr[i] <> r2.arr[i]) then
  1490. exit;
  1491. result := true;
  1492. end;
  1493. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1494. function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
  1495. var
  1496. i: Integer;
  1497. begin
  1498. result := false;
  1499. for i := 0 to high(r1.arr) do
  1500. if (r1.arr[i] <> r2.arr[i]) then
  1501. exit;
  1502. result := true;
  1503. end;
  1504. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1505. function glBitmapCreateTestData(const aFormat: TglBitmapFormat): TglBitmapData;
  1506. var
  1507. desc: TFormatDescriptor;
  1508. p, tmp: PByte;
  1509. x, y, i: Integer;
  1510. md: Pointer;
  1511. px: TglBitmapPixelData;
  1512. begin
  1513. result := nil;
  1514. desc := TFormatDescriptor.Get(aFormat);
  1515. if (desc.IsCompressed) or (desc.glFormat = 0) then
  1516. exit;
  1517. p := GetMemory(ceil(25 * desc.BytesPerPixel)); // 5 x 5 pixel
  1518. md := desc.CreateMappingData;
  1519. try
  1520. tmp := p;
  1521. desc.PreparePixel(px);
  1522. for y := 0 to 4 do
  1523. for x := 0 to 4 do begin
  1524. px.Data := glBitmapRec4ui(0, 0, 0, 0);
  1525. for i := 0 to 3 do begin
  1526. if ((y < 3) and (y = i)) or
  1527. ((y = 3) and (i < 3)) or
  1528. ((y = 4) and (i = 3))
  1529. then
  1530. px.Data.arr[i] := Trunc(px.Range.arr[i] / 4 * x)
  1531. else if ((y < 4) and (i = 3)) or
  1532. ((y = 4) and (i < 3))
  1533. then
  1534. px.Data.arr[i] := px.Range.arr[i]
  1535. else
  1536. px.Data.arr[i] := 0; //px.Range.arr[i];
  1537. end;
  1538. desc.Map(px, tmp, md);
  1539. end;
  1540. finally
  1541. desc.FreeMappingData(md);
  1542. end;
  1543. result := TglBitmapData.Create(glBitmapPosition(5, 5), aFormat, p);
  1544. end;
  1545. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1546. function glBitmapShiftRec(const r, g, b, a: Byte): TglBitmapRec4ub;
  1547. begin
  1548. result.r := r;
  1549. result.g := g;
  1550. result.b := b;
  1551. result.a := a;
  1552. end;
  1553. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1554. function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
  1555. begin
  1556. result := [];
  1557. if (aFormat in [
  1558. //8bpp
  1559. tfAlpha4ub1, tfAlpha8ub1,
  1560. tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1,
  1561. //16bpp
  1562. tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
  1563. tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
  1564. tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1,
  1565. //24bpp
  1566. tfBGR8ub3, tfRGB8ub3,
  1567. //32bpp
  1568. tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
  1569. tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1])
  1570. then
  1571. result := result + [ ftBMP ];
  1572. if (aFormat in [
  1573. //8bbp
  1574. tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1,
  1575. //16bbp
  1576. tfAlpha16us1, tfLuminance16us1,
  1577. tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
  1578. tfX1RGB5us1, tfARGB4us1, tfA1RGB5us1, tfDepth16us1,
  1579. //24bbp
  1580. tfBGR8ub3,
  1581. //32bbp
  1582. tfX2RGB10ui1, tfARGB8ui1, tfBGRA8ub4, tfA2RGB10ui1,
  1583. tfDepth24ui1, tfDepth32ui1])
  1584. then
  1585. result := result + [ftTGA];
  1586. if not (aFormat in [tfEmpty, tfRGB16us3, tfBGR16us3]) then
  1587. result := result + [ftDDS];
  1588. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  1589. if aFormat in [
  1590. tfAlpha8ub1, tfLuminance8ub1, tfLuminance8Alpha8ub2,
  1591. tfRGB8ub3, tfRGBA8ui1,
  1592. tfBGR8ub3, tfBGRA8ui1] then
  1593. result := result + [ftPNG];
  1594. {$ENDIF}
  1595. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  1596. if aFormat in [tfAlpha8ub1, tfLuminance8ub1, tfRGB8ub3, tfBGR8ub3] then
  1597. result := result + [ftJPEG];
  1598. {$ENDIF}
  1599. end;
  1600. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1601. function IsPowerOfTwo(aNumber: Integer): Boolean;
  1602. begin
  1603. while (aNumber and 1) = 0 do
  1604. aNumber := aNumber shr 1;
  1605. result := aNumber = 1;
  1606. end;
  1607. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1608. function GetTopMostBit(aBitSet: QWord): Integer;
  1609. begin
  1610. result := 0;
  1611. while aBitSet > 0 do begin
  1612. inc(result);
  1613. aBitSet := aBitSet shr 1;
  1614. end;
  1615. end;
  1616. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1617. function CountSetBits(aBitSet: QWord): Integer;
  1618. begin
  1619. result := 0;
  1620. while aBitSet > 0 do begin
  1621. if (aBitSet and 1) = 1 then
  1622. inc(result);
  1623. aBitSet := aBitSet shr 1;
  1624. end;
  1625. end;
  1626. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1627. function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1628. begin
  1629. result := Trunc(
  1630. LUMINANCE_WEIGHT_R * aPixel.Data.r +
  1631. LUMINANCE_WEIGHT_G * aPixel.Data.g +
  1632. LUMINANCE_WEIGHT_B * aPixel.Data.b);
  1633. end;
  1634. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1635. function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1636. begin
  1637. result := Trunc(
  1638. DEPTH_WEIGHT_R * aPixel.Data.r +
  1639. DEPTH_WEIGHT_G * aPixel.Data.g +
  1640. DEPTH_WEIGHT_B * aPixel.Data.b);
  1641. end;
  1642. {$IFDEF GLB_SDL_IMAGE}
  1643. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1644. // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1645. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1646. function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
  1647. begin
  1648. result := TStream(context^.unknown.data1).Seek(offset, whence);
  1649. end;
  1650. function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
  1651. begin
  1652. result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
  1653. end;
  1654. function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
  1655. begin
  1656. result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
  1657. end;
  1658. function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
  1659. begin
  1660. result := 0;
  1661. end;
  1662. function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
  1663. begin
  1664. result := SDL_AllocRW;
  1665. if result = nil then
  1666. raise EglBitmap.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
  1667. result^.seek := glBitmapRWseek;
  1668. result^.read := glBitmapRWread;
  1669. result^.write := glBitmapRWwrite;
  1670. result^.close := glBitmapRWclose;
  1671. result^.unknown.data1 := Stream;
  1672. end;
  1673. {$ENDIF}
  1674. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1675. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1676. begin
  1677. glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
  1678. end;
  1679. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1680. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1681. begin
  1682. glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
  1683. end;
  1684. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1685. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1686. begin
  1687. glBitmapDefaultMipmap := aValue;
  1688. end;
  1689. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1690. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1691. begin
  1692. glBitmapDefaultFormat := aFormat;
  1693. end;
  1694. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1695. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1696. begin
  1697. glBitmapDefaultFilterMin := aMin;
  1698. glBitmapDefaultFilterMag := aMag;
  1699. end;
  1700. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1701. procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
  1702. begin
  1703. glBitmapDefaultWrapS := S;
  1704. glBitmapDefaultWrapT := T;
  1705. glBitmapDefaultWrapR := R;
  1706. end;
  1707. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1708. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  1709. procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
  1710. begin
  1711. glDefaultSwizzle[0] := r;
  1712. glDefaultSwizzle[1] := g;
  1713. glDefaultSwizzle[2] := b;
  1714. glDefaultSwizzle[3] := a;
  1715. end;
  1716. {$IFEND}
  1717. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1718. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1719. begin
  1720. result := glBitmapDefaultDeleteTextureOnFree;
  1721. end;
  1722. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1723. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1724. begin
  1725. result := glBitmapDefaultFreeDataAfterGenTextures;
  1726. end;
  1727. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1728. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1729. begin
  1730. result := glBitmapDefaultMipmap;
  1731. end;
  1732. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1733. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1734. begin
  1735. result := glBitmapDefaultFormat;
  1736. end;
  1737. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1738. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  1739. begin
  1740. aMin := glBitmapDefaultFilterMin;
  1741. aMag := glBitmapDefaultFilterMag;
  1742. end;
  1743. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1744. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  1745. begin
  1746. S := glBitmapDefaultWrapS;
  1747. T := glBitmapDefaultWrapT;
  1748. R := glBitmapDefaultWrapR;
  1749. end;
  1750. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  1751. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1752. procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
  1753. begin
  1754. r := glDefaultSwizzle[0];
  1755. g := glDefaultSwizzle[1];
  1756. b := glDefaultSwizzle[2];
  1757. a := glDefaultSwizzle[3];
  1758. end;
  1759. {$IFEND}
  1760. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1761. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1762. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1763. function TFormatDescriptor.CreateMappingData: Pointer;
  1764. begin
  1765. result := nil;
  1766. end;
  1767. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1768. procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
  1769. begin
  1770. //DUMMY
  1771. end;
  1772. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1773. function TFormatDescriptor.IsEmpty: Boolean;
  1774. begin
  1775. result := (fFormat = tfEmpty);
  1776. end;
  1777. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1778. function TFormatDescriptor.MaskMatch(const aMask: TglBitmapRec4ul): Boolean;
  1779. var
  1780. i: Integer;
  1781. m: TglBitmapRec4ul;
  1782. begin
  1783. result := false;
  1784. if (aMask.r = 0) and (aMask.g = 0) and (aMask.b = 0) and (aMask.a = 0) then
  1785. raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
  1786. m := Mask;
  1787. for i := 0 to 3 do
  1788. if (aMask.arr[i] <> m.arr[i]) then
  1789. exit;
  1790. result := true;
  1791. end;
  1792. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1793. procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
  1794. begin
  1795. FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
  1796. aPixel.Data := Range;
  1797. aPixel.Format := fFormat;
  1798. aPixel.Range := Range;
  1799. end;
  1800. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1801. constructor TFormatDescriptor.Create;
  1802. begin
  1803. inherited Create;
  1804. end;
  1805. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1806. //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1807. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1808. procedure TfdAlphaUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1809. begin
  1810. aData^ := aPixel.Data.a;
  1811. inc(aData);
  1812. end;
  1813. procedure TfdAlphaUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1814. begin
  1815. aPixel.Data.r := 0;
  1816. aPixel.Data.g := 0;
  1817. aPixel.Data.b := 0;
  1818. aPixel.Data.a := aData^;
  1819. inc(aData);
  1820. end;
  1821. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1822. //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1823. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1824. procedure TfdLuminanceUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1825. begin
  1826. aData^ := LuminanceWeight(aPixel);
  1827. inc(aData);
  1828. end;
  1829. procedure TfdLuminanceUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1830. begin
  1831. aPixel.Data.r := aData^;
  1832. aPixel.Data.g := aData^;
  1833. aPixel.Data.b := aData^;
  1834. aPixel.Data.a := 0;
  1835. inc(aData);
  1836. end;
  1837. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1838. //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1839. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1840. procedure TfdUniversalUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1841. var
  1842. i: Integer;
  1843. begin
  1844. aData^ := 0;
  1845. for i := 0 to 3 do
  1846. if (Range.arr[i] > 0) then
  1847. aData^ := aData^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
  1848. inc(aData);
  1849. end;
  1850. procedure TfdUniversalUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1851. var
  1852. i: Integer;
  1853. begin
  1854. for i := 0 to 3 do
  1855. aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and Range.arr[i];
  1856. inc(aData);
  1857. end;
  1858. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1859. //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1860. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1861. procedure TfdLuminanceAlphaUB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1862. begin
  1863. inherited Map(aPixel, aData, aMapData);
  1864. aData^ := aPixel.Data.a;
  1865. inc(aData);
  1866. end;
  1867. procedure TfdLuminanceAlphaUB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1868. begin
  1869. inherited Unmap(aData, aPixel, aMapData);
  1870. aPixel.Data.a := aData^;
  1871. inc(aData);
  1872. end;
  1873. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1874. //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1875. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1876. procedure TfdRGBub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1877. begin
  1878. aData^ := aPixel.Data.r;
  1879. inc(aData);
  1880. aData^ := aPixel.Data.g;
  1881. inc(aData);
  1882. aData^ := aPixel.Data.b;
  1883. inc(aData);
  1884. end;
  1885. procedure TfdRGBub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1886. begin
  1887. aPixel.Data.r := aData^;
  1888. inc(aData);
  1889. aPixel.Data.g := aData^;
  1890. inc(aData);
  1891. aPixel.Data.b := aData^;
  1892. inc(aData);
  1893. aPixel.Data.a := 0;
  1894. end;
  1895. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1896. //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1897. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1898. procedure TfdBGRub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1899. begin
  1900. aData^ := aPixel.Data.b;
  1901. inc(aData);
  1902. aData^ := aPixel.Data.g;
  1903. inc(aData);
  1904. aData^ := aPixel.Data.r;
  1905. inc(aData);
  1906. end;
  1907. procedure TfdBGRub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1908. begin
  1909. aPixel.Data.b := aData^;
  1910. inc(aData);
  1911. aPixel.Data.g := aData^;
  1912. inc(aData);
  1913. aPixel.Data.r := aData^;
  1914. inc(aData);
  1915. aPixel.Data.a := 0;
  1916. end;
  1917. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1918. //TfdRGBA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1919. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1920. procedure TfdRGBAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1921. begin
  1922. inherited Map(aPixel, aData, aMapData);
  1923. aData^ := aPixel.Data.a;
  1924. inc(aData);
  1925. end;
  1926. procedure TfdRGBAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1927. begin
  1928. inherited Unmap(aData, aPixel, aMapData);
  1929. aPixel.Data.a := aData^;
  1930. inc(aData);
  1931. end;
  1932. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1933. //TfdBGRA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1934. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1935. procedure TfdBGRAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1936. begin
  1937. inherited Map(aPixel, aData, aMapData);
  1938. aData^ := aPixel.Data.a;
  1939. inc(aData);
  1940. end;
  1941. procedure TfdBGRAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1942. begin
  1943. inherited Unmap(aData, aPixel, aMapData);
  1944. aPixel.Data.a := aData^;
  1945. inc(aData);
  1946. end;
  1947. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1948. //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1949. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1950. procedure TfdAlphaUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1951. begin
  1952. PWord(aData)^ := aPixel.Data.a;
  1953. inc(aData, 2);
  1954. end;
  1955. procedure TfdAlphaUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1956. begin
  1957. aPixel.Data.r := 0;
  1958. aPixel.Data.g := 0;
  1959. aPixel.Data.b := 0;
  1960. aPixel.Data.a := PWord(aData)^;
  1961. inc(aData, 2);
  1962. end;
  1963. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1964. //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1965. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1966. procedure TfdLuminanceUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1967. begin
  1968. PWord(aData)^ := LuminanceWeight(aPixel);
  1969. inc(aData, 2);
  1970. end;
  1971. procedure TfdLuminanceUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1972. begin
  1973. aPixel.Data.r := PWord(aData)^;
  1974. aPixel.Data.g := PWord(aData)^;
  1975. aPixel.Data.b := PWord(aData)^;
  1976. aPixel.Data.a := 0;
  1977. inc(aData, 2);
  1978. end;
  1979. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1980. //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1981. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1982. procedure TfdUniversalUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1983. var
  1984. i: Integer;
  1985. begin
  1986. PWord(aData)^ := 0;
  1987. for i := 0 to 3 do
  1988. if (Range.arr[i] > 0) then
  1989. PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
  1990. inc(aData, 2);
  1991. end;
  1992. procedure TfdUniversalUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1993. var
  1994. i: Integer;
  1995. begin
  1996. for i := 0 to 3 do
  1997. aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and Range.arr[i];
  1998. inc(aData, 2);
  1999. end;
  2000. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2001. //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2002. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2003. procedure TfdDepthUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2004. begin
  2005. PWord(aData)^ := DepthWeight(aPixel);
  2006. inc(aData, 2);
  2007. end;
  2008. procedure TfdDepthUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2009. begin
  2010. aPixel.Data.r := PWord(aData)^;
  2011. aPixel.Data.g := PWord(aData)^;
  2012. aPixel.Data.b := PWord(aData)^;
  2013. aPixel.Data.a := PWord(aData)^;;
  2014. inc(aData, 2);
  2015. end;
  2016. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2017. //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2018. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2019. procedure TfdLuminanceAlphaUS2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2020. begin
  2021. inherited Map(aPixel, aData, aMapData);
  2022. PWord(aData)^ := aPixel.Data.a;
  2023. inc(aData, 2);
  2024. end;
  2025. procedure TfdLuminanceAlphaUS2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2026. begin
  2027. inherited Unmap(aData, aPixel, aMapData);
  2028. aPixel.Data.a := PWord(aData)^;
  2029. inc(aData, 2);
  2030. end;
  2031. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2032. //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2033. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2034. procedure TfdRGBus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2035. begin
  2036. PWord(aData)^ := aPixel.Data.r;
  2037. inc(aData, 2);
  2038. PWord(aData)^ := aPixel.Data.g;
  2039. inc(aData, 2);
  2040. PWord(aData)^ := aPixel.Data.b;
  2041. inc(aData, 2);
  2042. end;
  2043. procedure TfdRGBus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2044. begin
  2045. aPixel.Data.r := PWord(aData)^;
  2046. inc(aData, 2);
  2047. aPixel.Data.g := PWord(aData)^;
  2048. inc(aData, 2);
  2049. aPixel.Data.b := PWord(aData)^;
  2050. inc(aData, 2);
  2051. aPixel.Data.a := 0;
  2052. end;
  2053. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2054. //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2055. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2056. procedure TfdBGRus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2057. begin
  2058. PWord(aData)^ := aPixel.Data.b;
  2059. inc(aData, 2);
  2060. PWord(aData)^ := aPixel.Data.g;
  2061. inc(aData, 2);
  2062. PWord(aData)^ := aPixel.Data.r;
  2063. inc(aData, 2);
  2064. end;
  2065. procedure TfdBGRus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2066. begin
  2067. aPixel.Data.b := PWord(aData)^;
  2068. inc(aData, 2);
  2069. aPixel.Data.g := PWord(aData)^;
  2070. inc(aData, 2);
  2071. aPixel.Data.r := PWord(aData)^;
  2072. inc(aData, 2);
  2073. aPixel.Data.a := 0;
  2074. end;
  2075. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2076. //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2077. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2078. procedure TfdRGBAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2079. begin
  2080. inherited Map(aPixel, aData, aMapData);
  2081. PWord(aData)^ := aPixel.Data.a;
  2082. inc(aData, 2);
  2083. end;
  2084. procedure TfdRGBAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2085. begin
  2086. inherited Unmap(aData, aPixel, aMapData);
  2087. aPixel.Data.a := PWord(aData)^;
  2088. inc(aData, 2);
  2089. end;
  2090. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2091. //TfdARGB_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2092. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2093. procedure TfdARGBus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2094. begin
  2095. PWord(aData)^ := aPixel.Data.a;
  2096. inc(aData, 2);
  2097. inherited Map(aPixel, aData, aMapData);
  2098. end;
  2099. procedure TfdARGBus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2100. begin
  2101. aPixel.Data.a := PWord(aData)^;
  2102. inc(aData, 2);
  2103. inherited Unmap(aData, aPixel, aMapData);
  2104. end;
  2105. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2106. //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2107. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2108. procedure TfdBGRAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2109. begin
  2110. inherited Map(aPixel, aData, aMapData);
  2111. PWord(aData)^ := aPixel.Data.a;
  2112. inc(aData, 2);
  2113. end;
  2114. procedure TfdBGRAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2115. begin
  2116. inherited Unmap(aData, aPixel, aMapData);
  2117. aPixel.Data.a := PWord(aData)^;
  2118. inc(aData, 2);
  2119. end;
  2120. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2121. //TfdABGR_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2122. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2123. procedure TfdABGRus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2124. begin
  2125. PWord(aData)^ := aPixel.Data.a;
  2126. inc(aData, 2);
  2127. inherited Map(aPixel, aData, aMapData);
  2128. end;
  2129. procedure TfdABGRus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2130. begin
  2131. aPixel.Data.a := PWord(aData)^;
  2132. inc(aData, 2);
  2133. inherited Unmap(aData, aPixel, aMapData);
  2134. end;
  2135. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2136. //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2137. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2138. procedure TfdUniversalUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2139. var
  2140. i: Integer;
  2141. begin
  2142. PCardinal(aData)^ := 0;
  2143. for i := 0 to 3 do
  2144. if (Range.arr[i] > 0) then
  2145. PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
  2146. inc(aData, 4);
  2147. end;
  2148. procedure TfdUniversalUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2149. var
  2150. i: Integer;
  2151. begin
  2152. for i := 0 to 3 do
  2153. aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and Range.arr[i];
  2154. inc(aData, 2);
  2155. end;
  2156. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2157. //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2158. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2159. procedure TfdDepthUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2160. begin
  2161. PCardinal(aData)^ := DepthWeight(aPixel);
  2162. inc(aData, 4);
  2163. end;
  2164. procedure TfdDepthUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2165. begin
  2166. aPixel.Data.r := PCardinal(aData)^;
  2167. aPixel.Data.g := PCardinal(aData)^;
  2168. aPixel.Data.b := PCardinal(aData)^;
  2169. aPixel.Data.a := PCardinal(aData)^;
  2170. inc(aData, 4);
  2171. end;
  2172. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2173. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2174. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2175. procedure TfdAlpha4ub1.SetValues;
  2176. begin
  2177. inherited SetValues;
  2178. fBitsPerPixel := 8;
  2179. fFormat := tfAlpha4ub1;
  2180. fWithAlpha := tfAlpha4ub1;
  2181. fPrecision := glBitmapRec4ub(0, 0, 0, 8);
  2182. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2183. {$IFNDEF OPENGL_ES}
  2184. fOpenGLFormat := tfAlpha4ub1;
  2185. fglFormat := GL_ALPHA;
  2186. fglInternalFormat := GL_ALPHA4;
  2187. fglDataFormat := GL_UNSIGNED_BYTE;
  2188. {$ELSE}
  2189. fOpenGLFormat := tfAlpha8ub1;
  2190. {$ENDIF}
  2191. end;
  2192. procedure TfdAlpha8ub1.SetValues;
  2193. begin
  2194. inherited SetValues;
  2195. fBitsPerPixel := 8;
  2196. fFormat := tfAlpha8ub1;
  2197. fWithAlpha := tfAlpha8ub1;
  2198. fPrecision := glBitmapRec4ub(0, 0, 0, 8);
  2199. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2200. fOpenGLFormat := tfAlpha8ub1;
  2201. fglFormat := GL_ALPHA;
  2202. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_ALPHA8{$ELSE}GL_ALPHA{$ENDIF};
  2203. fglDataFormat := GL_UNSIGNED_BYTE;
  2204. end;
  2205. procedure TfdAlpha16us1.SetValues;
  2206. begin
  2207. inherited SetValues;
  2208. fBitsPerPixel := 16;
  2209. fFormat := tfAlpha16us1;
  2210. fWithAlpha := tfAlpha16us1;
  2211. fPrecision := glBitmapRec4ub(0, 0, 0, 16);
  2212. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2213. {$IFNDEF OPENGL_ES}
  2214. fOpenGLFormat := tfAlpha16us1;
  2215. fglFormat := GL_ALPHA;
  2216. fglInternalFormat := GL_ALPHA16;
  2217. fglDataFormat := GL_UNSIGNED_SHORT;
  2218. {$ELSE}
  2219. fOpenGLFormat := tfAlpha8ub1;
  2220. {$ENDIF}
  2221. end;
  2222. procedure TfdLuminance4ub1.SetValues;
  2223. begin
  2224. inherited SetValues;
  2225. fBitsPerPixel := 8;
  2226. fFormat := tfLuminance4ub1;
  2227. fWithAlpha := tfLuminance4Alpha4ub2;
  2228. fWithoutAlpha := tfLuminance4ub1;
  2229. fPrecision := glBitmapRec4ub(8, 8, 8, 0);
  2230. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2231. {$IFNDEF OPENGL_ES}
  2232. fOpenGLFormat := tfLuminance4ub1;
  2233. fglFormat := GL_LUMINANCE;
  2234. fglInternalFormat := GL_LUMINANCE4;
  2235. fglDataFormat := GL_UNSIGNED_BYTE;
  2236. {$ELSE}
  2237. fOpenGLFormat := tfLuminance8ub1;
  2238. {$ENDIF}
  2239. end;
  2240. procedure TfdLuminance8ub1.SetValues;
  2241. begin
  2242. inherited SetValues;
  2243. fBitsPerPixel := 8;
  2244. fFormat := tfLuminance8ub1;
  2245. fWithAlpha := tfLuminance8Alpha8ub2;
  2246. fWithoutAlpha := tfLuminance8ub1;
  2247. fOpenGLFormat := tfLuminance8ub1;
  2248. fPrecision := glBitmapRec4ub(8, 8, 8, 0);
  2249. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2250. fglFormat := GL_LUMINANCE;
  2251. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8{$ELSE}GL_LUMINANCE{$ENDIF};
  2252. fglDataFormat := GL_UNSIGNED_BYTE;
  2253. end;
  2254. procedure TfdLuminance16us1.SetValues;
  2255. begin
  2256. inherited SetValues;
  2257. fBitsPerPixel := 16;
  2258. fFormat := tfLuminance16us1;
  2259. fWithAlpha := tfLuminance16Alpha16us2;
  2260. fWithoutAlpha := tfLuminance16us1;
  2261. fPrecision := glBitmapRec4ub(16, 16, 16, 0);
  2262. fShift := glBitmapRec4ub( 0, 0, 0, 0);
  2263. {$IFNDEF OPENGL_ES}
  2264. fOpenGLFormat := tfLuminance16us1;
  2265. fglFormat := GL_LUMINANCE;
  2266. fglInternalFormat := GL_LUMINANCE16;
  2267. fglDataFormat := GL_UNSIGNED_SHORT;
  2268. {$ELSE}
  2269. fOpenGLFormat := tfLuminance8ub1;
  2270. {$ENDIF}
  2271. end;
  2272. procedure TfdLuminance4Alpha4ub2.SetValues;
  2273. begin
  2274. inherited SetValues;
  2275. fBitsPerPixel := 16;
  2276. fFormat := tfLuminance4Alpha4ub2;
  2277. fWithAlpha := tfLuminance4Alpha4ub2;
  2278. fWithoutAlpha := tfLuminance4ub1;
  2279. fPrecision := glBitmapRec4ub(8, 8, 8, 8);
  2280. fShift := glBitmapRec4ub(0, 0, 0, 8);
  2281. {$IFNDEF OPENGL_ES}
  2282. fOpenGLFormat := tfLuminance4Alpha4ub2;
  2283. fglFormat := GL_LUMINANCE_ALPHA;
  2284. fglInternalFormat := GL_LUMINANCE4_ALPHA4;
  2285. fglDataFormat := GL_UNSIGNED_BYTE;
  2286. {$ELSE}
  2287. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2288. {$ENDIF}
  2289. end;
  2290. procedure TfdLuminance6Alpha2ub2.SetValues;
  2291. begin
  2292. inherited SetValues;
  2293. fBitsPerPixel := 16;
  2294. fFormat := tfLuminance6Alpha2ub2;
  2295. fWithAlpha := tfLuminance6Alpha2ub2;
  2296. fWithoutAlpha := tfLuminance8ub1;
  2297. fPrecision := glBitmapRec4ub(8, 8, 8, 8);
  2298. fShift := glBitmapRec4ub(0, 0, 0, 8);
  2299. {$IFNDEF OPENGL_ES}
  2300. fOpenGLFormat := tfLuminance6Alpha2ub2;
  2301. fglFormat := GL_LUMINANCE_ALPHA;
  2302. fglInternalFormat := GL_LUMINANCE6_ALPHA2;
  2303. fglDataFormat := GL_UNSIGNED_BYTE;
  2304. {$ELSE}
  2305. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2306. {$ENDIF}
  2307. end;
  2308. procedure TfdLuminance8Alpha8ub2.SetValues;
  2309. begin
  2310. inherited SetValues;
  2311. fBitsPerPixel := 16;
  2312. fFormat := tfLuminance8Alpha8ub2;
  2313. fWithAlpha := tfLuminance8Alpha8ub2;
  2314. fWithoutAlpha := tfLuminance8ub1;
  2315. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2316. fPrecision := glBitmapRec4ub(8, 8, 8, 8);
  2317. fShift := glBitmapRec4ub(0, 0, 0, 8);
  2318. fglFormat := GL_LUMINANCE_ALPHA;
  2319. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8_ALPHA8{$ELSE}GL_LUMINANCE_ALPHA{$ENDIF};
  2320. fglDataFormat := GL_UNSIGNED_BYTE;
  2321. end;
  2322. procedure TfdLuminance12Alpha4us2.SetValues;
  2323. begin
  2324. inherited SetValues;
  2325. fBitsPerPixel := 32;
  2326. fFormat := tfLuminance12Alpha4us2;
  2327. fWithAlpha := tfLuminance12Alpha4us2;
  2328. fWithoutAlpha := tfLuminance16us1;
  2329. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  2330. fShift := glBitmapRec4ub( 0, 0, 0, 16);
  2331. {$IFNDEF OPENGL_ES}
  2332. fOpenGLFormat := tfLuminance12Alpha4us2;
  2333. fglFormat := GL_LUMINANCE_ALPHA;
  2334. fglInternalFormat := GL_LUMINANCE12_ALPHA4;
  2335. fglDataFormat := GL_UNSIGNED_SHORT;
  2336. {$ELSE}
  2337. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2338. {$ENDIF}
  2339. end;
  2340. procedure TfdLuminance16Alpha16us2.SetValues;
  2341. begin
  2342. inherited SetValues;
  2343. fBitsPerPixel := 32;
  2344. fFormat := tfLuminance16Alpha16us2;
  2345. fWithAlpha := tfLuminance16Alpha16us2;
  2346. fWithoutAlpha := tfLuminance16us1;
  2347. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  2348. fShift := glBitmapRec4ub( 0, 0, 0, 16);
  2349. {$IFNDEF OPENGL_ES}
  2350. fOpenGLFormat := tfLuminance16Alpha16us2;
  2351. fglFormat := GL_LUMINANCE_ALPHA;
  2352. fglInternalFormat := GL_LUMINANCE16_ALPHA16;
  2353. fglDataFormat := GL_UNSIGNED_SHORT;
  2354. {$ELSE}
  2355. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2356. {$ENDIF}
  2357. end;
  2358. procedure TfdR3G3B2ub1.SetValues;
  2359. begin
  2360. inherited SetValues;
  2361. fBitsPerPixel := 8;
  2362. fFormat := tfR3G3B2ub1;
  2363. fWithAlpha := tfRGBA4us1;
  2364. fWithoutAlpha := tfR3G3B2ub1;
  2365. fRGBInverted := tfEmpty;
  2366. fPrecision := glBitmapRec4ub(3, 3, 2, 0);
  2367. fShift := glBitmapRec4ub(5, 2, 0, 0);
  2368. {$IFNDEF OPENGL_ES}
  2369. fOpenGLFormat := tfR3G3B2ub1;
  2370. fglFormat := GL_RGB;
  2371. fglInternalFormat := GL_R3_G3_B2;
  2372. fglDataFormat := GL_UNSIGNED_BYTE_3_3_2;
  2373. {$ELSE}
  2374. fOpenGLFormat := tfR5G6B5us1;
  2375. {$ENDIF}
  2376. end;
  2377. procedure TfdRGBX4us1.SetValues;
  2378. begin
  2379. inherited SetValues;
  2380. fBitsPerPixel := 16;
  2381. fFormat := tfRGBX4us1;
  2382. fWithAlpha := tfRGBA4us1;
  2383. fWithoutAlpha := tfRGBX4us1;
  2384. fRGBInverted := tfBGRX4us1;
  2385. fPrecision := glBitmapRec4ub( 4, 4, 4, 0);
  2386. fShift := glBitmapRec4ub(12, 8, 4, 0);
  2387. {$IFNDEF OPENGL_ES}
  2388. fOpenGLFormat := tfRGBX4us1;
  2389. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2390. fglInternalFormat := GL_RGB4;
  2391. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  2392. {$ELSE}
  2393. fOpenGLFormat := tfR5G6B5us1;
  2394. {$ENDIF}
  2395. end;
  2396. procedure TfdXRGB4us1.SetValues;
  2397. begin
  2398. inherited SetValues;
  2399. fBitsPerPixel := 16;
  2400. fFormat := tfXRGB4us1;
  2401. fWithAlpha := tfARGB4us1;
  2402. fWithoutAlpha := tfXRGB4us1;
  2403. fRGBInverted := tfXBGR4us1;
  2404. fPrecision := glBitmapRec4ub(4, 4, 4, 0);
  2405. fShift := glBitmapRec4ub(8, 4, 0, 0);
  2406. {$IFNDEF OPENGL_ES}
  2407. fOpenGLFormat := tfXRGB4us1;
  2408. fglFormat := GL_BGRA;
  2409. fglInternalFormat := GL_RGB4;
  2410. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2411. {$ELSE}
  2412. fOpenGLFormat := tfR5G6B5us1;
  2413. {$ENDIF}
  2414. end;
  2415. procedure TfdR5G6B5us1.SetValues;
  2416. begin
  2417. inherited SetValues;
  2418. fBitsPerPixel := 16;
  2419. fFormat := tfR5G6B5us1;
  2420. fWithAlpha := tfRGB5A1us1;
  2421. fWithoutAlpha := tfR5G6B5us1;
  2422. fRGBInverted := tfB5G6R5us1;
  2423. fPrecision := glBitmapRec4ub( 5, 6, 5, 0);
  2424. fShift := glBitmapRec4ub(11, 5, 0, 0);
  2425. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  2426. fOpenGLFormat := tfR5G6B5us1;
  2427. fglFormat := GL_RGB;
  2428. fglInternalFormat := GL_RGB565;
  2429. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5;
  2430. {$ELSE}
  2431. fOpenGLFormat := tfRGB8ub3;
  2432. {$IFEND}
  2433. end;
  2434. procedure TfdRGB5X1us1.SetValues;
  2435. begin
  2436. inherited SetValues;
  2437. fBitsPerPixel := 16;
  2438. fFormat := tfRGB5X1us1;
  2439. fWithAlpha := tfRGB5A1us1;
  2440. fWithoutAlpha := tfRGB5X1us1;
  2441. fRGBInverted := tfBGR5X1us1;
  2442. fPrecision := glBitmapRec4ub( 5, 5, 5, 0);
  2443. fShift := glBitmapRec4ub(11, 6, 1, 0);
  2444. {$IFNDEF OPENGL_ES}
  2445. fOpenGLFormat := tfRGB5X1us1;
  2446. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2447. fglInternalFormat := GL_RGB5;
  2448. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  2449. {$ELSE}
  2450. fOpenGLFormat := tfR5G6B5us1;
  2451. {$ENDIF}
  2452. end;
  2453. procedure TfdX1RGB5us1.SetValues;
  2454. begin
  2455. inherited SetValues;
  2456. fBitsPerPixel := 16;
  2457. fFormat := tfX1RGB5us1;
  2458. fWithAlpha := tfA1RGB5us1;
  2459. fWithoutAlpha := tfX1RGB5us1;
  2460. fRGBInverted := tfX1BGR5us1;
  2461. fPrecision := glBitmapRec4ub( 5, 5, 5, 0);
  2462. fShift := glBitmapRec4ub(10, 5, 0, 0);
  2463. {$IFNDEF OPENGL_ES}
  2464. fOpenGLFormat := tfX1RGB5us1;
  2465. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2466. fglInternalFormat := GL_RGB5;
  2467. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2468. {$ELSE}
  2469. fOpenGLFormat := tfR5G6B5us1;
  2470. {$ENDIF}
  2471. end;
  2472. procedure TfdRGB8ub3.SetValues;
  2473. begin
  2474. inherited SetValues;
  2475. fBitsPerPixel := 24;
  2476. fFormat := tfRGB8ub3;
  2477. fWithAlpha := tfRGBA8ub4;
  2478. fWithoutAlpha := tfRGB8ub3;
  2479. fRGBInverted := tfBGR8ub3;
  2480. fPrecision := glBitmapRec4ub(8, 8, 8, 0);
  2481. fShift := glBitmapRec4ub(0, 8, 16, 0);
  2482. fOpenGLFormat := tfRGB8ub3;
  2483. fglFormat := GL_RGB;
  2484. fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGB8{$ELSE}GL_RGB{$IFEND};
  2485. fglDataFormat := GL_UNSIGNED_BYTE;
  2486. end;
  2487. procedure TfdRGBX8ui1.SetValues;
  2488. begin
  2489. inherited SetValues;
  2490. fBitsPerPixel := 32;
  2491. fFormat := tfRGBX8ui1;
  2492. fWithAlpha := tfRGBA8ui1;
  2493. fWithoutAlpha := tfRGBX8ui1;
  2494. fRGBInverted := tfBGRX8ui1;
  2495. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  2496. fShift := glBitmapRec4ub(24, 16, 8, 0);
  2497. {$IFNDEF OPENGL_ES}
  2498. fOpenGLFormat := tfRGBX8ui1;
  2499. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2500. fglInternalFormat := GL_RGB8;
  2501. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  2502. {$ELSE}
  2503. fOpenGLFormat := tfRGB8ub3;
  2504. {$ENDIF}
  2505. end;
  2506. procedure TfdXRGB8ui1.SetValues;
  2507. begin
  2508. inherited SetValues;
  2509. fBitsPerPixel := 32;
  2510. fFormat := tfXRGB8ui1;
  2511. fWithAlpha := tfXRGB8ui1;
  2512. fWithoutAlpha := tfXRGB8ui1;
  2513. fOpenGLFormat := tfXRGB8ui1;
  2514. fRGBInverted := tfXBGR8ui1;
  2515. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  2516. fShift := glBitmapRec4ub(16, 8, 0, 0);
  2517. {$IFNDEF OPENGL_ES}
  2518. fOpenGLFormat := tfXRGB8ui1;
  2519. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2520. fglInternalFormat := GL_RGB8;
  2521. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  2522. {$ELSE}
  2523. fOpenGLFormat := tfRGB8ub3;
  2524. {$ENDIF}
  2525. end;
  2526. procedure TfdRGB10X2ui1.SetValues;
  2527. begin
  2528. inherited SetValues;
  2529. fBitsPerPixel := 32;
  2530. fFormat := tfRGB10X2ui1;
  2531. fWithAlpha := tfRGB10A2ui1;
  2532. fWithoutAlpha := tfRGB10X2ui1;
  2533. fRGBInverted := tfBGR10X2ui1;
  2534. fPrecision := glBitmapRec4ub(10, 10, 10, 0);
  2535. fShift := glBitmapRec4ub(22, 12, 2, 0);
  2536. {$IFNDEF OPENGL_ES}
  2537. fOpenGLFormat := tfRGB10X2ui1;
  2538. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2539. fglInternalFormat := GL_RGB10;
  2540. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  2541. {$ELSE}
  2542. fOpenGLFormat := tfRGB16us3;
  2543. {$ENDIF}
  2544. end;
  2545. procedure TfdX2RGB10ui1.SetValues;
  2546. begin
  2547. inherited SetValues;
  2548. fBitsPerPixel := 32;
  2549. fFormat := tfX2RGB10ui1;
  2550. fWithAlpha := tfA2RGB10ui1;
  2551. fWithoutAlpha := tfX2RGB10ui1;
  2552. fRGBInverted := tfX2BGR10ui1;
  2553. fPrecision := glBitmapRec4ub(10, 10, 10, 0);
  2554. fShift := glBitmapRec4ub(20, 10, 0, 0);
  2555. {$IFNDEF OPENGL_ES}
  2556. fOpenGLFormat := tfX2RGB10ui1;
  2557. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2558. fglInternalFormat := GL_RGB10;
  2559. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2560. {$ELSE}
  2561. fOpenGLFormat := tfRGB16us3;
  2562. {$ENDIF}
  2563. end;
  2564. procedure TfdRGB16us3.SetValues;
  2565. begin
  2566. inherited SetValues;
  2567. fBitsPerPixel := 48;
  2568. fFormat := tfRGB16us3;
  2569. fWithAlpha := tfRGBA16us4;
  2570. fWithoutAlpha := tfRGB16us3;
  2571. fRGBInverted := tfBGR16us3;
  2572. fPrecision := glBitmapRec4ub(16, 16, 16, 0);
  2573. fShift := glBitmapRec4ub( 0, 16, 32, 0);
  2574. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  2575. fOpenGLFormat := tfRGB16us3;
  2576. fglFormat := GL_RGB;
  2577. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGB16{$ELSE}GL_RGB16UI{$ENDIF};
  2578. fglDataFormat := GL_UNSIGNED_SHORT;
  2579. {$ELSE}
  2580. fOpenGLFormat := tfRGB8ub3;
  2581. {$IFEND}
  2582. end;
  2583. procedure TfdRGBA4us1.SetValues;
  2584. begin
  2585. inherited SetValues;
  2586. fBitsPerPixel := 16;
  2587. fFormat := tfRGBA4us1;
  2588. fWithAlpha := tfRGBA4us1;
  2589. fWithoutAlpha := tfRGBX4us1;
  2590. fOpenGLFormat := tfRGBA4us1;
  2591. fRGBInverted := tfBGRA4us1;
  2592. fPrecision := glBitmapRec4ub( 4, 4, 4, 4);
  2593. fShift := glBitmapRec4ub(12, 8, 4, 0);
  2594. fglFormat := GL_RGBA;
  2595. fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA8{$ELSE}GL_RGBA{$IFEND};
  2596. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  2597. end;
  2598. procedure TfdARGB4us1.SetValues;
  2599. begin
  2600. inherited SetValues;
  2601. fBitsPerPixel := 16;
  2602. fFormat := tfARGB4us1;
  2603. fWithAlpha := tfARGB4us1;
  2604. fWithoutAlpha := tfXRGB4us1;
  2605. fRGBInverted := tfABGR4us1;
  2606. fPrecision := glBitmapRec4ub( 4, 4, 4, 4);
  2607. fShift := glBitmapRec4ub( 8, 4, 0, 12);
  2608. {$IFNDEF OPENGL_ES}
  2609. fOpenGLFormat := tfARGB4us1;
  2610. fglFormat := GL_BGRA;
  2611. fglInternalFormat := GL_RGBA4;
  2612. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2613. {$ELSE}
  2614. fOpenGLFormat := tfRGBA4us1;
  2615. {$ENDIF}
  2616. end;
  2617. procedure TfdRGB5A1us1.SetValues;
  2618. begin
  2619. inherited SetValues;
  2620. fBitsPerPixel := 16;
  2621. fFormat := tfRGB5A1us1;
  2622. fWithAlpha := tfRGB5A1us1;
  2623. fWithoutAlpha := tfRGB5X1us1;
  2624. fOpenGLFormat := tfRGB5A1us1;
  2625. fRGBInverted := tfBGR5A1us1;
  2626. fPrecision := glBitmapRec4ub( 5, 5, 5, 1);
  2627. fShift := glBitmapRec4ub(11, 6, 1, 0);
  2628. fglFormat := GL_RGBA;
  2629. fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}GL_RGB5_A1{$ELSE}GL_RGBA{$IFEND};
  2630. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  2631. end;
  2632. procedure TfdA1RGB5us1.SetValues;
  2633. begin
  2634. inherited SetValues;
  2635. fBitsPerPixel := 16;
  2636. fFormat := tfA1RGB5us1;
  2637. fWithAlpha := tfA1RGB5us1;
  2638. fWithoutAlpha := tfX1RGB5us1;
  2639. fRGBInverted := tfA1BGR5us1;
  2640. fPrecision := glBitmapRec4ub( 5, 5, 5, 1);
  2641. fShift := glBitmapRec4ub(10, 5, 0, 15);
  2642. {$IFNDEF OPENGL_ES}
  2643. fOpenGLFormat := tfA1RGB5us1;
  2644. fglFormat := GL_BGRA;
  2645. fglInternalFormat := GL_RGB5_A1;
  2646. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2647. {$ELSE}
  2648. fOpenGLFormat := tfRGB5A1us1;
  2649. {$ENDIF}
  2650. end;
  2651. procedure TfdRGBA8ui1.SetValues;
  2652. begin
  2653. inherited SetValues;
  2654. fBitsPerPixel := 32;
  2655. fFormat := tfRGBA8ui1;
  2656. fWithAlpha := tfRGBA8ui1;
  2657. fWithoutAlpha := tfRGBX8ui1;
  2658. fRGBInverted := tfBGRA8ui1;
  2659. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  2660. fShift := glBitmapRec4ub(24, 16, 8, 0);
  2661. {$IFNDEF OPENGL_ES}
  2662. fOpenGLFormat := tfRGBA8ui1;
  2663. fglFormat := GL_RGBA;
  2664. fglInternalFormat := GL_RGBA8;
  2665. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  2666. {$ELSE}
  2667. fOpenGLFormat := tfRGBA8ub4;
  2668. {$ENDIF}
  2669. end;
  2670. procedure TfdARGB8ui1.SetValues;
  2671. begin
  2672. inherited SetValues;
  2673. fBitsPerPixel := 32;
  2674. fFormat := tfARGB8ui1;
  2675. fWithAlpha := tfARGB8ui1;
  2676. fWithoutAlpha := tfXRGB8ui1;
  2677. fRGBInverted := tfABGR8ui1;
  2678. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  2679. fShift := glBitmapRec4ub(16, 8, 0, 24);
  2680. {$IFNDEF OPENGL_ES}
  2681. fOpenGLFormat := tfARGB8ui1;
  2682. fglFormat := GL_BGRA;
  2683. fglInternalFormat := GL_RGBA8;
  2684. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  2685. {$ELSE}
  2686. fOpenGLFormat := tfRGBA8ub4;
  2687. {$ENDIF}
  2688. end;
  2689. procedure TfdRGBA8ub4.SetValues;
  2690. begin
  2691. inherited SetValues;
  2692. fBitsPerPixel := 32;
  2693. fFormat := tfRGBA8ub4;
  2694. fWithAlpha := tfRGBA8ub4;
  2695. fWithoutAlpha := tfRGB8ub3;
  2696. fOpenGLFormat := tfRGBA8ub4;
  2697. fRGBInverted := tfBGRA8ub4;
  2698. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  2699. fShift := glBitmapRec4ub( 0, 8, 16, 24);
  2700. fglFormat := GL_RGBA;
  2701. fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA8{$ELSE}GL_RGBA{$IFEND};
  2702. fglDataFormat := GL_UNSIGNED_BYTE;
  2703. end;
  2704. procedure TfdRGB10A2ui1.SetValues;
  2705. begin
  2706. inherited SetValues;
  2707. fBitsPerPixel := 32;
  2708. fFormat := tfRGB10A2ui1;
  2709. fWithAlpha := tfRGB10A2ui1;
  2710. fWithoutAlpha := tfRGB10X2ui1;
  2711. fRGBInverted := tfBGR10A2ui1;
  2712. fPrecision := glBitmapRec4ub(10, 10, 10, 2);
  2713. fShift := glBitmapRec4ub(22, 12, 2, 0);
  2714. {$IFNDEF OPENGL_ES}
  2715. fOpenGLFormat := tfRGB10A2ui1;
  2716. fglFormat := GL_RGBA;
  2717. fglInternalFormat := GL_RGB10_A2;
  2718. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  2719. {$ELSE}
  2720. fOpenGLFormat := tfA2RGB10ui1;
  2721. {$ENDIF}
  2722. end;
  2723. procedure TfdA2RGB10ui1.SetValues;
  2724. begin
  2725. inherited SetValues;
  2726. fBitsPerPixel := 32;
  2727. fFormat := tfA2RGB10ui1;
  2728. fWithAlpha := tfA2RGB10ui1;
  2729. fWithoutAlpha := tfX2RGB10ui1;
  2730. fRGBInverted := tfA2BGR10ui1;
  2731. fPrecision := glBitmapRec4ub(10, 10, 10, 2);
  2732. fShift := glBitmapRec4ub(20, 10, 0, 30);
  2733. {$IF NOT DEFINED(OPENGL_ES)}
  2734. fOpenGLFormat := tfA2RGB10ui1;
  2735. fglFormat := GL_BGRA;
  2736. fglInternalFormat := GL_RGB10_A2;
  2737. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2738. {$ELSEIF DEFINED(OPENGL_ES_3_0)}
  2739. fOpenGLFormat := tfA2RGB10ui1;
  2740. fglFormat := GL_RGBA;
  2741. fglInternalFormat := GL_RGB10_A2;
  2742. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2743. {$ELSE}
  2744. fOpenGLFormat := tfRGBA8ui1;
  2745. {$IFEND}
  2746. end;
  2747. procedure TfdRGBA16us4.SetValues;
  2748. begin
  2749. inherited SetValues;
  2750. fBitsPerPixel := 64;
  2751. fFormat := tfRGBA16us4;
  2752. fWithAlpha := tfRGBA16us4;
  2753. fWithoutAlpha := tfRGB16us3;
  2754. fRGBInverted := tfBGRA16us4;
  2755. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  2756. fShift := glBitmapRec4ub( 0, 16, 32, 48);
  2757. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  2758. fOpenGLFormat := tfRGBA16us4;
  2759. fglFormat := GL_RGBA;
  2760. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGBA16{$ELSE}GL_RGBA16UI{$ENDIF};
  2761. fglDataFormat := GL_UNSIGNED_SHORT;
  2762. {$ELSE}
  2763. fOpenGLFormat := tfRGBA8ub4;
  2764. {$IFEND}
  2765. end;
  2766. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2767. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2768. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2769. procedure TfdBGRX4us1.SetValues;
  2770. begin
  2771. inherited SetValues;
  2772. fBitsPerPixel := 16;
  2773. fFormat := tfBGRX4us1;
  2774. fWithAlpha := tfBGRA4us1;
  2775. fWithoutAlpha := tfBGRX4us1;
  2776. fRGBInverted := tfRGBX4us1;
  2777. fPrecision := glBitmapRec4ub( 4, 4, 4, 0);
  2778. fShift := glBitmapRec4ub( 4, 8, 12, 0);
  2779. {$IFNDEF OPENGL_ES}
  2780. fOpenGLFormat := tfBGRX4us1;
  2781. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2782. fglInternalFormat := GL_RGB4;
  2783. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  2784. {$ELSE}
  2785. fOpenGLFormat := tfR5G6B5us1;
  2786. {$ENDIF}
  2787. end;
  2788. procedure TfdXBGR4us1.SetValues;
  2789. begin
  2790. inherited SetValues;
  2791. fBitsPerPixel := 16;
  2792. fFormat := tfXBGR4us1;
  2793. fWithAlpha := tfABGR4us1;
  2794. fWithoutAlpha := tfXBGR4us1;
  2795. fRGBInverted := tfXRGB4us1;
  2796. fPrecision := glBitmapRec4ub( 4, 4, 4, 0);
  2797. fShift := glBitmapRec4ub( 0, 4, 8, 0);
  2798. {$IFNDEF OPENGL_ES}
  2799. fOpenGLFormat := tfXBGR4us1;
  2800. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2801. fglInternalFormat := GL_RGB4;
  2802. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2803. {$ELSE}
  2804. fOpenGLFormat := tfR5G6B5us1;
  2805. {$ENDIF}
  2806. end;
  2807. procedure TfdB5G6R5us1.SetValues;
  2808. begin
  2809. inherited SetValues;
  2810. fBitsPerPixel := 16;
  2811. fFormat := tfB5G6R5us1;
  2812. fWithAlpha := tfBGR5A1us1;
  2813. fWithoutAlpha := tfB5G6R5us1;
  2814. fRGBInverted := tfR5G6B5us1;
  2815. fPrecision := glBitmapRec4ub( 5, 6, 5, 0);
  2816. fShift := glBitmapRec4ub( 0, 5, 11, 0);
  2817. {$IFNDEF OPENGL_ES}
  2818. fOpenGLFormat := tfB5G6R5us1;
  2819. fglFormat := GL_RGB;
  2820. fglInternalFormat := GL_RGB565;
  2821. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5_REV;
  2822. {$ELSE}
  2823. fOpenGLFormat := tfR5G6B5us1;
  2824. {$ENDIF}
  2825. end;
  2826. procedure TfdBGR5X1us1.SetValues;
  2827. begin
  2828. inherited SetValues;
  2829. fBitsPerPixel := 16;
  2830. fFormat := tfBGR5X1us1;
  2831. fWithAlpha := tfBGR5A1us1;
  2832. fWithoutAlpha := tfBGR5X1us1;
  2833. fRGBInverted := tfRGB5X1us1;
  2834. fPrecision := glBitmapRec4ub( 5, 5, 5, 0);
  2835. fShift := glBitmapRec4ub( 1, 6, 11, 0);
  2836. {$IFNDEF OPENGL_ES}
  2837. fOpenGLFormat := tfBGR5X1us1;
  2838. fglFormat := GL_BGRA;
  2839. fglInternalFormat := GL_RGB5;
  2840. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  2841. {$ELSE}
  2842. fOpenGLFormat := tfR5G6B5us1;
  2843. {$ENDIF}
  2844. end;
  2845. procedure TfdX1BGR5us1.SetValues;
  2846. begin
  2847. inherited SetValues;
  2848. fBitsPerPixel := 16;
  2849. fFormat := tfX1BGR5us1;
  2850. fWithAlpha := tfA1BGR5us1;
  2851. fWithoutAlpha := tfX1BGR5us1;
  2852. fRGBInverted := tfX1RGB5us1;
  2853. fPrecision := glBitmapRec4ub( 5, 5, 5, 0);
  2854. fShift := glBitmapRec4ub( 0, 5, 10, 0);
  2855. {$IFNDEF OPENGL_ES}
  2856. fOpenGLFormat := tfX1BGR5us1;
  2857. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2858. fglInternalFormat := GL_RGB5;
  2859. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2860. {$ELSE}
  2861. fOpenGLFormat := tfR5G6B5us1;
  2862. {$ENDIF}
  2863. end;
  2864. procedure TfdBGR8ub3.SetValues;
  2865. begin
  2866. inherited SetValues;
  2867. fBitsPerPixel := 24;
  2868. fFormat := tfBGR8ub3;
  2869. fWithAlpha := tfBGRA8ub4;
  2870. fWithoutAlpha := tfBGR8ub3;
  2871. fRGBInverted := tfRGB8ub3;
  2872. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  2873. fShift := glBitmapRec4ub(16, 8, 0, 0);
  2874. {$IFNDEF OPENGL_ES}
  2875. fOpenGLFormat := tfBGR8ub3;
  2876. fglFormat := GL_BGR;
  2877. fglInternalFormat := GL_RGB8;
  2878. fglDataFormat := GL_UNSIGNED_BYTE;
  2879. {$ELSE}
  2880. fOpenGLFormat := tfRGB8ub3;
  2881. {$ENDIF}
  2882. end;
  2883. procedure TfdBGRX8ui1.SetValues;
  2884. begin
  2885. inherited SetValues;
  2886. fBitsPerPixel := 32;
  2887. fFormat := tfBGRX8ui1;
  2888. fWithAlpha := tfBGRA8ui1;
  2889. fWithoutAlpha := tfBGRX8ui1;
  2890. fRGBInverted := tfRGBX8ui1;
  2891. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  2892. fShift := glBitmapRec4ub( 8, 16, 24, 0);
  2893. {$IFNDEF OPENGL_ES}
  2894. fOpenGLFormat := tfBGRX8ui1;
  2895. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2896. fglInternalFormat := GL_RGB8;
  2897. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  2898. {$ELSE}
  2899. fOpenGLFormat := tfRGB8ub3;
  2900. {$ENDIF}
  2901. end;
  2902. procedure TfdXBGR8ui1.SetValues;
  2903. begin
  2904. inherited SetValues;
  2905. fBitsPerPixel := 32;
  2906. fFormat := tfXBGR8ui1;
  2907. fWithAlpha := tfABGR8ui1;
  2908. fWithoutAlpha := tfXBGR8ui1;
  2909. fRGBInverted := tfXRGB8ui1;
  2910. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  2911. fShift := glBitmapRec4ub( 0, 8, 16, 0);
  2912. {$IFNDEF OPENGL_ES}
  2913. fOpenGLFormat := tfXBGR8ui1;
  2914. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2915. fglInternalFormat := GL_RGB8;
  2916. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  2917. {$ELSE}
  2918. fOpenGLFormat := tfRGB8ub3;
  2919. {$ENDIF}
  2920. end;
  2921. procedure TfdBGR10X2ui1.SetValues;
  2922. begin
  2923. inherited SetValues;
  2924. fBitsPerPixel := 32;
  2925. fFormat := tfBGR10X2ui1;
  2926. fWithAlpha := tfBGR10A2ui1;
  2927. fWithoutAlpha := tfBGR10X2ui1;
  2928. fRGBInverted := tfRGB10X2ui1;
  2929. fPrecision := glBitmapRec4ub(10, 10, 10, 0);
  2930. fShift := glBitmapRec4ub( 2, 12, 22, 0);
  2931. {$IFNDEF OPENGL_ES}
  2932. fOpenGLFormat := tfBGR10X2ui1;
  2933. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2934. fglInternalFormat := GL_RGB10;
  2935. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  2936. {$ELSE}
  2937. fOpenGLFormat := tfRGB16us3;
  2938. {$ENDIF}
  2939. end;
  2940. procedure TfdX2BGR10ui1.SetValues;
  2941. begin
  2942. inherited SetValues;
  2943. fBitsPerPixel := 32;
  2944. fFormat := tfX2BGR10ui1;
  2945. fWithAlpha := tfA2BGR10ui1;
  2946. fWithoutAlpha := tfX2BGR10ui1;
  2947. fRGBInverted := tfX2RGB10ui1;
  2948. fPrecision := glBitmapRec4ub(10, 10, 10, 0);
  2949. fShift := glBitmapRec4ub( 0, 10, 20, 0);
  2950. {$IFNDEF OPENGL_ES}
  2951. fOpenGLFormat := tfX2BGR10ui1;
  2952. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2953. fglInternalFormat := GL_RGB10;
  2954. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2955. {$ELSE}
  2956. fOpenGLFormat := tfRGB16us3;
  2957. {$ENDIF}
  2958. end;
  2959. procedure TfdBGR16us3.SetValues;
  2960. begin
  2961. inherited SetValues;
  2962. fBitsPerPixel := 48;
  2963. fFormat := tfBGR16us3;
  2964. fWithAlpha := tfBGRA16us4;
  2965. fWithoutAlpha := tfBGR16us3;
  2966. fRGBInverted := tfRGB16us3;
  2967. fPrecision := glBitmapRec4ub(16, 16, 16, 0);
  2968. fShift := glBitmapRec4ub(32, 16, 0, 0);
  2969. {$IFNDEF OPENGL_ES}
  2970. fOpenGLFormat := tfBGR16us3;
  2971. fglFormat := GL_BGR;
  2972. fglInternalFormat := GL_RGB16;
  2973. fglDataFormat := GL_UNSIGNED_SHORT;
  2974. {$ELSE}
  2975. fOpenGLFormat := tfRGB16us3;
  2976. {$ENDIF}
  2977. end;
  2978. procedure TfdBGRA4us1.SetValues;
  2979. begin
  2980. inherited SetValues;
  2981. fBitsPerPixel := 16;
  2982. fFormat := tfBGRA4us1;
  2983. fWithAlpha := tfBGRA4us1;
  2984. fWithoutAlpha := tfBGRX4us1;
  2985. fRGBInverted := tfRGBA4us1;
  2986. fPrecision := glBitmapRec4ub( 4, 4, 4, 4);
  2987. fShift := glBitmapRec4ub( 4, 8, 12, 0);
  2988. {$IFNDEF OPENGL_ES}
  2989. fOpenGLFormat := tfBGRA4us1;
  2990. fglFormat := GL_BGRA;
  2991. fglInternalFormat := GL_RGBA4;
  2992. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  2993. {$ELSE}
  2994. fOpenGLFormat := tfRGBA4us1;
  2995. {$ENDIF}
  2996. end;
  2997. procedure TfdABGR4us1.SetValues;
  2998. begin
  2999. inherited SetValues;
  3000. fBitsPerPixel := 16;
  3001. fFormat := tfABGR4us1;
  3002. fWithAlpha := tfABGR4us1;
  3003. fWithoutAlpha := tfXBGR4us1;
  3004. fRGBInverted := tfARGB4us1;
  3005. fPrecision := glBitmapRec4ub( 4, 4, 4, 4);
  3006. fShift := glBitmapRec4ub( 0, 4, 8, 12);
  3007. {$IFNDEF OPENGL_ES}
  3008. fOpenGLFormat := tfABGR4us1;
  3009. fglFormat := GL_RGBA;
  3010. fglInternalFormat := GL_RGBA4;
  3011. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  3012. {$ELSE}
  3013. fOpenGLFormat := tfRGBA4us1;
  3014. {$ENDIF}
  3015. end;
  3016. procedure TfdBGR5A1us1.SetValues;
  3017. begin
  3018. inherited SetValues;
  3019. fBitsPerPixel := 16;
  3020. fFormat := tfBGR5A1us1;
  3021. fWithAlpha := tfBGR5A1us1;
  3022. fWithoutAlpha := tfBGR5X1us1;
  3023. fRGBInverted := tfRGB5A1us1;
  3024. fPrecision := glBitmapRec4ub( 5, 5, 5, 1);
  3025. fShift := glBitmapRec4ub( 1, 6, 11, 0);
  3026. {$IFNDEF OPENGL_ES}
  3027. fOpenGLFormat := tfBGR5A1us1;
  3028. fglFormat := GL_BGRA;
  3029. fglInternalFormat := GL_RGB5_A1;
  3030. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  3031. {$ELSE}
  3032. fOpenGLFormat := tfRGB5A1us1;
  3033. {$ENDIF}
  3034. end;
  3035. procedure TfdA1BGR5us1.SetValues;
  3036. begin
  3037. inherited SetValues;
  3038. fBitsPerPixel := 16;
  3039. fFormat := tfA1BGR5us1;
  3040. fWithAlpha := tfA1BGR5us1;
  3041. fWithoutAlpha := tfX1BGR5us1;
  3042. fRGBInverted := tfA1RGB5us1;
  3043. fPrecision := glBitmapRec4ub( 5, 5, 5, 1);
  3044. fShift := glBitmapRec4ub( 0, 5, 10, 15);
  3045. {$IFNDEF OPENGL_ES}
  3046. fOpenGLFormat := tfA1BGR5us1;
  3047. fglFormat := GL_RGBA;
  3048. fglInternalFormat := GL_RGB5_A1;
  3049. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  3050. {$ELSE}
  3051. fOpenGLFormat := tfRGB5A1us1;
  3052. {$ENDIF}
  3053. end;
  3054. procedure TfdBGRA8ui1.SetValues;
  3055. begin
  3056. inherited SetValues;
  3057. fBitsPerPixel := 32;
  3058. fFormat := tfBGRA8ui1;
  3059. fWithAlpha := tfBGRA8ui1;
  3060. fWithoutAlpha := tfBGRX8ui1;
  3061. fRGBInverted := tfRGBA8ui1;
  3062. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  3063. fShift := glBitmapRec4ub( 8, 16, 24, 0);
  3064. {$IFNDEF OPENGL_ES}
  3065. fOpenGLFormat := tfBGRA8ui1;
  3066. fglFormat := GL_BGRA;
  3067. fglInternalFormat := GL_RGBA8;
  3068. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  3069. {$ELSE}
  3070. fOpenGLFormat := tfRGBA8ub4;
  3071. {$ENDIF}
  3072. end;
  3073. procedure TfdABGR8ui1.SetValues;
  3074. begin
  3075. inherited SetValues;
  3076. fBitsPerPixel := 32;
  3077. fFormat := tfABGR8ui1;
  3078. fWithAlpha := tfABGR8ui1;
  3079. fWithoutAlpha := tfXBGR8ui1;
  3080. fRGBInverted := tfARGB8ui1;
  3081. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  3082. fShift := glBitmapRec4ub( 0, 8, 16, 24);
  3083. {$IFNDEF OPENGL_ES}
  3084. fOpenGLFormat := tfABGR8ui1;
  3085. fglFormat := GL_RGBA;
  3086. fglInternalFormat := GL_RGBA8;
  3087. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  3088. {$ELSE}
  3089. fOpenGLFormat := tfRGBA8ub4
  3090. {$ENDIF}
  3091. end;
  3092. procedure TfdBGRA8ub4.SetValues;
  3093. begin
  3094. inherited SetValues;
  3095. fBitsPerPixel := 32;
  3096. fFormat := tfBGRA8ub4;
  3097. fWithAlpha := tfBGRA8ub4;
  3098. fWithoutAlpha := tfBGR8ub3;
  3099. fRGBInverted := tfRGBA8ub4;
  3100. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  3101. fShift := glBitmapRec4ub(16, 8, 0, 24);
  3102. {$IFNDEF OPENGL_ES}
  3103. fOpenGLFormat := tfBGRA8ub4;
  3104. fglFormat := GL_BGRA;
  3105. fglInternalFormat := GL_RGBA8;
  3106. fglDataFormat := GL_UNSIGNED_BYTE;
  3107. {$ELSE}
  3108. fOpenGLFormat := tfRGBA8ub4;
  3109. {$ENDIF}
  3110. end;
  3111. procedure TfdBGR10A2ui1.SetValues;
  3112. begin
  3113. inherited SetValues;
  3114. fBitsPerPixel := 32;
  3115. fFormat := tfBGR10A2ui1;
  3116. fWithAlpha := tfBGR10A2ui1;
  3117. fWithoutAlpha := tfBGR10X2ui1;
  3118. fRGBInverted := tfRGB10A2ui1;
  3119. fPrecision := glBitmapRec4ub(10, 10, 10, 2);
  3120. fShift := glBitmapRec4ub( 2, 12, 22, 0);
  3121. {$IFNDEF OPENGL_ES}
  3122. fOpenGLFormat := tfBGR10A2ui1;
  3123. fglFormat := GL_BGRA;
  3124. fglInternalFormat := GL_RGB10_A2;
  3125. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  3126. {$ELSE}
  3127. fOpenGLFormat := tfA2RGB10ui1;
  3128. {$ENDIF}
  3129. end;
  3130. procedure TfdA2BGR10ui1.SetValues;
  3131. begin
  3132. inherited SetValues;
  3133. fBitsPerPixel := 32;
  3134. fFormat := tfA2BGR10ui1;
  3135. fWithAlpha := tfA2BGR10ui1;
  3136. fWithoutAlpha := tfX2BGR10ui1;
  3137. fRGBInverted := tfA2RGB10ui1;
  3138. fPrecision := glBitmapRec4ub(10, 10, 10, 2);
  3139. fShift := glBitmapRec4ub( 0, 10, 20, 30);
  3140. {$IFNDEF OPENGL_ES}
  3141. fOpenGLFormat := tfA2BGR10ui1;
  3142. fglFormat := GL_RGBA;
  3143. fglInternalFormat := GL_RGB10_A2;
  3144. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3145. {$ELSE}
  3146. fOpenGLFormat := tfA2RGB10ui1;
  3147. {$ENDIF}
  3148. end;
  3149. procedure TfdBGRA16us4.SetValues;
  3150. begin
  3151. inherited SetValues;
  3152. fBitsPerPixel := 64;
  3153. fFormat := tfBGRA16us4;
  3154. fWithAlpha := tfBGRA16us4;
  3155. fWithoutAlpha := tfBGR16us3;
  3156. fRGBInverted := tfRGBA16us4;
  3157. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  3158. fShift := glBitmapRec4ub(32, 16, 0, 48);
  3159. {$IFNDEF OPENGL_ES}
  3160. fOpenGLFormat := tfBGRA16us4;
  3161. fglFormat := GL_BGRA;
  3162. fglInternalFormat := GL_RGBA16;
  3163. fglDataFormat := GL_UNSIGNED_SHORT;
  3164. {$ELSE}
  3165. fOpenGLFormat := tfRGBA16us4;
  3166. {$ENDIF}
  3167. end;
  3168. procedure TfdDepth16us1.SetValues;
  3169. begin
  3170. inherited SetValues;
  3171. fBitsPerPixel := 16;
  3172. fFormat := tfDepth16us1;
  3173. fWithoutAlpha := tfDepth16us1;
  3174. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  3175. fShift := glBitmapRec4ub( 0, 0, 0, 0);
  3176. {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  3177. fOpenGLFormat := tfDepth16us1;
  3178. fglFormat := GL_DEPTH_COMPONENT;
  3179. fglInternalFormat := GL_DEPTH_COMPONENT16;
  3180. fglDataFormat := GL_UNSIGNED_SHORT;
  3181. {$IFEND}
  3182. end;
  3183. procedure TfdDepth24ui1.SetValues;
  3184. begin
  3185. inherited SetValues;
  3186. fBitsPerPixel := 32;
  3187. fFormat := tfDepth24ui1;
  3188. fWithoutAlpha := tfDepth24ui1;
  3189. fOpenGLFormat := tfDepth24ui1;
  3190. fPrecision := glBitmapRec4ub(32, 32, 32, 32);
  3191. fShift := glBitmapRec4ub( 0, 0, 0, 0);
  3192. {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  3193. fOpenGLFormat := tfDepth24ui1;
  3194. fglFormat := GL_DEPTH_COMPONENT;
  3195. fglInternalFormat := GL_DEPTH_COMPONENT24;
  3196. fglDataFormat := GL_UNSIGNED_INT;
  3197. {$IFEND}
  3198. end;
  3199. procedure TfdDepth32ui1.SetValues;
  3200. begin
  3201. inherited SetValues;
  3202. fBitsPerPixel := 32;
  3203. fFormat := tfDepth32ui1;
  3204. fWithoutAlpha := tfDepth32ui1;
  3205. fPrecision := glBitmapRec4ub(32, 32, 32, 32);
  3206. fShift := glBitmapRec4ub( 0, 0, 0, 0);
  3207. {$IF NOT DEFINED(OPENGL_ES)}
  3208. fOpenGLFormat := tfDepth32ui1;
  3209. fglFormat := GL_DEPTH_COMPONENT;
  3210. fglInternalFormat := GL_DEPTH_COMPONENT32;
  3211. fglDataFormat := GL_UNSIGNED_INT;
  3212. {$ELSEIF DEFINED(OPENGL_ES_3_0)}
  3213. fOpenGLFormat := tfDepth24ui1;
  3214. {$ELSEIF DEFINED(OPENGL_ES_2_0)}
  3215. fOpenGLFormat := tfDepth16us1;
  3216. {$IFEND}
  3217. end;
  3218. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3219. //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3220. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3221. procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3222. begin
  3223. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3224. end;
  3225. procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3226. begin
  3227. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3228. end;
  3229. procedure TfdS3tcDtx1RGBA.SetValues;
  3230. begin
  3231. inherited SetValues;
  3232. fFormat := tfS3tcDtx1RGBA;
  3233. fWithAlpha := tfS3tcDtx1RGBA;
  3234. fUncompressed := tfRGB5A1us1;
  3235. fBitsPerPixel := 4;
  3236. fIsCompressed := true;
  3237. {$IFNDEF OPENGL_ES}
  3238. fOpenGLFormat := tfS3tcDtx1RGBA;
  3239. fglFormat := GL_COMPRESSED_RGBA;
  3240. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
  3241. fglDataFormat := GL_UNSIGNED_BYTE;
  3242. {$ELSE}
  3243. fOpenGLFormat := fUncompressed;
  3244. {$ENDIF}
  3245. end;
  3246. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3247. //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3248. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3249. procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3250. begin
  3251. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3252. end;
  3253. procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3254. begin
  3255. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3256. end;
  3257. procedure TfdS3tcDtx3RGBA.SetValues;
  3258. begin
  3259. inherited SetValues;
  3260. fFormat := tfS3tcDtx3RGBA;
  3261. fWithAlpha := tfS3tcDtx3RGBA;
  3262. fUncompressed := tfRGBA8ub4;
  3263. fBitsPerPixel := 8;
  3264. fIsCompressed := true;
  3265. {$IFNDEF OPENGL_ES}
  3266. fOpenGLFormat := tfS3tcDtx3RGBA;
  3267. fglFormat := GL_COMPRESSED_RGBA;
  3268. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
  3269. fglDataFormat := GL_UNSIGNED_BYTE;
  3270. {$ELSE}
  3271. fOpenGLFormat := fUncompressed;
  3272. {$ENDIF}
  3273. end;
  3274. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3275. //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3276. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3277. procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3278. begin
  3279. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3280. end;
  3281. procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3282. begin
  3283. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3284. end;
  3285. procedure TfdS3tcDtx5RGBA.SetValues;
  3286. begin
  3287. inherited SetValues;
  3288. fFormat := tfS3tcDtx3RGBA;
  3289. fWithAlpha := tfS3tcDtx3RGBA;
  3290. fUncompressed := tfRGBA8ub4;
  3291. fBitsPerPixel := 8;
  3292. fIsCompressed := true;
  3293. {$IFNDEF OPENGL_ES}
  3294. fOpenGLFormat := tfS3tcDtx3RGBA;
  3295. fglFormat := GL_COMPRESSED_RGBA;
  3296. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
  3297. fglDataFormat := GL_UNSIGNED_BYTE;
  3298. {$ELSE}
  3299. fOpenGLFormat := fUncompressed;
  3300. {$ENDIF}
  3301. end;
  3302. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3303. //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3304. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3305. function TglBitmapFormatDescriptor.GetHasRed: Boolean;
  3306. begin
  3307. result := (fPrecision.r > 0);
  3308. end;
  3309. function TglBitmapFormatDescriptor.GetHasGreen: Boolean;
  3310. begin
  3311. result := (fPrecision.g > 0);
  3312. end;
  3313. function TglBitmapFormatDescriptor.GetHasBlue: Boolean;
  3314. begin
  3315. result := (fPrecision.b > 0);
  3316. end;
  3317. function TglBitmapFormatDescriptor.GetHasAlpha: Boolean;
  3318. begin
  3319. result := (fPrecision.a > 0);
  3320. end;
  3321. function TglBitmapFormatDescriptor.GetHasColor: Boolean;
  3322. begin
  3323. result := HasRed or HasGreen or HasBlue;
  3324. end;
  3325. function TglBitmapFormatDescriptor.GetIsGrayscale: Boolean;
  3326. begin
  3327. result := (Mask.r = Mask.g) and (Mask.g = Mask.b) and (Mask.r > 0);
  3328. end;
  3329. function TglBitmapFormatDescriptor.GetHasOpenGLSupport: Boolean;
  3330. begin
  3331. result := (OpenGLFormat = Format);
  3332. end;
  3333. procedure TglBitmapFormatDescriptor.SetValues;
  3334. begin
  3335. fFormat := tfEmpty;
  3336. fWithAlpha := tfEmpty;
  3337. fWithoutAlpha := tfEmpty;
  3338. fOpenGLFormat := tfEmpty;
  3339. fRGBInverted := tfEmpty;
  3340. fUncompressed := tfEmpty;
  3341. fBitsPerPixel := 0;
  3342. fIsCompressed := false;
  3343. fglFormat := 0;
  3344. fglInternalFormat := 0;
  3345. fglDataFormat := 0;
  3346. FillChar(fPrecision, 0, SizeOf(fPrecision));
  3347. FillChar(fShift, 0, SizeOf(fShift));
  3348. end;
  3349. procedure TglBitmapFormatDescriptor.CalcValues;
  3350. var
  3351. i: Integer;
  3352. begin
  3353. fBytesPerPixel := fBitsPerPixel / 8;
  3354. fChannelCount := 0;
  3355. for i := 0 to 3 do begin
  3356. if (fPrecision.arr[i] > 0) then
  3357. inc(fChannelCount);
  3358. fRange.arr[i] := (1 shl fPrecision.arr[i]) - 1;
  3359. fMask.arr[i] := fRange.arr[i] shl fShift.arr[i];
  3360. end;
  3361. end;
  3362. function TglBitmapFormatDescriptor.GetSize(const aSize: TglBitmapSize): Integer;
  3363. var
  3364. w, h: Integer;
  3365. begin
  3366. if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
  3367. w := Max(1, aSize.X);
  3368. h := Max(1, aSize.Y);
  3369. result := GetSize(w, h);
  3370. end else
  3371. result := 0;
  3372. end;
  3373. function TglBitmapFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
  3374. begin
  3375. result := 0;
  3376. if (aWidth <= 0) or (aHeight <= 0) then
  3377. exit;
  3378. result := Ceil(aWidth * aHeight * BytesPerPixel);
  3379. end;
  3380. constructor TglBitmapFormatDescriptor.Create;
  3381. begin
  3382. inherited Create;
  3383. SetValues;
  3384. CalcValues;
  3385. end;
  3386. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3387. class function TglBitmapFormatDescriptor.GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
  3388. var
  3389. f: TglBitmapFormat;
  3390. begin
  3391. for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
  3392. result := TFormatDescriptor.Get(f);
  3393. if (result.glInternalFormat = aInternalFormat) then
  3394. exit;
  3395. end;
  3396. result := TFormatDescriptor.Get(tfEmpty);
  3397. end;
  3398. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3399. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3400. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3401. class procedure TFormatDescriptor.Init;
  3402. begin
  3403. if not Assigned(FormatDescriptorCS) then
  3404. FormatDescriptorCS := TCriticalSection.Create;
  3405. end;
  3406. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3407. class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3408. begin
  3409. FormatDescriptorCS.Enter;
  3410. try
  3411. result := FormatDescriptors[aFormat];
  3412. if not Assigned(result) then begin
  3413. result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
  3414. FormatDescriptors[aFormat] := result;
  3415. end;
  3416. finally
  3417. FormatDescriptorCS.Leave;
  3418. end;
  3419. end;
  3420. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3421. class function TFormatDescriptor.GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3422. begin
  3423. result := Get(Get(aFormat).WithAlpha);
  3424. end;
  3425. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3426. class function TFormatDescriptor.GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer): TFormatDescriptor;
  3427. var
  3428. ft: TglBitmapFormat;
  3429. begin
  3430. // find matching format with OpenGL support
  3431. for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  3432. result := Get(ft);
  3433. if (result.MaskMatch(aMask)) and
  3434. (result.glFormat <> 0) and
  3435. (result.glInternalFormat <> 0) and
  3436. ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
  3437. then
  3438. exit;
  3439. end;
  3440. // find matching format without OpenGL Support
  3441. for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  3442. result := Get(ft);
  3443. if result.MaskMatch(aMask) and ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
  3444. exit;
  3445. end;
  3446. result := TFormatDescriptor.Get(tfEmpty);
  3447. end;
  3448. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3449. class function TFormatDescriptor.GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
  3450. var
  3451. ft: TglBitmapFormat;
  3452. begin
  3453. // find matching format with OpenGL support
  3454. for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  3455. result := Get(ft);
  3456. if glBitmapRec4ubCompare(result.Shift, aShift) and
  3457. glBitmapRec4ubCompare(result.Precision, aPrec) and
  3458. (result.glFormat <> 0) and
  3459. (result.glInternalFormat <> 0) and
  3460. ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
  3461. then
  3462. exit;
  3463. end;
  3464. // find matching format without OpenGL Support
  3465. for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  3466. result := Get(ft);
  3467. if glBitmapRec4ubCompare(result.Shift, aShift) and
  3468. glBitmapRec4ubCompare(result.Precision, aPrec) and
  3469. ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
  3470. exit;
  3471. end;
  3472. result := TFormatDescriptor.Get(tfEmpty);
  3473. end;
  3474. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3475. class procedure TFormatDescriptor.Clear;
  3476. var
  3477. f: TglBitmapFormat;
  3478. begin
  3479. FormatDescriptorCS.Enter;
  3480. try
  3481. for f := low(FormatDescriptors) to high(FormatDescriptors) do
  3482. FreeAndNil(FormatDescriptors[f]);
  3483. finally
  3484. FormatDescriptorCS.Leave;
  3485. end;
  3486. end;
  3487. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3488. class procedure TFormatDescriptor.Finalize;
  3489. begin
  3490. Clear;
  3491. FreeAndNil(FormatDescriptorCS);
  3492. end;
  3493. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3494. //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3495. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3496. procedure TbmpBitfieldFormat.SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul);
  3497. var
  3498. i: Integer;
  3499. begin
  3500. for i := 0 to 3 do begin
  3501. fShift.arr[i] := 0;
  3502. while (aMask.arr[i] > 0) and ((aMask.arr[i] and 1) = 0) do begin
  3503. aMask.arr[i] := aMask.arr[i] shr 1;
  3504. inc(fShift.arr[i]);
  3505. end;
  3506. fPrecision.arr[i] := CountSetBits(aMask.arr[i]);
  3507. end;
  3508. fBitsPerPixel := aBPP;
  3509. CalcValues;
  3510. end;
  3511. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3512. procedure TbmpBitfieldFormat.SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub);
  3513. begin
  3514. fBitsPerPixel := aBBP;
  3515. fPrecision := aPrec;
  3516. fShift := aShift;
  3517. CalcValues;
  3518. end;
  3519. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3520. procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3521. var
  3522. data: QWord;
  3523. begin
  3524. data :=
  3525. ((aPixel.Data.r and Range.r) shl Shift.r) or
  3526. ((aPixel.Data.g and Range.g) shl Shift.g) or
  3527. ((aPixel.Data.b and Range.b) shl Shift.b) or
  3528. ((aPixel.Data.a and Range.a) shl Shift.a);
  3529. case BitsPerPixel of
  3530. 8: aData^ := data;
  3531. 16: PWord(aData)^ := data;
  3532. 32: PCardinal(aData)^ := data;
  3533. 64: PQWord(aData)^ := data;
  3534. else
  3535. raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
  3536. end;
  3537. inc(aData, Round(BytesPerPixel));
  3538. end;
  3539. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3540. procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3541. var
  3542. data: QWord;
  3543. i: Integer;
  3544. begin
  3545. case BitsPerPixel of
  3546. 8: data := aData^;
  3547. 16: data := PWord(aData)^;
  3548. 32: data := PCardinal(aData)^;
  3549. 64: data := PQWord(aData)^;
  3550. else
  3551. raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
  3552. end;
  3553. for i := 0 to 3 do
  3554. aPixel.Data.arr[i] := (data shr fShift.arr[i]) and Range.arr[i];
  3555. inc(aData, Round(BytesPerPixel));
  3556. end;
  3557. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3558. //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3559. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3560. procedure TbmpColorTableFormat.SetValues;
  3561. begin
  3562. inherited SetValues;
  3563. fShift := glBitmapRec4ub(8, 8, 8, 0);
  3564. end;
  3565. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3566. procedure TbmpColorTableFormat.SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub);
  3567. begin
  3568. fFormat := aFormat;
  3569. fBitsPerPixel := aBPP;
  3570. fPrecision := aPrec;
  3571. fShift := aShift;
  3572. CalcValues;
  3573. end;
  3574. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3575. procedure TbmpColorTableFormat.CalcValues;
  3576. begin
  3577. inherited CalcValues;
  3578. end;
  3579. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3580. procedure TbmpColorTableFormat.CreateColorTable;
  3581. var
  3582. i: Integer;
  3583. begin
  3584. SetLength(fColorTable, 256);
  3585. if not HasColor then begin
  3586. // alpha
  3587. for i := 0 to High(fColorTable) do begin
  3588. fColorTable[i].r := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
  3589. fColorTable[i].g := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
  3590. fColorTable[i].b := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
  3591. fColorTable[i].a := 0;
  3592. end;
  3593. end else begin
  3594. // normal
  3595. for i := 0 to High(fColorTable) do begin
  3596. fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
  3597. fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
  3598. fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
  3599. fColorTable[i].a := 0;
  3600. end;
  3601. end;
  3602. end;
  3603. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3604. function TbmpColorTableFormat.CreateMappingData: Pointer;
  3605. begin
  3606. result := Pointer(0);
  3607. end;
  3608. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3609. procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3610. begin
  3611. if (BitsPerPixel <> 8) then
  3612. raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
  3613. if not HasColor then
  3614. // alpha
  3615. aData^ := aPixel.Data.a
  3616. else
  3617. // normal
  3618. aData^ := Round(
  3619. ((aPixel.Data.r shr Shift.r) and Range.r) * LUMINANCE_WEIGHT_R +
  3620. ((aPixel.Data.g shr Shift.g) and Range.g) * LUMINANCE_WEIGHT_G +
  3621. ((aPixel.Data.b shr Shift.b) and Range.b) * LUMINANCE_WEIGHT_B);
  3622. inc(aData);
  3623. end;
  3624. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3625. procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3626. function ReadValue: Byte;
  3627. var
  3628. i: PtrUInt;
  3629. begin
  3630. if (BitsPerPixel = 8) then begin
  3631. result := aData^;
  3632. inc(aData);
  3633. end else begin
  3634. i := {%H-}PtrUInt(aMapData);
  3635. if (BitsPerPixel > 1) then
  3636. result := (aData^ shr i) and ((1 shl BitsPerPixel) - 1)
  3637. else
  3638. result := (aData^ shr (7-i)) and ((1 shl BitsPerPixel) - 1);
  3639. inc(i, BitsPerPixel);
  3640. while (i >= 8) do begin
  3641. inc(aData);
  3642. dec(i, 8);
  3643. end;
  3644. aMapData := {%H-}Pointer(i);
  3645. end;
  3646. end;
  3647. begin
  3648. if (BitsPerPixel > 8) then
  3649. raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
  3650. with fColorTable[ReadValue] do begin
  3651. aPixel.Data.r := r;
  3652. aPixel.Data.g := g;
  3653. aPixel.Data.b := b;
  3654. aPixel.Data.a := a;
  3655. end;
  3656. end;
  3657. destructor TbmpColorTableFormat.Destroy;
  3658. begin
  3659. SetLength(fColorTable, 0);
  3660. inherited Destroy;
  3661. end;
  3662. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3663. //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3664. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3665. procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
  3666. var
  3667. i: Integer;
  3668. begin
  3669. for i := 0 to 3 do begin
  3670. if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
  3671. if (aSourceFD.Range.arr[i] > 0) then
  3672. aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
  3673. else
  3674. aPixel.Data.arr[i] := 0;
  3675. end;
  3676. end;
  3677. end;
  3678. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3679. procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
  3680. begin
  3681. with aFuncRec do begin
  3682. if (Source.Range.r > 0) then
  3683. Dest.Data.r := Source.Data.r;
  3684. if (Source.Range.g > 0) then
  3685. Dest.Data.g := Source.Data.g;
  3686. if (Source.Range.b > 0) then
  3687. Dest.Data.b := Source.Data.b;
  3688. if (Source.Range.a > 0) then
  3689. Dest.Data.a := Source.Data.a;
  3690. end;
  3691. end;
  3692. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3693. procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3694. var
  3695. i: Integer;
  3696. begin
  3697. with aFuncRec do begin
  3698. for i := 0 to 3 do
  3699. if (Source.Range.arr[i] > 0) then
  3700. Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
  3701. end;
  3702. end;
  3703. type
  3704. TShiftData = packed record
  3705. case Integer of
  3706. 0: (r, g, b, a: SmallInt);
  3707. 1: (arr: array[0..3] of SmallInt);
  3708. end;
  3709. PShiftData = ^TShiftData;
  3710. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3711. procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3712. var
  3713. i: Integer;
  3714. begin
  3715. with aFuncRec do
  3716. for i := 0 to 3 do
  3717. if (Source.Range.arr[i] > 0) then
  3718. Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
  3719. end;
  3720. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3721. procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
  3722. var
  3723. i: Integer;
  3724. begin
  3725. with aFuncRec do begin
  3726. Dest.Data := Source.Data;
  3727. for i := 0 to 3 do
  3728. if ({%H-}PtrUInt(Args) and (1 shl i) > 0) then
  3729. Dest.Data.arr[i] := Dest.Data.arr[i] xor Dest.Range.arr[i];
  3730. end;
  3731. end;
  3732. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3733. procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
  3734. var
  3735. i: Integer;
  3736. begin
  3737. with aFuncRec do begin
  3738. for i := 0 to 3 do
  3739. Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
  3740. end;
  3741. end;
  3742. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3743. procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3744. var
  3745. Temp: Single;
  3746. begin
  3747. with FuncRec do begin
  3748. if (FuncRec.Args = nil) then begin //source has no alpha
  3749. Temp :=
  3750. Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
  3751. Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
  3752. Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
  3753. Dest.Data.a := Round(Dest.Range.a * Temp);
  3754. end else
  3755. Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
  3756. end;
  3757. end;
  3758. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3759. procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3760. type
  3761. PglBitmapPixelData = ^TglBitmapPixelData;
  3762. begin
  3763. with FuncRec do begin
  3764. Dest.Data.r := Source.Data.r;
  3765. Dest.Data.g := Source.Data.g;
  3766. Dest.Data.b := Source.Data.b;
  3767. with PglBitmapPixelData(Args)^ do
  3768. if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
  3769. (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
  3770. (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
  3771. Dest.Data.a := 0
  3772. else
  3773. Dest.Data.a := Dest.Range.a;
  3774. end;
  3775. end;
  3776. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3777. procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3778. begin
  3779. with FuncRec do begin
  3780. Dest.Data.r := Source.Data.r;
  3781. Dest.Data.g := Source.Data.g;
  3782. Dest.Data.b := Source.Data.b;
  3783. Dest.Data.a := PCardinal(Args)^;
  3784. end;
  3785. end;
  3786. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3787. procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
  3788. type
  3789. PRGBPix = ^TRGBPix;
  3790. TRGBPix = array [0..2] of byte;
  3791. var
  3792. Temp: Byte;
  3793. begin
  3794. while aWidth > 0 do begin
  3795. Temp := PRGBPix(aData)^[0];
  3796. PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
  3797. PRGBPix(aData)^[2] := Temp;
  3798. if aHasAlpha then
  3799. Inc(aData, 4)
  3800. else
  3801. Inc(aData, 3);
  3802. dec(aWidth);
  3803. end;
  3804. end;
  3805. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3806. //TglBitmapData///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3807. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3808. function TglBitmapData.GetFormatDescriptor: TglBitmapFormatDescriptor;
  3809. begin
  3810. result := TFormatDescriptor.Get(fFormat);
  3811. end;
  3812. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3813. function TglBitmapData.GetWidth: Integer;
  3814. begin
  3815. if (ffX in fDimension.Fields) then
  3816. result := fDimension.X
  3817. else
  3818. result := -1;
  3819. end;
  3820. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3821. function TglBitmapData.GetHeight: Integer;
  3822. begin
  3823. if (ffY in fDimension.Fields) then
  3824. result := fDimension.Y
  3825. else
  3826. result := -1;
  3827. end;
  3828. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3829. function TglBitmapData.GetScanlines(const aIndex: Integer): PByte;
  3830. begin
  3831. if fHasScanlines and (aIndex >= Low(fScanlines)) and (aIndex <= High(fScanlines)) then
  3832. result := fScanlines[aIndex]
  3833. else
  3834. result := nil;
  3835. end;
  3836. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3837. procedure TglBitmapData.SetFormat(const aValue: TglBitmapFormat);
  3838. begin
  3839. if fFormat = aValue then
  3840. exit;
  3841. if TFormatDescriptor.Get(Format).BitsPerPixel <> TFormatDescriptor.Get(aValue).BitsPerPixel then
  3842. raise EglBitmapUnsupportedFormat.Create(Format);
  3843. SetData(fData, aValue, Width, Height);
  3844. end;
  3845. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3846. procedure TglBitmapData.PrepareResType(var aResource: String; var aResType: PChar);
  3847. var
  3848. TempPos: Integer;
  3849. begin
  3850. if not Assigned(aResType) then begin
  3851. TempPos := Pos('.', aResource);
  3852. aResType := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
  3853. aResource := UpperCase(Copy(aResource, 0, TempPos -1));
  3854. end;
  3855. end;
  3856. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3857. procedure TglBitmapData.UpdateScanlines;
  3858. var
  3859. w, h, i, LineWidth: Integer;
  3860. begin
  3861. w := Width;
  3862. h := Height;
  3863. fHasScanlines := Assigned(fData) and (w > 0) and (h > 0);
  3864. if fHasScanlines then begin
  3865. SetLength(fScanlines, h);
  3866. LineWidth := Trunc(w * FormatDescriptor.BytesPerPixel);
  3867. for i := 0 to h-1 do begin
  3868. fScanlines[i] := fData;
  3869. Inc(fScanlines[i], i * LineWidth);
  3870. end;
  3871. end else
  3872. SetLength(fScanlines, 0);
  3873. end;
  3874. {$IFDEF GLB_SUPPORT_PNG_READ}
  3875. {$IF DEFINED(GLB_LAZ_PNG)}
  3876. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3877. //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3878. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3879. function TglBitmapData.LoadPNG(const aStream: TStream): Boolean;
  3880. const
  3881. MAGIC_LEN = 8;
  3882. PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
  3883. var
  3884. reader: TLazReaderPNG;
  3885. intf: TLazIntfImage;
  3886. StreamPos: Int64;
  3887. magic: String[MAGIC_LEN];
  3888. begin
  3889. result := true;
  3890. StreamPos := aStream.Position;
  3891. SetLength(magic, MAGIC_LEN);
  3892. aStream.Read(magic[1], MAGIC_LEN);
  3893. aStream.Position := StreamPos;
  3894. if (magic <> PNG_MAGIC) then begin
  3895. result := false;
  3896. exit;
  3897. end;
  3898. intf := TLazIntfImage.Create(0, 0);
  3899. reader := TLazReaderPNG.Create;
  3900. try try
  3901. reader.UpdateDescription := true;
  3902. reader.ImageRead(aStream, intf);
  3903. AssignFromLazIntfImage(intf);
  3904. except
  3905. result := false;
  3906. aStream.Position := StreamPos;
  3907. exit;
  3908. end;
  3909. finally
  3910. reader.Free;
  3911. intf.Free;
  3912. end;
  3913. end;
  3914. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
  3915. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3916. function TglBitmapData.LoadPNG(const aStream: TStream): Boolean;
  3917. var
  3918. Surface: PSDL_Surface;
  3919. RWops: PSDL_RWops;
  3920. begin
  3921. result := false;
  3922. RWops := glBitmapCreateRWops(aStream);
  3923. try
  3924. if IMG_isPNG(RWops) > 0 then begin
  3925. Surface := IMG_LoadPNG_RW(RWops);
  3926. try
  3927. AssignFromSurface(Surface);
  3928. result := true;
  3929. finally
  3930. SDL_FreeSurface(Surface);
  3931. end;
  3932. end;
  3933. finally
  3934. SDL_FreeRW(RWops);
  3935. end;
  3936. end;
  3937. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  3938. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3939. procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  3940. begin
  3941. TStream(png_get_io_ptr(png)).Read(buffer^, size);
  3942. end;
  3943. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3944. function TglBitmapData.LoadPNG(const aStream: TStream): Boolean;
  3945. var
  3946. StreamPos: Int64;
  3947. signature: array [0..7] of byte;
  3948. png: png_structp;
  3949. png_info: png_infop;
  3950. TempHeight, TempWidth: Integer;
  3951. Format: TglBitmapFormat;
  3952. png_data: pByte;
  3953. png_rows: array of pByte;
  3954. Row, LineSize: Integer;
  3955. begin
  3956. result := false;
  3957. if not init_libPNG then
  3958. raise Exception.Create('LoadPNG - unable to initialize libPNG.');
  3959. try
  3960. // signature
  3961. StreamPos := aStream.Position;
  3962. aStream.Read(signature{%H-}, 8);
  3963. aStream.Position := StreamPos;
  3964. if png_check_sig(@signature, 8) <> 0 then begin
  3965. // png read struct
  3966. png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  3967. if png = nil then
  3968. raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
  3969. // png info
  3970. png_info := png_create_info_struct(png);
  3971. if png_info = nil then begin
  3972. png_destroy_read_struct(@png, nil, nil);
  3973. raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
  3974. end;
  3975. // set read callback
  3976. png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
  3977. // read informations
  3978. png_read_info(png, png_info);
  3979. // size
  3980. TempHeight := png_get_image_height(png, png_info);
  3981. TempWidth := png_get_image_width(png, png_info);
  3982. // format
  3983. case png_get_color_type(png, png_info) of
  3984. PNG_COLOR_TYPE_GRAY:
  3985. Format := tfLuminance8ub1;
  3986. PNG_COLOR_TYPE_GRAY_ALPHA:
  3987. Format := tfLuminance8Alpha8us1;
  3988. PNG_COLOR_TYPE_RGB:
  3989. Format := tfRGB8ub3;
  3990. PNG_COLOR_TYPE_RGB_ALPHA:
  3991. Format := tfRGBA8ub4;
  3992. else
  3993. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  3994. end;
  3995. // cut upper 8 bit from 16 bit formats
  3996. if png_get_bit_depth(png, png_info) > 8 then
  3997. png_set_strip_16(png);
  3998. // expand bitdepth smaller than 8
  3999. if png_get_bit_depth(png, png_info) < 8 then
  4000. png_set_expand(png);
  4001. // allocating mem for scanlines
  4002. LineSize := png_get_rowbytes(png, png_info);
  4003. GetMem(png_data, TempHeight * LineSize);
  4004. try
  4005. SetLength(png_rows, TempHeight);
  4006. for Row := Low(png_rows) to High(png_rows) do begin
  4007. png_rows[Row] := png_data;
  4008. Inc(png_rows[Row], Row * LineSize);
  4009. end;
  4010. // read complete image into scanlines
  4011. png_read_image(png, @png_rows[0]);
  4012. // read end
  4013. png_read_end(png, png_info);
  4014. // destroy read struct
  4015. png_destroy_read_struct(@png, @png_info, nil);
  4016. SetLength(png_rows, 0);
  4017. // set new data
  4018. SetData(png_data, Format, TempWidth, TempHeight);
  4019. result := true;
  4020. except
  4021. if Assigned(png_data) then
  4022. FreeMem(png_data);
  4023. raise;
  4024. end;
  4025. end;
  4026. finally
  4027. quit_libPNG;
  4028. end;
  4029. end;
  4030. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  4031. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4032. function TglBitmapData.LoadPNG(const aStream: TStream): Boolean;
  4033. var
  4034. StreamPos: Int64;
  4035. Png: TPNGObject;
  4036. Header: String[8];
  4037. Row, Col, PixSize, LineSize: Integer;
  4038. NewImage, pSource, pDest, pAlpha: pByte;
  4039. PngFormat: TglBitmapFormat;
  4040. FormatDesc: TFormatDescriptor;
  4041. const
  4042. PngHeader: String[8] = #137#80#78#71#13#10#26#10;
  4043. begin
  4044. result := false;
  4045. StreamPos := aStream.Position;
  4046. aStream.Read(Header[0], SizeOf(Header));
  4047. aStream.Position := StreamPos;
  4048. {Test if the header matches}
  4049. if Header = PngHeader then begin
  4050. Png := TPNGObject.Create;
  4051. try
  4052. Png.LoadFromStream(aStream);
  4053. case Png.Header.ColorType of
  4054. COLOR_GRAYSCALE:
  4055. PngFormat := tfLuminance8ub1;
  4056. COLOR_GRAYSCALEALPHA:
  4057. PngFormat := tfLuminance8Alpha8us1;
  4058. COLOR_RGB:
  4059. PngFormat := tfBGR8ub3;
  4060. COLOR_RGBALPHA:
  4061. PngFormat := tfBGRA8ub4;
  4062. else
  4063. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  4064. end;
  4065. FormatDesc := TFormatDescriptor.Get(PngFormat);
  4066. PixSize := Round(FormatDesc.PixelSize);
  4067. LineSize := FormatDesc.GetSize(Png.Header.Width, 1);
  4068. GetMem(NewImage, LineSize * Integer(Png.Header.Height));
  4069. try
  4070. pDest := NewImage;
  4071. case Png.Header.ColorType of
  4072. COLOR_RGB, COLOR_GRAYSCALE:
  4073. begin
  4074. for Row := 0 to Png.Height -1 do begin
  4075. Move (Png.Scanline[Row]^, pDest^, LineSize);
  4076. Inc(pDest, LineSize);
  4077. end;
  4078. end;
  4079. COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
  4080. begin
  4081. PixSize := PixSize -1;
  4082. for Row := 0 to Png.Height -1 do begin
  4083. pSource := Png.Scanline[Row];
  4084. pAlpha := pByte(Png.AlphaScanline[Row]);
  4085. for Col := 0 to Png.Width -1 do begin
  4086. Move (pSource^, pDest^, PixSize);
  4087. Inc(pSource, PixSize);
  4088. Inc(pDest, PixSize);
  4089. pDest^ := pAlpha^;
  4090. inc(pAlpha);
  4091. Inc(pDest);
  4092. end;
  4093. end;
  4094. end;
  4095. else
  4096. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  4097. end;
  4098. SetData(NewImage, PngFormat, Png.Header.Width, Png.Header.Height);
  4099. result := true;
  4100. except
  4101. if Assigned(NewImage) then
  4102. FreeMem(NewImage);
  4103. raise;
  4104. end;
  4105. finally
  4106. Png.Free;
  4107. end;
  4108. end;
  4109. end;
  4110. {$IFEND}
  4111. {$ENDIF}
  4112. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  4113. {$IFDEF GLB_LIB_PNG}
  4114. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4115. procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  4116. begin
  4117. TStream(png_get_io_ptr(png)).Write(buffer^, size);
  4118. end;
  4119. {$ENDIF}
  4120. {$IF DEFINED(GLB_LAZ_PNG)}
  4121. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4122. procedure TglBitmapData.SavePNG(const aStream: TStream);
  4123. var
  4124. png: TPortableNetworkGraphic;
  4125. intf: TLazIntfImage;
  4126. raw: TRawImage;
  4127. begin
  4128. png := TPortableNetworkGraphic.Create;
  4129. intf := TLazIntfImage.Create(0, 0);
  4130. try
  4131. if not AssignToLazIntfImage(intf) then
  4132. raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
  4133. intf.GetRawImage(raw);
  4134. png.LoadFromRawImage(raw, false);
  4135. png.SaveToStream(aStream);
  4136. finally
  4137. png.Free;
  4138. intf.Free;
  4139. end;
  4140. end;
  4141. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  4142. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4143. procedure TglBitmapData.SavePNG(const aStream: TStream);
  4144. var
  4145. png: png_structp;
  4146. png_info: png_infop;
  4147. png_rows: array of pByte;
  4148. LineSize: Integer;
  4149. ColorType: Integer;
  4150. Row: Integer;
  4151. FormatDesc: TFormatDescriptor;
  4152. begin
  4153. if not (ftPNG in FormatGetSupportedFiles(Format)) then
  4154. raise EglBitmapUnsupportedFormat.Create(Format);
  4155. if not init_libPNG then
  4156. raise Exception.Create('unable to initialize libPNG.');
  4157. try
  4158. case Format of
  4159. tfAlpha8ub1, tfLuminance8ub1:
  4160. ColorType := PNG_COLOR_TYPE_GRAY;
  4161. tfLuminance8Alpha8us1:
  4162. ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
  4163. tfBGR8ub3, tfRGB8ub3:
  4164. ColorType := PNG_COLOR_TYPE_RGB;
  4165. tfBGRA8ub4, tfRGBA8ub4:
  4166. ColorType := PNG_COLOR_TYPE_RGBA;
  4167. else
  4168. raise EglBitmapUnsupportedFormat.Create(Format);
  4169. end;
  4170. FormatDesc := TFormatDescriptor.Get(Format);
  4171. LineSize := FormatDesc.GetSize(Width, 1);
  4172. // creating array for scanline
  4173. SetLength(png_rows, Height);
  4174. try
  4175. for Row := 0 to Height - 1 do begin
  4176. png_rows[Row] := Data;
  4177. Inc(png_rows[Row], Row * LineSize)
  4178. end;
  4179. // write struct
  4180. png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  4181. if png = nil then
  4182. raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
  4183. // create png info
  4184. png_info := png_create_info_struct(png);
  4185. if png_info = nil then begin
  4186. png_destroy_write_struct(@png, nil);
  4187. raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
  4188. end;
  4189. // set read callback
  4190. png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
  4191. // set compression
  4192. png_set_compression_level(png, 6);
  4193. if Format in [tfBGR8ub3, tfBGRA8ub4] then
  4194. png_set_bgr(png);
  4195. png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
  4196. png_write_info(png, png_info);
  4197. png_write_image(png, @png_rows[0]);
  4198. png_write_end(png, png_info);
  4199. png_destroy_write_struct(@png, @png_info);
  4200. finally
  4201. SetLength(png_rows, 0);
  4202. end;
  4203. finally
  4204. quit_libPNG;
  4205. end;
  4206. end;
  4207. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  4208. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4209. procedure TglBitmapData.SavePNG(const aStream: TStream);
  4210. var
  4211. Png: TPNGObject;
  4212. pSource, pDest: pByte;
  4213. X, Y, PixSize: Integer;
  4214. ColorType: Cardinal;
  4215. Alpha: Boolean;
  4216. pTemp: pByte;
  4217. Temp: Byte;
  4218. begin
  4219. if not (ftPNG in FormatGetSupportedFiles (Format)) then
  4220. raise EglBitmapUnsupportedFormat.Create(Format);
  4221. case Format of
  4222. tfAlpha8ub1, tfLuminance8ub1: begin
  4223. ColorType := COLOR_GRAYSCALE;
  4224. PixSize := 1;
  4225. Alpha := false;
  4226. end;
  4227. tfLuminance8Alpha8us1: begin
  4228. ColorType := COLOR_GRAYSCALEALPHA;
  4229. PixSize := 1;
  4230. Alpha := true;
  4231. end;
  4232. tfBGR8ub3, tfRGB8ub3: begin
  4233. ColorType := COLOR_RGB;
  4234. PixSize := 3;
  4235. Alpha := false;
  4236. end;
  4237. tfBGRA8ub4, tfRGBA8ub4: begin
  4238. ColorType := COLOR_RGBALPHA;
  4239. PixSize := 3;
  4240. Alpha := true
  4241. end;
  4242. else
  4243. raise EglBitmapUnsupportedFormat.Create(Format);
  4244. end;
  4245. Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
  4246. try
  4247. // Copy ImageData
  4248. pSource := Data;
  4249. for Y := 0 to Height -1 do begin
  4250. pDest := png.ScanLine[Y];
  4251. for X := 0 to Width -1 do begin
  4252. Move(pSource^, pDest^, PixSize);
  4253. Inc(pDest, PixSize);
  4254. Inc(pSource, PixSize);
  4255. if Alpha then begin
  4256. png.AlphaScanline[Y]^[X] := pSource^;
  4257. Inc(pSource);
  4258. end;
  4259. end;
  4260. // convert RGB line to BGR
  4261. if Format in [tfRGB8ub3, tfRGBA8ub4] then begin
  4262. pTemp := png.ScanLine[Y];
  4263. for X := 0 to Width -1 do begin
  4264. Temp := pByteArray(pTemp)^[0];
  4265. pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
  4266. pByteArray(pTemp)^[2] := Temp;
  4267. Inc(pTemp, 3);
  4268. end;
  4269. end;
  4270. end;
  4271. // Save to Stream
  4272. Png.CompressionLevel := 6;
  4273. Png.SaveToStream(aStream);
  4274. finally
  4275. FreeAndNil(Png);
  4276. end;
  4277. end;
  4278. {$IFEND}
  4279. {$ENDIF}
  4280. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4281. //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4282. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4283. {$IFDEF GLB_LIB_JPEG}
  4284. type
  4285. glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
  4286. glBitmap_libJPEG_source_mgr = record
  4287. pub: jpeg_source_mgr;
  4288. SrcStream: TStream;
  4289. SrcBuffer: array [1..4096] of byte;
  4290. end;
  4291. glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
  4292. glBitmap_libJPEG_dest_mgr = record
  4293. pub: jpeg_destination_mgr;
  4294. DestStream: TStream;
  4295. DestBuffer: array [1..4096] of byte;
  4296. end;
  4297. procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
  4298. begin
  4299. //DUMMY
  4300. end;
  4301. procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
  4302. begin
  4303. //DUMMY
  4304. end;
  4305. procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
  4306. begin
  4307. //DUMMY
  4308. end;
  4309. procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
  4310. begin
  4311. //DUMMY
  4312. end;
  4313. procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
  4314. begin
  4315. //DUMMY
  4316. end;
  4317. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4318. function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
  4319. var
  4320. src: glBitmap_libJPEG_source_mgr_ptr;
  4321. bytes: integer;
  4322. begin
  4323. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  4324. bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
  4325. if (bytes <= 0) then begin
  4326. src^.SrcBuffer[1] := $FF;
  4327. src^.SrcBuffer[2] := JPEG_EOI;
  4328. bytes := 2;
  4329. end;
  4330. src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
  4331. src^.pub.bytes_in_buffer := bytes;
  4332. result := true;
  4333. end;
  4334. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4335. procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
  4336. var
  4337. src: glBitmap_libJPEG_source_mgr_ptr;
  4338. begin
  4339. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  4340. if num_bytes > 0 then begin
  4341. // wanted byte isn't in buffer so set stream position and read buffer
  4342. if num_bytes > src^.pub.bytes_in_buffer then begin
  4343. src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
  4344. src^.pub.fill_input_buffer(cinfo);
  4345. end else begin
  4346. // wanted byte is in buffer so only skip
  4347. inc(src^.pub.next_input_byte, num_bytes);
  4348. dec(src^.pub.bytes_in_buffer, num_bytes);
  4349. end;
  4350. end;
  4351. end;
  4352. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4353. function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
  4354. var
  4355. dest: glBitmap_libJPEG_dest_mgr_ptr;
  4356. begin
  4357. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  4358. if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
  4359. // write complete buffer
  4360. dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
  4361. // reset buffer
  4362. dest^.pub.next_output_byte := @dest^.DestBuffer[1];
  4363. dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
  4364. end;
  4365. result := true;
  4366. end;
  4367. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4368. procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
  4369. var
  4370. Idx: Integer;
  4371. dest: glBitmap_libJPEG_dest_mgr_ptr;
  4372. begin
  4373. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  4374. for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
  4375. // check for endblock
  4376. if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
  4377. // write endblock
  4378. dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
  4379. // leave
  4380. break;
  4381. end else
  4382. dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
  4383. end;
  4384. end;
  4385. {$ENDIF}
  4386. {$IFDEF GLB_SUPPORT_JPEG_READ}
  4387. {$IF DEFINED(GLB_LAZ_JPEG)}
  4388. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4389. function TglBitmapData.LoadJPEG(const aStream: TStream): Boolean;
  4390. const
  4391. MAGIC_LEN = 2;
  4392. JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
  4393. var
  4394. intf: TLazIntfImage;
  4395. reader: TFPReaderJPEG;
  4396. StreamPos: Int64;
  4397. magic: String[MAGIC_LEN];
  4398. begin
  4399. result := true;
  4400. StreamPos := aStream.Position;
  4401. SetLength(magic, MAGIC_LEN);
  4402. aStream.Read(magic[1], MAGIC_LEN);
  4403. aStream.Position := StreamPos;
  4404. if (magic <> JPEG_MAGIC) then begin
  4405. result := false;
  4406. exit;
  4407. end;
  4408. reader := TFPReaderJPEG.Create;
  4409. intf := TLazIntfImage.Create(0, 0);
  4410. try try
  4411. intf.DataDescription := GetDescriptionFromDevice(0, 0, 0);
  4412. reader.ImageRead(aStream, intf);
  4413. AssignFromLazIntfImage(intf);
  4414. except
  4415. result := false;
  4416. aStream.Position := StreamPos;
  4417. exit;
  4418. end;
  4419. finally
  4420. reader.Free;
  4421. intf.Free;
  4422. end;
  4423. end;
  4424. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
  4425. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4426. function TglBitmapData.LoadJPEG(const aStream: TStream): Boolean;
  4427. var
  4428. Surface: PSDL_Surface;
  4429. RWops: PSDL_RWops;
  4430. begin
  4431. result := false;
  4432. RWops := glBitmapCreateRWops(aStream);
  4433. try
  4434. if IMG_isJPG(RWops) > 0 then begin
  4435. Surface := IMG_LoadJPG_RW(RWops);
  4436. try
  4437. AssignFromSurface(Surface);
  4438. result := true;
  4439. finally
  4440. SDL_FreeSurface(Surface);
  4441. end;
  4442. end;
  4443. finally
  4444. SDL_FreeRW(RWops);
  4445. end;
  4446. end;
  4447. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  4448. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4449. function TglBitmapData.LoadJPEG(const aStream: TStream): Boolean;
  4450. var
  4451. StreamPos: Int64;
  4452. Temp: array[0..1]of Byte;
  4453. jpeg: jpeg_decompress_struct;
  4454. jpeg_err: jpeg_error_mgr;
  4455. IntFormat: TglBitmapFormat;
  4456. pImage: pByte;
  4457. TempHeight, TempWidth: Integer;
  4458. pTemp: pByte;
  4459. Row: Integer;
  4460. FormatDesc: TFormatDescriptor;
  4461. begin
  4462. result := false;
  4463. if not init_libJPEG then
  4464. raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
  4465. try
  4466. // reading first two bytes to test file and set cursor back to begin
  4467. StreamPos := aStream.Position;
  4468. aStream.Read({%H-}Temp[0], 2);
  4469. aStream.Position := StreamPos;
  4470. // if Bitmap then read file.
  4471. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  4472. FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
  4473. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  4474. // error managment
  4475. jpeg.err := jpeg_std_error(@jpeg_err);
  4476. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  4477. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  4478. // decompression struct
  4479. jpeg_create_decompress(@jpeg);
  4480. // allocation space for streaming methods
  4481. jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
  4482. // seeting up custom functions
  4483. with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
  4484. pub.init_source := glBitmap_libJPEG_init_source;
  4485. pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
  4486. pub.skip_input_data := glBitmap_libJPEG_skip_input_data;
  4487. pub.resync_to_restart := jpeg_resync_to_restart; // use default method
  4488. pub.term_source := glBitmap_libJPEG_term_source;
  4489. pub.bytes_in_buffer := 0; // forces fill_input_buffer on first read
  4490. pub.next_input_byte := nil; // until buffer loaded
  4491. SrcStream := aStream;
  4492. end;
  4493. // set global decoding state
  4494. jpeg.global_state := DSTATE_START;
  4495. // read header of jpeg
  4496. jpeg_read_header(@jpeg, false);
  4497. // setting output parameter
  4498. case jpeg.jpeg_color_space of
  4499. JCS_GRAYSCALE:
  4500. begin
  4501. jpeg.out_color_space := JCS_GRAYSCALE;
  4502. IntFormat := tfLuminance8ub1;
  4503. end;
  4504. else
  4505. jpeg.out_color_space := JCS_RGB;
  4506. IntFormat := tfRGB8ub3;
  4507. end;
  4508. // reading image
  4509. jpeg_start_decompress(@jpeg);
  4510. TempHeight := jpeg.output_height;
  4511. TempWidth := jpeg.output_width;
  4512. FormatDesc := TFormatDescriptor.Get(IntFormat);
  4513. // creating new image
  4514. GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
  4515. try
  4516. pTemp := pImage;
  4517. for Row := 0 to TempHeight -1 do begin
  4518. jpeg_read_scanlines(@jpeg, @pTemp, 1);
  4519. Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
  4520. end;
  4521. // finish decompression
  4522. jpeg_finish_decompress(@jpeg);
  4523. // destroy decompression
  4524. jpeg_destroy_decompress(@jpeg);
  4525. SetData(pImage, IntFormat, TempWidth, TempHeight);
  4526. result := true;
  4527. except
  4528. if Assigned(pImage) then
  4529. FreeMem(pImage);
  4530. raise;
  4531. end;
  4532. end;
  4533. finally
  4534. quit_libJPEG;
  4535. end;
  4536. end;
  4537. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  4538. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4539. function TglBitmapData.LoadJPEG(const aStream: TStream): Boolean;
  4540. var
  4541. bmp: TBitmap;
  4542. jpg: TJPEGImage;
  4543. StreamPos: Int64;
  4544. Temp: array[0..1]of Byte;
  4545. begin
  4546. result := false;
  4547. // reading first two bytes to test file and set cursor back to begin
  4548. StreamPos := aStream.Position;
  4549. aStream.Read(Temp[0], 2);
  4550. aStream.Position := StreamPos;
  4551. // if Bitmap then read file.
  4552. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  4553. bmp := TBitmap.Create;
  4554. try
  4555. jpg := TJPEGImage.Create;
  4556. try
  4557. jpg.LoadFromStream(aStream);
  4558. bmp.Assign(jpg);
  4559. result := AssignFromBitmap(bmp);
  4560. finally
  4561. jpg.Free;
  4562. end;
  4563. finally
  4564. bmp.Free;
  4565. end;
  4566. end;
  4567. end;
  4568. {$IFEND}
  4569. {$ENDIF}
  4570. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  4571. {$IF DEFINED(GLB_LAZ_JPEG)}
  4572. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4573. procedure TglBitmapData.SaveJPEG(const aStream: TStream);
  4574. var
  4575. jpeg: TJPEGImage;
  4576. intf: TLazIntfImage;
  4577. raw: TRawImage;
  4578. begin
  4579. jpeg := TJPEGImage.Create;
  4580. intf := TLazIntfImage.Create(0, 0);
  4581. try
  4582. if not AssignToLazIntfImage(intf) then
  4583. raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
  4584. intf.GetRawImage(raw);
  4585. jpeg.LoadFromRawImage(raw, false);
  4586. jpeg.SaveToStream(aStream);
  4587. finally
  4588. intf.Free;
  4589. jpeg.Free;
  4590. end;
  4591. end;
  4592. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  4593. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4594. procedure TglBitmapData.SaveJPEG(const aStream: TStream);
  4595. var
  4596. jpeg: jpeg_compress_struct;
  4597. jpeg_err: jpeg_error_mgr;
  4598. Row: Integer;
  4599. pTemp, pTemp2: pByte;
  4600. procedure CopyRow(pDest, pSource: pByte);
  4601. var
  4602. X: Integer;
  4603. begin
  4604. for X := 0 to Width - 1 do begin
  4605. pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
  4606. pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
  4607. pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
  4608. Inc(pDest, 3);
  4609. Inc(pSource, 3);
  4610. end;
  4611. end;
  4612. begin
  4613. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  4614. raise EglBitmapUnsupportedFormat.Create(Format);
  4615. if not init_libJPEG then
  4616. raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
  4617. try
  4618. FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
  4619. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  4620. // error managment
  4621. jpeg.err := jpeg_std_error(@jpeg_err);
  4622. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  4623. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  4624. // compression struct
  4625. jpeg_create_compress(@jpeg);
  4626. // allocation space for streaming methods
  4627. jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
  4628. // seeting up custom functions
  4629. with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
  4630. pub.init_destination := glBitmap_libJPEG_init_destination;
  4631. pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
  4632. pub.term_destination := glBitmap_libJPEG_term_destination;
  4633. pub.next_output_byte := @DestBuffer[1];
  4634. pub.free_in_buffer := Length(DestBuffer);
  4635. DestStream := aStream;
  4636. end;
  4637. // very important state
  4638. jpeg.global_state := CSTATE_START;
  4639. jpeg.image_width := Width;
  4640. jpeg.image_height := Height;
  4641. case Format of
  4642. tfAlpha8ub1, tfLuminance8ub1: begin
  4643. jpeg.input_components := 1;
  4644. jpeg.in_color_space := JCS_GRAYSCALE;
  4645. end;
  4646. tfRGB8ub3, tfBGR8ub3: begin
  4647. jpeg.input_components := 3;
  4648. jpeg.in_color_space := JCS_RGB;
  4649. end;
  4650. end;
  4651. jpeg_set_defaults(@jpeg);
  4652. jpeg_set_quality(@jpeg, 95, true);
  4653. jpeg_start_compress(@jpeg, true);
  4654. pTemp := Data;
  4655. if Format = tfBGR8ub3 then
  4656. GetMem(pTemp2, fRowSize)
  4657. else
  4658. pTemp2 := pTemp;
  4659. try
  4660. for Row := 0 to jpeg.image_height -1 do begin
  4661. // prepare row
  4662. if Format = tfBGR8ub3 then
  4663. CopyRow(pTemp2, pTemp)
  4664. else
  4665. pTemp2 := pTemp;
  4666. // write row
  4667. jpeg_write_scanlines(@jpeg, @pTemp2, 1);
  4668. inc(pTemp, fRowSize);
  4669. end;
  4670. finally
  4671. // free memory
  4672. if Format = tfBGR8ub3 then
  4673. FreeMem(pTemp2);
  4674. end;
  4675. jpeg_finish_compress(@jpeg);
  4676. jpeg_destroy_compress(@jpeg);
  4677. finally
  4678. quit_libJPEG;
  4679. end;
  4680. end;
  4681. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  4682. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4683. procedure TglBitmapData.SaveJPEG(const aStream: TStream);
  4684. var
  4685. Bmp: TBitmap;
  4686. Jpg: TJPEGImage;
  4687. begin
  4688. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  4689. raise EglBitmapUnsupportedFormat.Create(Format);
  4690. Bmp := TBitmap.Create;
  4691. try
  4692. Jpg := TJPEGImage.Create;
  4693. try
  4694. AssignToBitmap(Bmp);
  4695. if (Format in [tfAlpha8ub1, tfLuminance8ub1]) then begin
  4696. Jpg.Grayscale := true;
  4697. Jpg.PixelFormat := jf8Bit;
  4698. end;
  4699. Jpg.Assign(Bmp);
  4700. Jpg.SaveToStream(aStream);
  4701. finally
  4702. FreeAndNil(Jpg);
  4703. end;
  4704. finally
  4705. FreeAndNil(Bmp);
  4706. end;
  4707. end;
  4708. {$IFEND}
  4709. {$ENDIF}
  4710. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4711. //RAW/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4712. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4713. type
  4714. RawHeader = packed record
  4715. Magic: String[5];
  4716. Version: Byte;
  4717. Width: Integer;
  4718. Height: Integer;
  4719. DataSize: Integer;
  4720. BitsPerPixel: Integer;
  4721. Precision: TglBitmapRec4ub;
  4722. Shift: TglBitmapRec4ub;
  4723. end;
  4724. function TglBitmapData.LoadRAW(const aStream: TStream): Boolean;
  4725. var
  4726. header: RawHeader;
  4727. StartPos: Int64;
  4728. fd: TFormatDescriptor;
  4729. buf: PByte;
  4730. begin
  4731. result := false;
  4732. StartPos := aStream.Position;
  4733. aStream.Read(header{%H-}, SizeOf(header));
  4734. if (header.Magic <> 'glBMP') then begin
  4735. aStream.Position := StartPos;
  4736. exit;
  4737. end;
  4738. fd := TFormatDescriptor.GetFromPrecShift(header.Precision, header.Shift, header.BitsPerPixel);
  4739. if (fd.Format = tfEmpty) then
  4740. raise EglBitmapUnsupportedFormat.Create('no supported format found');
  4741. buf := GetMemory(header.DataSize);
  4742. aStream.Read(buf^, header.DataSize);
  4743. SetData(buf, fd.Format, header.Width, header.Height);
  4744. result := true;
  4745. end;
  4746. procedure TglBitmapData.SaveRAW(const aStream: TStream);
  4747. var
  4748. header: RawHeader;
  4749. fd: TFormatDescriptor;
  4750. begin
  4751. fd := TFormatDescriptor.Get(Format);
  4752. header.Magic := 'glBMP';
  4753. header.Version := 1;
  4754. header.Width := Width;
  4755. header.Height := Height;
  4756. header.DataSize := fd.GetSize(fDimension);
  4757. header.BitsPerPixel := fd.BitsPerPixel;
  4758. header.Precision := fd.Precision;
  4759. header.Shift := fd.Shift;
  4760. aStream.Write(header, SizeOf(header));
  4761. aStream.Write(Data^, header.DataSize);
  4762. end;
  4763. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4764. //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4765. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4766. const
  4767. BMP_MAGIC = $4D42;
  4768. BMP_COMP_RGB = 0;
  4769. BMP_COMP_RLE8 = 1;
  4770. BMP_COMP_RLE4 = 2;
  4771. BMP_COMP_BITFIELDS = 3;
  4772. type
  4773. TBMPHeader = packed record
  4774. bfType: Word;
  4775. bfSize: Cardinal;
  4776. bfReserved1: Word;
  4777. bfReserved2: Word;
  4778. bfOffBits: Cardinal;
  4779. end;
  4780. TBMPInfo = packed record
  4781. biSize: Cardinal;
  4782. biWidth: Longint;
  4783. biHeight: Longint;
  4784. biPlanes: Word;
  4785. biBitCount: Word;
  4786. biCompression: Cardinal;
  4787. biSizeImage: Cardinal;
  4788. biXPelsPerMeter: Longint;
  4789. biYPelsPerMeter: Longint;
  4790. biClrUsed: Cardinal;
  4791. biClrImportant: Cardinal;
  4792. end;
  4793. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4794. function TglBitmapData.LoadBMP(const aStream: TStream): Boolean;
  4795. //////////////////////////////////////////////////////////////////////////////////////////////////
  4796. function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapRec4ul): TglBitmapFormat;
  4797. var
  4798. tmp, i: Cardinal;
  4799. begin
  4800. result := tfEmpty;
  4801. aStream.Read(aInfo{%H-}, SizeOf(aInfo));
  4802. FillChar(aMask{%H-}, SizeOf(aMask), 0);
  4803. //Read Compression
  4804. case aInfo.biCompression of
  4805. BMP_COMP_RLE4,
  4806. BMP_COMP_RLE8: begin
  4807. raise EglBitmap.Create('RLE compression is not supported');
  4808. end;
  4809. BMP_COMP_BITFIELDS: begin
  4810. if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
  4811. for i := 0 to 2 do begin
  4812. aStream.Read(tmp{%H-}, SizeOf(tmp));
  4813. aMask.arr[i] := tmp;
  4814. end;
  4815. end else
  4816. raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
  4817. end;
  4818. end;
  4819. //get suitable format
  4820. case aInfo.biBitCount of
  4821. 8: result := tfLuminance8ub1;
  4822. 16: result := tfX1RGB5us1;
  4823. 24: result := tfBGR8ub3;
  4824. 32: result := tfXRGB8ui1;
  4825. end;
  4826. end;
  4827. function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
  4828. var
  4829. i, c: Integer;
  4830. fd: TFormatDescriptor;
  4831. ColorTable: TbmpColorTable;
  4832. begin
  4833. result := nil;
  4834. if (aInfo.biBitCount >= 16) then
  4835. exit;
  4836. aFormat := tfLuminance8ub1;
  4837. c := aInfo.biClrUsed;
  4838. if (c = 0) then
  4839. c := 1 shl aInfo.biBitCount;
  4840. SetLength(ColorTable, c);
  4841. for i := 0 to c-1 do begin
  4842. aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
  4843. if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
  4844. aFormat := tfRGB8ub3;
  4845. end;
  4846. fd := TFormatDescriptor.Get(aFormat);
  4847. result := TbmpColorTableFormat.Create;
  4848. result.ColorTable := ColorTable;
  4849. result.SetCustomValues(aFormat, aInfo.biBitCount, fd.Precision, fd.Shift);
  4850. end;
  4851. //////////////////////////////////////////////////////////////////////////////////////////////////
  4852. function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapRec4ul; const aInfo: TBMPInfo): TbmpBitfieldFormat;
  4853. var
  4854. fd: TFormatDescriptor;
  4855. begin
  4856. result := nil;
  4857. if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
  4858. // find suitable format ...
  4859. fd := TFormatDescriptor.GetFromMask(aMask);
  4860. if (fd.Format <> tfEmpty) then begin
  4861. aFormat := fd.Format;
  4862. exit;
  4863. end;
  4864. // or create custom bitfield format
  4865. result := TbmpBitfieldFormat.Create;
  4866. result.SetCustomValues(aInfo.biBitCount, aMask);
  4867. end;
  4868. end;
  4869. var
  4870. //simple types
  4871. StartPos: Int64;
  4872. ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
  4873. PaddingBuff: Cardinal;
  4874. LineBuf, ImageData, TmpData: PByte;
  4875. SourceMD, DestMD: Pointer;
  4876. BmpFormat: TglBitmapFormat;
  4877. //records
  4878. Mask: TglBitmapRec4ul;
  4879. Header: TBMPHeader;
  4880. Info: TBMPInfo;
  4881. //classes
  4882. SpecialFormat: TFormatDescriptor;
  4883. FormatDesc: TFormatDescriptor;
  4884. //////////////////////////////////////////////////////////////////////////////////////////////////
  4885. procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
  4886. var
  4887. i: Integer;
  4888. Pixel: TglBitmapPixelData;
  4889. begin
  4890. aStream.Read(aLineBuf^, rbLineSize);
  4891. SpecialFormat.PreparePixel(Pixel);
  4892. for i := 0 to Info.biWidth-1 do begin
  4893. SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
  4894. glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
  4895. FormatDesc.Map(Pixel, aData, DestMD);
  4896. end;
  4897. end;
  4898. begin
  4899. result := false;
  4900. BmpFormat := tfEmpty;
  4901. SpecialFormat := nil;
  4902. LineBuf := nil;
  4903. SourceMD := nil;
  4904. DestMD := nil;
  4905. // Header
  4906. StartPos := aStream.Position;
  4907. aStream.Read(Header{%H-}, SizeOf(Header));
  4908. if Header.bfType = BMP_MAGIC then begin
  4909. try try
  4910. BmpFormat := ReadInfo(Info, Mask);
  4911. SpecialFormat := ReadColorTable(BmpFormat, Info);
  4912. if not Assigned(SpecialFormat) then
  4913. SpecialFormat := CheckBitfields(BmpFormat, Mask, Info);
  4914. aStream.Position := StartPos + Header.bfOffBits;
  4915. if (BmpFormat <> tfEmpty) then begin
  4916. FormatDesc := TFormatDescriptor.Get(BmpFormat);
  4917. rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
  4918. wbLineSize := Trunc(Info.biWidth * FormatDesc.BytesPerPixel);
  4919. Padding := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
  4920. //get Memory
  4921. DestMD := FormatDesc.CreateMappingData;
  4922. ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
  4923. GetMem(ImageData, ImageSize);
  4924. if Assigned(SpecialFormat) then begin
  4925. GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
  4926. SourceMD := SpecialFormat.CreateMappingData;
  4927. end;
  4928. //read Data
  4929. try try
  4930. FillChar(ImageData^, ImageSize, $FF);
  4931. TmpData := ImageData;
  4932. if (Info.biHeight > 0) then
  4933. Inc(TmpData, wbLineSize * (Info.biHeight-1));
  4934. for i := 0 to Abs(Info.biHeight)-1 do begin
  4935. if Assigned(SpecialFormat) then
  4936. SpecialFormatReadLine(TmpData, LineBuf) //if is special format read and convert data
  4937. else
  4938. aStream.Read(TmpData^, wbLineSize); //else only read data
  4939. if (Info.biHeight > 0) then
  4940. dec(TmpData, wbLineSize)
  4941. else
  4942. inc(TmpData, wbLineSize);
  4943. aStream.Read(PaddingBuff{%H-}, Padding);
  4944. end;
  4945. SetData(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight));
  4946. result := true;
  4947. finally
  4948. if Assigned(LineBuf) then
  4949. FreeMem(LineBuf);
  4950. if Assigned(SourceMD) then
  4951. SpecialFormat.FreeMappingData(SourceMD);
  4952. FormatDesc.FreeMappingData(DestMD);
  4953. end;
  4954. except
  4955. if Assigned(ImageData) then
  4956. FreeMem(ImageData);
  4957. raise;
  4958. end;
  4959. end else
  4960. raise EglBitmap.Create('LoadBMP - No suitable format found');
  4961. except
  4962. aStream.Position := StartPos;
  4963. raise;
  4964. end;
  4965. finally
  4966. FreeAndNil(SpecialFormat);
  4967. end;
  4968. end
  4969. else aStream.Position := StartPos;
  4970. end;
  4971. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4972. procedure TglBitmapData.SaveBMP(const aStream: TStream);
  4973. var
  4974. Header: TBMPHeader;
  4975. Info: TBMPInfo;
  4976. Converter: TFormatDescriptor;
  4977. FormatDesc: TFormatDescriptor;
  4978. SourceFD, DestFD: Pointer;
  4979. pData, srcData, dstData, ConvertBuffer: pByte;
  4980. Pixel: TglBitmapPixelData;
  4981. ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
  4982. RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
  4983. PaddingBuff: Cardinal;
  4984. function GetLineWidth : Integer;
  4985. begin
  4986. result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
  4987. end;
  4988. begin
  4989. if not (ftBMP in FormatGetSupportedFiles(Format)) then
  4990. raise EglBitmapUnsupportedFormat.Create(Format);
  4991. Converter := nil;
  4992. FormatDesc := TFormatDescriptor.Get(Format);
  4993. ImageSize := FormatDesc.GetSize(Dimension);
  4994. FillChar(Header{%H-}, SizeOf(Header), 0);
  4995. Header.bfType := BMP_MAGIC;
  4996. Header.bfSize := SizeOf(Header) + SizeOf(Info) + ImageSize;
  4997. Header.bfReserved1 := 0;
  4998. Header.bfReserved2 := 0;
  4999. Header.bfOffBits := SizeOf(Header) + SizeOf(Info);
  5000. FillChar(Info{%H-}, SizeOf(Info), 0);
  5001. Info.biSize := SizeOf(Info);
  5002. Info.biWidth := Width;
  5003. Info.biHeight := Height;
  5004. Info.biPlanes := 1;
  5005. Info.biCompression := BMP_COMP_RGB;
  5006. Info.biSizeImage := ImageSize;
  5007. try
  5008. case Format of
  5009. tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1:
  5010. begin
  5011. Info.biBitCount := 8;
  5012. Header.bfSize := Header.bfSize + 256 * SizeOf(Cardinal);
  5013. Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
  5014. Converter := TbmpColorTableFormat.Create;
  5015. with (Converter as TbmpColorTableFormat) do begin
  5016. SetCustomValues(fFormat, 8, FormatDesc.Precision, FormatDesc.Shift);
  5017. CreateColorTable;
  5018. end;
  5019. end;
  5020. tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
  5021. tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
  5022. tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1:
  5023. begin
  5024. Info.biBitCount := 16;
  5025. Info.biCompression := BMP_COMP_BITFIELDS;
  5026. end;
  5027. tfBGR8ub3, tfRGB8ub3:
  5028. begin
  5029. Info.biBitCount := 24;
  5030. if (Format = tfRGB8ub3) then
  5031. Converter := TfdBGR8ub3.Create; //use BGR8 Format Descriptor to Swap RGB Values
  5032. end;
  5033. tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
  5034. tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1:
  5035. begin
  5036. Info.biBitCount := 32;
  5037. Info.biCompression := BMP_COMP_BITFIELDS;
  5038. end;
  5039. else
  5040. raise EglBitmapUnsupportedFormat.Create(Format);
  5041. end;
  5042. Info.biXPelsPerMeter := 2835;
  5043. Info.biYPelsPerMeter := 2835;
  5044. // prepare bitmasks
  5045. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  5046. Header.bfSize := Header.bfSize + 4 * SizeOf(Cardinal);
  5047. Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
  5048. RedMask := FormatDesc.Mask.r;
  5049. GreenMask := FormatDesc.Mask.g;
  5050. BlueMask := FormatDesc.Mask.b;
  5051. AlphaMask := FormatDesc.Mask.a;
  5052. end;
  5053. // headers
  5054. aStream.Write(Header, SizeOf(Header));
  5055. aStream.Write(Info, SizeOf(Info));
  5056. // colortable
  5057. if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
  5058. with (Converter as TbmpColorTableFormat) do
  5059. aStream.Write(ColorTable[0].b,
  5060. SizeOf(TbmpColorTableEnty) * Length(ColorTable));
  5061. // bitmasks
  5062. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  5063. aStream.Write(RedMask, SizeOf(Cardinal));
  5064. aStream.Write(GreenMask, SizeOf(Cardinal));
  5065. aStream.Write(BlueMask, SizeOf(Cardinal));
  5066. aStream.Write(AlphaMask, SizeOf(Cardinal));
  5067. end;
  5068. // image data
  5069. rbLineSize := Round(Info.biWidth * FormatDesc.BytesPerPixel);
  5070. wbLineSize := Round(Info.biWidth * Info.biBitCount / 8);
  5071. Padding := GetLineWidth - wbLineSize;
  5072. PaddingBuff := 0;
  5073. pData := Data;
  5074. inc(pData, (Height-1) * rbLineSize);
  5075. // prepare row buffer. But only for RGB because RGBA supports color masks
  5076. // so it's possible to change color within the image.
  5077. if Assigned(Converter) then begin
  5078. FormatDesc.PreparePixel(Pixel);
  5079. GetMem(ConvertBuffer, wbLineSize);
  5080. SourceFD := FormatDesc.CreateMappingData;
  5081. DestFD := Converter.CreateMappingData;
  5082. end else
  5083. ConvertBuffer := nil;
  5084. try
  5085. for LineIdx := 0 to Height - 1 do begin
  5086. // preparing row
  5087. if Assigned(Converter) then begin
  5088. srcData := pData;
  5089. dstData := ConvertBuffer;
  5090. for PixelIdx := 0 to Info.biWidth-1 do begin
  5091. FormatDesc.Unmap(srcData, Pixel, SourceFD);
  5092. glBitmapConvertPixel(Pixel, FormatDesc, Converter);
  5093. Converter.Map(Pixel, dstData, DestFD);
  5094. end;
  5095. aStream.Write(ConvertBuffer^, wbLineSize);
  5096. end else begin
  5097. aStream.Write(pData^, rbLineSize);
  5098. end;
  5099. dec(pData, rbLineSize);
  5100. if (Padding > 0) then
  5101. aStream.Write(PaddingBuff, Padding);
  5102. end;
  5103. finally
  5104. // destroy row buffer
  5105. if Assigned(ConvertBuffer) then begin
  5106. FormatDesc.FreeMappingData(SourceFD);
  5107. Converter.FreeMappingData(DestFD);
  5108. FreeMem(ConvertBuffer);
  5109. end;
  5110. end;
  5111. finally
  5112. if Assigned(Converter) then
  5113. Converter.Free;
  5114. end;
  5115. end;
  5116. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5117. //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5118. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5119. type
  5120. TTGAHeader = packed record
  5121. ImageID: Byte;
  5122. ColorMapType: Byte;
  5123. ImageType: Byte;
  5124. //ColorMapSpec: Array[0..4] of Byte;
  5125. ColorMapStart: Word;
  5126. ColorMapLength: Word;
  5127. ColorMapEntrySize: Byte;
  5128. OrigX: Word;
  5129. OrigY: Word;
  5130. Width: Word;
  5131. Height: Word;
  5132. Bpp: Byte;
  5133. ImageDesc: Byte;
  5134. end;
  5135. const
  5136. TGA_UNCOMPRESSED_RGB = 2;
  5137. TGA_UNCOMPRESSED_GRAY = 3;
  5138. TGA_COMPRESSED_RGB = 10;
  5139. TGA_COMPRESSED_GRAY = 11;
  5140. TGA_NONE_COLOR_TABLE = 0;
  5141. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5142. function TglBitmapData.LoadTGA(const aStream: TStream): Boolean;
  5143. var
  5144. Header: TTGAHeader;
  5145. ImageData: System.PByte;
  5146. StartPosition: Int64;
  5147. PixelSize, LineSize: Integer;
  5148. tgaFormat: TglBitmapFormat;
  5149. FormatDesc: TFormatDescriptor;
  5150. Counter: packed record
  5151. X, Y: packed record
  5152. low, high, dir: Integer;
  5153. end;
  5154. end;
  5155. const
  5156. CACHE_SIZE = $4000;
  5157. ////////////////////////////////////////////////////////////////////////////////////////
  5158. procedure ReadUncompressed;
  5159. var
  5160. i, j: Integer;
  5161. buf, tmp1, tmp2: System.PByte;
  5162. begin
  5163. buf := nil;
  5164. if (Counter.X.dir < 0) then
  5165. GetMem(buf, LineSize);
  5166. try
  5167. while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
  5168. tmp1 := ImageData;
  5169. inc(tmp1, (Counter.Y.low * LineSize)); //pointer to LineStart
  5170. if (Counter.X.dir < 0) then begin //flip X
  5171. aStream.Read(buf^, LineSize);
  5172. tmp2 := buf;
  5173. inc(tmp2, LineSize - PixelSize); //pointer to last pixel in line
  5174. for i := 0 to Header.Width-1 do begin //for all pixels in line
  5175. for j := 0 to PixelSize-1 do begin //for all bytes in pixel
  5176. tmp1^ := tmp2^;
  5177. inc(tmp1);
  5178. inc(tmp2);
  5179. end;
  5180. dec(tmp2, 2*PixelSize); //move 2 backwards, because j-loop moved 1 forward
  5181. end;
  5182. end else
  5183. aStream.Read(tmp1^, LineSize);
  5184. inc(Counter.Y.low, Counter.Y.dir); //move to next line index
  5185. end;
  5186. finally
  5187. if Assigned(buf) then
  5188. FreeMem(buf);
  5189. end;
  5190. end;
  5191. ////////////////////////////////////////////////////////////////////////////////////////
  5192. procedure ReadCompressed;
  5193. /////////////////////////////////////////////////////////////////
  5194. var
  5195. TmpData: System.PByte;
  5196. LinePixelsRead: Integer;
  5197. procedure CheckLine;
  5198. begin
  5199. if (LinePixelsRead >= Header.Width) then begin
  5200. LinePixelsRead := 0;
  5201. inc(Counter.Y.low, Counter.Y.dir); //next line index
  5202. TmpData := ImageData;
  5203. inc(TmpData, Counter.Y.low * LineSize); //set line
  5204. if (Counter.X.dir < 0) then //if x flipped then
  5205. inc(TmpData, LineSize - PixelSize); //set last pixel
  5206. end;
  5207. end;
  5208. /////////////////////////////////////////////////////////////////
  5209. var
  5210. Cache: PByte;
  5211. CacheSize, CachePos: Integer;
  5212. procedure CachedRead(out Buffer; Count: Integer);
  5213. var
  5214. BytesRead: Integer;
  5215. begin
  5216. if (CachePos + Count > CacheSize) then begin
  5217. //if buffer overflow save non read bytes
  5218. BytesRead := 0;
  5219. if (CacheSize - CachePos > 0) then begin
  5220. BytesRead := CacheSize - CachePos;
  5221. Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
  5222. inc(CachePos, BytesRead);
  5223. end;
  5224. //load cache from file
  5225. CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
  5226. aStream.Read(Cache^, CacheSize);
  5227. CachePos := 0;
  5228. //read rest of requested bytes
  5229. if (Count - BytesRead > 0) then begin
  5230. Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
  5231. inc(CachePos, Count - BytesRead);
  5232. end;
  5233. end else begin
  5234. //if no buffer overflow just read the data
  5235. Move(PByteArray(Cache)^[CachePos], Buffer, Count);
  5236. inc(CachePos, Count);
  5237. end;
  5238. end;
  5239. procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
  5240. begin
  5241. case PixelSize of
  5242. 1: begin
  5243. aBuffer^ := aData^;
  5244. inc(aBuffer, Counter.X.dir);
  5245. end;
  5246. 2: begin
  5247. PWord(aBuffer)^ := PWord(aData)^;
  5248. inc(aBuffer, 2 * Counter.X.dir);
  5249. end;
  5250. 3: begin
  5251. PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
  5252. PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
  5253. PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
  5254. inc(aBuffer, 3 * Counter.X.dir);
  5255. end;
  5256. 4: begin
  5257. PCardinal(aBuffer)^ := PCardinal(aData)^;
  5258. inc(aBuffer, 4 * Counter.X.dir);
  5259. end;
  5260. end;
  5261. end;
  5262. var
  5263. TotalPixelsToRead, TotalPixelsRead: Integer;
  5264. Temp: Byte;
  5265. buf: array [0..3] of Byte; //1 pixel is max 32bit long
  5266. PixelRepeat: Boolean;
  5267. PixelsToRead, PixelCount: Integer;
  5268. begin
  5269. CacheSize := 0;
  5270. CachePos := 0;
  5271. TotalPixelsToRead := Header.Width * Header.Height;
  5272. TotalPixelsRead := 0;
  5273. LinePixelsRead := 0;
  5274. GetMem(Cache, CACHE_SIZE);
  5275. try
  5276. TmpData := ImageData;
  5277. inc(TmpData, Counter.Y.low * LineSize); //set line
  5278. if (Counter.X.dir < 0) then //if x flipped then
  5279. inc(TmpData, LineSize - PixelSize); //set last pixel
  5280. repeat
  5281. //read CommandByte
  5282. CachedRead(Temp, 1);
  5283. PixelRepeat := (Temp and $80) > 0;
  5284. PixelsToRead := (Temp and $7F) + 1;
  5285. inc(TotalPixelsRead, PixelsToRead);
  5286. if PixelRepeat then
  5287. CachedRead(buf[0], PixelSize);
  5288. while (PixelsToRead > 0) do begin
  5289. CheckLine;
  5290. PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
  5291. while (PixelCount > 0) do begin
  5292. if not PixelRepeat then
  5293. CachedRead(buf[0], PixelSize);
  5294. PixelToBuffer(@buf[0], TmpData);
  5295. inc(LinePixelsRead);
  5296. dec(PixelsToRead);
  5297. dec(PixelCount);
  5298. end;
  5299. end;
  5300. until (TotalPixelsRead >= TotalPixelsToRead);
  5301. finally
  5302. FreeMem(Cache);
  5303. end;
  5304. end;
  5305. function IsGrayFormat: Boolean;
  5306. begin
  5307. result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
  5308. end;
  5309. begin
  5310. result := false;
  5311. // reading header to test file and set cursor back to begin
  5312. StartPosition := aStream.Position;
  5313. aStream.Read(Header{%H-}, SizeOf(Header));
  5314. // no colormapped files
  5315. if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
  5316. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
  5317. begin
  5318. try
  5319. if Header.ImageID <> 0 then // skip image ID
  5320. aStream.Position := aStream.Position + Header.ImageID;
  5321. tgaFormat := tfEmpty;
  5322. case Header.Bpp of
  5323. 8: if IsGrayFormat then case (Header.ImageDesc and $F) of
  5324. 0: tgaFormat := tfLuminance8ub1;
  5325. 8: tgaFormat := tfAlpha8ub1;
  5326. end;
  5327. 16: if IsGrayFormat then case (Header.ImageDesc and $F) of
  5328. 0: tgaFormat := tfLuminance16us1;
  5329. 8: tgaFormat := tfLuminance8Alpha8ub2;
  5330. end else case (Header.ImageDesc and $F) of
  5331. 0: tgaFormat := tfX1RGB5us1;
  5332. 1: tgaFormat := tfA1RGB5us1;
  5333. 4: tgaFormat := tfARGB4us1;
  5334. end;
  5335. 24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  5336. 0: tgaFormat := tfBGR8ub3;
  5337. end;
  5338. 32: if IsGrayFormat then case (Header.ImageDesc and $F) of
  5339. 0: tgaFormat := tfDepth32ui1;
  5340. end else case (Header.ImageDesc and $F) of
  5341. 0: tgaFormat := tfX2RGB10ui1;
  5342. 2: tgaFormat := tfA2RGB10ui1;
  5343. 8: tgaFormat := tfARGB8ui1;
  5344. end;
  5345. end;
  5346. if (tgaFormat = tfEmpty) then
  5347. raise EglBitmap.Create('LoadTga - unsupported format');
  5348. FormatDesc := TFormatDescriptor.Get(tgaFormat);
  5349. PixelSize := FormatDesc.GetSize(1, 1);
  5350. LineSize := FormatDesc.GetSize(Header.Width, 1);
  5351. GetMem(ImageData, LineSize * Header.Height);
  5352. try
  5353. //column direction
  5354. if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
  5355. Counter.X.low := Header.Height-1;;
  5356. Counter.X.high := 0;
  5357. Counter.X.dir := -1;
  5358. end else begin
  5359. Counter.X.low := 0;
  5360. Counter.X.high := Header.Height-1;
  5361. Counter.X.dir := 1;
  5362. end;
  5363. // Row direction
  5364. if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
  5365. Counter.Y.low := 0;
  5366. Counter.Y.high := Header.Height-1;
  5367. Counter.Y.dir := 1;
  5368. end else begin
  5369. Counter.Y.low := Header.Height-1;;
  5370. Counter.Y.high := 0;
  5371. Counter.Y.dir := -1;
  5372. end;
  5373. // Read Image
  5374. case Header.ImageType of
  5375. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
  5376. ReadUncompressed;
  5377. TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
  5378. ReadCompressed;
  5379. end;
  5380. SetData(ImageData, tgaFormat, Header.Width, Header.Height);
  5381. result := true;
  5382. except
  5383. if Assigned(ImageData) then
  5384. FreeMem(ImageData);
  5385. raise;
  5386. end;
  5387. finally
  5388. aStream.Position := StartPosition;
  5389. end;
  5390. end
  5391. else aStream.Position := StartPosition;
  5392. end;
  5393. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5394. procedure TglBitmapData.SaveTGA(const aStream: TStream);
  5395. var
  5396. Header: TTGAHeader;
  5397. Size: Integer;
  5398. FormatDesc: TFormatDescriptor;
  5399. begin
  5400. if not (ftTGA in FormatGetSupportedFiles(Format)) then
  5401. raise EglBitmapUnsupportedFormat.Create(Format);
  5402. //prepare header
  5403. FormatDesc := TFormatDescriptor.Get(Format);
  5404. FillChar(Header{%H-}, SizeOf(Header), 0);
  5405. Header.ImageDesc := CountSetBits(FormatDesc.Range.a) and $F;
  5406. Header.Bpp := FormatDesc.BitsPerPixel;
  5407. Header.Width := Width;
  5408. Header.Height := Height;
  5409. Header.ImageDesc := Header.ImageDesc or $20; //flip y
  5410. if FormatDesc.IsGrayscale or (not FormatDesc.IsGrayscale and not FormatDesc.HasRed and FormatDesc.HasAlpha) then
  5411. Header.ImageType := TGA_UNCOMPRESSED_GRAY
  5412. else
  5413. Header.ImageType := TGA_UNCOMPRESSED_RGB;
  5414. aStream.Write(Header, SizeOf(Header));
  5415. // write Data
  5416. Size := FormatDesc.GetSize(Dimension);
  5417. aStream.Write(Data^, Size);
  5418. end;
  5419. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5420. //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5421. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5422. const
  5423. DDS_MAGIC: Cardinal = $20534444;
  5424. // DDS_header.dwFlags
  5425. DDSD_CAPS = $00000001;
  5426. DDSD_HEIGHT = $00000002;
  5427. DDSD_WIDTH = $00000004;
  5428. DDSD_PIXELFORMAT = $00001000;
  5429. // DDS_header.sPixelFormat.dwFlags
  5430. DDPF_ALPHAPIXELS = $00000001;
  5431. DDPF_ALPHA = $00000002;
  5432. DDPF_FOURCC = $00000004;
  5433. DDPF_RGB = $00000040;
  5434. DDPF_LUMINANCE = $00020000;
  5435. // DDS_header.sCaps.dwCaps1
  5436. DDSCAPS_TEXTURE = $00001000;
  5437. // DDS_header.sCaps.dwCaps2
  5438. DDSCAPS2_CUBEMAP = $00000200;
  5439. D3DFMT_DXT1 = $31545844;
  5440. D3DFMT_DXT3 = $33545844;
  5441. D3DFMT_DXT5 = $35545844;
  5442. type
  5443. TDDSPixelFormat = packed record
  5444. dwSize: Cardinal;
  5445. dwFlags: Cardinal;
  5446. dwFourCC: Cardinal;
  5447. dwRGBBitCount: Cardinal;
  5448. dwRBitMask: Cardinal;
  5449. dwGBitMask: Cardinal;
  5450. dwBBitMask: Cardinal;
  5451. dwABitMask: Cardinal;
  5452. end;
  5453. TDDSCaps = packed record
  5454. dwCaps1: Cardinal;
  5455. dwCaps2: Cardinal;
  5456. dwDDSX: Cardinal;
  5457. dwReserved: Cardinal;
  5458. end;
  5459. TDDSHeader = packed record
  5460. dwSize: Cardinal;
  5461. dwFlags: Cardinal;
  5462. dwHeight: Cardinal;
  5463. dwWidth: Cardinal;
  5464. dwPitchOrLinearSize: Cardinal;
  5465. dwDepth: Cardinal;
  5466. dwMipMapCount: Cardinal;
  5467. dwReserved: array[0..10] of Cardinal;
  5468. PixelFormat: TDDSPixelFormat;
  5469. Caps: TDDSCaps;
  5470. dwReserved2: Cardinal;
  5471. end;
  5472. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5473. function TglBitmapData.LoadDDS(const aStream: TStream): Boolean;
  5474. var
  5475. Header: TDDSHeader;
  5476. Converter: TbmpBitfieldFormat;
  5477. function GetDDSFormat: TglBitmapFormat;
  5478. var
  5479. fd: TFormatDescriptor;
  5480. i: Integer;
  5481. Mask: TglBitmapRec4ul;
  5482. Range: TglBitmapRec4ui;
  5483. match: Boolean;
  5484. begin
  5485. result := tfEmpty;
  5486. with Header.PixelFormat do begin
  5487. // Compresses
  5488. if ((dwFlags and DDPF_FOURCC) > 0) then begin
  5489. case Header.PixelFormat.dwFourCC of
  5490. D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
  5491. D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
  5492. D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
  5493. end;
  5494. end else if ((dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE or DDPF_ALPHA)) > 0) then begin
  5495. // prepare masks
  5496. if ((dwFlags and DDPF_LUMINANCE) = 0) then begin
  5497. Mask.r := dwRBitMask;
  5498. Mask.g := dwGBitMask;
  5499. Mask.b := dwBBitMask;
  5500. end else begin
  5501. Mask.r := dwRBitMask;
  5502. Mask.g := dwRBitMask;
  5503. Mask.b := dwRBitMask;
  5504. end;
  5505. if (dwFlags and DDPF_ALPHAPIXELS > 0) then
  5506. Mask.a := dwABitMask
  5507. else
  5508. Mask.a := 0;;
  5509. //find matching format
  5510. fd := TFormatDescriptor.GetFromMask(Mask, dwRGBBitCount);
  5511. result := fd.Format;
  5512. if (result <> tfEmpty) then
  5513. exit;
  5514. //find format with same Range
  5515. for i := 0 to 3 do
  5516. Range.arr[i] := (2 shl CountSetBits(Mask.arr[i])) - 1;
  5517. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  5518. fd := TFormatDescriptor.Get(result);
  5519. match := true;
  5520. for i := 0 to 3 do
  5521. if (fd.Range.arr[i] <> Range.arr[i]) then begin
  5522. match := false;
  5523. break;
  5524. end;
  5525. if match then
  5526. break;
  5527. end;
  5528. //no format with same range found -> use default
  5529. if (result = tfEmpty) then begin
  5530. if (dwABitMask > 0) then
  5531. result := tfRGBA8ui1
  5532. else
  5533. result := tfRGB8ub3;
  5534. end;
  5535. Converter := TbmpBitfieldFormat.Create;
  5536. Converter.SetCustomValues(dwRGBBitCount, glBitmapRec4ul(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask));
  5537. end;
  5538. end;
  5539. end;
  5540. var
  5541. StreamPos: Int64;
  5542. x, y, LineSize, RowSize, Magic: Cardinal;
  5543. NewImage, TmpData, RowData, SrcData: System.PByte;
  5544. SourceMD, DestMD: Pointer;
  5545. Pixel: TglBitmapPixelData;
  5546. ddsFormat: TglBitmapFormat;
  5547. FormatDesc: TFormatDescriptor;
  5548. begin
  5549. result := false;
  5550. Converter := nil;
  5551. StreamPos := aStream.Position;
  5552. // Magic
  5553. aStream.Read(Magic{%H-}, sizeof(Magic));
  5554. if (Magic <> DDS_MAGIC) then begin
  5555. aStream.Position := StreamPos;
  5556. exit;
  5557. end;
  5558. //Header
  5559. aStream.Read(Header{%H-}, sizeof(Header));
  5560. if (Header.dwSize <> SizeOf(Header)) or
  5561. ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
  5562. (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
  5563. begin
  5564. aStream.Position := StreamPos;
  5565. exit;
  5566. end;
  5567. if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
  5568. raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
  5569. ddsFormat := GetDDSFormat;
  5570. try
  5571. if (ddsFormat = tfEmpty) then
  5572. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  5573. FormatDesc := TFormatDescriptor.Get(ddsFormat);
  5574. LineSize := Trunc(Header.dwWidth * FormatDesc.BytesPerPixel);
  5575. GetMem(NewImage, Header.dwHeight * LineSize);
  5576. try
  5577. TmpData := NewImage;
  5578. //Converter needed
  5579. if Assigned(Converter) then begin
  5580. RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
  5581. GetMem(RowData, RowSize);
  5582. SourceMD := Converter.CreateMappingData;
  5583. DestMD := FormatDesc.CreateMappingData;
  5584. try
  5585. for y := 0 to Header.dwHeight-1 do begin
  5586. TmpData := NewImage;
  5587. inc(TmpData, y * LineSize);
  5588. SrcData := RowData;
  5589. aStream.Read(SrcData^, RowSize);
  5590. for x := 0 to Header.dwWidth-1 do begin
  5591. Converter.Unmap(SrcData, Pixel, SourceMD);
  5592. glBitmapConvertPixel(Pixel, Converter, FormatDesc);
  5593. FormatDesc.Map(Pixel, TmpData, DestMD);
  5594. end;
  5595. end;
  5596. finally
  5597. Converter.FreeMappingData(SourceMD);
  5598. FormatDesc.FreeMappingData(DestMD);
  5599. FreeMem(RowData);
  5600. end;
  5601. end else
  5602. // Compressed
  5603. if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
  5604. RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
  5605. for Y := 0 to Header.dwHeight-1 do begin
  5606. aStream.Read(TmpData^, RowSize);
  5607. Inc(TmpData, LineSize);
  5608. end;
  5609. end else
  5610. // Uncompressed
  5611. if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
  5612. RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
  5613. for Y := 0 to Header.dwHeight-1 do begin
  5614. aStream.Read(TmpData^, RowSize);
  5615. Inc(TmpData, LineSize);
  5616. end;
  5617. end else
  5618. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  5619. SetData(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight);
  5620. result := true;
  5621. except
  5622. if Assigned(NewImage) then
  5623. FreeMem(NewImage);
  5624. raise;
  5625. end;
  5626. finally
  5627. FreeAndNil(Converter);
  5628. end;
  5629. end;
  5630. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5631. procedure TglBitmapData.SaveDDS(const aStream: TStream);
  5632. var
  5633. Header: TDDSHeader;
  5634. FormatDesc: TFormatDescriptor;
  5635. begin
  5636. if not (ftDDS in FormatGetSupportedFiles(Format)) then
  5637. raise EglBitmapUnsupportedFormat.Create(Format);
  5638. FormatDesc := TFormatDescriptor.Get(Format);
  5639. // Generell
  5640. FillChar(Header{%H-}, SizeOf(Header), 0);
  5641. Header.dwSize := SizeOf(Header);
  5642. Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
  5643. Header.dwWidth := Max(1, Width);
  5644. Header.dwHeight := Max(1, Height);
  5645. // Caps
  5646. Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
  5647. // Pixelformat
  5648. Header.PixelFormat.dwSize := sizeof(Header);
  5649. if (FormatDesc.IsCompressed) then begin
  5650. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
  5651. case Format of
  5652. tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
  5653. tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
  5654. tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
  5655. end;
  5656. end else if not FormatDesc.HasColor and FormatDesc.HasAlpha then begin
  5657. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHA;
  5658. Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
  5659. Header.PixelFormat.dwABitMask := FormatDesc.Mask.a;
  5660. end else if FormatDesc.IsGrayscale then begin
  5661. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
  5662. Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
  5663. Header.PixelFormat.dwRBitMask := FormatDesc.Mask.r;
  5664. Header.PixelFormat.dwABitMask := FormatDesc.Mask.a;
  5665. end else begin
  5666. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
  5667. Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
  5668. Header.PixelFormat.dwRBitMask := FormatDesc.Mask.r;
  5669. Header.PixelFormat.dwGBitMask := FormatDesc.Mask.g;
  5670. Header.PixelFormat.dwBBitMask := FormatDesc.Mask.b;
  5671. Header.PixelFormat.dwABitMask := FormatDesc.Mask.a;
  5672. end;
  5673. if (FormatDesc.HasAlpha) then
  5674. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
  5675. aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
  5676. aStream.Write(Header, SizeOf(Header));
  5677. aStream.Write(Data^, FormatDesc.GetSize(Dimension));
  5678. end;
  5679. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5680. function TglBitmapData.FlipHorz: Boolean;
  5681. var
  5682. fd: TglBitmapFormatDescriptor;
  5683. Col, RowSize, PixelSize: Integer;
  5684. pTempDest, pDest, pSource: PByte;
  5685. begin
  5686. result := false;
  5687. fd := FormatDescriptor;
  5688. PixelSize := Ceil(fd.BytesPerPixel);
  5689. RowSize := fd.GetSize(Width, 1);
  5690. if Assigned(Data) and not fd.IsCompressed then begin
  5691. pSource := Data;
  5692. GetMem(pDest, RowSize);
  5693. try
  5694. pTempDest := pDest;
  5695. Inc(pTempDest, RowSize);
  5696. for Col := 0 to Width-1 do begin
  5697. dec(pTempDest, PixelSize); //dec before, because ptr is behind last byte of data
  5698. Move(pSource^, pTempDest^, PixelSize);
  5699. Inc(pSource, PixelSize);
  5700. end;
  5701. SetData(pDest, Format, Width);
  5702. result := true;
  5703. except
  5704. if Assigned(pDest) then
  5705. FreeMem(pDest);
  5706. raise;
  5707. end;
  5708. end;
  5709. end;
  5710. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5711. function TglBitmapData.FlipVert: Boolean;
  5712. var
  5713. fd: TglBitmapFormatDescriptor;
  5714. Row, RowSize, PixelSize: Integer;
  5715. TempDestData, DestData, SourceData: PByte;
  5716. begin
  5717. result := false;
  5718. fd := FormatDescriptor;
  5719. PixelSize := Ceil(fd.BytesPerPixel);
  5720. RowSize := fd.GetSize(Width, 1);
  5721. if Assigned(Data) then begin
  5722. SourceData := Data;
  5723. GetMem(DestData, Height * RowSize);
  5724. try
  5725. TempDestData := DestData;
  5726. Inc(TempDestData, Width * (Height -1) * PixelSize);
  5727. for Row := 0 to Height -1 do begin
  5728. Move(SourceData^, TempDestData^, RowSize);
  5729. Dec(TempDestData, RowSize);
  5730. Inc(SourceData, RowSize);
  5731. end;
  5732. SetData(DestData, Format, Width, Height);
  5733. result := true;
  5734. except
  5735. if Assigned(DestData) then
  5736. FreeMem(DestData);
  5737. raise;
  5738. end;
  5739. end;
  5740. end;
  5741. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5742. procedure TglBitmapData.LoadFromFile(const aFilename: String);
  5743. var
  5744. fs: TFileStream;
  5745. begin
  5746. if not FileExists(aFilename) then
  5747. raise EglBitmap.Create('file does not exist: ' + aFilename);
  5748. fs := TFileStream.Create(aFilename, fmOpenRead);
  5749. try
  5750. fs.Position := 0;
  5751. LoadFromStream(fs);
  5752. fFilename := aFilename;
  5753. finally
  5754. fs.Free;
  5755. end;
  5756. end;
  5757. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5758. procedure TglBitmapData.LoadFromStream(const aStream: TStream);
  5759. begin
  5760. {$IFDEF GLB_SUPPORT_PNG_READ}
  5761. if not LoadPNG(aStream) then
  5762. {$ENDIF}
  5763. {$IFDEF GLB_SUPPORT_JPEG_READ}
  5764. if not LoadJPEG(aStream) then
  5765. {$ENDIF}
  5766. if not LoadDDS(aStream) then
  5767. if not LoadTGA(aStream) then
  5768. if not LoadBMP(aStream) then
  5769. if not LoadRAW(aStream) then
  5770. raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
  5771. end;
  5772. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5773. procedure TglBitmapData.LoadFromFunc(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat;
  5774. const aFunc: TglBitmapFunction; const aArgs: Pointer);
  5775. var
  5776. tmpData: PByte;
  5777. size: Integer;
  5778. begin
  5779. size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  5780. GetMem(tmpData, size);
  5781. try
  5782. FillChar(tmpData^, size, #$FF);
  5783. SetData(tmpData, aFormat, aSize.X, aSize.Y);
  5784. except
  5785. if Assigned(tmpData) then
  5786. FreeMem(tmpData);
  5787. raise;
  5788. end;
  5789. Convert(Self, aFunc, false, aFormat, aArgs);
  5790. end;
  5791. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5792. procedure TglBitmapData.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
  5793. var
  5794. rs: TResourceStream;
  5795. begin
  5796. PrepareResType(aResource, aResType);
  5797. rs := TResourceStream.Create(aInstance, aResource, aResType);
  5798. try
  5799. LoadFromStream(rs);
  5800. finally
  5801. rs.Free;
  5802. end;
  5803. end;
  5804. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5805. procedure TglBitmapData.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  5806. var
  5807. rs: TResourceStream;
  5808. begin
  5809. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  5810. try
  5811. LoadFromStream(rs);
  5812. finally
  5813. rs.Free;
  5814. end;
  5815. end;
  5816. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5817. procedure TglBitmapData.SaveToFile(const aFilename: String; const aFileType: TglBitmapFileType);
  5818. var
  5819. fs: TFileStream;
  5820. begin
  5821. fs := TFileStream.Create(aFileName, fmCreate);
  5822. try
  5823. fs.Position := 0;
  5824. SaveToStream(fs, aFileType);
  5825. finally
  5826. fs.Free;
  5827. end;
  5828. end;
  5829. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5830. procedure TglBitmapData.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
  5831. begin
  5832. case aFileType of
  5833. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  5834. ftPNG: SavePNG(aStream);
  5835. {$ENDIF}
  5836. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  5837. ftJPEG: SaveJPEG(aStream);
  5838. {$ENDIF}
  5839. ftDDS: SaveDDS(aStream);
  5840. ftTGA: SaveTGA(aStream);
  5841. ftBMP: SaveBMP(aStream);
  5842. ftRAW: SaveRAW(aStream);
  5843. end;
  5844. end;
  5845. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5846. function TglBitmapData.Convert(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
  5847. begin
  5848. result := Convert(Self, aFunc, aCreateTemp, Format, aArgs);
  5849. end;
  5850. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5851. function TglBitmapData.Convert(const aSource: TglBitmapData; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  5852. const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
  5853. var
  5854. DestData, TmpData, SourceData: pByte;
  5855. TempHeight, TempWidth: Integer;
  5856. SourceFD, DestFD: TFormatDescriptor;
  5857. SourceMD, DestMD: Pointer;
  5858. FuncRec: TglBitmapFunctionRec;
  5859. begin
  5860. Assert(Assigned(Data));
  5861. Assert(Assigned(aSource));
  5862. Assert(Assigned(aSource.Data));
  5863. result := false;
  5864. if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
  5865. SourceFD := TFormatDescriptor.Get(aSource.Format);
  5866. DestFD := TFormatDescriptor.Get(aFormat);
  5867. if (SourceFD.IsCompressed) then
  5868. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
  5869. if (DestFD.IsCompressed) then
  5870. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
  5871. // inkompatible Formats so CreateTemp
  5872. if (SourceFD.BitsPerPixel <> DestFD.BitsPerPixel) then
  5873. aCreateTemp := true;
  5874. // Values
  5875. TempHeight := Max(1, aSource.Height);
  5876. TempWidth := Max(1, aSource.Width);
  5877. FuncRec.Sender := Self;
  5878. FuncRec.Args := aArgs;
  5879. TmpData := nil;
  5880. if aCreateTemp then begin
  5881. GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
  5882. DestData := TmpData;
  5883. end else
  5884. DestData := Data;
  5885. try
  5886. SourceFD.PreparePixel(FuncRec.Source);
  5887. DestFD.PreparePixel (FuncRec.Dest);
  5888. SourceMD := SourceFD.CreateMappingData;
  5889. DestMD := DestFD.CreateMappingData;
  5890. FuncRec.Size := aSource.Dimension;
  5891. FuncRec.Position.Fields := FuncRec.Size.Fields;
  5892. try
  5893. SourceData := aSource.Data;
  5894. FuncRec.Position.Y := 0;
  5895. while FuncRec.Position.Y < TempHeight do begin
  5896. FuncRec.Position.X := 0;
  5897. while FuncRec.Position.X < TempWidth do begin
  5898. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  5899. aFunc(FuncRec);
  5900. DestFD.Map(FuncRec.Dest, DestData, DestMD);
  5901. inc(FuncRec.Position.X);
  5902. end;
  5903. inc(FuncRec.Position.Y);
  5904. end;
  5905. // Updating Image or InternalFormat
  5906. if aCreateTemp then
  5907. SetData(TmpData, aFormat, aSource.Width, aSource.Height)
  5908. else if (aFormat <> fFormat) then
  5909. Format := aFormat;
  5910. result := true;
  5911. finally
  5912. SourceFD.FreeMappingData(SourceMD);
  5913. DestFD.FreeMappingData(DestMD);
  5914. end;
  5915. except
  5916. if aCreateTemp and Assigned(TmpData) then
  5917. FreeMem(TmpData);
  5918. raise;
  5919. end;
  5920. end;
  5921. end;
  5922. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5923. function TglBitmapData.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
  5924. var
  5925. SourceFD, DestFD: TFormatDescriptor;
  5926. SourcePD, DestPD: TglBitmapPixelData;
  5927. ShiftData: TShiftData;
  5928. function DataIsIdentical: Boolean;
  5929. begin
  5930. result := SourceFD.MaskMatch(DestFD.Mask);
  5931. end;
  5932. function CanCopyDirect: Boolean;
  5933. begin
  5934. result :=
  5935. ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  5936. ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  5937. ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  5938. ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  5939. end;
  5940. function CanShift: Boolean;
  5941. begin
  5942. result :=
  5943. ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  5944. ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  5945. ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  5946. ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  5947. end;
  5948. function GetShift(aSource, aDest: Cardinal) : ShortInt;
  5949. begin
  5950. result := 0;
  5951. while (aSource > aDest) and (aSource > 0) do begin
  5952. inc(result);
  5953. aSource := aSource shr 1;
  5954. end;
  5955. end;
  5956. begin
  5957. if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
  5958. SourceFD := TFormatDescriptor.Get(Format);
  5959. DestFD := TFormatDescriptor.Get(aFormat);
  5960. if DataIsIdentical then begin
  5961. result := true;
  5962. Format := aFormat;
  5963. exit;
  5964. end;
  5965. SourceFD.PreparePixel(SourcePD);
  5966. DestFD.PreparePixel (DestPD);
  5967. if CanCopyDirect then
  5968. result := Convert(Self, glBitmapConvertCopyFunc, false, aFormat)
  5969. else if CanShift then begin
  5970. ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
  5971. ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
  5972. ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
  5973. ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
  5974. result := Convert(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
  5975. end else
  5976. result := Convert(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
  5977. end else
  5978. result := true;
  5979. end;
  5980. {$IFDEF GLB_SDL}
  5981. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5982. function TglBitmapData.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  5983. var
  5984. Row, RowSize: Integer;
  5985. SourceData, TmpData: PByte;
  5986. TempDepth: Integer;
  5987. FormatDesc: TFormatDescriptor;
  5988. function GetRowPointer(Row: Integer): pByte;
  5989. begin
  5990. result := aSurface.pixels;
  5991. Inc(result, Row * RowSize);
  5992. end;
  5993. begin
  5994. result := false;
  5995. FormatDesc := TFormatDescriptor.Get(Format);
  5996. if FormatDesc.IsCompressed then
  5997. raise EglBitmapUnsupportedFormat.Create(Format);
  5998. if Assigned(Data) then begin
  5999. case Trunc(FormatDesc.PixelSize) of
  6000. 1: TempDepth := 8;
  6001. 2: TempDepth := 16;
  6002. 3: TempDepth := 24;
  6003. 4: TempDepth := 32;
  6004. else
  6005. raise EglBitmapUnsupportedFormat.Create(Format);
  6006. end;
  6007. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
  6008. FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
  6009. SourceData := Data;
  6010. RowSize := FormatDesc.GetSize(FileWidth, 1);
  6011. for Row := 0 to FileHeight-1 do begin
  6012. TmpData := GetRowPointer(Row);
  6013. if Assigned(TmpData) then begin
  6014. Move(SourceData^, TmpData^, RowSize);
  6015. inc(SourceData, RowSize);
  6016. end;
  6017. end;
  6018. result := true;
  6019. end;
  6020. end;
  6021. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6022. function TglBitmapData.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  6023. var
  6024. pSource, pData, pTempData: PByte;
  6025. Row, RowSize, TempWidth, TempHeight: Integer;
  6026. IntFormat: TglBitmapFormat;
  6027. fd: TFormatDescriptor;
  6028. Mask: TglBitmapMask;
  6029. function GetRowPointer(Row: Integer): pByte;
  6030. begin
  6031. result := aSurface^.pixels;
  6032. Inc(result, Row * RowSize);
  6033. end;
  6034. begin
  6035. result := false;
  6036. if (Assigned(aSurface)) then begin
  6037. with aSurface^.format^ do begin
  6038. Mask.r := RMask;
  6039. Mask.g := GMask;
  6040. Mask.b := BMask;
  6041. Mask.a := AMask;
  6042. IntFormat := TFormatDescriptor.GetFromMask(Mask).Format;
  6043. if (IntFormat = tfEmpty) then
  6044. raise EglBitmap.Create('AssignFromSurface - Invalid Pixelformat.');
  6045. end;
  6046. fd := TFormatDescriptor.Get(IntFormat);
  6047. TempWidth := aSurface^.w;
  6048. TempHeight := aSurface^.h;
  6049. RowSize := fd.GetSize(TempWidth, 1);
  6050. GetMem(pData, TempHeight * RowSize);
  6051. try
  6052. pTempData := pData;
  6053. for Row := 0 to TempHeight -1 do begin
  6054. pSource := GetRowPointer(Row);
  6055. if (Assigned(pSource)) then begin
  6056. Move(pSource^, pTempData^, RowSize);
  6057. Inc(pTempData, RowSize);
  6058. end;
  6059. end;
  6060. SetData(pData, IntFormat, TempWidth, TempHeight);
  6061. result := true;
  6062. except
  6063. if Assigned(pData) then
  6064. FreeMem(pData);
  6065. raise;
  6066. end;
  6067. end;
  6068. end;
  6069. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6070. function TglBitmapData.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  6071. var
  6072. Row, Col, AlphaInterleave: Integer;
  6073. pSource, pDest: PByte;
  6074. function GetRowPointer(Row: Integer): pByte;
  6075. begin
  6076. result := aSurface.pixels;
  6077. Inc(result, Row * Width);
  6078. end;
  6079. begin
  6080. result := false;
  6081. if Assigned(Data) then begin
  6082. if Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfBGRA8ub4, tfRGBA8ub4] then begin
  6083. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
  6084. AlphaInterleave := 0;
  6085. case Format of
  6086. tfLuminance8Alpha8ub2:
  6087. AlphaInterleave := 1;
  6088. tfBGRA8ub4, tfRGBA8ub4:
  6089. AlphaInterleave := 3;
  6090. end;
  6091. pSource := Data;
  6092. for Row := 0 to Height -1 do begin
  6093. pDest := GetRowPointer(Row);
  6094. if Assigned(pDest) then begin
  6095. for Col := 0 to Width -1 do begin
  6096. Inc(pSource, AlphaInterleave);
  6097. pDest^ := pSource^;
  6098. Inc(pDest);
  6099. Inc(pSource);
  6100. end;
  6101. end;
  6102. end;
  6103. result := true;
  6104. end;
  6105. end;
  6106. end;
  6107. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6108. function TglBitmapData.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  6109. var
  6110. bmp: TglBitmap2D;
  6111. begin
  6112. bmp := TglBitmap2D.Create;
  6113. try
  6114. bmp.AssignFromSurface(aSurface);
  6115. result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
  6116. finally
  6117. bmp.Free;
  6118. end;
  6119. end;
  6120. {$ENDIF}
  6121. {$IFDEF GLB_DELPHI}
  6122. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6123. function CreateGrayPalette: HPALETTE;
  6124. var
  6125. Idx: Integer;
  6126. Pal: PLogPalette;
  6127. begin
  6128. GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
  6129. Pal.palVersion := $300;
  6130. Pal.palNumEntries := 256;
  6131. for Idx := 0 to Pal.palNumEntries - 1 do begin
  6132. Pal.palPalEntry[Idx].peRed := Idx;
  6133. Pal.palPalEntry[Idx].peGreen := Idx;
  6134. Pal.palPalEntry[Idx].peBlue := Idx;
  6135. Pal.palPalEntry[Idx].peFlags := 0;
  6136. end;
  6137. Result := CreatePalette(Pal^);
  6138. FreeMem(Pal);
  6139. end;
  6140. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6141. function TglBitmapData.AssignToBitmap(const aBitmap: TBitmap): Boolean;
  6142. var
  6143. Row, RowSize: Integer;
  6144. pSource, pData: PByte;
  6145. begin
  6146. result := false;
  6147. if Assigned(Data) then begin
  6148. if Assigned(aBitmap) then begin
  6149. aBitmap.Width := Width;
  6150. aBitmap.Height := Height;
  6151. case Format of
  6152. tfAlpha8ub1, tfLuminance8ub1: begin
  6153. aBitmap.PixelFormat := pf8bit;
  6154. aBitmap.Palette := CreateGrayPalette;
  6155. end;
  6156. tfRGB5A1us1:
  6157. aBitmap.PixelFormat := pf15bit;
  6158. tfR5G6B5us1:
  6159. aBitmap.PixelFormat := pf16bit;
  6160. tfRGB8ub3, tfBGR8ub3:
  6161. aBitmap.PixelFormat := pf24bit;
  6162. tfRGBA8ub4, tfBGRA8ub4:
  6163. aBitmap.PixelFormat := pf32bit;
  6164. else
  6165. raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
  6166. end;
  6167. RowSize := FormatDescriptor.GetSize(Width, 1);
  6168. pSource := Data;
  6169. for Row := 0 to Height-1 do begin
  6170. pData := aBitmap.Scanline[Row];
  6171. Move(pSource^, pData^, RowSize);
  6172. Inc(pSource, RowSize);
  6173. if (Format in [tfRGB8ub3, tfRGBA8ub4]) then // swap RGB(A) to BGR(A)
  6174. SwapRGB(pData, Width, Format = tfRGBA8ub4);
  6175. end;
  6176. result := true;
  6177. end;
  6178. end;
  6179. end;
  6180. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6181. function TglBitmapData.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  6182. var
  6183. pSource, pData, pTempData: PByte;
  6184. Row, RowSize, TempWidth, TempHeight: Integer;
  6185. IntFormat: TglBitmapFormat;
  6186. begin
  6187. result := false;
  6188. if (Assigned(aBitmap)) then begin
  6189. case aBitmap.PixelFormat of
  6190. pf8bit:
  6191. IntFormat := tfLuminance8ub1;
  6192. pf15bit:
  6193. IntFormat := tfRGB5A1us1;
  6194. pf16bit:
  6195. IntFormat := tfR5G6B5us1;
  6196. pf24bit:
  6197. IntFormat := tfBGR8ub3;
  6198. pf32bit:
  6199. IntFormat := tfBGRA8ub4;
  6200. else
  6201. raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
  6202. end;
  6203. TempWidth := aBitmap.Width;
  6204. TempHeight := aBitmap.Height;
  6205. RowSize := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
  6206. GetMem(pData, TempHeight * RowSize);
  6207. try
  6208. pTempData := pData;
  6209. for Row := 0 to TempHeight -1 do begin
  6210. pSource := aBitmap.Scanline[Row];
  6211. if (Assigned(pSource)) then begin
  6212. Move(pSource^, pTempData^, RowSize);
  6213. Inc(pTempData, RowSize);
  6214. end;
  6215. end;
  6216. SetData(pData, IntFormat, TempWidth, TempHeight);
  6217. result := true;
  6218. except
  6219. if Assigned(pData) then
  6220. FreeMem(pData);
  6221. raise;
  6222. end;
  6223. end;
  6224. end;
  6225. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6226. function TglBitmapData.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  6227. var
  6228. Row, Col, AlphaInterleave: Integer;
  6229. pSource, pDest: PByte;
  6230. begin
  6231. result := false;
  6232. if Assigned(Data) then begin
  6233. if (Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfRGBA8ub4, tfBGRA8ub4]) then begin
  6234. if Assigned(aBitmap) then begin
  6235. aBitmap.PixelFormat := pf8bit;
  6236. aBitmap.Palette := CreateGrayPalette;
  6237. aBitmap.Width := Width;
  6238. aBitmap.Height := Height;
  6239. case Format of
  6240. tfLuminance8Alpha8ub2:
  6241. AlphaInterleave := 1;
  6242. tfRGBA8ub4, tfBGRA8ub4:
  6243. AlphaInterleave := 3;
  6244. else
  6245. AlphaInterleave := 0;
  6246. end;
  6247. // Copy Data
  6248. pSource := Data;
  6249. for Row := 0 to Height -1 do begin
  6250. pDest := aBitmap.Scanline[Row];
  6251. if Assigned(pDest) then begin
  6252. for Col := 0 to Width -1 do begin
  6253. Inc(pSource, AlphaInterleave);
  6254. pDest^ := pSource^;
  6255. Inc(pDest);
  6256. Inc(pSource);
  6257. end;
  6258. end;
  6259. end;
  6260. result := true;
  6261. end;
  6262. end;
  6263. end;
  6264. end;
  6265. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6266. function TglBitmapData.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  6267. var
  6268. data: TglBitmapData;
  6269. begin
  6270. data := TglBitmapData.Create;
  6271. try
  6272. data.AssignFromBitmap(aBitmap);
  6273. result := AddAlphaFromDataObj(data, aFunc, aArgs);
  6274. finally
  6275. data.Free;
  6276. end;
  6277. end;
  6278. {$ENDIF}
  6279. {$IFDEF GLB_LAZARUS}
  6280. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6281. function TglBitmapData.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  6282. var
  6283. rid: TRawImageDescription;
  6284. FormatDesc: TFormatDescriptor;
  6285. begin
  6286. if not Assigned(Data) then
  6287. raise EglBitmap.Create('no pixel data assigned. load data before save');
  6288. result := false;
  6289. if not Assigned(aImage) or (Format = tfEmpty) then
  6290. exit;
  6291. FormatDesc := TFormatDescriptor.Get(Format);
  6292. if FormatDesc.IsCompressed then
  6293. exit;
  6294. FillChar(rid{%H-}, SizeOf(rid), 0);
  6295. if FormatDesc.IsGrayscale then
  6296. rid.Format := ricfGray
  6297. else
  6298. rid.Format := ricfRGBA;
  6299. rid.Width := Width;
  6300. rid.Height := Height;
  6301. rid.Depth := FormatDesc.BitsPerPixel;
  6302. rid.BitOrder := riboBitsInOrder;
  6303. rid.ByteOrder := riboLSBFirst;
  6304. rid.LineOrder := riloTopToBottom;
  6305. rid.LineEnd := rileTight;
  6306. rid.BitsPerPixel := FormatDesc.BitsPerPixel;
  6307. rid.RedPrec := CountSetBits(FormatDesc.Range.r);
  6308. rid.GreenPrec := CountSetBits(FormatDesc.Range.g);
  6309. rid.BluePrec := CountSetBits(FormatDesc.Range.b);
  6310. rid.AlphaPrec := CountSetBits(FormatDesc.Range.a);
  6311. rid.RedShift := FormatDesc.Shift.r;
  6312. rid.GreenShift := FormatDesc.Shift.g;
  6313. rid.BlueShift := FormatDesc.Shift.b;
  6314. rid.AlphaShift := FormatDesc.Shift.a;
  6315. rid.MaskBitsPerPixel := 0;
  6316. rid.PaletteColorCount := 0;
  6317. aImage.DataDescription := rid;
  6318. aImage.CreateData;
  6319. if not Assigned(aImage.PixelData) then
  6320. raise EglBitmap.Create('error while creating LazIntfImage');
  6321. Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
  6322. result := true;
  6323. end;
  6324. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6325. function TglBitmapData.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  6326. var
  6327. f: TglBitmapFormat;
  6328. FormatDesc: TFormatDescriptor;
  6329. ImageData: PByte;
  6330. ImageSize: Integer;
  6331. CanCopy: Boolean;
  6332. Mask: TglBitmapRec4ul;
  6333. procedure CopyConvert;
  6334. var
  6335. bfFormat: TbmpBitfieldFormat;
  6336. pSourceLine, pDestLine: PByte;
  6337. pSourceMD, pDestMD: Pointer;
  6338. Shift, Prec: TglBitmapRec4ub;
  6339. x, y: Integer;
  6340. pixel: TglBitmapPixelData;
  6341. begin
  6342. bfFormat := TbmpBitfieldFormat.Create;
  6343. with aImage.DataDescription do begin
  6344. Prec.r := RedPrec;
  6345. Prec.g := GreenPrec;
  6346. Prec.b := BluePrec;
  6347. Prec.a := AlphaPrec;
  6348. Shift.r := RedShift;
  6349. Shift.g := GreenShift;
  6350. Shift.b := BlueShift;
  6351. Shift.a := AlphaShift;
  6352. bfFormat.SetCustomValues(BitsPerPixel, Prec, Shift);
  6353. end;
  6354. pSourceMD := bfFormat.CreateMappingData;
  6355. pDestMD := FormatDesc.CreateMappingData;
  6356. try
  6357. for y := 0 to aImage.Height-1 do begin
  6358. pSourceLine := aImage.PixelData + y {%H-}* aImage.DataDescription.BytesPerLine;
  6359. pDestLine := ImageData + y * Round(FormatDesc.BytesPerPixel * aImage.Width);
  6360. for x := 0 to aImage.Width-1 do begin
  6361. bfFormat.Unmap(pSourceLine, pixel, pSourceMD);
  6362. FormatDesc.Map(pixel, pDestLine, pDestMD);
  6363. end;
  6364. end;
  6365. finally
  6366. FormatDesc.FreeMappingData(pDestMD);
  6367. bfFormat.FreeMappingData(pSourceMD);
  6368. bfFormat.Free;
  6369. end;
  6370. end;
  6371. begin
  6372. result := false;
  6373. if not Assigned(aImage) then
  6374. exit;
  6375. with aImage.DataDescription do begin
  6376. Mask.r := (QWord(1 shl RedPrec )-1) shl RedShift;
  6377. Mask.g := (QWord(1 shl GreenPrec)-1) shl GreenShift;
  6378. Mask.b := (QWord(1 shl BluePrec )-1) shl BlueShift;
  6379. Mask.a := (QWord(1 shl AlphaPrec)-1) shl AlphaShift;
  6380. end;
  6381. FormatDesc := TFormatDescriptor.GetFromMask(Mask);
  6382. f := FormatDesc.Format;
  6383. if (f = tfEmpty) then
  6384. exit;
  6385. CanCopy :=
  6386. (FormatDesc.BitsPerPixel = aImage.DataDescription.Depth) and
  6387. (aImage.DataDescription.BitsPerPixel = aImage.DataDescription.Depth);
  6388. ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
  6389. ImageData := GetMem(ImageSize);
  6390. try
  6391. if CanCopy then
  6392. Move(aImage.PixelData^, ImageData^, ImageSize)
  6393. else
  6394. CopyConvert;
  6395. SetData(ImageData, f, aImage.Width, aImage.Height);
  6396. except
  6397. if Assigned(ImageData) then
  6398. FreeMem(ImageData);
  6399. raise;
  6400. end;
  6401. result := true;
  6402. end;
  6403. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6404. function TglBitmapData.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  6405. var
  6406. rid: TRawImageDescription;
  6407. FormatDesc: TFormatDescriptor;
  6408. Pixel: TglBitmapPixelData;
  6409. x, y: Integer;
  6410. srcMD: Pointer;
  6411. src, dst: PByte;
  6412. begin
  6413. result := false;
  6414. if not Assigned(aImage) or (Format = tfEmpty) then
  6415. exit;
  6416. FormatDesc := TFormatDescriptor.Get(Format);
  6417. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  6418. exit;
  6419. FillChar(rid{%H-}, SizeOf(rid), 0);
  6420. rid.Format := ricfGray;
  6421. rid.Width := Width;
  6422. rid.Height := Height;
  6423. rid.Depth := CountSetBits(FormatDesc.Range.a);
  6424. rid.BitOrder := riboBitsInOrder;
  6425. rid.ByteOrder := riboLSBFirst;
  6426. rid.LineOrder := riloTopToBottom;
  6427. rid.LineEnd := rileTight;
  6428. rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
  6429. rid.RedPrec := CountSetBits(FormatDesc.Range.a);
  6430. rid.GreenPrec := 0;
  6431. rid.BluePrec := 0;
  6432. rid.AlphaPrec := 0;
  6433. rid.RedShift := 0;
  6434. rid.GreenShift := 0;
  6435. rid.BlueShift := 0;
  6436. rid.AlphaShift := 0;
  6437. rid.MaskBitsPerPixel := 0;
  6438. rid.PaletteColorCount := 0;
  6439. aImage.DataDescription := rid;
  6440. aImage.CreateData;
  6441. srcMD := FormatDesc.CreateMappingData;
  6442. try
  6443. FormatDesc.PreparePixel(Pixel);
  6444. src := Data;
  6445. dst := aImage.PixelData;
  6446. for y := 0 to Height-1 do
  6447. for x := 0 to Width-1 do begin
  6448. FormatDesc.Unmap(src, Pixel, srcMD);
  6449. case rid.BitsPerPixel of
  6450. 8: begin
  6451. dst^ := Pixel.Data.a;
  6452. inc(dst);
  6453. end;
  6454. 16: begin
  6455. PWord(dst)^ := Pixel.Data.a;
  6456. inc(dst, 2);
  6457. end;
  6458. 24: begin
  6459. PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
  6460. PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
  6461. PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
  6462. inc(dst, 3);
  6463. end;
  6464. 32: begin
  6465. PCardinal(dst)^ := Pixel.Data.a;
  6466. inc(dst, 4);
  6467. end;
  6468. else
  6469. raise EglBitmapUnsupportedFormat.Create(Format);
  6470. end;
  6471. end;
  6472. finally
  6473. FormatDesc.FreeMappingData(srcMD);
  6474. end;
  6475. result := true;
  6476. end;
  6477. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6478. function TglBitmapData.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  6479. var
  6480. data: TglBitmapData;
  6481. begin
  6482. data := TglBitmapData.Create;
  6483. try
  6484. data.AssignFromLazIntfImage(aImage);
  6485. result := AddAlphaFromDataObj(data, aFunc, aArgs);
  6486. finally
  6487. data.Free;
  6488. end;
  6489. end;
  6490. {$ENDIF}
  6491. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6492. function TglBitmapData.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
  6493. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  6494. var
  6495. rs: TResourceStream;
  6496. begin
  6497. PrepareResType(aResource, aResType);
  6498. rs := TResourceStream.Create(aInstance, aResource, aResType);
  6499. try
  6500. result := AddAlphaFromStream(rs, aFunc, aArgs);
  6501. finally
  6502. rs.Free;
  6503. end;
  6504. end;
  6505. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6506. function TglBitmapData.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  6507. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  6508. var
  6509. rs: TResourceStream;
  6510. begin
  6511. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  6512. try
  6513. result := AddAlphaFromStream(rs, aFunc, aArgs);
  6514. finally
  6515. rs.Free;
  6516. end;
  6517. end;
  6518. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6519. function TglBitmapData.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  6520. begin
  6521. if TFormatDescriptor.Get(Format).IsCompressed then
  6522. raise EglBitmapUnsupportedFormat.Create(Format);
  6523. result := Convert(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
  6524. end;
  6525. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6526. function TglBitmapData.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  6527. var
  6528. FS: TFileStream;
  6529. begin
  6530. FS := TFileStream.Create(aFileName, fmOpenRead);
  6531. try
  6532. result := AddAlphaFromStream(FS, aFunc, aArgs);
  6533. finally
  6534. FS.Free;
  6535. end;
  6536. end;
  6537. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6538. function TglBitmapData.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  6539. var
  6540. data: TglBitmapData;
  6541. begin
  6542. data := TglBitmapData.Create(aStream);
  6543. try
  6544. result := AddAlphaFromDataObj(data, aFunc, aArgs);
  6545. finally
  6546. data.Free;
  6547. end;
  6548. end;
  6549. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6550. function TglBitmapData.AddAlphaFromDataObj(const aDataObj: TglBitmapData; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  6551. var
  6552. DestData, DestData2, SourceData: pByte;
  6553. TempHeight, TempWidth: Integer;
  6554. SourceFD, DestFD: TFormatDescriptor;
  6555. SourceMD, DestMD, DestMD2: Pointer;
  6556. FuncRec: TglBitmapFunctionRec;
  6557. begin
  6558. result := false;
  6559. Assert(Assigned(Data));
  6560. Assert(Assigned(aDataObj));
  6561. Assert(Assigned(aDataObj.Data));
  6562. if ((aDataObj.Width = Width) and (aDataObj.Height = Height)) then begin
  6563. result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
  6564. SourceFD := TFormatDescriptor.Get(aDataObj.Format);
  6565. DestFD := TFormatDescriptor.Get(Format);
  6566. if not Assigned(aFunc) then begin
  6567. aFunc := glBitmapAlphaFunc;
  6568. FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
  6569. end else
  6570. FuncRec.Args := aArgs;
  6571. // Values
  6572. TempWidth := aDataObj.Width;
  6573. TempHeight := aDataObj.Height;
  6574. if (TempWidth <= 0) or (TempHeight <= 0) then
  6575. exit;
  6576. FuncRec.Sender := Self;
  6577. FuncRec.Size := Dimension;
  6578. FuncRec.Position.Fields := FuncRec.Size.Fields;
  6579. DestData := Data;
  6580. DestData2 := Data;
  6581. SourceData := aDataObj.Data;
  6582. // Mapping
  6583. SourceFD.PreparePixel(FuncRec.Source);
  6584. DestFD.PreparePixel (FuncRec.Dest);
  6585. SourceMD := SourceFD.CreateMappingData;
  6586. DestMD := DestFD.CreateMappingData;
  6587. DestMD2 := DestFD.CreateMappingData;
  6588. try
  6589. FuncRec.Position.Y := 0;
  6590. while FuncRec.Position.Y < TempHeight do begin
  6591. FuncRec.Position.X := 0;
  6592. while FuncRec.Position.X < TempWidth do begin
  6593. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  6594. DestFD.Unmap (DestData, FuncRec.Dest, DestMD);
  6595. aFunc(FuncRec);
  6596. DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
  6597. inc(FuncRec.Position.X);
  6598. end;
  6599. inc(FuncRec.Position.Y);
  6600. end;
  6601. finally
  6602. SourceFD.FreeMappingData(SourceMD);
  6603. DestFD.FreeMappingData(DestMD);
  6604. DestFD.FreeMappingData(DestMD2);
  6605. end;
  6606. end;
  6607. end;
  6608. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6609. function TglBitmapData.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
  6610. begin
  6611. result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
  6612. end;
  6613. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6614. function TglBitmapData.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
  6615. var
  6616. PixelData: TglBitmapPixelData;
  6617. begin
  6618. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  6619. result := AddAlphaFromColorKeyFloat(
  6620. aRed / PixelData.Range.r,
  6621. aGreen / PixelData.Range.g,
  6622. aBlue / PixelData.Range.b,
  6623. aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
  6624. end;
  6625. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6626. function TglBitmapData.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
  6627. var
  6628. values: array[0..2] of Single;
  6629. tmp: Cardinal;
  6630. i: Integer;
  6631. PixelData: TglBitmapPixelData;
  6632. begin
  6633. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  6634. with PixelData do begin
  6635. values[0] := aRed;
  6636. values[1] := aGreen;
  6637. values[2] := aBlue;
  6638. for i := 0 to 2 do begin
  6639. tmp := Trunc(Range.arr[i] * aDeviation);
  6640. Data.arr[i] := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
  6641. Range.arr[i] := Max(0, Trunc(Range.arr[i] * values[i] - tmp));
  6642. end;
  6643. Data.a := 0;
  6644. Range.a := 0;
  6645. end;
  6646. result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
  6647. end;
  6648. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6649. function TglBitmapData.AddAlphaFromValue(const aAlpha: Byte): Boolean;
  6650. begin
  6651. result := AddAlphaFromValueFloat(aAlpha / $FF);
  6652. end;
  6653. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6654. function TglBitmapData.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  6655. var
  6656. PixelData: TglBitmapPixelData;
  6657. begin
  6658. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  6659. result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
  6660. end;
  6661. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6662. function TglBitmapData.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  6663. var
  6664. PixelData: TglBitmapPixelData;
  6665. begin
  6666. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  6667. with PixelData do
  6668. Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
  6669. result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
  6670. end;
  6671. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6672. function TglBitmapData.RemoveAlpha: Boolean;
  6673. var
  6674. FormatDesc: TFormatDescriptor;
  6675. begin
  6676. result := false;
  6677. FormatDesc := TFormatDescriptor.Get(Format);
  6678. if Assigned(Data) then begin
  6679. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  6680. raise EglBitmapUnsupportedFormat.Create(Format);
  6681. result := ConvertTo(FormatDesc.WithoutAlpha);
  6682. end;
  6683. end;
  6684. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6685. procedure TglBitmapData.FillWithColor(const aRed, aGreen, aBlue: Byte;
  6686. const aAlpha: Byte);
  6687. begin
  6688. FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
  6689. end;
  6690. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6691. procedure TglBitmapData.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
  6692. var
  6693. PixelData: TglBitmapPixelData;
  6694. begin
  6695. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  6696. FillWithColorFloat(
  6697. aRed / PixelData.Range.r,
  6698. aGreen / PixelData.Range.g,
  6699. aBlue / PixelData.Range.b,
  6700. aAlpha / PixelData.Range.a);
  6701. end;
  6702. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6703. procedure TglBitmapData.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
  6704. var
  6705. PixelData: TglBitmapPixelData;
  6706. begin
  6707. TFormatDescriptor.Get(Format).PreparePixel(PixelData);
  6708. with PixelData do begin
  6709. Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
  6710. Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
  6711. Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
  6712. Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
  6713. end;
  6714. Convert(glBitmapFillWithColorFunc, false, @PixelData);
  6715. end;
  6716. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6717. procedure TglBitmapData.SetData(const aData: PByte; const aFormat: TglBitmapFormat; const aWidth: Integer; const aHeight: Integer);
  6718. begin
  6719. if (Data <> aData) then begin
  6720. if (Assigned(Data)) then
  6721. FreeMem(Data);
  6722. fData := aData;
  6723. end;
  6724. if Assigned(fData) then begin
  6725. FillChar(fDimension, SizeOf(fDimension), 0);
  6726. if aWidth <> -1 then begin
  6727. fDimension.Fields := fDimension.Fields + [ffX];
  6728. fDimension.X := aWidth;
  6729. end;
  6730. if aHeight <> -1 then begin
  6731. fDimension.Fields := fDimension.Fields + [ffY];
  6732. fDimension.Y := aHeight;
  6733. end;
  6734. fFormat := aFormat;
  6735. end else
  6736. fFormat := tfEmpty;
  6737. UpdateScanlines;
  6738. end;
  6739. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6740. function TglBitmapData.Clone: TglBitmapData;
  6741. var
  6742. Temp: TglBitmapData;
  6743. TempPtr: PByte;
  6744. Size: Integer;
  6745. begin
  6746. result := nil;
  6747. Temp := (ClassType.Create as TglBitmapData);
  6748. try
  6749. // copy texture data if assigned
  6750. if Assigned(Data) then begin
  6751. Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
  6752. GetMem(TempPtr, Size);
  6753. try
  6754. Move(Data^, TempPtr^, Size);
  6755. Temp.SetData(TempPtr, Format, Width, Height);
  6756. except
  6757. if Assigned(TempPtr) then
  6758. FreeMem(TempPtr);
  6759. raise;
  6760. end;
  6761. end else begin
  6762. TempPtr := nil;
  6763. Temp.SetData(TempPtr, Format, Width, Height);
  6764. end;
  6765. // copy properties
  6766. Temp.fFormat := Format;
  6767. result := Temp;
  6768. except
  6769. FreeAndNil(Temp);
  6770. raise;
  6771. end;
  6772. end;
  6773. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6774. procedure TglBitmapData.Invert(const aRed, aGreen, aBlue, aAlpha: Boolean);
  6775. var
  6776. mask: PtrInt;
  6777. begin
  6778. mask :=
  6779. (Byte(aRed) and 1) or
  6780. ((Byte(aGreen) and 1) shl 1) or
  6781. ((Byte(aBlue) and 1) shl 2) or
  6782. ((Byte(aAlpha) and 1) shl 3);
  6783. if (mask > 0) then
  6784. Convert(glBitmapInvertFunc, false, {%H-}Pointer(mask));
  6785. end;
  6786. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6787. type
  6788. TMatrixItem = record
  6789. X, Y: Integer;
  6790. W: Single;
  6791. end;
  6792. PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
  6793. TglBitmapToNormalMapRec = Record
  6794. Scale: Single;
  6795. Heights: array of Single;
  6796. MatrixU : array of TMatrixItem;
  6797. MatrixV : array of TMatrixItem;
  6798. end;
  6799. const
  6800. ONE_OVER_255 = 1 / 255;
  6801. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6802. procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
  6803. var
  6804. Val: Single;
  6805. begin
  6806. with FuncRec do begin
  6807. Val :=
  6808. Source.Data.r * LUMINANCE_WEIGHT_R +
  6809. Source.Data.g * LUMINANCE_WEIGHT_G +
  6810. Source.Data.b * LUMINANCE_WEIGHT_B;
  6811. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
  6812. end;
  6813. end;
  6814. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6815. procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  6816. begin
  6817. with FuncRec do
  6818. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
  6819. end;
  6820. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6821. procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
  6822. type
  6823. TVec = Array[0..2] of Single;
  6824. var
  6825. Idx: Integer;
  6826. du, dv: Double;
  6827. Len: Single;
  6828. Vec: TVec;
  6829. function GetHeight(X, Y: Integer): Single;
  6830. begin
  6831. with FuncRec do begin
  6832. X := Max(0, Min(Size.X -1, X));
  6833. Y := Max(0, Min(Size.Y -1, Y));
  6834. result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
  6835. end;
  6836. end;
  6837. begin
  6838. with FuncRec do begin
  6839. with PglBitmapToNormalMapRec(Args)^ do begin
  6840. du := 0;
  6841. for Idx := Low(MatrixU) to High(MatrixU) do
  6842. du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
  6843. dv := 0;
  6844. for Idx := Low(MatrixU) to High(MatrixU) do
  6845. dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
  6846. Vec[0] := -du * Scale;
  6847. Vec[1] := -dv * Scale;
  6848. Vec[2] := 1;
  6849. end;
  6850. // Normalize
  6851. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  6852. if Len <> 0 then begin
  6853. Vec[0] := Vec[0] * Len;
  6854. Vec[1] := Vec[1] * Len;
  6855. Vec[2] := Vec[2] * Len;
  6856. end;
  6857. // Farbe zuweisem
  6858. Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
  6859. Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
  6860. Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
  6861. end;
  6862. end;
  6863. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6864. procedure TglBitmapData.GenerateNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
  6865. var
  6866. Rec: TglBitmapToNormalMapRec;
  6867. procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
  6868. begin
  6869. if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
  6870. Matrix[Index].X := X;
  6871. Matrix[Index].Y := Y;
  6872. Matrix[Index].W := W;
  6873. end;
  6874. end;
  6875. begin
  6876. if TFormatDescriptor.Get(Format).IsCompressed then
  6877. raise EglBitmapUnsupportedFormat.Create(Format);
  6878. if aScale > 100 then
  6879. Rec.Scale := 100
  6880. else if aScale < -100 then
  6881. Rec.Scale := -100
  6882. else
  6883. Rec.Scale := aScale;
  6884. SetLength(Rec.Heights, Width * Height);
  6885. try
  6886. case aFunc of
  6887. nm4Samples: begin
  6888. SetLength(Rec.MatrixU, 2);
  6889. SetEntry(Rec.MatrixU, 0, -1, 0, -0.5);
  6890. SetEntry(Rec.MatrixU, 1, 1, 0, 0.5);
  6891. SetLength(Rec.MatrixV, 2);
  6892. SetEntry(Rec.MatrixV, 0, 0, 1, 0.5);
  6893. SetEntry(Rec.MatrixV, 1, 0, -1, -0.5);
  6894. end;
  6895. nmSobel: begin
  6896. SetLength(Rec.MatrixU, 6);
  6897. SetEntry(Rec.MatrixU, 0, -1, 1, -1.0);
  6898. SetEntry(Rec.MatrixU, 1, -1, 0, -2.0);
  6899. SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
  6900. SetEntry(Rec.MatrixU, 3, 1, 1, 1.0);
  6901. SetEntry(Rec.MatrixU, 4, 1, 0, 2.0);
  6902. SetEntry(Rec.MatrixU, 5, 1, -1, 1.0);
  6903. SetLength(Rec.MatrixV, 6);
  6904. SetEntry(Rec.MatrixV, 0, -1, 1, 1.0);
  6905. SetEntry(Rec.MatrixV, 1, 0, 1, 2.0);
  6906. SetEntry(Rec.MatrixV, 2, 1, 1, 1.0);
  6907. SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
  6908. SetEntry(Rec.MatrixV, 4, 0, -1, -2.0);
  6909. SetEntry(Rec.MatrixV, 5, 1, -1, -1.0);
  6910. end;
  6911. nm3x3: begin
  6912. SetLength(Rec.MatrixU, 6);
  6913. SetEntry(Rec.MatrixU, 0, -1, 1, -1/6);
  6914. SetEntry(Rec.MatrixU, 1, -1, 0, -1/6);
  6915. SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
  6916. SetEntry(Rec.MatrixU, 3, 1, 1, 1/6);
  6917. SetEntry(Rec.MatrixU, 4, 1, 0, 1/6);
  6918. SetEntry(Rec.MatrixU, 5, 1, -1, 1/6);
  6919. SetLength(Rec.MatrixV, 6);
  6920. SetEntry(Rec.MatrixV, 0, -1, 1, 1/6);
  6921. SetEntry(Rec.MatrixV, 1, 0, 1, 1/6);
  6922. SetEntry(Rec.MatrixV, 2, 1, 1, 1/6);
  6923. SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
  6924. SetEntry(Rec.MatrixV, 4, 0, -1, -1/6);
  6925. SetEntry(Rec.MatrixV, 5, 1, -1, -1/6);
  6926. end;
  6927. nm5x5: begin
  6928. SetLength(Rec.MatrixU, 20);
  6929. SetEntry(Rec.MatrixU, 0, -2, 2, -1 / 16);
  6930. SetEntry(Rec.MatrixU, 1, -1, 2, -1 / 10);
  6931. SetEntry(Rec.MatrixU, 2, 1, 2, 1 / 10);
  6932. SetEntry(Rec.MatrixU, 3, 2, 2, 1 / 16);
  6933. SetEntry(Rec.MatrixU, 4, -2, 1, -1 / 10);
  6934. SetEntry(Rec.MatrixU, 5, -1, 1, -1 / 8);
  6935. SetEntry(Rec.MatrixU, 6, 1, 1, 1 / 8);
  6936. SetEntry(Rec.MatrixU, 7, 2, 1, 1 / 10);
  6937. SetEntry(Rec.MatrixU, 8, -2, 0, -1 / 2.8);
  6938. SetEntry(Rec.MatrixU, 9, -1, 0, -0.5);
  6939. SetEntry(Rec.MatrixU, 10, 1, 0, 0.5);
  6940. SetEntry(Rec.MatrixU, 11, 2, 0, 1 / 2.8);
  6941. SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
  6942. SetEntry(Rec.MatrixU, 13, -1, -1, -1 / 8);
  6943. SetEntry(Rec.MatrixU, 14, 1, -1, 1 / 8);
  6944. SetEntry(Rec.MatrixU, 15, 2, -1, 1 / 10);
  6945. SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
  6946. SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
  6947. SetEntry(Rec.MatrixU, 18, 1, -2, 1 / 10);
  6948. SetEntry(Rec.MatrixU, 19, 2, -2, 1 / 16);
  6949. SetLength(Rec.MatrixV, 20);
  6950. SetEntry(Rec.MatrixV, 0, -2, 2, 1 / 16);
  6951. SetEntry(Rec.MatrixV, 1, -1, 2, 1 / 10);
  6952. SetEntry(Rec.MatrixV, 2, 0, 2, 0.25);
  6953. SetEntry(Rec.MatrixV, 3, 1, 2, 1 / 10);
  6954. SetEntry(Rec.MatrixV, 4, 2, 2, 1 / 16);
  6955. SetEntry(Rec.MatrixV, 5, -2, 1, 1 / 10);
  6956. SetEntry(Rec.MatrixV, 6, -1, 1, 1 / 8);
  6957. SetEntry(Rec.MatrixV, 7, 0, 1, 0.5);
  6958. SetEntry(Rec.MatrixV, 8, 1, 1, 1 / 8);
  6959. SetEntry(Rec.MatrixV, 9, 2, 1, 1 / 16);
  6960. SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
  6961. SetEntry(Rec.MatrixV, 11, -1, -1, -1 / 8);
  6962. SetEntry(Rec.MatrixV, 12, 0, -1, -0.5);
  6963. SetEntry(Rec.MatrixV, 13, 1, -1, -1 / 8);
  6964. SetEntry(Rec.MatrixV, 14, 2, -1, -1 / 10);
  6965. SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
  6966. SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
  6967. SetEntry(Rec.MatrixV, 17, 0, -2, -0.25);
  6968. SetEntry(Rec.MatrixV, 18, 1, -2, -1 / 10);
  6969. SetEntry(Rec.MatrixV, 19, 2, -2, -1 / 16);
  6970. end;
  6971. end;
  6972. // Daten Sammeln
  6973. if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
  6974. Convert(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
  6975. else
  6976. Convert(glBitmapToNormalMapPrepareFunc, false, @Rec);
  6977. Convert(glBitmapToNormalMapFunc, false, @Rec);
  6978. finally
  6979. SetLength(Rec.Heights, 0);
  6980. end;
  6981. end;
  6982. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6983. constructor TglBitmapData.Create;
  6984. begin
  6985. inherited Create;
  6986. fFormat := glBitmapDefaultFormat;
  6987. end;
  6988. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6989. constructor TglBitmapData.Create(const aFileName: String);
  6990. begin
  6991. Create;
  6992. LoadFromFile(aFileName);
  6993. end;
  6994. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6995. constructor TglBitmapData.Create(const aStream: TStream);
  6996. begin
  6997. Create;
  6998. LoadFromStream(aStream);
  6999. end;
  7000. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7001. constructor TglBitmapData.Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; aData: PByte);
  7002. var
  7003. ImageSize: Integer;
  7004. begin
  7005. Create;
  7006. if not Assigned(aData) then begin
  7007. ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  7008. GetMem(aData, ImageSize);
  7009. try
  7010. FillChar(aData^, ImageSize, #$FF);
  7011. SetData(aData, aFormat, aSize.X, aSize.Y);
  7012. except
  7013. if Assigned(aData) then
  7014. FreeMem(aData);
  7015. raise;
  7016. end;
  7017. end else begin
  7018. SetData(aData, aFormat, aSize.X, aSize.Y);
  7019. end;
  7020. end;
  7021. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7022. constructor TglBitmapData.Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer);
  7023. begin
  7024. Create;
  7025. LoadFromFunc(aSize, aFormat, aFunc, aArgs);
  7026. end;
  7027. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7028. constructor TglBitmapData.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
  7029. begin
  7030. Create;
  7031. LoadFromResource(aInstance, aResource, aResType);
  7032. end;
  7033. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7034. constructor TglBitmapData.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  7035. begin
  7036. Create;
  7037. LoadFromResourceID(aInstance, aResourceID, aResType);
  7038. end;
  7039. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7040. destructor TglBitmapData.Destroy;
  7041. begin
  7042. SetData(nil, tfEmpty);
  7043. inherited Destroy;
  7044. end;
  7045. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7046. //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7047. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7048. function TglBitmap.GetWidth: Integer;
  7049. begin
  7050. if (ffX in fDimension.Fields) then
  7051. result := fDimension.X
  7052. else
  7053. result := -1;
  7054. end;
  7055. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7056. function TglBitmap.GetHeight: Integer;
  7057. begin
  7058. if (ffY in fDimension.Fields) then
  7059. result := fDimension.Y
  7060. else
  7061. result := -1;
  7062. end;
  7063. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7064. procedure TglBitmap.SetCustomData(const aValue: Pointer);
  7065. begin
  7066. if fCustomData = aValue then
  7067. exit;
  7068. fCustomData := aValue;
  7069. end;
  7070. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7071. procedure TglBitmap.SetCustomName(const aValue: String);
  7072. begin
  7073. if fCustomName = aValue then
  7074. exit;
  7075. fCustomName := aValue;
  7076. end;
  7077. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7078. procedure TglBitmap.SetCustomNameW(const aValue: WideString);
  7079. begin
  7080. if fCustomNameW = aValue then
  7081. exit;
  7082. fCustomNameW := aValue;
  7083. end;
  7084. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7085. procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
  7086. begin
  7087. if fDeleteTextureOnFree = aValue then
  7088. exit;
  7089. fDeleteTextureOnFree := aValue;
  7090. end;
  7091. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7092. procedure TglBitmap.SetID(const aValue: Cardinal);
  7093. begin
  7094. if fID = aValue then
  7095. exit;
  7096. fID := aValue;
  7097. end;
  7098. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7099. procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
  7100. begin
  7101. if fMipMap = aValue then
  7102. exit;
  7103. fMipMap := aValue;
  7104. end;
  7105. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7106. procedure TglBitmap.SetTarget(const aValue: Cardinal);
  7107. begin
  7108. if fTarget = aValue then
  7109. exit;
  7110. fTarget := aValue;
  7111. end;
  7112. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7113. procedure TglBitmap.SetAnisotropic(const aValue: Integer);
  7114. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)}
  7115. var
  7116. MaxAnisotropic: Integer;
  7117. {$IFEND}
  7118. begin
  7119. fAnisotropic := aValue;
  7120. if (ID > 0) then begin
  7121. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)}
  7122. if GL_EXT_texture_filter_anisotropic then begin
  7123. if fAnisotropic > 0 then begin
  7124. Bind(false);
  7125. glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
  7126. if aValue > MaxAnisotropic then
  7127. fAnisotropic := MaxAnisotropic;
  7128. glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
  7129. end;
  7130. end else begin
  7131. fAnisotropic := 0;
  7132. end;
  7133. {$ELSE}
  7134. fAnisotropic := 0;
  7135. {$IFEND}
  7136. end;
  7137. end;
  7138. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7139. procedure TglBitmap.CreateID;
  7140. begin
  7141. if (ID <> 0) then
  7142. glDeleteTextures(1, @fID);
  7143. glGenTextures(1, @fID);
  7144. Bind(false);
  7145. end;
  7146. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7147. procedure TglBitmap.SetupParameters({$IFNDEF OPENGL_ES}out aBuildWithGlu: Boolean{$ENDIF});
  7148. begin
  7149. // Set Up Parameters
  7150. SetWrap(fWrapS, fWrapT, fWrapR);
  7151. SetFilter(fFilterMin, fFilterMag);
  7152. SetAnisotropic(fAnisotropic);
  7153. {$IFNDEF OPENGL_ES}
  7154. SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
  7155. if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  7156. SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  7157. {$ENDIF}
  7158. {$IFNDEF OPENGL_ES}
  7159. // Mip Maps Generation Mode
  7160. aBuildWithGlu := false;
  7161. if (MipMap = mmMipmap) then begin
  7162. if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
  7163. glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)
  7164. else
  7165. aBuildWithGlu := true;
  7166. end else if (MipMap = mmMipmapGlu) then
  7167. aBuildWithGlu := true;
  7168. {$ELSE}
  7169. if (MipMap = mmMipmap) then
  7170. glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE);
  7171. {$ENDIF}
  7172. end;
  7173. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7174. //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7175. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7176. procedure TglBitmap.AfterConstruction;
  7177. begin
  7178. inherited AfterConstruction;
  7179. fID := 0;
  7180. fTarget := 0;
  7181. {$IFNDEF OPENGL_ES}
  7182. fIsResident := false;
  7183. {$ENDIF}
  7184. fMipMap := glBitmapDefaultMipmap;
  7185. fDeleteTextureOnFree := glBitmapGetDefaultDeleteTextureOnFree;
  7186. glBitmapGetDefaultFilter (fFilterMin, fFilterMag);
  7187. glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
  7188. {$IFNDEF OPENGL_ES}
  7189. glBitmapGetDefaultSwizzle (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  7190. {$ENDIF}
  7191. end;
  7192. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7193. procedure TglBitmap.BeforeDestruction;
  7194. begin
  7195. if (fID > 0) and fDeleteTextureOnFree then
  7196. glDeleteTextures(1, @fID);
  7197. inherited BeforeDestruction;
  7198. end;
  7199. {$IFNDEF OPENGL_ES}
  7200. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7201. procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  7202. begin
  7203. fBorderColor[0] := aRed;
  7204. fBorderColor[1] := aGreen;
  7205. fBorderColor[2] := aBlue;
  7206. fBorderColor[3] := aAlpha;
  7207. if (ID > 0) then begin
  7208. Bind(false);
  7209. glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
  7210. end;
  7211. end;
  7212. {$ENDIF}
  7213. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7214. procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
  7215. begin
  7216. //check MIN filter
  7217. case aMin of
  7218. GL_NEAREST:
  7219. fFilterMin := GL_NEAREST;
  7220. GL_LINEAR:
  7221. fFilterMin := GL_LINEAR;
  7222. GL_NEAREST_MIPMAP_NEAREST:
  7223. fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
  7224. GL_LINEAR_MIPMAP_NEAREST:
  7225. fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
  7226. GL_NEAREST_MIPMAP_LINEAR:
  7227. fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
  7228. GL_LINEAR_MIPMAP_LINEAR:
  7229. fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
  7230. else
  7231. raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
  7232. end;
  7233. //check MAG filter
  7234. case aMag of
  7235. GL_NEAREST:
  7236. fFilterMag := GL_NEAREST;
  7237. GL_LINEAR:
  7238. fFilterMag := GL_LINEAR;
  7239. else
  7240. raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
  7241. end;
  7242. //apply filter
  7243. if (ID > 0) then begin
  7244. Bind(false);
  7245. glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
  7246. if (MipMap = mmNone) {$IFNDEF OPENGL_ES}or (Target = GL_TEXTURE_RECTANGLE){$ENDIF} then begin
  7247. case fFilterMin of
  7248. GL_NEAREST, GL_LINEAR:
  7249. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  7250. GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
  7251. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
  7252. GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
  7253. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
  7254. end;
  7255. end else
  7256. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  7257. end;
  7258. end;
  7259. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7260. procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
  7261. procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
  7262. begin
  7263. case aValue of
  7264. {$IFNDEF OPENGL_ES}
  7265. GL_CLAMP:
  7266. aTarget := GL_CLAMP;
  7267. {$ENDIF}
  7268. GL_REPEAT:
  7269. aTarget := GL_REPEAT;
  7270. GL_CLAMP_TO_EDGE: begin
  7271. {$IFNDEF OPENGL_ES}
  7272. if not GL_VERSION_1_2 and not GL_EXT_texture_edge_clamp then
  7273. aTarget := GL_CLAMP
  7274. else
  7275. {$ENDIF}
  7276. aTarget := GL_CLAMP_TO_EDGE;
  7277. end;
  7278. {$IFNDEF OPENGL_ES}
  7279. GL_CLAMP_TO_BORDER: begin
  7280. if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
  7281. aTarget := GL_CLAMP_TO_BORDER
  7282. else
  7283. aTarget := GL_CLAMP;
  7284. end;
  7285. {$ENDIF}
  7286. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  7287. GL_MIRRORED_REPEAT: begin
  7288. {$IFNDEF OPENGL_ES}
  7289. if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
  7290. {$ELSE}
  7291. if GL_VERSION_2_0 then
  7292. {$ENDIF}
  7293. aTarget := GL_MIRRORED_REPEAT
  7294. else
  7295. raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
  7296. end;
  7297. {$IFEND}
  7298. else
  7299. raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
  7300. end;
  7301. end;
  7302. begin
  7303. CheckAndSetWrap(S, fWrapS);
  7304. CheckAndSetWrap(T, fWrapT);
  7305. CheckAndSetWrap(R, fWrapR);
  7306. if (ID > 0) then begin
  7307. Bind(false);
  7308. glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
  7309. glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
  7310. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  7311. {$IFDEF OPENGL_ES} if GL_VERSION_3_0 then{$ENDIF}
  7312. glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
  7313. {$IFEND}
  7314. end;
  7315. end;
  7316. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  7317. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7318. procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
  7319. procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
  7320. begin
  7321. if (aValue = GL_ZERO) or (aValue = GL_ONE) or (aValue = GL_ALPHA) or
  7322. (aValue = GL_RED) or (aValue = GL_GREEN) or (aValue = GL_BLUE) then
  7323. fSwizzle[aIndex] := aValue
  7324. else
  7325. raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
  7326. end;
  7327. begin
  7328. {$IFNDEF OPENGL_ES}
  7329. if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  7330. raise EglBitmapNotSupported.Create('texture swizzle is not supported');
  7331. {$ELSE}
  7332. if not GL_VERSION_3_0 then
  7333. raise EglBitmapNotSupported.Create('texture swizzle is not supported');
  7334. {$ENDIF}
  7335. CheckAndSetValue(r, 0);
  7336. CheckAndSetValue(g, 1);
  7337. CheckAndSetValue(b, 2);
  7338. CheckAndSetValue(a, 3);
  7339. if (ID > 0) then begin
  7340. Bind(false);
  7341. {$IFNDEF OPENGL_ES}
  7342. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, PGLint(@fSwizzle[0]));
  7343. {$ELSE}
  7344. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_R, PGLint(@fSwizzle[0]));
  7345. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_G, PGLint(@fSwizzle[1]));
  7346. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_B, PGLint(@fSwizzle[2]));
  7347. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_A, PGLint(@fSwizzle[3]));
  7348. {$ENDIF}
  7349. end;
  7350. end;
  7351. {$IFEND}
  7352. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7353. procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);
  7354. begin
  7355. if aEnableTextureUnit then
  7356. glEnable(Target);
  7357. if (ID > 0) then
  7358. glBindTexture(Target, ID);
  7359. end;
  7360. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7361. procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);
  7362. begin
  7363. if aDisableTextureUnit then
  7364. glDisable(Target);
  7365. glBindTexture(Target, 0);
  7366. end;
  7367. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7368. procedure TglBitmap.UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean);
  7369. var
  7370. w, h: Integer;
  7371. begin
  7372. w := aDataObj.Width;
  7373. h := aDataObj.Height;
  7374. fDimension.Fields := [];
  7375. if (w > 0) then
  7376. fDimension.Fields := fDimension.Fields + [ffX];
  7377. if (h > 0) then
  7378. fDimension.Fields := fDimension.Fields + [ffY];
  7379. fDimension.X := w;
  7380. fDimension.Y := h;
  7381. end;
  7382. {$IFNDEF OPENGL_ES}
  7383. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7384. function TglBitmap.DownloadData(const aDataObj: TglBitmapData): Boolean;
  7385. var
  7386. Temp: PByte;
  7387. TempWidth, TempHeight: Integer;
  7388. TempIntFormat: GLint;
  7389. IntFormat: TglBitmapFormat;
  7390. FormatDesc: TFormatDescriptor;
  7391. begin
  7392. result := false;
  7393. Bind;
  7394. // Request Data
  7395. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH, @TempWidth);
  7396. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT, @TempHeight);
  7397. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
  7398. FormatDesc := (TglBitmapFormatDescriptor.GetByFormat(TempIntFormat) as TFormatDescriptor);
  7399. IntFormat := FormatDesc.Format;
  7400. // Getting data from OpenGL
  7401. FormatDesc := TFormatDescriptor.Get(IntFormat);
  7402. GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
  7403. try
  7404. if FormatDesc.IsCompressed then begin
  7405. if not Assigned(glGetCompressedTexImage) then
  7406. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7407. glGetCompressedTexImage(Target, 0, Temp)
  7408. end else
  7409. glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  7410. aDataObj.SetData(Temp, IntFormat, TempWidth, TempHeight);
  7411. result := true;
  7412. except
  7413. if Assigned(Temp) then
  7414. FreeMem(Temp);
  7415. raise;
  7416. end;
  7417. end;
  7418. {$ENDIF}
  7419. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7420. constructor TglBitmap.Create;
  7421. begin
  7422. if (ClassType = TglBitmap) then
  7423. raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
  7424. inherited Create;
  7425. end;
  7426. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7427. constructor TglBitmap.Create(const aData: TglBitmapData);
  7428. begin
  7429. Create;
  7430. UploadData(aData);
  7431. end;
  7432. {$IFNDEF OPENGL_ES}
  7433. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7434. //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7435. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7436. procedure TglBitmap1D.UploadDataIntern(const aDataObj: TglBitmapData; const aBuildWithGlu: Boolean);
  7437. var
  7438. fd: TglBitmapFormatDescriptor;
  7439. begin
  7440. // Upload data
  7441. fd := aDataObj.FormatDescriptor;
  7442. if (fd.glFormat = 0) or (fd.glInternalFormat = 0) or (fd.glDataFormat = 0) then
  7443. raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data');
  7444. if fd.IsCompressed then begin
  7445. if not Assigned(glCompressedTexImage1D) then
  7446. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7447. glCompressedTexImage1D(Target, 0, fd.glInternalFormat, aDataObj.Width, 0, fd.GetSize(aDataObj.Width, 1), aDataObj.Data)
  7448. end else if aBuildWithGlu then
  7449. gluBuild1DMipmaps(Target, fd.glInternalFormat, aDataObj.Width, fd.glFormat, fd.glDataFormat, aDataObj.Data)
  7450. else
  7451. glTexImage1D(Target, 0, fd.glInternalFormat, aDataObj.Width, 0, fd.glFormat, fd.glDataFormat, aDataObj.Data);
  7452. end;
  7453. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7454. procedure TglBitmap1D.AfterConstruction;
  7455. begin
  7456. inherited;
  7457. Target := GL_TEXTURE_1D;
  7458. end;
  7459. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7460. procedure TglBitmap1D.UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean);
  7461. var
  7462. BuildWithGlu, TexRec: Boolean;
  7463. TexSize: Integer;
  7464. begin
  7465. if not Assigned(aDataObj) then
  7466. exit;
  7467. // Check Texture Size
  7468. if (aCheckSize) then begin
  7469. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  7470. if (aDataObj.Width > TexSize) then
  7471. raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  7472. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
  7473. (Target = GL_TEXTURE_RECTANGLE);
  7474. if not (IsPowerOfTwo(aDataObj.Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  7475. raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7476. end;
  7477. if (fID = 0) then
  7478. CreateID;
  7479. SetupParameters(BuildWithGlu);
  7480. UploadDataIntern(aDataObj, BuildWithGlu);
  7481. glAreTexturesResident(1, @fID, @fIsResident);
  7482. inherited UploadData(aDataObj, aCheckSize);
  7483. end;
  7484. {$ENDIF}
  7485. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7486. //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7487. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7488. procedure TglBitmap2D.UploadDataIntern(const aDataObj: TglBitmapData; const aTarget: GLenum; const aBuildWithGlu: Boolean);
  7489. var
  7490. fd: TglBitmapFormatDescriptor;
  7491. begin
  7492. fd := aDataObj.FormatDescriptor;
  7493. if (fd.glFormat = 0) or (fd.glInternalFormat = 0) or (fd.glDataFormat = 0) then
  7494. raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data');
  7495. glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
  7496. if fd.IsCompressed then begin
  7497. if not Assigned(glCompressedTexImage2D) then
  7498. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7499. glCompressedTexImage2D(aTarget, 0, fd.glInternalFormat, aDataObj.Width, aDataObj.Height, 0, fd.GetSize(fDimension), aDataObj.Data)
  7500. {$IFNDEF OPENGL_ES}
  7501. end else if aBuildWithGlu then begin
  7502. gluBuild2DMipmaps(aTarget, fd.ChannelCount, aDataObj.Width, aDataObj.Height, fd.glFormat, fd.glDataFormat, aDataObj.Data)
  7503. {$ENDIF}
  7504. end else begin
  7505. glTexImage2D(aTarget, 0, fd.glInternalFormat, aDataObj.Width, aDataObj.Height, 0, fd.glFormat, fd.glDataFormat, aDataObj.Data);
  7506. end;
  7507. end;
  7508. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7509. procedure TglBitmap2D.AfterConstruction;
  7510. begin
  7511. inherited;
  7512. Target := GL_TEXTURE_2D;
  7513. end;
  7514. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7515. procedure TglBitmap2D.UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean);
  7516. var
  7517. {$IFNDEF OPENGL_ES}
  7518. BuildWithGlu, TexRec: Boolean;
  7519. {$ENDIF}
  7520. PotTex: Boolean;
  7521. TexSize: Integer;
  7522. begin
  7523. if not Assigned(aDataObj) then
  7524. exit;
  7525. // Check Texture Size
  7526. if (aCheckSize) then begin
  7527. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  7528. if ((aDataObj.Width > TexSize) or (aDataObj.Height > TexSize)) then
  7529. raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  7530. PotTex := IsPowerOfTwo(aDataObj.Width) and IsPowerOfTwo(aDataObj.Height);
  7531. {$IF NOT DEFINED(OPENGL_ES)}
  7532. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
  7533. if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  7534. raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7535. {$ELSEIF DEFINED(OPENGL_ES_EXT)}
  7536. if not PotTex and not GL_OES_texture_npot then
  7537. raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7538. {$ELSE}
  7539. if not PotTex then
  7540. raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7541. {$IFEND}
  7542. end;
  7543. if (fID = 0) then
  7544. CreateID;
  7545. SetupParameters({$IFNDEF OPENGL_ES}BuildWithGlu{$ENDIF});
  7546. UploadDataIntern(aDataObj, Target{$IFNDEF OPENGL_ES}, BuildWithGlu{$ENDIF});
  7547. {$IFNDEF OPENGL_ES}
  7548. glAreTexturesResident(1, @fID, @fIsResident);
  7549. {$ENDIF}
  7550. inherited UploadData(aDataObj, aCheckSize);
  7551. end;
  7552. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7553. class procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat; const aDataObj: TglBitmapData);
  7554. var
  7555. Temp: pByte;
  7556. Size, w, h: Integer;
  7557. FormatDesc: TFormatDescriptor;
  7558. begin
  7559. FormatDesc := TFormatDescriptor.Get(aFormat);
  7560. if FormatDesc.IsCompressed then
  7561. raise EglBitmapUnsupportedFormat.Create(aFormat);
  7562. w := aRight - aLeft;
  7563. h := aBottom - aTop;
  7564. Size := FormatDesc.GetSize(w, h);
  7565. GetMem(Temp, Size);
  7566. try
  7567. glPixelStorei(GL_PACK_ALIGNMENT, 1);
  7568. glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  7569. aDataObj.SetData(Temp, aFormat, w, h);
  7570. aDataObj.FlipVert;
  7571. except
  7572. if Assigned(Temp) then
  7573. FreeMem(Temp);
  7574. raise;
  7575. end;
  7576. end;
  7577. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  7578. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7579. //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7580. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7581. procedure TglBitmapCubeMap.AfterConstruction;
  7582. begin
  7583. inherited;
  7584. {$IFNDEF OPENGL_ES}
  7585. if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
  7586. raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
  7587. {$ELSE}
  7588. if not (GL_VERSION_2_0) then
  7589. raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');
  7590. {$ENDIF}
  7591. SetWrap;
  7592. Target := GL_TEXTURE_CUBE_MAP;
  7593. {$IFNDEF OPENGL_ES}
  7594. fGenMode := GL_REFLECTION_MAP;
  7595. {$ENDIF}
  7596. end;
  7597. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7598. procedure TglBitmapCubeMap.UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean);
  7599. begin
  7600. Assert(false, 'TglBitmapCubeMap.UploadData - Don''t call UploadData directly, use UploadCubeMap instead');
  7601. end;
  7602. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7603. procedure TglBitmapCubeMap.UploadCubeMap(const aDataObj: TglBitmapData; const aCubeTarget: Cardinal; const aCheckSize: Boolean);
  7604. var
  7605. {$IFNDEF OPENGL_ES}
  7606. BuildWithGlu: Boolean;
  7607. {$ENDIF}
  7608. TexSize: Integer;
  7609. begin
  7610. if (aCheckSize) then begin
  7611. glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
  7612. if (aDataObj.Width > TexSize) or (aDataObj.Height > TexSize) then
  7613. raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenerateCubeMap - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
  7614. {$IF NOT DEFINED(OPENGL_ES)}
  7615. if not ((IsPowerOfTwo(aDataObj.Width) and IsPowerOfTwo(aDataObj.Height)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
  7616. raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
  7617. {$ELSEIF DEFINED(OPENGL_ES_EXT)}
  7618. if not (IsPowerOfTwo(aDataObj.Width) and IsPowerOfTwo(aDataObj.Height)) and not GL_OES_texture_npot then
  7619. raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
  7620. {$ELSE}
  7621. if not (IsPowerOfTwo(aDataObj.Width) and IsPowerOfTwo(aDataObj.Height)) then
  7622. raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
  7623. {$IFEND}
  7624. end;
  7625. if (fID = 0) then
  7626. CreateID;
  7627. SetupParameters({$IFNDEF OPENGL_ES}BuildWithGlu{$ENDIF});
  7628. UploadDataIntern(aDataObj, aCubeTarget{$IFNDEF OPENGL_ES}, BuildWithGlu{$ENDIF});
  7629. inherited UploadData(aDataObj, aCheckSize);
  7630. end;
  7631. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7632. procedure TglBitmapCubeMap.Bind({$IFNDEF OPENGL_ES}const aEnableTexCoordsGen: Boolean;{$ENDIF} const aEnableTextureUnit: Boolean);
  7633. begin
  7634. inherited Bind (aEnableTextureUnit);
  7635. {$IFNDEF OPENGL_ES}
  7636. if aEnableTexCoordsGen then begin
  7637. glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
  7638. glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
  7639. glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
  7640. glEnable(GL_TEXTURE_GEN_S);
  7641. glEnable(GL_TEXTURE_GEN_T);
  7642. glEnable(GL_TEXTURE_GEN_R);
  7643. end;
  7644. {$ENDIF}
  7645. end;
  7646. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7647. procedure TglBitmapCubeMap.Unbind({$IFNDEF OPENGL_ES}const aDisableTexCoordsGen: Boolean;{$ENDIF} const aDisableTextureUnit: Boolean);
  7648. begin
  7649. inherited Unbind(aDisableTextureUnit);
  7650. {$IFNDEF OPENGL_ES}
  7651. if aDisableTexCoordsGen then begin
  7652. glDisable(GL_TEXTURE_GEN_S);
  7653. glDisable(GL_TEXTURE_GEN_T);
  7654. glDisable(GL_TEXTURE_GEN_R);
  7655. end;
  7656. {$ENDIF}
  7657. end;
  7658. {$IFEND}
  7659. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  7660. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7661. //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7662. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7663. type
  7664. TVec = Array[0..2] of Single;
  7665. TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7666. PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
  7667. TglBitmapNormalMapRec = record
  7668. HalfSize : Integer;
  7669. Func: TglBitmapNormalMapGetVectorFunc;
  7670. end;
  7671. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7672. procedure glBitmapNormalMapPosX(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 glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7680. begin
  7681. aVec[0] := - aHalfSize;
  7682. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7683. aVec[2] := aPosition.X + 0.5 - aHalfSize;
  7684. end;
  7685. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7686. procedure glBitmapNormalMapPosY(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 glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7694. begin
  7695. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7696. aVec[1] := - aHalfSize;
  7697. aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
  7698. end;
  7699. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7700. procedure glBitmapNormalMapPosZ(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 glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7708. begin
  7709. aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
  7710. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7711. aVec[2] := - aHalfSize;
  7712. end;
  7713. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7714. procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
  7715. var
  7716. i: Integer;
  7717. Vec: TVec;
  7718. Len: Single;
  7719. begin
  7720. with FuncRec do begin
  7721. with PglBitmapNormalMapRec(Args)^ do begin
  7722. Func(Vec, Position, HalfSize);
  7723. // Normalize
  7724. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  7725. if Len <> 0 then begin
  7726. Vec[0] := Vec[0] * Len;
  7727. Vec[1] := Vec[1] * Len;
  7728. Vec[2] := Vec[2] * Len;
  7729. end;
  7730. // Scale Vector and AddVectro
  7731. Vec[0] := Vec[0] * 0.5 + 0.5;
  7732. Vec[1] := Vec[1] * 0.5 + 0.5;
  7733. Vec[2] := Vec[2] * 0.5 + 0.5;
  7734. end;
  7735. // Set Color
  7736. for i := 0 to 2 do
  7737. Dest.Data.arr[i] := Round(Vec[i] * 255);
  7738. end;
  7739. end;
  7740. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7741. procedure TglBitmapNormalMap.AfterConstruction;
  7742. begin
  7743. inherited;
  7744. {$IFNDEF OPENGL_ES}
  7745. fGenMode := GL_NORMAL_MAP;
  7746. {$ENDIF}
  7747. end;
  7748. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7749. procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aCheckSize: Boolean);
  7750. var
  7751. Rec: TglBitmapNormalMapRec;
  7752. SizeRec: TglBitmapSize;
  7753. DataObj: TglBitmapData;
  7754. begin
  7755. Rec.HalfSize := aSize div 2;
  7756. SizeRec.Fields := [ffX, ffY];
  7757. SizeRec.X := aSize;
  7758. SizeRec.Y := aSize;
  7759. DataObj := TglBitmapData.Create;
  7760. try
  7761. // Positive X
  7762. Rec.Func := glBitmapNormalMapPosX;
  7763. DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
  7764. UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_POSITIVE_X, aCheckSize);
  7765. // Negative X
  7766. Rec.Func := glBitmapNormalMapNegX;
  7767. DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
  7768. UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aCheckSize);
  7769. // Positive Y
  7770. Rec.Func := glBitmapNormalMapPosY;
  7771. DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
  7772. UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aCheckSize);
  7773. // Negative Y
  7774. Rec.Func := glBitmapNormalMapNegY;
  7775. DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
  7776. UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aCheckSize);
  7777. // Positive Z
  7778. Rec.Func := glBitmapNormalMapPosZ;
  7779. DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
  7780. UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aCheckSize);
  7781. // Negative Z
  7782. Rec.Func := glBitmapNormalMapNegZ;
  7783. DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
  7784. UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aCheckSize);
  7785. finally
  7786. FreeAndNil(DataObj);
  7787. end;
  7788. end;
  7789. {$IFEND}
  7790. initialization
  7791. glBitmapSetDefaultFormat (tfEmpty);
  7792. glBitmapSetDefaultMipmap (mmMipmap);
  7793. glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
  7794. glBitmapSetDefaultWrap (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
  7795. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  7796. glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
  7797. {$IFEND}
  7798. glBitmapSetDefaultFreeDataAfterGenTexture(true);
  7799. glBitmapSetDefaultDeleteTextureOnFree (true);
  7800. TFormatDescriptor.Init;
  7801. finalization
  7802. TFormatDescriptor.Finalize;
  7803. end.