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.

8943 lines
318 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 uglcBitmap;
  22. {$I glBitmapConf.inc}
  23. // Delphi Versions
  24. {$IFDEF fpc}
  25. {$MODE Delphi}
  26. {$MINENUMSIZE DEFAULT}
  27. {$IFDEF CPUI386}
  28. {$DEFINE CPU386}
  29. {$ASMMODE INTEL}
  30. {$ENDIF}
  31. {$IFNDEF WINDOWS}
  32. {$linklib c}
  33. {$ENDIF}
  34. {$ENDIF}
  35. // Operation System
  36. {$IF DEFINED(WIN32) or DEFINED(WIN64) or DEFINED(WINDOWS)}
  37. {$DEFINE GLB_WIN}
  38. {$ELSEIF DEFINED(LINUX)}
  39. {$DEFINE GLB_LINUX}
  40. {$IFEND}
  41. // OpenGL ES
  42. {$IF DEFINED(OPENGL_ES_EXT)} {$DEFINE OPENGL_ES_1_1} {$IFEND}
  43. {$IF DEFINED(OPENGL_ES_3_0)} {$DEFINE OPENGL_ES_2_0} {$IFEND}
  44. {$IF DEFINED(OPENGL_ES_2_0)} {$DEFINE OPENGL_ES_1_1} {$IFEND}
  45. {$IF DEFINED(OPENGL_ES_1_1)} {$DEFINE OPENGL_ES} {$IFEND}
  46. // checking define combinations
  47. //SDL Image
  48. {$IFDEF GLB_SDL_IMAGE}
  49. {$IFNDEF GLB_SDL}
  50. {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
  51. {$DEFINE GLB_SDL}
  52. {$ENDIF}
  53. {$IFDEF GLB_LAZ_PNG}
  54. {$MESSAGE warn 'The Lazarus TPortableNetworkGraphics will be ignored because you are using SDL_image.'}
  55. {$undef GLB_LAZ_PNG}
  56. {$ENDIF}
  57. {$IFDEF GLB_PNGIMAGE}
  58. {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
  59. {$undef GLB_PNGIMAGE}
  60. {$ENDIF}
  61. {$IFDEF GLB_LAZ_JPEG}
  62. {$MESSAGE warn 'The Lazarus TJPEGImage will be ignored because you are using SDL_image.'}
  63. {$undef GLB_LAZ_JPEG}
  64. {$ENDIF}
  65. {$IFDEF GLB_DELPHI_JPEG}
  66. {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
  67. {$undef GLB_DELPHI_JPEG}
  68. {$ENDIF}
  69. {$IFDEF GLB_LIB_PNG}
  70. {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
  71. {$undef GLB_LIB_PNG}
  72. {$ENDIF}
  73. {$IFDEF GLB_LIB_JPEG}
  74. {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
  75. {$undef GLB_LIB_JPEG}
  76. {$ENDIF}
  77. {$DEFINE GLB_SUPPORT_PNG_READ}
  78. {$DEFINE GLB_SUPPORT_JPEG_READ}
  79. {$ENDIF}
  80. // Lazarus TPortableNetworkGraphic
  81. {$IFDEF GLB_LAZ_PNG}
  82. {$IFNDEF GLB_LAZARUS}
  83. {$MESSAGE warn 'Lazarus TPortableNetworkGraphic won''t work without Lazarus. Lazarus will be activated.'}
  84. {$DEFINE GLB_LAZARUS}
  85. {$ENDIF}
  86. {$IFDEF GLB_PNGIMAGE}
  87. {$MESSAGE warn 'The pngimage will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
  88. {$undef GLB_PNGIMAGE}
  89. {$ENDIF}
  90. {$IFDEF GLB_LIB_PNG}
  91. {$MESSAGE warn 'The library libPNG will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
  92. {$undef GLB_LIB_PNG}
  93. {$ENDIF}
  94. {$DEFINE GLB_SUPPORT_PNG_READ}
  95. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  96. {$ENDIF}
  97. // PNG Image
  98. {$IFDEF GLB_PNGIMAGE}
  99. {$IFDEF GLB_LIB_PNG}
  100. {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
  101. {$undef GLB_LIB_PNG}
  102. {$ENDIF}
  103. {$DEFINE GLB_SUPPORT_PNG_READ}
  104. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  105. {$ENDIF}
  106. // libPNG
  107. {$IFDEF GLB_LIB_PNG}
  108. {$DEFINE GLB_SUPPORT_PNG_READ}
  109. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  110. {$ENDIF}
  111. // Lazarus TJPEGImage
  112. {$IFDEF GLB_LAZ_JPEG}
  113. {$IFNDEF GLB_LAZARUS}
  114. {$MESSAGE warn 'Lazarus TJPEGImage won''t work without Lazarus. Lazarus will be activated.'}
  115. {$DEFINE GLB_LAZARUS}
  116. {$ENDIF}
  117. {$IFDEF GLB_DELPHI_JPEG}
  118. {$MESSAGE warn 'The Delphi JPEGImage will be ignored if you are using the Lazarus TJPEGImage.'}
  119. {$undef GLB_DELPHI_JPEG}
  120. {$ENDIF}
  121. {$IFDEF GLB_LIB_JPEG}
  122. {$MESSAGE warn 'The library libJPEG will be ignored if you are using the Lazarus TJPEGImage.'}
  123. {$undef GLB_LIB_JPEG}
  124. {$ENDIF}
  125. {$DEFINE GLB_SUPPORT_JPEG_READ}
  126. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  127. {$ENDIF}
  128. // JPEG Image
  129. {$IFDEF GLB_DELPHI_JPEG}
  130. {$IFDEF GLB_LIB_JPEG}
  131. {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
  132. {$undef GLB_LIB_JPEG}
  133. {$ENDIF}
  134. {$DEFINE GLB_SUPPORT_JPEG_READ}
  135. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  136. {$ENDIF}
  137. // libJPEG
  138. {$IFDEF GLB_LIB_JPEG}
  139. {$DEFINE GLB_SUPPORT_JPEG_READ}
  140. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  141. {$ENDIF}
  142. // general options
  143. {$EXTENDEDSYNTAX ON}
  144. {$LONGSTRINGS ON}
  145. {$ALIGN ON}
  146. {$IFNDEF FPC}
  147. {$OPTIMIZATION ON}
  148. {$ENDIF}
  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. tfRGBA8ub4, //< 1 x unsigned byte (red), 1 x unsigned byte (green), 1 x unsigned byte (blue), 1 x unsigned byte (alpha)
  208. tfRGBA8ui1, //< 1 x unsigned int (8bit red, 8bit green, 8bit blue, 8 bit alpha)
  209. tfARGB8ui1, //< 1 x unsigned int (8 bit alpha, 8bit red, 8bit green, 8bit blue)
  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. tfBGRA8ub4, //< 1 x unsigned byte (blue), 1 x unsigned byte (green), 1 x unsigned byte (red), 1 x unsigned byte (alpha)
  229. tfBGRA8ui1, //< 1 x unsigned int (8bit blue, 8bit green, 8bit red, 8bit alpha)
  230. tfABGR8ui1, //< 1 x unsigned int (8bit alpha, 8bit blue, 8bit green, 8bit red)
  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, glGenerateMipmap for 3.0+ or GL_GENERATE_MIPMAP for legacy
  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; overload;
  378. { get the format descriptor by the given format
  379. @param aFormat format to get descriptor for
  380. @return suitable format descriptor or tfEmpty-Descriptor }
  381. class function GetByFormat(const aFormat: TglBitmapFormat): TglBitmapFormatDescriptor; overload;
  382. end;
  383. ////////////////////////////////////////////////////////////////////////////////////////////////////
  384. TglBitmapData = class;
  385. { structure to store data for converting in }
  386. TglBitmapFunctionRec = record
  387. Sender: TglBitmapData; //< texture object that stores the data to convert
  388. Size: TglBitmapSize; //< size of the texture
  389. Position: TglBitmapPixelPosition; //< position of the currently pixel
  390. Source: TglBitmapPixelData; //< pixel data of the current pixel
  391. Dest: TglBitmapPixelData; //< new data of the pixel (must be filled in)
  392. Args: Pointer; //< user defined args that was passed to the convert function
  393. end;
  394. { callback to use for converting texture data }
  395. TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
  396. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  397. { class to store texture data in. used to load, save and
  398. manipulate data before assigned to texture object
  399. all operations on a data object can be done from a background thread }
  400. TglBitmapData = class
  401. private { fields }
  402. fData: PByte; //< texture data
  403. fDimension: TglBitmapSize; //< pixel size of the data
  404. fFormat: TglBitmapFormat; //< format the texture data is stored in
  405. fFilename: String; //< file the data was load from
  406. fScanlines: array of PByte; //< pointer to begin of each line
  407. fHasScanlines: Boolean; //< @true if scanlines are initialized, @false otherwise
  408. private { getter / setter }
  409. { @returns the format descriptor suitable to the texture data format }
  410. function GetFormatDescriptor: TglBitmapFormatDescriptor;
  411. { @returns the width of the texture data (in pixel) or -1 if no data is set }
  412. function GetWidth: Integer;
  413. { @returns the height of the texture data (in pixel) or -1 if no data is set }
  414. function GetHeight: Integer;
  415. { get scanline at index aIndex
  416. @returns Pointer to start of line or @nil }
  417. function GetScanlines(const aIndex: Integer): PByte;
  418. { set new value for the data format. only possible if new format has the same pixel size.
  419. if you want to convert the texture data, see ConvertTo function }
  420. procedure SetFormat(const aValue: TglBitmapFormat);
  421. private { internal misc }
  422. { splits a resource identifier into the resource and it's type
  423. @param aResource resource identifier to split and store name in
  424. @param aResType type of the resource }
  425. procedure PrepareResType(var aResource: String; var aResType: PChar);
  426. { updates scanlines array }
  427. procedure UpdateScanlines;
  428. private { internal load and save }
  429. {$IFDEF GLB_SUPPORT_PNG_READ}
  430. { try to load a PNG from a stream
  431. @param aStream stream to load PNG from
  432. @returns @true on success, @false otherwise }
  433. function LoadPNG(const aStream: TStream): Boolean; virtual;
  434. {$ENDIF}
  435. {$ifdef GLB_SUPPORT_PNG_WRITE}
  436. { save texture data as PNG to stream
  437. @param aStream stream to save data to}
  438. procedure SavePNG(const aStream: TStream); virtual;
  439. {$ENDIF}
  440. {$IFDEF GLB_SUPPORT_JPEG_READ}
  441. { try to load a JPEG from a stream
  442. @param aStream stream to load JPEG from
  443. @returns @true on success, @false otherwise }
  444. function LoadJPEG(const aStream: TStream): Boolean; virtual;
  445. {$ENDIF}
  446. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  447. { save texture data as JPEG to stream
  448. @param aStream stream to save data to}
  449. procedure SaveJPEG(const aStream: TStream); virtual;
  450. {$ENDIF}
  451. { try to load a RAW image from a stream
  452. @param aStream stream to load RAW image from
  453. @returns @true on success, @false otherwise }
  454. function LoadRAW(const aStream: TStream): Boolean;
  455. { save texture data as RAW image to stream
  456. @param aStream stream to save data to}
  457. procedure SaveRAW(const aStream: TStream);
  458. { try to load a BMP from a stream
  459. @param aStream stream to load BMP from
  460. @returns @true on success, @false otherwise }
  461. function LoadBMP(const aStream: TStream): Boolean;
  462. { save texture data as BMP to stream
  463. @param aStream stream to save data to}
  464. procedure SaveBMP(const aStream: TStream);
  465. { try to load a TGA from a stream
  466. @param aStream stream to load TGA from
  467. @returns @true on success, @false otherwise }
  468. function LoadTGA(const aStream: TStream): Boolean;
  469. { save texture data as TGA to stream
  470. @param aStream stream to save data to}
  471. procedure SaveTGA(const aStream: TStream);
  472. { try to load a DDS from a stream
  473. @param aStream stream to load DDS from
  474. @returns @true on success, @false otherwise }
  475. function LoadDDS(const aStream: TStream): Boolean;
  476. { save texture data as DDS to stream
  477. @param aStream stream to save data to}
  478. procedure SaveDDS(const aStream: TStream);
  479. public { properties }
  480. property Data: PByte read fData; //< texture data (be carefull with this!)
  481. property Dimension: TglBitmapSize read fDimension; //< size of the texture data (in pixel)
  482. property Filename: String read fFilename; //< file the data was loaded from
  483. property Width: Integer read GetWidth; //< width of the texture data (in pixel)
  484. property Height: Integer read GetHeight; //< height of the texture data (in pixel)
  485. property Format: TglBitmapFormat read fFormat write SetFormat; //< format the texture data is stored in
  486. property Scanlines[const aIndex: Integer]: PByte read GetScanlines; //< pointer to begin of line at given index or @nil
  487. property FormatDescriptor: TglBitmapFormatDescriptor read GetFormatDescriptor; //< descriptor object that describes the format of the stored data
  488. public { flip }
  489. { flip texture horizontal
  490. @returns @true in success, @false otherwise }
  491. function FlipHorz: Boolean; virtual;
  492. { flip texture vertical
  493. @returns @true in success, @false otherwise }
  494. function FlipVert: Boolean; virtual;
  495. public { load }
  496. { load a texture from a file
  497. @param aFilename file to load texuture from }
  498. procedure LoadFromFile(const aFilename: String);
  499. { load a texture from a stream
  500. @param aStream stream to load texture from }
  501. procedure LoadFromStream(const aStream: TStream); virtual;
  502. { use a function to generate texture data
  503. @param aSize size of the texture
  504. @param aFormat format of the texture data
  505. @param aFunc callback to use for generation
  506. @param aArgs user defined paramaters (use at will) }
  507. procedure LoadFromFunc(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil);
  508. { load a texture from a resource
  509. @param aInstance resource handle
  510. @param aResource resource indentifier
  511. @param aResType resource type (if known) }
  512. procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
  513. { load a texture from a resource id
  514. @param aInstance resource handle
  515. @param aResource resource ID
  516. @param aResType resource type }
  517. procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  518. public { save }
  519. { save texture data to a file
  520. @param aFilename filename to store texture in
  521. @param aFileType file type to store data into }
  522. procedure SaveToFile(const aFilename: String; const aFileType: TglBitmapFileType);
  523. { save texture data to a stream
  524. @param aFilename filename to store texture in
  525. @param aFileType file type to store data into }
  526. procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
  527. public { convert }
  528. { convert texture data using a user defined callback
  529. @param aFunc callback to use for converting
  530. @param aCreateTemp create a temporary buffer to use for converting
  531. @param aArgs user defined paramters (use at will)
  532. @returns @true if converting was successful, @false otherwise }
  533. function Convert(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
  534. { convert texture data using a user defined callback
  535. @param aSource glBitmap to read data from
  536. @param aFunc callback to use for converting
  537. @param aCreateTemp create a temporary buffer to use for converting
  538. @param aFormat format of the new data
  539. @param aArgs user defined paramters (use at will)
  540. @returns @true if converting was successful, @false otherwise }
  541. function Convert(const aSource: TglBitmapData; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  542. const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
  543. { convert texture data using a specific format
  544. @param aFormat new format of texture data
  545. @returns @true if converting was successful, @false otherwise }
  546. function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
  547. {$IFDEF GLB_SDL}
  548. public { SDL }
  549. { assign texture data to SDL surface
  550. @param aSurface SDL surface to write data to
  551. @returns @true on success, @false otherwise }
  552. function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  553. { assign texture data from SDL surface
  554. @param aSurface SDL surface to read data from
  555. @returns @true on success, @false otherwise }
  556. function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  557. { assign alpha channel data to SDL surface
  558. @param aSurface SDL surface to write alpha channel data to
  559. @returns @true on success, @false otherwise }
  560. function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  561. { assign alpha channel data from SDL surface
  562. @param aSurface SDL surface to read data from
  563. @param aFunc callback to use for converting
  564. @param aArgs user defined parameters (use at will)
  565. @returns @true on success, @false otherwise }
  566. function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  567. {$ENDIF}
  568. {$IFDEF GLB_DELPHI}
  569. public { Delphi }
  570. { assign texture data to TBitmap object
  571. @param aBitmap TBitmap to write data to
  572. @returns @true on success, @false otherwise }
  573. function AssignToBitmap(const aBitmap: TBitmap): Boolean;
  574. { assign texture data from TBitmap object
  575. @param aBitmap TBitmap to read data from
  576. @returns @true on success, @false otherwise }
  577. function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  578. { assign alpha channel data to TBitmap object
  579. @param aBitmap TBitmap to write data to
  580. @returns @true on success, @false otherwise }
  581. function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  582. { assign alpha channel data from TBitmap object
  583. @param aBitmap TBitmap to read data from
  584. @param aFunc callback to use for converting
  585. @param aArgs user defined parameters (use at will)
  586. @returns @true on success, @false otherwise }
  587. function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  588. {$ENDIF}
  589. {$IFDEF GLB_LAZARUS}
  590. public { Lazarus }
  591. { assign texture data to TLazIntfImage object
  592. @param aImage TLazIntfImage to write data to
  593. @returns @true on success, @false otherwise }
  594. function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  595. { assign texture data from TLazIntfImage object
  596. @param aImage TLazIntfImage to read data from
  597. @returns @true on success, @false otherwise }
  598. function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  599. { assign alpha channel data to TLazIntfImage object
  600. @param aImage TLazIntfImage to write data to
  601. @returns @true on success, @false otherwise }
  602. function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  603. { assign alpha channel data from TLazIntfImage object
  604. @param aImage TLazIntfImage to read data from
  605. @param aFunc callback to use for converting
  606. @param aArgs user defined parameters (use at will)
  607. @returns @true on success, @false otherwise }
  608. function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  609. {$ENDIF}
  610. public { Alpha }
  611. { load alpha channel data from resource
  612. @param aInstance resource handle
  613. @param aResource resource ID
  614. @param aResType resource type
  615. @param aFunc callback to use for converting
  616. @param aArgs user defined parameters (use at will)
  617. @returns @true on success, @false otherwise }
  618. function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  619. { load alpha channel data from resource ID
  620. @param aInstance resource handle
  621. @param aResourceID resource ID
  622. @param aResType resource type
  623. @param aFunc callback to use for converting
  624. @param aArgs user defined parameters (use at will)
  625. @returns @true on success, @false otherwise }
  626. function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  627. { add alpha channel data from function
  628. @param aFunc callback to get data from
  629. @param aArgs user defined parameters (use at will)
  630. @returns @true on success, @false otherwise }
  631. function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
  632. { add alpha channel data from file (macro for: new glBitmap, LoadFromFile, AddAlphaFromGlBitmap)
  633. @param aFilename file to load alpha channel data from
  634. @param aFunc callback to use for converting
  635. @param aArgs SetFormat user defined parameters (use at will)
  636. @returns @true on success, @false otherwise }
  637. function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  638. { add alpha channel data from stream (macro for: new glBitmap, LoadFromStream, AddAlphaFromGlBitmap)
  639. @param aStream stream to load alpha channel data from
  640. @param aFunc callback to use for converting
  641. @param aArgs user defined parameters (use at will)
  642. @returns @true on success, @false otherwise }
  643. function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  644. { add alpha channel data from existing glBitmap object
  645. @param aBitmap TglBitmap to copy alpha channel data from
  646. @param aFunc callback to use for converting
  647. @param aArgs user defined parameters (use at will)
  648. @returns @true on success, @false otherwise }
  649. function AddAlphaFromDataObj(const aDataObj: TglBitmapData; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  650. { add alpha to pixel if the pixels color is greter than the given color value
  651. @param aRed red threshold (0-255)
  652. @param aGreen green threshold (0-255)
  653. @param aBlue blue threshold (0-255)
  654. @param aDeviatation accepted deviatation (0-255)
  655. @returns @true on success, @false otherwise }
  656. function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
  657. { add alpha to pixel if the pixels color is greter than the given color value
  658. @param aRed red threshold (0-Range.r)
  659. @param aGreen green threshold (0-Range.g)
  660. @param aBlue blue threshold (0-Range.b)
  661. @param aDeviatation accepted deviatation (0-max(Range.rgb))
  662. @returns @true on success, @false otherwise }
  663. function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
  664. { add alpha to pixel if the pixels color is greter than the given color value
  665. @param aRed red threshold (0.0-1.0)
  666. @param aGreen green threshold (0.0-1.0)
  667. @param aBlue blue threshold (0.0-1.0)
  668. @param aDeviatation accepted deviatation (0.0-1.0)
  669. @returns @true on success, @false otherwise }
  670. function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
  671. { add a constand alpha value to all pixels
  672. @param aAlpha alpha value to add (0-255)
  673. @returns @true on success, @false otherwise }
  674. function AddAlphaFromValue(const aAlpha: Byte): Boolean;
  675. { add a constand alpha value to all pixels
  676. @param aAlpha alpha value to add (0-max(Range.rgb))
  677. @returns @true on success, @false otherwise }
  678. function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  679. { add a constand alpha value to all pixels
  680. @param aAlpha alpha value to add (0.0-1.0)
  681. @returns @true on success, @false otherwise }
  682. function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  683. { remove alpha channel
  684. @returns @true on success, @false otherwise }
  685. function RemoveAlpha: Boolean; virtual;
  686. public { fill }
  687. { fill complete texture with one color
  688. @param aRed red color for border (0-255)
  689. @param aGreen green color for border (0-255)
  690. @param aBlue blue color for border (0-255)
  691. @param aAlpha alpha color for border (0-255) }
  692. procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
  693. { fill complete texture with one color
  694. @param aRed red color for border (0-Range.r)
  695. @param aGreen green color for border (0-Range.g)
  696. @param aBlue blue color for border (0-Range.b)
  697. @param aAlpha alpha color for border (0-Range.a) }
  698. procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
  699. { fill complete texture with one color
  700. @param aRed red color for border (0.0-1.0)
  701. @param aGreen green color for border (0.0-1.0)
  702. @param aBlue blue color for border (0.0-1.0)
  703. @param aAlpha alpha color for border (0.0-1.0) }
  704. procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single = 1.0);
  705. public { Misc }
  706. { set data pointer of texture data
  707. @param aData pointer to new texture data
  708. @param aFormat format of the data stored at aData
  709. @param aWidth width of the texture data
  710. @param aHeight height of the texture data }
  711. procedure SetData(const aData: PByte; const aFormat: TglBitmapFormat;
  712. const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;
  713. { create a clone of the current object
  714. @returns clone of this object}
  715. function Clone: TglBitmapData;
  716. { invert color data (bitwise not)
  717. @param aRed invert red channel
  718. @param aGreen invert green channel
  719. @param aBlue invert blue channel
  720. @param aAlpha invert alpha channel }
  721. procedure Invert(const aRed, aGreen, aBlue, aAlpha: Boolean);
  722. { create normal map from texture data
  723. @param aFunc normal map function to generate normalmap with
  724. @param aScale scale of the normale stored in the normal map
  725. @param aUseAlpha generate normalmap from alpha channel data (if present) }
  726. procedure GenerateNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
  727. const aScale: Single = 2; const aUseAlpha: Boolean = false);
  728. public { constructor }
  729. { constructor - creates a texutre data object }
  730. constructor Create; overload;
  731. { constructor - creates a texture data object and loads it from a file
  732. @param aFilename file to load texture from }
  733. constructor Create(const aFileName: String); overload;
  734. { constructor - creates a texture data object and loads it from a stream
  735. @param aStream stream to load texture from }
  736. constructor Create(const aStream: TStream); overload;
  737. { constructor - creates a texture data object with the given size, format and data
  738. @param aSize size of the texture
  739. @param aFormat format of the given data
  740. @param aData texture data - be carefull: the data will now be managed by the texture data object }
  741. constructor Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; aData: PByte = nil); overload;
  742. { constructor - creates a texture data object with the given size and format and uses the given callback to create the data
  743. @param aSize size of the texture
  744. @param aFormat format of the given data
  745. @param aFunc callback to use for generating the data
  746. @param aArgs user defined parameters (use at will) }
  747. constructor Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
  748. { constructor - creates a texture data object and loads it from a resource
  749. @param aInstance resource handle
  750. @param aResource resource indentifier
  751. @param aResType resource type (if known) }
  752. constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
  753. { constructor - creates a texture data object and loads it from a resource
  754. @param aInstance resource handle
  755. @param aResourceID resource ID
  756. @param aResType resource type (if known) }
  757. constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
  758. { destructor }
  759. destructor Destroy; override;
  760. end;
  761. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  762. { base class for all glBitmap classes. used to manage OpenGL texture objects
  763. all operations on a bitmap object must be done from the render thread }
  764. TglBitmap = class
  765. protected
  766. fID: GLuint; //< name of the OpenGL texture object
  767. fTarget: GLuint; //< texture target (e.g. GL_TEXTURE_2D)
  768. fDeleteTextureOnFree: Boolean; //< delete OpenGL texture object when this object is destroyed
  769. // texture properties
  770. fFilterMin: GLenum; //< min filter to apply to the texture
  771. fFilterMag: GLenum; //< mag filter to apply to the texture
  772. fWrapS: GLenum; //< texture wrapping for x axis
  773. fWrapT: GLenum; //< texture wrapping for y axis
  774. fWrapR: GLenum; //< texture wrapping for z axis
  775. fAnisotropic: Integer; //< anisotropic level
  776. fBorderColor: array[0..3] of Single; //< color of the texture border
  777. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  778. //Swizzle
  779. fSwizzle: array[0..3] of GLenum; //< color channel swizzle
  780. {$IFEND}
  781. {$IFNDEF OPENGL_ES}
  782. fIsResident: GLboolean; //< @true if OpenGL texture object has data, @false otherwise
  783. {$ENDIF}
  784. fDimension: TglBitmapSize; //< size of this texture
  785. fMipMap: TglBitmapMipMap; //< mipmap type
  786. // CustomData
  787. fCustomData: Pointer; //< user defined data
  788. fCustomName: String; //< user defined name
  789. fCustomNameW: WideString; //< user defined name
  790. protected
  791. { @returns the actual width of the texture }
  792. function GetWidth: Integer; virtual;
  793. { @returns the actual height of the texture }
  794. function GetHeight: Integer; virtual;
  795. protected
  796. { set a new value for fCustomData }
  797. procedure SetCustomData(const aValue: Pointer);
  798. { set a new value for fCustomName }
  799. procedure SetCustomName(const aValue: String);
  800. { set a new value for fCustomNameW }
  801. procedure SetCustomNameW(const aValue: WideString);
  802. { set new value for fDeleteTextureOnFree }
  803. procedure SetDeleteTextureOnFree(const aValue: Boolean);
  804. { set name of OpenGL texture object }
  805. procedure SetID(const aValue: Cardinal);
  806. { set new value for fMipMap }
  807. procedure SetMipMap(const aValue: TglBitmapMipMap);
  808. { set new value for target }
  809. procedure SetTarget(const aValue: Cardinal);
  810. { set new value for fAnisotrophic }
  811. procedure SetAnisotropic(const aValue: Integer);
  812. protected
  813. { initialize variables }
  814. procedure Init; virtual;
  815. { finalize variables }
  816. procedure Finish; virtual;
  817. { create OpenGL texture object (delete exisiting object if exists) }
  818. procedure CreateID;
  819. { setup texture parameters }
  820. procedure SetupParameters({$IFNDEF OPENGL_ES}out aRealMipMapMode: TglBitmapMipMap{$ENDIF});
  821. protected
  822. property Width: Integer read GetWidth; //< the actual width of the texture
  823. property Height: Integer read GetHeight; //< the actual height of the texture
  824. public
  825. property ID: Cardinal read fID write SetID; //< name of the OpenGL texture object
  826. property Target: Cardinal read fTarget write SetTarget; //< texture target (e.g. GL_TEXTURE_2D)
  827. property DeleteTextureOnFree: Boolean read fDeleteTextureOnFree write SetDeleteTextureOnFree; //< delete texture object when this object is destroyed
  828. property MipMap: TglBitmapMipMap read fMipMap write SetMipMap; //< mipmap type
  829. property Anisotropic: Integer read fAnisotropic write SetAnisotropic; //< anisotropic level
  830. property CustomData: Pointer read fCustomData write SetCustomData; //< user defined data (use at will)
  831. property CustomName: String read fCustomName write SetCustomName; //< user defined name (use at will)
  832. property CustomNameW: WideString read fCustomNameW write SetCustomNameW; //< user defined name (as WideString; use at will)
  833. property Dimension: TglBitmapSize read fDimension; //< size of the texture
  834. {$IFNDEF OPENGL_ES}
  835. property IsResident: GLboolean read fIsResident; //< @true if OpenGL texture object has data, @false otherwise
  836. {$ENDIF}
  837. public
  838. {$IFNDEF OPENGL_ES}
  839. { set the new value for texture border color
  840. @param aRed red color for border (0.0-1.0)
  841. @param aGreen green color for border (0.0-1.0)
  842. @param aBlue blue color for border (0.0-1.0)
  843. @param aAlpha alpha color for border (0.0-1.0) }
  844. procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  845. {$ENDIF}
  846. public
  847. { set new texture filer
  848. @param aMin min filter
  849. @param aMag mag filter }
  850. procedure SetFilter(const aMin, aMag: GLenum);
  851. { set new texture wrapping
  852. @param S texture wrapping for x axis
  853. @param T texture wrapping for y axis
  854. @param R texture wrapping for z axis }
  855. procedure SetWrap(
  856. const S: GLenum = GL_CLAMP_TO_EDGE;
  857. const T: GLenum = GL_CLAMP_TO_EDGE;
  858. const R: GLenum = GL_CLAMP_TO_EDGE);
  859. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  860. { set new swizzle
  861. @param r swizzle for red channel
  862. @param g swizzle for green channel
  863. @param b swizzle for blue channel
  864. @param a swizzle for alpha channel }
  865. procedure SetSwizzle(const r, g, b, a: GLenum);
  866. {$IFEND}
  867. public
  868. { bind texture
  869. @param aEnableTextureUnit enable texture unit for this texture (e.g. glEnable(GL_TEXTURE_2D)) }
  870. procedure Bind({$IFNDEF OPENGL_ES}const aEnableTextureUnit: Boolean = true{$ENDIF}); virtual;
  871. { bind texture
  872. @param aDisableTextureUnit disable texture unit for this texture (e.g. glEnable(GL_TEXTURE_2D)) }
  873. procedure Unbind({$IFNDEF OPENGL_ES}const aDisableTextureUnit: Boolean = true{$ENDIF}); virtual;
  874. { upload texture data from given data object to video card
  875. @param aData texture data object that contains the actual data
  876. @param aCheckSize check size before upload and throw exception if something is wrong }
  877. procedure UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean = true); virtual;
  878. {$IFNDEF OPENGL_ES}
  879. { download texture data from video card and store it into given data object
  880. @returns @true when download was successfull, @false otherwise }
  881. function DownloadData(const aDataObj: TglBitmapData): Boolean; virtual;
  882. {$ENDIF}
  883. public
  884. { constructor - creates an empty texture }
  885. constructor Create; overload;
  886. { constructor - creates an texture object and uploads the given data }
  887. constructor Create(const aData: TglBitmapData); overload;
  888. { destructor }
  889. destructor Destroy; override;
  890. end;
  891. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  892. {$IF NOT DEFINED(OPENGL_ES)}
  893. { wrapper class for 1-dimensional textures (OpenGL target = GL_TEXTURE_1D
  894. all operations on a bitmap object must be done from the render thread }
  895. TglBitmap1D = class(TglBitmap)
  896. protected
  897. { this method is called after constructor and initializes the object }
  898. procedure Init; override;
  899. { upload the texture data to video card
  900. @param aDataObj texture data object that contains the actual data
  901. @param aBuildWithGlu use glu functions to build mipmaps }
  902. procedure UploadDataIntern(const aDataObj: TglBitmapData; const aRealMipMapMode: TglBitmapMipMap);
  903. public
  904. property Width; //< actual with of the texture
  905. { upload texture data from given data object to video card
  906. @param aData texture data object that contains the actual data
  907. @param aCheckSize check size before upload and throw exception if something is wrong }
  908. procedure UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean = true); override;
  909. end;
  910. {$IFEND}
  911. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  912. { wrapper class for 2-dimensional textures (OpenGL target = GL_TEXTURE_2D)
  913. all operations on a bitmap object must be done from the render thread }
  914. TglBitmap2D = class(TglBitmap)
  915. protected
  916. { this method is called after constructor and initializes the object }
  917. procedure Init; override;
  918. { upload the texture data to video card
  919. @param aDataObj texture data object that contains the actual data
  920. @param aTarget target o upload data to (e.g. GL_TEXTURE_2D)
  921. @param aBuildWithGlu use glu functions to build mipmaps }
  922. procedure UploadDataIntern(const aDataObj: TglBitmapData; const aTarget: GLenum
  923. {$IFNDEF OPENGL_ES}; const aRealMipMap: TglBitmapMipMap{$ENDIF});
  924. public
  925. property Width; //< actual width of the texture
  926. property Height; //< actual height of the texture
  927. { upload texture data from given data object to video card
  928. @param aData texture data object that contains the actual data
  929. @param aCheckSize check size before upload and throw exception if something is wrong }
  930. procedure UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean = true); override;
  931. public
  932. { copy a part of the frame buffer to the texture
  933. @param aTop topmost pixel to copy
  934. @param aLeft leftmost pixel to copy
  935. @param aRight rightmost pixel to copy
  936. @param aBottom bottommost pixel to copy
  937. @param aFormat format to store data in
  938. @param aDataObj texture data object to store the data in }
  939. class procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat; const aDataObj: TglBitmapData);
  940. end;
  941. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  942. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  943. { wrapper class for cube maps (OpenGL target = GL_TEXTURE_CUBE_MAP)
  944. all operations on a bitmap object must be done from the render thread }
  945. TglBitmapCubeMap = class(TglBitmap2D)
  946. protected
  947. {$IFNDEF OPENGL_ES}
  948. fGenMode: Integer; //< generation mode for the cube map (e.g. GL_REFLECTION_MAP)
  949. {$ENDIF}
  950. { this method is called after constructor and initializes the object }
  951. procedure Init; override;
  952. public
  953. { upload texture data from given data object to video card
  954. @param aData texture data object that contains the actual data
  955. @param aCheckSize check size before upload and throw exception if something is wrong }
  956. procedure UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean = true); override;
  957. { upload texture data from given data object to video card
  958. @param aData texture data object that contains the actual data
  959. @param aCubeTarget cube map target to upload data to (e.g. GL_TEXTURE_CUBE_MAP_POSITIVE_X)
  960. @param aCheckSize check size before upload and throw exception if something is wrong }
  961. procedure UploadCubeMap(const aDataObj: TglBitmapData; const aCubeTarget: Cardinal; const aCheckSize: Boolean);
  962. { bind texture
  963. @param aEnableTexCoordsGen enable cube map generator
  964. @param aEnableTextureUnit enable texture unit }
  965. procedure Bind({$IFNDEF OPENGL_ES}const aEnableTexCoordsGen: Boolean = true; const aEnableTextureUnit: Boolean = true{$ENDIF}); reintroduce; virtual;
  966. { unbind texture
  967. @param aDisableTexCoordsGen disable cube map generator
  968. @param aDisableTextureUnit disable texture unit }
  969. procedure Unbind({$IFNDEF OPENGL_ES}const aDisableTexCoordsGen: Boolean = true; const aDisableTextureUnit: Boolean = true{$ENDIF}); reintroduce; virtual;
  970. end;
  971. {$IFEND}
  972. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  973. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  974. { wrapper class for cube normal maps
  975. all operations on a bitmap object must be done from the render thread }
  976. TglBitmapNormalMap = class(TglBitmapCubeMap)
  977. public
  978. { this method is called after constructor and initializes the object }
  979. procedure Init; override;
  980. { create cube normal map from texture data and upload it to video card
  981. @param aSize size of each cube map texture
  982. @param aCheckSize check size before upload and throw exception if something is wrong }
  983. procedure GenerateNormalMap(const aSize: Integer = 32; const aCheckSize: Boolean = true);
  984. end;
  985. {$IFEND}
  986. TglcBitmapFormat = TglBitmapFormat;
  987. TglcBitmap2D = TglBitmap2D;
  988. TglcBitmapData = TglBitmapData;
  989. {$IF NOT DEFINED(OPENGL_ES)}
  990. TglcBitmap1D = TglBitmap1D;
  991. TglcBitmapCubeMap = TglBitmapCubeMap;
  992. TglcBitmapNormalMap = TglBitmapNormalMap;
  993. {$ELSEIF DEFINED(OPENGL_ES_2_0)}
  994. TglcBitmapCubeMap = TglBitmapCubeMap;
  995. TglcBitmapNormalMap = TglBitmapNormalMap;
  996. {$IFEND}
  997. const
  998. NULL_SIZE: TglBitmapSize = (Fields: []; X: 0; Y: 0);
  999. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1000. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1001. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1002. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1003. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1004. procedure glBitmapSetDefaultWrap(
  1005. const S: Cardinal = GL_CLAMP_TO_EDGE;
  1006. const T: Cardinal = GL_CLAMP_TO_EDGE;
  1007. const R: Cardinal = GL_CLAMP_TO_EDGE);
  1008. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  1009. procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
  1010. {$IFEND}
  1011. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1012. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1013. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1014. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1015. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  1016. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  1017. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  1018. procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
  1019. {$IFEND}
  1020. function glBitmapSize(X: Integer = -1; Y: Integer = -1): TglBitmapSize;
  1021. function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
  1022. function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
  1023. function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
  1024. function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
  1025. function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
  1026. function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
  1027. function glBitmapCreateTestData(const aFormat: TglBitmapFormat): TglBitmapData;
  1028. {$IFDEF GLB_DELPHI}
  1029. function CreateGrayPalette: HPALETTE;
  1030. {$ENDIF}
  1031. implementation
  1032. uses
  1033. Math, syncobjs, typinfo
  1034. {$IF DEFINED(GLB_SUPPORT_JPEG_READ) AND DEFINED(GLB_LAZ_JPEG)}, FPReadJPEG{$IFEND};
  1035. var
  1036. glBitmapDefaultDeleteTextureOnFree: Boolean;
  1037. glBitmapDefaultFreeDataAfterGenTextures: Boolean;
  1038. glBitmapDefaultFormat: TglBitmapFormat;
  1039. glBitmapDefaultMipmap: TglBitmapMipMap;
  1040. glBitmapDefaultFilterMin: Cardinal;
  1041. glBitmapDefaultFilterMag: Cardinal;
  1042. glBitmapDefaultWrapS: Cardinal;
  1043. glBitmapDefaultWrapT: Cardinal;
  1044. glBitmapDefaultWrapR: Cardinal;
  1045. glDefaultSwizzle: array[0..3] of GLenum;
  1046. ////////////////////////////////////////////////////////////////////////////////////////////////////
  1047. type
  1048. TFormatDescriptor = class(TglBitmapFormatDescriptor)
  1049. public
  1050. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
  1051. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
  1052. function CreateMappingData: Pointer; virtual;
  1053. procedure FreeMappingData(var aMappingData: Pointer); virtual;
  1054. function IsEmpty: Boolean; virtual;
  1055. function MaskMatch(const aMask: TglBitmapRec4ul): Boolean; virtual;
  1056. procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
  1057. constructor Create; virtual;
  1058. public
  1059. class procedure Init;
  1060. class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1061. class function GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1062. class function GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer = 0): TFormatDescriptor;
  1063. class function GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
  1064. class procedure Clear;
  1065. class procedure Finalize;
  1066. end;
  1067. TFormatDescriptorClass = class of TFormatDescriptor;
  1068. TfdEmpty = class(TFormatDescriptor);
  1069. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1070. TfdAlphaUB1 = class(TFormatDescriptor) //1* unsigned byte
  1071. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1072. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1073. end;
  1074. TfdLuminanceUB1 = class(TFormatDescriptor) //1* unsigned byte
  1075. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1076. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1077. end;
  1078. TfdUniversalUB1 = class(TFormatDescriptor) //1* unsigned byte
  1079. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1080. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1081. end;
  1082. TfdLuminanceAlphaUB2 = class(TfdLuminanceUB1) //2* unsigned byte
  1083. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1084. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1085. end;
  1086. TfdRGBub3 = class(TFormatDescriptor) //3* unsigned byte
  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. TfdBGRub3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
  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. TfdRGBAub4 = class(TfdRGBub3) //3* unsigned byte
  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. TfdBGRAub4 = class(TfdBGRub3) //3* unsigned byte (inverse)
  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. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1103. TfdAlphaUS1 = class(TFormatDescriptor) //1* unsigned short
  1104. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1105. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1106. end;
  1107. TfdLuminanceUS1 = class(TFormatDescriptor) //1* unsigned short
  1108. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1109. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1110. end;
  1111. TfdUniversalUS1 = class(TFormatDescriptor) //1* unsigned short
  1112. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1113. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1114. end;
  1115. TfdDepthUS1 = class(TFormatDescriptor) //1* unsigned short
  1116. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1117. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1118. end;
  1119. TfdLuminanceAlphaUS2 = class(TfdLuminanceUS1) //2* unsigned short
  1120. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1121. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1122. end;
  1123. TfdRGBus3 = class(TFormatDescriptor) //3* unsigned short
  1124. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1125. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1126. end;
  1127. TfdBGRus3 = class(TFormatDescriptor) //3* unsigned short (inverse)
  1128. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1129. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1130. end;
  1131. TfdRGBAus4 = class(TfdRGBus3) //4* unsigned short
  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. TfdARGBus4 = class(TfdRGBus3) //4* unsigned short
  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. TfdBGRAus4 = class(TfdBGRus3) //4* unsigned short (inverse)
  1140. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1141. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1142. end;
  1143. TfdABGRus4 = class(TfdBGRus3) //4* unsigned short (inverse)
  1144. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1145. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1146. end;
  1147. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1148. TfdUniversalUI1 = class(TFormatDescriptor) //1* unsigned int
  1149. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1150. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1151. end;
  1152. TfdDepthUI1 = class(TFormatDescriptor) //1* unsigned int
  1153. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1154. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1155. end;
  1156. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1157. TfdAlpha4ub1 = class(TfdAlphaUB1)
  1158. procedure SetValues; override;
  1159. end;
  1160. TfdAlpha8ub1 = class(TfdAlphaUB1)
  1161. procedure SetValues; override;
  1162. end;
  1163. TfdAlpha16us1 = class(TfdAlphaUS1)
  1164. procedure SetValues; override;
  1165. end;
  1166. TfdLuminance4ub1 = class(TfdLuminanceUB1)
  1167. procedure SetValues; override;
  1168. end;
  1169. TfdLuminance8ub1 = class(TfdLuminanceUB1)
  1170. procedure SetValues; override;
  1171. end;
  1172. TfdLuminance16us1 = class(TfdLuminanceUS1)
  1173. procedure SetValues; override;
  1174. end;
  1175. TfdLuminance4Alpha4ub2 = class(TfdLuminanceAlphaUB2)
  1176. procedure SetValues; override;
  1177. end;
  1178. TfdLuminance6Alpha2ub2 = class(TfdLuminanceAlphaUB2)
  1179. procedure SetValues; override;
  1180. end;
  1181. TfdLuminance8Alpha8ub2 = class(TfdLuminanceAlphaUB2)
  1182. procedure SetValues; override;
  1183. end;
  1184. TfdLuminance12Alpha4us2 = class(TfdLuminanceAlphaUS2)
  1185. procedure SetValues; override;
  1186. end;
  1187. TfdLuminance16Alpha16us2 = class(TfdLuminanceAlphaUS2)
  1188. procedure SetValues; override;
  1189. end;
  1190. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1191. TfdR3G3B2ub1 = class(TfdUniversalUB1)
  1192. procedure SetValues; override;
  1193. end;
  1194. TfdRGBX4us1 = class(TfdUniversalUS1)
  1195. procedure SetValues; override;
  1196. end;
  1197. TfdXRGB4us1 = class(TfdUniversalUS1)
  1198. procedure SetValues; override;
  1199. end;
  1200. TfdR5G6B5us1 = class(TfdUniversalUS1)
  1201. procedure SetValues; override;
  1202. end;
  1203. TfdRGB5X1us1 = class(TfdUniversalUS1)
  1204. procedure SetValues; override;
  1205. end;
  1206. TfdX1RGB5us1 = class(TfdUniversalUS1)
  1207. procedure SetValues; override;
  1208. end;
  1209. TfdRGB8ub3 = class(TfdRGBub3)
  1210. procedure SetValues; override;
  1211. end;
  1212. TfdRGBX8ui1 = class(TfdUniversalUI1)
  1213. procedure SetValues; override;
  1214. end;
  1215. TfdXRGB8ui1 = class(TfdUniversalUI1)
  1216. procedure SetValues; override;
  1217. end;
  1218. TfdRGB10X2ui1 = class(TfdUniversalUI1)
  1219. procedure SetValues; override;
  1220. end;
  1221. TfdX2RGB10ui1 = class(TfdUniversalUI1)
  1222. procedure SetValues; override;
  1223. end;
  1224. TfdRGB16us3 = class(TfdRGBus3)
  1225. procedure SetValues; override;
  1226. end;
  1227. TfdRGBA4us1 = class(TfdUniversalUS1)
  1228. procedure SetValues; override;
  1229. end;
  1230. TfdARGB4us1 = class(TfdUniversalUS1)
  1231. procedure SetValues; override;
  1232. end;
  1233. TfdRGB5A1us1 = class(TfdUniversalUS1)
  1234. procedure SetValues; override;
  1235. end;
  1236. TfdA1RGB5us1 = class(TfdUniversalUS1)
  1237. procedure SetValues; override;
  1238. end;
  1239. TfdRGBA8ui1 = class(TfdUniversalUI1)
  1240. procedure SetValues; override;
  1241. end;
  1242. TfdARGB8ui1 = class(TfdUniversalUI1)
  1243. procedure SetValues; override;
  1244. end;
  1245. TfdRGBA8ub4 = class(TfdRGBAub4)
  1246. procedure SetValues; override;
  1247. end;
  1248. TfdRGB10A2ui1 = class(TfdUniversalUI1)
  1249. procedure SetValues; override;
  1250. end;
  1251. TfdA2RGB10ui1 = class(TfdUniversalUI1)
  1252. procedure SetValues; override;
  1253. end;
  1254. TfdRGBA16us4 = class(TfdRGBAus4)
  1255. procedure SetValues; override;
  1256. end;
  1257. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1258. TfdBGRX4us1 = class(TfdUniversalUS1)
  1259. procedure SetValues; override;
  1260. end;
  1261. TfdXBGR4us1 = class(TfdUniversalUS1)
  1262. procedure SetValues; override;
  1263. end;
  1264. TfdB5G6R5us1 = class(TfdUniversalUS1)
  1265. procedure SetValues; override;
  1266. end;
  1267. TfdBGR5X1us1 = class(TfdUniversalUS1)
  1268. procedure SetValues; override;
  1269. end;
  1270. TfdX1BGR5us1 = class(TfdUniversalUS1)
  1271. procedure SetValues; override;
  1272. end;
  1273. TfdBGR8ub3 = class(TfdBGRub3)
  1274. procedure SetValues; override;
  1275. end;
  1276. TfdBGRX8ui1 = class(TfdUniversalUI1)
  1277. procedure SetValues; override;
  1278. end;
  1279. TfdXBGR8ui1 = class(TfdUniversalUI1)
  1280. procedure SetValues; override;
  1281. end;
  1282. TfdBGR10X2ui1 = class(TfdUniversalUI1)
  1283. procedure SetValues; override;
  1284. end;
  1285. TfdX2BGR10ui1 = class(TfdUniversalUI1)
  1286. procedure SetValues; override;
  1287. end;
  1288. TfdBGR16us3 = class(TfdBGRus3)
  1289. procedure SetValues; override;
  1290. end;
  1291. TfdBGRA4us1 = class(TfdUniversalUS1)
  1292. procedure SetValues; override;
  1293. end;
  1294. TfdABGR4us1 = class(TfdUniversalUS1)
  1295. procedure SetValues; override;
  1296. end;
  1297. TfdBGR5A1us1 = class(TfdUniversalUS1)
  1298. procedure SetValues; override;
  1299. end;
  1300. TfdA1BGR5us1 = class(TfdUniversalUS1)
  1301. procedure SetValues; override;
  1302. end;
  1303. TfdBGRA8ui1 = class(TfdUniversalUI1)
  1304. procedure SetValues; override;
  1305. end;
  1306. TfdABGR8ui1 = class(TfdUniversalUI1)
  1307. procedure SetValues; override;
  1308. end;
  1309. TfdBGRA8ub4 = class(TfdBGRAub4)
  1310. procedure SetValues; override;
  1311. end;
  1312. TfdBGR10A2ui1 = class(TfdUniversalUI1)
  1313. procedure SetValues; override;
  1314. end;
  1315. TfdA2BGR10ui1 = class(TfdUniversalUI1)
  1316. procedure SetValues; override;
  1317. end;
  1318. TfdBGRA16us4 = class(TfdBGRAus4)
  1319. procedure SetValues; override;
  1320. end;
  1321. TfdDepth16us1 = class(TfdDepthUS1)
  1322. procedure SetValues; override;
  1323. end;
  1324. TfdDepth24ui1 = class(TfdDepthUI1)
  1325. procedure SetValues; override;
  1326. end;
  1327. TfdDepth32ui1 = class(TfdDepthUI1)
  1328. procedure SetValues; override;
  1329. end;
  1330. TfdS3tcDtx1RGBA = class(TFormatDescriptor)
  1331. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1332. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1333. procedure SetValues; override;
  1334. end;
  1335. TfdS3tcDtx3RGBA = class(TFormatDescriptor)
  1336. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1337. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1338. procedure SetValues; override;
  1339. end;
  1340. TfdS3tcDtx5RGBA = class(TFormatDescriptor)
  1341. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1342. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1343. procedure SetValues; override;
  1344. end;
  1345. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1346. TbmpBitfieldFormat = class(TFormatDescriptor)
  1347. public
  1348. procedure SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul); overload;
  1349. procedure SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
  1350. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1351. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1352. end;
  1353. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1354. TbmpColorTableEnty = packed record
  1355. b, g, r, a: Byte;
  1356. end;
  1357. TbmpColorTable = array of TbmpColorTableEnty;
  1358. TbmpColorTableFormat = class(TFormatDescriptor)
  1359. private
  1360. fColorTable: TbmpColorTable;
  1361. protected
  1362. procedure SetValues; override;
  1363. public
  1364. property ColorTable: TbmpColorTable read fColorTable write fColorTable;
  1365. procedure SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
  1366. procedure CalcValues;
  1367. procedure CreateColorTable;
  1368. function CreateMappingData: Pointer; override;
  1369. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1370. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1371. destructor Destroy; override;
  1372. end;
  1373. const
  1374. LUMINANCE_WEIGHT_R = 0.30;
  1375. LUMINANCE_WEIGHT_G = 0.59;
  1376. LUMINANCE_WEIGHT_B = 0.11;
  1377. ALPHA_WEIGHT_R = 0.30;
  1378. ALPHA_WEIGHT_G = 0.59;
  1379. ALPHA_WEIGHT_B = 0.11;
  1380. DEPTH_WEIGHT_R = 0.333333333;
  1381. DEPTH_WEIGHT_G = 0.333333333;
  1382. DEPTH_WEIGHT_B = 0.333333333;
  1383. FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
  1384. TfdEmpty,
  1385. TfdAlpha4ub1,
  1386. TfdAlpha8ub1,
  1387. TfdAlpha16us1,
  1388. TfdLuminance4ub1,
  1389. TfdLuminance8ub1,
  1390. TfdLuminance16us1,
  1391. TfdLuminance4Alpha4ub2,
  1392. TfdLuminance6Alpha2ub2,
  1393. TfdLuminance8Alpha8ub2,
  1394. TfdLuminance12Alpha4us2,
  1395. TfdLuminance16Alpha16us2,
  1396. TfdR3G3B2ub1,
  1397. TfdRGBX4us1,
  1398. TfdXRGB4us1,
  1399. TfdR5G6B5us1,
  1400. TfdRGB5X1us1,
  1401. TfdX1RGB5us1,
  1402. TfdRGB8ub3,
  1403. TfdRGBX8ui1,
  1404. TfdXRGB8ui1,
  1405. TfdRGB10X2ui1,
  1406. TfdX2RGB10ui1,
  1407. TfdRGB16us3,
  1408. TfdRGBA4us1,
  1409. TfdARGB4us1,
  1410. TfdRGB5A1us1,
  1411. TfdA1RGB5us1,
  1412. TfdRGBA8ub4,
  1413. TfdRGBA8ui1,
  1414. TfdARGB8ui1,
  1415. TfdRGB10A2ui1,
  1416. TfdA2RGB10ui1,
  1417. TfdRGBA16us4,
  1418. TfdBGRX4us1,
  1419. TfdXBGR4us1,
  1420. TfdB5G6R5us1,
  1421. TfdBGR5X1us1,
  1422. TfdX1BGR5us1,
  1423. TfdBGR8ub3,
  1424. TfdBGRX8ui1,
  1425. TfdXBGR8ui1,
  1426. TfdBGR10X2ui1,
  1427. TfdX2BGR10ui1,
  1428. TfdBGR16us3,
  1429. TfdBGRA4us1,
  1430. TfdABGR4us1,
  1431. TfdBGR5A1us1,
  1432. TfdA1BGR5us1,
  1433. TfdBGRA8ub4,
  1434. TfdBGRA8ui1,
  1435. TfdABGR8ui1,
  1436. TfdBGR10A2ui1,
  1437. TfdA2BGR10ui1,
  1438. TfdBGRA16us4,
  1439. TfdDepth16us1,
  1440. TfdDepth24ui1,
  1441. TfdDepth32ui1,
  1442. TfdS3tcDtx1RGBA,
  1443. TfdS3tcDtx3RGBA,
  1444. TfdS3tcDtx5RGBA
  1445. );
  1446. var
  1447. FormatDescriptorCS: TCriticalSection;
  1448. FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
  1449. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1450. constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
  1451. begin
  1452. inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1453. end;
  1454. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1455. constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
  1456. begin
  1457. inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1458. end;
  1459. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1460. function glBitmapSize(X: Integer; Y: Integer): TglBitmapSize;
  1461. begin
  1462. result.Fields := [];
  1463. if (X >= 0) then
  1464. result.Fields := result.Fields + [ffX];
  1465. if (Y >= 0) then
  1466. result.Fields := result.Fields + [ffY];
  1467. result.X := Max(0, X);
  1468. result.Y := Max(0, Y);
  1469. end;
  1470. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1471. function glBitmapPosition(X: Integer; Y: Integer): TglBitmapPixelPosition;
  1472. begin
  1473. result := glBitmapSize(X, Y);
  1474. end;
  1475. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1476. function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
  1477. begin
  1478. result.r := r;
  1479. result.g := g;
  1480. result.b := b;
  1481. result.a := a;
  1482. end;
  1483. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1484. function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
  1485. begin
  1486. result.r := r;
  1487. result.g := g;
  1488. result.b := b;
  1489. result.a := a;
  1490. end;
  1491. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1492. function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
  1493. begin
  1494. result.r := r;
  1495. result.g := g;
  1496. result.b := b;
  1497. result.a := a;
  1498. end;
  1499. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1500. function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
  1501. var
  1502. i: Integer;
  1503. begin
  1504. result := false;
  1505. for i := 0 to high(r1.arr) do
  1506. if (r1.arr[i] <> r2.arr[i]) then
  1507. exit;
  1508. result := true;
  1509. end;
  1510. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1511. function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
  1512. var
  1513. i: Integer;
  1514. begin
  1515. result := false;
  1516. for i := 0 to high(r1.arr) do
  1517. if (r1.arr[i] <> r2.arr[i]) then
  1518. exit;
  1519. result := true;
  1520. end;
  1521. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1522. function glBitmapCreateTestData(const aFormat: TglBitmapFormat): TglBitmapData;
  1523. var
  1524. desc: TFormatDescriptor;
  1525. p, tmp: PByte;
  1526. x, y, i: Integer;
  1527. md: Pointer;
  1528. px: TglBitmapPixelData;
  1529. begin
  1530. result := nil;
  1531. desc := TFormatDescriptor.Get(aFormat);
  1532. if (desc.IsCompressed) or (desc.glFormat = 0) then
  1533. exit;
  1534. p := GetMemory(ceil(25 * desc.BytesPerPixel)); // 5 x 5 pixel
  1535. md := desc.CreateMappingData;
  1536. try
  1537. tmp := p;
  1538. desc.PreparePixel(px);
  1539. for y := 0 to 4 do
  1540. for x := 0 to 4 do begin
  1541. px.Data := glBitmapRec4ui(0, 0, 0, 0);
  1542. for i := 0 to 3 do begin
  1543. if ((y < 3) and (y = i)) or
  1544. ((y = 3) and (i < 3)) or
  1545. ((y = 4) and (i = 3))
  1546. then
  1547. px.Data.arr[i] := Trunc(px.Range.arr[i] / 4 * x)
  1548. else if ((y < 4) and (i = 3)) or
  1549. ((y = 4) and (i < 3))
  1550. then
  1551. px.Data.arr[i] := px.Range.arr[i]
  1552. else
  1553. px.Data.arr[i] := 0; //px.Range.arr[i];
  1554. end;
  1555. desc.Map(px, tmp, md);
  1556. end;
  1557. finally
  1558. desc.FreeMappingData(md);
  1559. end;
  1560. result := TglBitmapData.Create(glBitmapPosition(5, 5), aFormat, p);
  1561. end;
  1562. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1563. function glBitmapShiftRec(const r, g, b, a: Byte): TglBitmapRec4ub;
  1564. begin
  1565. result.r := r;
  1566. result.g := g;
  1567. result.b := b;
  1568. result.a := a;
  1569. end;
  1570. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1571. function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
  1572. begin
  1573. result := [];
  1574. if (aFormat in [
  1575. //8bpp
  1576. tfAlpha4ub1, tfAlpha8ub1,
  1577. tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1,
  1578. //16bpp
  1579. tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
  1580. tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
  1581. tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1,
  1582. //24bpp
  1583. tfBGR8ub3, tfRGB8ub3,
  1584. //32bpp
  1585. tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
  1586. tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1])
  1587. then
  1588. result := result + [ ftBMP ];
  1589. if (aFormat in [
  1590. //8bbp
  1591. tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1,
  1592. //16bbp
  1593. tfAlpha16us1, tfLuminance16us1,
  1594. tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
  1595. tfX1RGB5us1, tfARGB4us1, tfA1RGB5us1, tfDepth16us1,
  1596. //24bbp
  1597. tfBGR8ub3,
  1598. //32bbp
  1599. tfX2RGB10ui1, tfARGB8ui1, tfBGRA8ub4, tfA2RGB10ui1,
  1600. tfDepth24ui1, tfDepth32ui1])
  1601. then
  1602. result := result + [ftTGA];
  1603. if not (aFormat in [tfEmpty, tfRGB16us3, tfBGR16us3]) then
  1604. result := result + [ftDDS];
  1605. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  1606. if aFormat in [
  1607. tfAlpha8ub1, tfLuminance8ub1, tfLuminance8Alpha8ub2,
  1608. tfRGB8ub3, tfRGBA8ui1,
  1609. tfBGR8ub3, tfBGRA8ui1] then
  1610. result := result + [ftPNG];
  1611. {$ENDIF}
  1612. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  1613. if aFormat in [tfAlpha8ub1, tfLuminance8ub1, tfRGB8ub3, tfBGR8ub3] then
  1614. result := result + [ftJPEG];
  1615. {$ENDIF}
  1616. end;
  1617. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1618. function IsPowerOfTwo(aNumber: Integer): Boolean;
  1619. begin
  1620. while (aNumber and 1) = 0 do
  1621. aNumber := aNumber shr 1;
  1622. result := aNumber = 1;
  1623. end;
  1624. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1625. function GetTopMostBit(aBitSet: QWord): Integer;
  1626. begin
  1627. result := 0;
  1628. while aBitSet > 0 do begin
  1629. inc(result);
  1630. aBitSet := aBitSet shr 1;
  1631. end;
  1632. end;
  1633. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1634. function CountSetBits(aBitSet: QWord): Integer;
  1635. begin
  1636. result := 0;
  1637. while aBitSet > 0 do begin
  1638. if (aBitSet and 1) = 1 then
  1639. inc(result);
  1640. aBitSet := aBitSet shr 1;
  1641. end;
  1642. end;
  1643. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1644. function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1645. begin
  1646. result := Trunc(
  1647. LUMINANCE_WEIGHT_R * aPixel.Data.r +
  1648. LUMINANCE_WEIGHT_G * aPixel.Data.g +
  1649. LUMINANCE_WEIGHT_B * aPixel.Data.b);
  1650. end;
  1651. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1652. function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1653. begin
  1654. result := Trunc(
  1655. DEPTH_WEIGHT_R * aPixel.Data.r +
  1656. DEPTH_WEIGHT_G * aPixel.Data.g +
  1657. DEPTH_WEIGHT_B * aPixel.Data.b);
  1658. end;
  1659. {$IFDEF GLB_SDL_IMAGE}
  1660. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1661. // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1662. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1663. function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
  1664. begin
  1665. result := TStream(context^.unknown.data1).Seek(offset, whence);
  1666. end;
  1667. function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
  1668. begin
  1669. result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
  1670. end;
  1671. function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
  1672. begin
  1673. result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
  1674. end;
  1675. function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
  1676. begin
  1677. result := 0;
  1678. end;
  1679. function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
  1680. begin
  1681. result := SDL_AllocRW;
  1682. if result = nil then
  1683. raise EglBitmap.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
  1684. result^.seek := glBitmapRWseek;
  1685. result^.read := glBitmapRWread;
  1686. result^.write := glBitmapRWwrite;
  1687. result^.close := glBitmapRWclose;
  1688. result^.unknown.data1 := Stream;
  1689. end;
  1690. {$ENDIF}
  1691. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1692. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1693. begin
  1694. glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
  1695. end;
  1696. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1697. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1698. begin
  1699. glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
  1700. end;
  1701. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1702. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1703. begin
  1704. glBitmapDefaultMipmap := aValue;
  1705. end;
  1706. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1707. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1708. begin
  1709. glBitmapDefaultFormat := aFormat;
  1710. end;
  1711. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1712. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1713. begin
  1714. glBitmapDefaultFilterMin := aMin;
  1715. glBitmapDefaultFilterMag := aMag;
  1716. end;
  1717. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1718. procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
  1719. begin
  1720. glBitmapDefaultWrapS := S;
  1721. glBitmapDefaultWrapT := T;
  1722. glBitmapDefaultWrapR := R;
  1723. end;
  1724. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1725. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  1726. procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
  1727. begin
  1728. glDefaultSwizzle[0] := r;
  1729. glDefaultSwizzle[1] := g;
  1730. glDefaultSwizzle[2] := b;
  1731. glDefaultSwizzle[3] := a;
  1732. end;
  1733. {$IFEND}
  1734. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1735. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1736. begin
  1737. result := glBitmapDefaultDeleteTextureOnFree;
  1738. end;
  1739. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1740. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1741. begin
  1742. result := glBitmapDefaultFreeDataAfterGenTextures;
  1743. end;
  1744. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1745. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1746. begin
  1747. result := glBitmapDefaultMipmap;
  1748. end;
  1749. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1750. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1751. begin
  1752. result := glBitmapDefaultFormat;
  1753. end;
  1754. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1755. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  1756. begin
  1757. aMin := glBitmapDefaultFilterMin;
  1758. aMag := glBitmapDefaultFilterMag;
  1759. end;
  1760. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1761. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  1762. begin
  1763. S := glBitmapDefaultWrapS;
  1764. T := glBitmapDefaultWrapT;
  1765. R := glBitmapDefaultWrapR;
  1766. end;
  1767. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  1768. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1769. procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
  1770. begin
  1771. r := glDefaultSwizzle[0];
  1772. g := glDefaultSwizzle[1];
  1773. b := glDefaultSwizzle[2];
  1774. a := glDefaultSwizzle[3];
  1775. end;
  1776. {$IFEND}
  1777. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1778. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1779. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1780. function TFormatDescriptor.CreateMappingData: Pointer;
  1781. begin
  1782. result := nil;
  1783. end;
  1784. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1785. procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
  1786. begin
  1787. //DUMMY
  1788. end;
  1789. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1790. function TFormatDescriptor.IsEmpty: Boolean;
  1791. begin
  1792. result := (fFormat = tfEmpty);
  1793. end;
  1794. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1795. function TFormatDescriptor.MaskMatch(const aMask: TglBitmapRec4ul): Boolean;
  1796. var
  1797. i: Integer;
  1798. m: TglBitmapRec4ul;
  1799. begin
  1800. result := false;
  1801. if (aMask.r = 0) and (aMask.g = 0) and (aMask.b = 0) and (aMask.a = 0) then
  1802. raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
  1803. m := Mask;
  1804. for i := 0 to 3 do
  1805. if (aMask.arr[i] <> m.arr[i]) then
  1806. exit;
  1807. result := true;
  1808. end;
  1809. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1810. procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
  1811. begin
  1812. FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
  1813. aPixel.Data := Range;
  1814. aPixel.Format := fFormat;
  1815. aPixel.Range := Range;
  1816. end;
  1817. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1818. constructor TFormatDescriptor.Create;
  1819. begin
  1820. inherited Create;
  1821. end;
  1822. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1823. //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1824. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1825. procedure TfdAlphaUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1826. begin
  1827. aData^ := aPixel.Data.a;
  1828. inc(aData);
  1829. end;
  1830. procedure TfdAlphaUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1831. begin
  1832. aPixel.Data.r := 0;
  1833. aPixel.Data.g := 0;
  1834. aPixel.Data.b := 0;
  1835. aPixel.Data.a := aData^;
  1836. inc(aData);
  1837. end;
  1838. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1839. //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1840. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1841. procedure TfdLuminanceUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1842. begin
  1843. aData^ := LuminanceWeight(aPixel);
  1844. inc(aData);
  1845. end;
  1846. procedure TfdLuminanceUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1847. begin
  1848. aPixel.Data.r := aData^;
  1849. aPixel.Data.g := aData^;
  1850. aPixel.Data.b := aData^;
  1851. aPixel.Data.a := 0;
  1852. inc(aData);
  1853. end;
  1854. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1855. //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1856. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1857. procedure TfdUniversalUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1858. var
  1859. i: Integer;
  1860. begin
  1861. aData^ := 0;
  1862. for i := 0 to 3 do
  1863. if (Range.arr[i] > 0) then
  1864. aData^ := aData^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
  1865. inc(aData);
  1866. end;
  1867. procedure TfdUniversalUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1868. var
  1869. i: Integer;
  1870. begin
  1871. for i := 0 to 3 do
  1872. aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and Range.arr[i];
  1873. inc(aData);
  1874. end;
  1875. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1876. //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1877. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1878. procedure TfdLuminanceAlphaUB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1879. begin
  1880. inherited Map(aPixel, aData, aMapData);
  1881. aData^ := aPixel.Data.a;
  1882. inc(aData);
  1883. end;
  1884. procedure TfdLuminanceAlphaUB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1885. begin
  1886. inherited Unmap(aData, aPixel, aMapData);
  1887. aPixel.Data.a := aData^;
  1888. inc(aData);
  1889. end;
  1890. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1891. //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1892. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1893. procedure TfdRGBub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1894. begin
  1895. aData^ := aPixel.Data.r;
  1896. inc(aData);
  1897. aData^ := aPixel.Data.g;
  1898. inc(aData);
  1899. aData^ := aPixel.Data.b;
  1900. inc(aData);
  1901. end;
  1902. procedure TfdRGBub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1903. begin
  1904. aPixel.Data.r := aData^;
  1905. inc(aData);
  1906. aPixel.Data.g := aData^;
  1907. inc(aData);
  1908. aPixel.Data.b := aData^;
  1909. inc(aData);
  1910. aPixel.Data.a := 0;
  1911. end;
  1912. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1913. //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1914. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1915. procedure TfdBGRub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1916. begin
  1917. aData^ := aPixel.Data.b;
  1918. inc(aData);
  1919. aData^ := aPixel.Data.g;
  1920. inc(aData);
  1921. aData^ := aPixel.Data.r;
  1922. inc(aData);
  1923. end;
  1924. procedure TfdBGRub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1925. begin
  1926. aPixel.Data.b := aData^;
  1927. inc(aData);
  1928. aPixel.Data.g := aData^;
  1929. inc(aData);
  1930. aPixel.Data.r := aData^;
  1931. inc(aData);
  1932. aPixel.Data.a := 0;
  1933. end;
  1934. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1935. //TfdRGBA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1936. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1937. procedure TfdRGBAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1938. begin
  1939. inherited Map(aPixel, aData, aMapData);
  1940. aData^ := aPixel.Data.a;
  1941. inc(aData);
  1942. end;
  1943. procedure TfdRGBAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1944. begin
  1945. inherited Unmap(aData, aPixel, aMapData);
  1946. aPixel.Data.a := aData^;
  1947. inc(aData);
  1948. end;
  1949. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1950. //TfdBGRA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1951. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1952. procedure TfdBGRAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1953. begin
  1954. inherited Map(aPixel, aData, aMapData);
  1955. aData^ := aPixel.Data.a;
  1956. inc(aData);
  1957. end;
  1958. procedure TfdBGRAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1959. begin
  1960. inherited Unmap(aData, aPixel, aMapData);
  1961. aPixel.Data.a := aData^;
  1962. inc(aData);
  1963. end;
  1964. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1965. //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1966. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1967. procedure TfdAlphaUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1968. begin
  1969. PWord(aData)^ := aPixel.Data.a;
  1970. inc(aData, 2);
  1971. end;
  1972. procedure TfdAlphaUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1973. begin
  1974. aPixel.Data.r := 0;
  1975. aPixel.Data.g := 0;
  1976. aPixel.Data.b := 0;
  1977. aPixel.Data.a := PWord(aData)^;
  1978. inc(aData, 2);
  1979. end;
  1980. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1981. //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1982. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1983. procedure TfdLuminanceUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1984. begin
  1985. PWord(aData)^ := LuminanceWeight(aPixel);
  1986. inc(aData, 2);
  1987. end;
  1988. procedure TfdLuminanceUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1989. begin
  1990. aPixel.Data.r := PWord(aData)^;
  1991. aPixel.Data.g := PWord(aData)^;
  1992. aPixel.Data.b := PWord(aData)^;
  1993. aPixel.Data.a := 0;
  1994. inc(aData, 2);
  1995. end;
  1996. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1997. //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1998. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1999. procedure TfdUniversalUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2000. var
  2001. i: Integer;
  2002. begin
  2003. PWord(aData)^ := 0;
  2004. for i := 0 to 3 do
  2005. if (Range.arr[i] > 0) then
  2006. PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
  2007. inc(aData, 2);
  2008. end;
  2009. procedure TfdUniversalUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2010. var
  2011. i: Integer;
  2012. begin
  2013. for i := 0 to 3 do
  2014. aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and Range.arr[i];
  2015. inc(aData, 2);
  2016. end;
  2017. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2018. //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2019. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2020. procedure TfdDepthUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2021. begin
  2022. PWord(aData)^ := DepthWeight(aPixel);
  2023. inc(aData, 2);
  2024. end;
  2025. procedure TfdDepthUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2026. begin
  2027. aPixel.Data.r := PWord(aData)^;
  2028. aPixel.Data.g := PWord(aData)^;
  2029. aPixel.Data.b := PWord(aData)^;
  2030. aPixel.Data.a := PWord(aData)^;;
  2031. inc(aData, 2);
  2032. end;
  2033. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2034. //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2035. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2036. procedure TfdLuminanceAlphaUS2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2037. begin
  2038. inherited Map(aPixel, aData, aMapData);
  2039. PWord(aData)^ := aPixel.Data.a;
  2040. inc(aData, 2);
  2041. end;
  2042. procedure TfdLuminanceAlphaUS2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2043. begin
  2044. inherited Unmap(aData, aPixel, aMapData);
  2045. aPixel.Data.a := PWord(aData)^;
  2046. inc(aData, 2);
  2047. end;
  2048. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2049. //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2050. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2051. procedure TfdRGBus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2052. begin
  2053. PWord(aData)^ := aPixel.Data.r;
  2054. inc(aData, 2);
  2055. PWord(aData)^ := aPixel.Data.g;
  2056. inc(aData, 2);
  2057. PWord(aData)^ := aPixel.Data.b;
  2058. inc(aData, 2);
  2059. end;
  2060. procedure TfdRGBus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2061. begin
  2062. aPixel.Data.r := PWord(aData)^;
  2063. inc(aData, 2);
  2064. aPixel.Data.g := PWord(aData)^;
  2065. inc(aData, 2);
  2066. aPixel.Data.b := PWord(aData)^;
  2067. inc(aData, 2);
  2068. aPixel.Data.a := 0;
  2069. end;
  2070. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2071. //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2072. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2073. procedure TfdBGRus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2074. begin
  2075. PWord(aData)^ := aPixel.Data.b;
  2076. inc(aData, 2);
  2077. PWord(aData)^ := aPixel.Data.g;
  2078. inc(aData, 2);
  2079. PWord(aData)^ := aPixel.Data.r;
  2080. inc(aData, 2);
  2081. end;
  2082. procedure TfdBGRus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2083. begin
  2084. aPixel.Data.b := PWord(aData)^;
  2085. inc(aData, 2);
  2086. aPixel.Data.g := PWord(aData)^;
  2087. inc(aData, 2);
  2088. aPixel.Data.r := PWord(aData)^;
  2089. inc(aData, 2);
  2090. aPixel.Data.a := 0;
  2091. end;
  2092. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2093. //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2094. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2095. procedure TfdRGBAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2096. begin
  2097. inherited Map(aPixel, aData, aMapData);
  2098. PWord(aData)^ := aPixel.Data.a;
  2099. inc(aData, 2);
  2100. end;
  2101. procedure TfdRGBAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2102. begin
  2103. inherited Unmap(aData, aPixel, aMapData);
  2104. aPixel.Data.a := PWord(aData)^;
  2105. inc(aData, 2);
  2106. end;
  2107. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2108. //TfdARGB_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2109. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2110. procedure TfdARGBus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2111. begin
  2112. PWord(aData)^ := aPixel.Data.a;
  2113. inc(aData, 2);
  2114. inherited Map(aPixel, aData, aMapData);
  2115. end;
  2116. procedure TfdARGBus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2117. begin
  2118. aPixel.Data.a := PWord(aData)^;
  2119. inc(aData, 2);
  2120. inherited Unmap(aData, aPixel, aMapData);
  2121. end;
  2122. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2123. //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2124. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2125. procedure TfdBGRAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2126. begin
  2127. inherited Map(aPixel, aData, aMapData);
  2128. PWord(aData)^ := aPixel.Data.a;
  2129. inc(aData, 2);
  2130. end;
  2131. procedure TfdBGRAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2132. begin
  2133. inherited Unmap(aData, aPixel, aMapData);
  2134. aPixel.Data.a := PWord(aData)^;
  2135. inc(aData, 2);
  2136. end;
  2137. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2138. //TfdABGR_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2139. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2140. procedure TfdABGRus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2141. begin
  2142. PWord(aData)^ := aPixel.Data.a;
  2143. inc(aData, 2);
  2144. inherited Map(aPixel, aData, aMapData);
  2145. end;
  2146. procedure TfdABGRus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2147. begin
  2148. aPixel.Data.a := PWord(aData)^;
  2149. inc(aData, 2);
  2150. inherited Unmap(aData, aPixel, aMapData);
  2151. end;
  2152. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2153. //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2154. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2155. procedure TfdUniversalUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2156. var
  2157. i: Integer;
  2158. begin
  2159. PCardinal(aData)^ := 0;
  2160. for i := 0 to 3 do
  2161. if (Range.arr[i] > 0) then
  2162. PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
  2163. inc(aData, 4);
  2164. end;
  2165. procedure TfdUniversalUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2166. var
  2167. i: Integer;
  2168. begin
  2169. for i := 0 to 3 do
  2170. aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and Range.arr[i];
  2171. inc(aData, 2);
  2172. end;
  2173. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2174. //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2175. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2176. procedure TfdDepthUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2177. begin
  2178. PCardinal(aData)^ := DepthWeight(aPixel);
  2179. inc(aData, 4);
  2180. end;
  2181. procedure TfdDepthUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2182. begin
  2183. aPixel.Data.r := PCardinal(aData)^;
  2184. aPixel.Data.g := PCardinal(aData)^;
  2185. aPixel.Data.b := PCardinal(aData)^;
  2186. aPixel.Data.a := PCardinal(aData)^;
  2187. inc(aData, 4);
  2188. end;
  2189. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2190. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2191. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2192. procedure TfdAlpha4ub1.SetValues;
  2193. begin
  2194. inherited SetValues;
  2195. fBitsPerPixel := 8;
  2196. fFormat := tfAlpha4ub1;
  2197. fWithAlpha := tfAlpha4ub1;
  2198. fPrecision := glBitmapRec4ub(0, 0, 0, 8);
  2199. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2200. {$IFNDEF OPENGL_ES}
  2201. fOpenGLFormat := tfAlpha4ub1;
  2202. fglFormat := GL_ALPHA;
  2203. fglInternalFormat := GL_ALPHA4;
  2204. fglDataFormat := GL_UNSIGNED_BYTE;
  2205. {$ELSE}
  2206. fOpenGLFormat := tfAlpha8ub1;
  2207. {$ENDIF}
  2208. end;
  2209. procedure TfdAlpha8ub1.SetValues;
  2210. begin
  2211. inherited SetValues;
  2212. fBitsPerPixel := 8;
  2213. fFormat := tfAlpha8ub1;
  2214. fWithAlpha := tfAlpha8ub1;
  2215. fPrecision := glBitmapRec4ub(0, 0, 0, 8);
  2216. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2217. fOpenGLFormat := tfAlpha8ub1;
  2218. fglFormat := GL_ALPHA;
  2219. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_ALPHA8{$ELSE}GL_ALPHA{$ENDIF};
  2220. fglDataFormat := GL_UNSIGNED_BYTE;
  2221. end;
  2222. procedure TfdAlpha16us1.SetValues;
  2223. begin
  2224. inherited SetValues;
  2225. fBitsPerPixel := 16;
  2226. fFormat := tfAlpha16us1;
  2227. fWithAlpha := tfAlpha16us1;
  2228. fPrecision := glBitmapRec4ub(0, 0, 0, 16);
  2229. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2230. {$IFNDEF OPENGL_ES}
  2231. fOpenGLFormat := tfAlpha16us1;
  2232. fglFormat := GL_ALPHA;
  2233. fglInternalFormat := GL_ALPHA16;
  2234. fglDataFormat := GL_UNSIGNED_SHORT;
  2235. {$ELSE}
  2236. fOpenGLFormat := tfAlpha8ub1;
  2237. {$ENDIF}
  2238. end;
  2239. procedure TfdLuminance4ub1.SetValues;
  2240. begin
  2241. inherited SetValues;
  2242. fBitsPerPixel := 8;
  2243. fFormat := tfLuminance4ub1;
  2244. fWithAlpha := tfLuminance4Alpha4ub2;
  2245. fWithoutAlpha := tfLuminance4ub1;
  2246. fPrecision := glBitmapRec4ub(8, 8, 8, 0);
  2247. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2248. {$IFNDEF OPENGL_ES}
  2249. fOpenGLFormat := tfLuminance4ub1;
  2250. fglFormat := GL_LUMINANCE;
  2251. fglInternalFormat := GL_LUMINANCE4;
  2252. fglDataFormat := GL_UNSIGNED_BYTE;
  2253. {$ELSE}
  2254. fOpenGLFormat := tfLuminance8ub1;
  2255. {$ENDIF}
  2256. end;
  2257. procedure TfdLuminance8ub1.SetValues;
  2258. begin
  2259. inherited SetValues;
  2260. fBitsPerPixel := 8;
  2261. fFormat := tfLuminance8ub1;
  2262. fWithAlpha := tfLuminance8Alpha8ub2;
  2263. fWithoutAlpha := tfLuminance8ub1;
  2264. fOpenGLFormat := tfLuminance8ub1;
  2265. fPrecision := glBitmapRec4ub(8, 8, 8, 0);
  2266. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2267. fglFormat := GL_LUMINANCE;
  2268. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8{$ELSE}GL_LUMINANCE{$ENDIF};
  2269. fglDataFormat := GL_UNSIGNED_BYTE;
  2270. end;
  2271. procedure TfdLuminance16us1.SetValues;
  2272. begin
  2273. inherited SetValues;
  2274. fBitsPerPixel := 16;
  2275. fFormat := tfLuminance16us1;
  2276. fWithAlpha := tfLuminance16Alpha16us2;
  2277. fWithoutAlpha := tfLuminance16us1;
  2278. fPrecision := glBitmapRec4ub(16, 16, 16, 0);
  2279. fShift := glBitmapRec4ub( 0, 0, 0, 0);
  2280. {$IFNDEF OPENGL_ES}
  2281. fOpenGLFormat := tfLuminance16us1;
  2282. fglFormat := GL_LUMINANCE;
  2283. fglInternalFormat := GL_LUMINANCE16;
  2284. fglDataFormat := GL_UNSIGNED_SHORT;
  2285. {$ELSE}
  2286. fOpenGLFormat := tfLuminance8ub1;
  2287. {$ENDIF}
  2288. end;
  2289. procedure TfdLuminance4Alpha4ub2.SetValues;
  2290. begin
  2291. inherited SetValues;
  2292. fBitsPerPixel := 16;
  2293. fFormat := tfLuminance4Alpha4ub2;
  2294. fWithAlpha := tfLuminance4Alpha4ub2;
  2295. fWithoutAlpha := tfLuminance4ub1;
  2296. fPrecision := glBitmapRec4ub(8, 8, 8, 8);
  2297. fShift := glBitmapRec4ub(0, 0, 0, 8);
  2298. {$IFNDEF OPENGL_ES}
  2299. fOpenGLFormat := tfLuminance4Alpha4ub2;
  2300. fglFormat := GL_LUMINANCE_ALPHA;
  2301. fglInternalFormat := GL_LUMINANCE4_ALPHA4;
  2302. fglDataFormat := GL_UNSIGNED_BYTE;
  2303. {$ELSE}
  2304. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2305. {$ENDIF}
  2306. end;
  2307. procedure TfdLuminance6Alpha2ub2.SetValues;
  2308. begin
  2309. inherited SetValues;
  2310. fBitsPerPixel := 16;
  2311. fFormat := tfLuminance6Alpha2ub2;
  2312. fWithAlpha := tfLuminance6Alpha2ub2;
  2313. fWithoutAlpha := tfLuminance8ub1;
  2314. fPrecision := glBitmapRec4ub(8, 8, 8, 8);
  2315. fShift := glBitmapRec4ub(0, 0, 0, 8);
  2316. {$IFNDEF OPENGL_ES}
  2317. fOpenGLFormat := tfLuminance6Alpha2ub2;
  2318. fglFormat := GL_LUMINANCE_ALPHA;
  2319. fglInternalFormat := GL_LUMINANCE6_ALPHA2;
  2320. fglDataFormat := GL_UNSIGNED_BYTE;
  2321. {$ELSE}
  2322. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2323. {$ENDIF}
  2324. end;
  2325. procedure TfdLuminance8Alpha8ub2.SetValues;
  2326. begin
  2327. inherited SetValues;
  2328. fBitsPerPixel := 16;
  2329. fFormat := tfLuminance8Alpha8ub2;
  2330. fWithAlpha := tfLuminance8Alpha8ub2;
  2331. fWithoutAlpha := tfLuminance8ub1;
  2332. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2333. fPrecision := glBitmapRec4ub(8, 8, 8, 8);
  2334. fShift := glBitmapRec4ub(0, 0, 0, 8);
  2335. fglFormat := GL_LUMINANCE_ALPHA;
  2336. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8_ALPHA8{$ELSE}GL_LUMINANCE_ALPHA{$ENDIF};
  2337. fglDataFormat := GL_UNSIGNED_BYTE;
  2338. end;
  2339. procedure TfdLuminance12Alpha4us2.SetValues;
  2340. begin
  2341. inherited SetValues;
  2342. fBitsPerPixel := 32;
  2343. fFormat := tfLuminance12Alpha4us2;
  2344. fWithAlpha := tfLuminance12Alpha4us2;
  2345. fWithoutAlpha := tfLuminance16us1;
  2346. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  2347. fShift := glBitmapRec4ub( 0, 0, 0, 16);
  2348. {$IFNDEF OPENGL_ES}
  2349. fOpenGLFormat := tfLuminance12Alpha4us2;
  2350. fglFormat := GL_LUMINANCE_ALPHA;
  2351. fglInternalFormat := GL_LUMINANCE12_ALPHA4;
  2352. fglDataFormat := GL_UNSIGNED_SHORT;
  2353. {$ELSE}
  2354. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2355. {$ENDIF}
  2356. end;
  2357. procedure TfdLuminance16Alpha16us2.SetValues;
  2358. begin
  2359. inherited SetValues;
  2360. fBitsPerPixel := 32;
  2361. fFormat := tfLuminance16Alpha16us2;
  2362. fWithAlpha := tfLuminance16Alpha16us2;
  2363. fWithoutAlpha := tfLuminance16us1;
  2364. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  2365. fShift := glBitmapRec4ub( 0, 0, 0, 16);
  2366. {$IFNDEF OPENGL_ES}
  2367. fOpenGLFormat := tfLuminance16Alpha16us2;
  2368. fglFormat := GL_LUMINANCE_ALPHA;
  2369. fglInternalFormat := GL_LUMINANCE16_ALPHA16;
  2370. fglDataFormat := GL_UNSIGNED_SHORT;
  2371. {$ELSE}
  2372. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2373. {$ENDIF}
  2374. end;
  2375. procedure TfdR3G3B2ub1.SetValues;
  2376. begin
  2377. inherited SetValues;
  2378. fBitsPerPixel := 8;
  2379. fFormat := tfR3G3B2ub1;
  2380. fWithAlpha := tfRGBA4us1;
  2381. fWithoutAlpha := tfR3G3B2ub1;
  2382. fRGBInverted := tfEmpty;
  2383. fPrecision := glBitmapRec4ub(3, 3, 2, 0);
  2384. fShift := glBitmapRec4ub(5, 2, 0, 0);
  2385. {$IFNDEF OPENGL_ES}
  2386. fOpenGLFormat := tfR3G3B2ub1;
  2387. fglFormat := GL_RGB;
  2388. fglInternalFormat := GL_R3_G3_B2;
  2389. fglDataFormat := GL_UNSIGNED_BYTE_3_3_2;
  2390. {$ELSE}
  2391. fOpenGLFormat := tfR5G6B5us1;
  2392. {$ENDIF}
  2393. end;
  2394. procedure TfdRGBX4us1.SetValues;
  2395. begin
  2396. inherited SetValues;
  2397. fBitsPerPixel := 16;
  2398. fFormat := tfRGBX4us1;
  2399. fWithAlpha := tfRGBA4us1;
  2400. fWithoutAlpha := tfRGBX4us1;
  2401. fRGBInverted := tfBGRX4us1;
  2402. fPrecision := glBitmapRec4ub( 4, 4, 4, 0);
  2403. fShift := glBitmapRec4ub(12, 8, 4, 0);
  2404. {$IFNDEF OPENGL_ES}
  2405. fOpenGLFormat := tfRGBX4us1;
  2406. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2407. fglInternalFormat := GL_RGB4;
  2408. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  2409. {$ELSE}
  2410. fOpenGLFormat := tfR5G6B5us1;
  2411. {$ENDIF}
  2412. end;
  2413. procedure TfdXRGB4us1.SetValues;
  2414. begin
  2415. inherited SetValues;
  2416. fBitsPerPixel := 16;
  2417. fFormat := tfXRGB4us1;
  2418. fWithAlpha := tfARGB4us1;
  2419. fWithoutAlpha := tfXRGB4us1;
  2420. fRGBInverted := tfXBGR4us1;
  2421. fPrecision := glBitmapRec4ub(4, 4, 4, 0);
  2422. fShift := glBitmapRec4ub(8, 4, 0, 0);
  2423. {$IFNDEF OPENGL_ES}
  2424. fOpenGLFormat := tfXRGB4us1;
  2425. fglFormat := GL_BGRA;
  2426. fglInternalFormat := GL_RGB4;
  2427. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2428. {$ELSE}
  2429. fOpenGLFormat := tfR5G6B5us1;
  2430. {$ENDIF}
  2431. end;
  2432. procedure TfdR5G6B5us1.SetValues;
  2433. begin
  2434. inherited SetValues;
  2435. fBitsPerPixel := 16;
  2436. fFormat := tfR5G6B5us1;
  2437. fWithAlpha := tfRGB5A1us1;
  2438. fWithoutAlpha := tfR5G6B5us1;
  2439. fRGBInverted := tfB5G6R5us1;
  2440. fPrecision := glBitmapRec4ub( 5, 6, 5, 0);
  2441. fShift := glBitmapRec4ub(11, 5, 0, 0);
  2442. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  2443. fOpenGLFormat := tfR5G6B5us1;
  2444. fglFormat := GL_RGB;
  2445. fglInternalFormat := GL_RGB565;
  2446. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5;
  2447. {$ELSE}
  2448. fOpenGLFormat := tfRGB8ub3;
  2449. {$IFEND}
  2450. end;
  2451. procedure TfdRGB5X1us1.SetValues;
  2452. begin
  2453. inherited SetValues;
  2454. fBitsPerPixel := 16;
  2455. fFormat := tfRGB5X1us1;
  2456. fWithAlpha := tfRGB5A1us1;
  2457. fWithoutAlpha := tfRGB5X1us1;
  2458. fRGBInverted := tfBGR5X1us1;
  2459. fPrecision := glBitmapRec4ub( 5, 5, 5, 0);
  2460. fShift := glBitmapRec4ub(11, 6, 1, 0);
  2461. {$IFNDEF OPENGL_ES}
  2462. fOpenGLFormat := tfRGB5X1us1;
  2463. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2464. fglInternalFormat := GL_RGB5;
  2465. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  2466. {$ELSE}
  2467. fOpenGLFormat := tfR5G6B5us1;
  2468. {$ENDIF}
  2469. end;
  2470. procedure TfdX1RGB5us1.SetValues;
  2471. begin
  2472. inherited SetValues;
  2473. fBitsPerPixel := 16;
  2474. fFormat := tfX1RGB5us1;
  2475. fWithAlpha := tfA1RGB5us1;
  2476. fWithoutAlpha := tfX1RGB5us1;
  2477. fRGBInverted := tfX1BGR5us1;
  2478. fPrecision := glBitmapRec4ub( 5, 5, 5, 0);
  2479. fShift := glBitmapRec4ub(10, 5, 0, 0);
  2480. {$IFNDEF OPENGL_ES}
  2481. fOpenGLFormat := tfX1RGB5us1;
  2482. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2483. fglInternalFormat := GL_RGB5;
  2484. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2485. {$ELSE}
  2486. fOpenGLFormat := tfR5G6B5us1;
  2487. {$ENDIF}
  2488. end;
  2489. procedure TfdRGB8ub3.SetValues;
  2490. begin
  2491. inherited SetValues;
  2492. fBitsPerPixel := 24;
  2493. fFormat := tfRGB8ub3;
  2494. fWithAlpha := tfRGBA8ub4;
  2495. fWithoutAlpha := tfRGB8ub3;
  2496. fRGBInverted := tfBGR8ub3;
  2497. fPrecision := glBitmapRec4ub(8, 8, 8, 0);
  2498. fShift := glBitmapRec4ub(0, 8, 16, 0);
  2499. fOpenGLFormat := tfRGB8ub3;
  2500. fglFormat := GL_RGB;
  2501. fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGB8{$ELSE}GL_RGB{$IFEND};
  2502. fglDataFormat := GL_UNSIGNED_BYTE;
  2503. end;
  2504. procedure TfdRGBX8ui1.SetValues;
  2505. begin
  2506. inherited SetValues;
  2507. fBitsPerPixel := 32;
  2508. fFormat := tfRGBX8ui1;
  2509. fWithAlpha := tfRGBA8ui1;
  2510. fWithoutAlpha := tfRGBX8ui1;
  2511. fRGBInverted := tfBGRX8ui1;
  2512. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  2513. fShift := glBitmapRec4ub(24, 16, 8, 0);
  2514. {$IFNDEF OPENGL_ES}
  2515. fOpenGLFormat := tfRGBX8ui1;
  2516. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2517. fglInternalFormat := GL_RGB8;
  2518. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  2519. {$ELSE}
  2520. fOpenGLFormat := tfRGB8ub3;
  2521. {$ENDIF}
  2522. end;
  2523. procedure TfdXRGB8ui1.SetValues;
  2524. begin
  2525. inherited SetValues;
  2526. fBitsPerPixel := 32;
  2527. fFormat := tfXRGB8ui1;
  2528. fWithAlpha := tfXRGB8ui1;
  2529. fWithoutAlpha := tfXRGB8ui1;
  2530. fOpenGLFormat := tfXRGB8ui1;
  2531. fRGBInverted := tfXBGR8ui1;
  2532. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  2533. fShift := glBitmapRec4ub(16, 8, 0, 0);
  2534. {$IFNDEF OPENGL_ES}
  2535. fOpenGLFormat := tfXRGB8ui1;
  2536. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2537. fglInternalFormat := GL_RGB8;
  2538. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  2539. {$ELSE}
  2540. fOpenGLFormat := tfRGB8ub3;
  2541. {$ENDIF}
  2542. end;
  2543. procedure TfdRGB10X2ui1.SetValues;
  2544. begin
  2545. inherited SetValues;
  2546. fBitsPerPixel := 32;
  2547. fFormat := tfRGB10X2ui1;
  2548. fWithAlpha := tfRGB10A2ui1;
  2549. fWithoutAlpha := tfRGB10X2ui1;
  2550. fRGBInverted := tfBGR10X2ui1;
  2551. fPrecision := glBitmapRec4ub(10, 10, 10, 0);
  2552. fShift := glBitmapRec4ub(22, 12, 2, 0);
  2553. {$IFNDEF OPENGL_ES}
  2554. fOpenGLFormat := tfRGB10X2ui1;
  2555. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2556. fglInternalFormat := GL_RGB10;
  2557. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  2558. {$ELSE}
  2559. fOpenGLFormat := tfRGB16us3;
  2560. {$ENDIF}
  2561. end;
  2562. procedure TfdX2RGB10ui1.SetValues;
  2563. begin
  2564. inherited SetValues;
  2565. fBitsPerPixel := 32;
  2566. fFormat := tfX2RGB10ui1;
  2567. fWithAlpha := tfA2RGB10ui1;
  2568. fWithoutAlpha := tfX2RGB10ui1;
  2569. fRGBInverted := tfX2BGR10ui1;
  2570. fPrecision := glBitmapRec4ub(10, 10, 10, 0);
  2571. fShift := glBitmapRec4ub(20, 10, 0, 0);
  2572. {$IFNDEF OPENGL_ES}
  2573. fOpenGLFormat := tfX2RGB10ui1;
  2574. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2575. fglInternalFormat := GL_RGB10;
  2576. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2577. {$ELSE}
  2578. fOpenGLFormat := tfRGB16us3;
  2579. {$ENDIF}
  2580. end;
  2581. procedure TfdRGB16us3.SetValues;
  2582. begin
  2583. inherited SetValues;
  2584. fBitsPerPixel := 48;
  2585. fFormat := tfRGB16us3;
  2586. fWithAlpha := tfRGBA16us4;
  2587. fWithoutAlpha := tfRGB16us3;
  2588. fRGBInverted := tfBGR16us3;
  2589. fPrecision := glBitmapRec4ub(16, 16, 16, 0);
  2590. fShift := glBitmapRec4ub( 0, 16, 32, 0);
  2591. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  2592. fOpenGLFormat := tfRGB16us3;
  2593. fglFormat := GL_RGB;
  2594. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGB16{$ELSE}GL_RGB16UI{$ENDIF};
  2595. fglDataFormat := GL_UNSIGNED_SHORT;
  2596. {$ELSE}
  2597. fOpenGLFormat := tfRGB8ub3;
  2598. {$IFEND}
  2599. end;
  2600. procedure TfdRGBA4us1.SetValues;
  2601. begin
  2602. inherited SetValues;
  2603. fBitsPerPixel := 16;
  2604. fFormat := tfRGBA4us1;
  2605. fWithAlpha := tfRGBA4us1;
  2606. fWithoutAlpha := tfRGBX4us1;
  2607. fOpenGLFormat := tfRGBA4us1;
  2608. fRGBInverted := tfBGRA4us1;
  2609. fPrecision := glBitmapRec4ub( 4, 4, 4, 4);
  2610. fShift := glBitmapRec4ub(12, 8, 4, 0);
  2611. fglFormat := GL_RGBA;
  2612. fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA4{$ELSE}GL_RGBA{$IFEND};
  2613. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  2614. end;
  2615. procedure TfdARGB4us1.SetValues;
  2616. begin
  2617. inherited SetValues;
  2618. fBitsPerPixel := 16;
  2619. fFormat := tfARGB4us1;
  2620. fWithAlpha := tfARGB4us1;
  2621. fWithoutAlpha := tfXRGB4us1;
  2622. fRGBInverted := tfABGR4us1;
  2623. fPrecision := glBitmapRec4ub( 4, 4, 4, 4);
  2624. fShift := glBitmapRec4ub( 8, 4, 0, 12);
  2625. {$IFNDEF OPENGL_ES}
  2626. fOpenGLFormat := tfARGB4us1;
  2627. fglFormat := GL_BGRA;
  2628. fglInternalFormat := GL_RGBA4;
  2629. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2630. {$ELSE}
  2631. fOpenGLFormat := tfRGBA4us1;
  2632. {$ENDIF}
  2633. end;
  2634. procedure TfdRGB5A1us1.SetValues;
  2635. begin
  2636. inherited SetValues;
  2637. fBitsPerPixel := 16;
  2638. fFormat := tfRGB5A1us1;
  2639. fWithAlpha := tfRGB5A1us1;
  2640. fWithoutAlpha := tfRGB5X1us1;
  2641. fOpenGLFormat := tfRGB5A1us1;
  2642. fRGBInverted := tfBGR5A1us1;
  2643. fPrecision := glBitmapRec4ub( 5, 5, 5, 1);
  2644. fShift := glBitmapRec4ub(11, 6, 1, 0);
  2645. fglFormat := GL_RGBA;
  2646. fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}GL_RGB5_A1{$ELSE}GL_RGBA{$IFEND};
  2647. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  2648. end;
  2649. procedure TfdA1RGB5us1.SetValues;
  2650. begin
  2651. inherited SetValues;
  2652. fBitsPerPixel := 16;
  2653. fFormat := tfA1RGB5us1;
  2654. fWithAlpha := tfA1RGB5us1;
  2655. fWithoutAlpha := tfX1RGB5us1;
  2656. fRGBInverted := tfA1BGR5us1;
  2657. fPrecision := glBitmapRec4ub( 5, 5, 5, 1);
  2658. fShift := glBitmapRec4ub(10, 5, 0, 15);
  2659. {$IFNDEF OPENGL_ES}
  2660. fOpenGLFormat := tfA1RGB5us1;
  2661. fglFormat := GL_BGRA;
  2662. fglInternalFormat := GL_RGB5_A1;
  2663. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2664. {$ELSE}
  2665. fOpenGLFormat := tfRGB5A1us1;
  2666. {$ENDIF}
  2667. end;
  2668. procedure TfdRGBA8ui1.SetValues;
  2669. begin
  2670. inherited SetValues;
  2671. fBitsPerPixel := 32;
  2672. fFormat := tfRGBA8ui1;
  2673. fWithAlpha := tfRGBA8ui1;
  2674. fWithoutAlpha := tfRGBX8ui1;
  2675. fRGBInverted := tfBGRA8ui1;
  2676. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  2677. fShift := glBitmapRec4ub(24, 16, 8, 0);
  2678. {$IFNDEF OPENGL_ES}
  2679. fOpenGLFormat := tfRGBA8ui1;
  2680. fglFormat := GL_RGBA;
  2681. fglInternalFormat := GL_RGBA8;
  2682. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  2683. {$ELSE}
  2684. fOpenGLFormat := tfRGBA8ub4;
  2685. {$ENDIF}
  2686. end;
  2687. procedure TfdARGB8ui1.SetValues;
  2688. begin
  2689. inherited SetValues;
  2690. fBitsPerPixel := 32;
  2691. fFormat := tfARGB8ui1;
  2692. fWithAlpha := tfARGB8ui1;
  2693. fWithoutAlpha := tfXRGB8ui1;
  2694. fRGBInverted := tfABGR8ui1;
  2695. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  2696. fShift := glBitmapRec4ub(16, 8, 0, 24);
  2697. {$IFNDEF OPENGL_ES}
  2698. fOpenGLFormat := tfARGB8ui1;
  2699. fglFormat := GL_BGRA;
  2700. fglInternalFormat := GL_RGBA8;
  2701. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  2702. {$ELSE}
  2703. fOpenGLFormat := tfRGBA8ub4;
  2704. {$ENDIF}
  2705. end;
  2706. procedure TfdRGBA8ub4.SetValues;
  2707. begin
  2708. inherited SetValues;
  2709. fBitsPerPixel := 32;
  2710. fFormat := tfRGBA8ub4;
  2711. fWithAlpha := tfRGBA8ub4;
  2712. fWithoutAlpha := tfRGB8ub3;
  2713. fOpenGLFormat := tfRGBA8ub4;
  2714. fRGBInverted := tfBGRA8ub4;
  2715. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  2716. fShift := glBitmapRec4ub( 0, 8, 16, 24);
  2717. fglFormat := GL_RGBA;
  2718. fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA8{$ELSE}GL_RGBA{$IFEND};
  2719. fglDataFormat := GL_UNSIGNED_BYTE;
  2720. end;
  2721. procedure TfdRGB10A2ui1.SetValues;
  2722. begin
  2723. inherited SetValues;
  2724. fBitsPerPixel := 32;
  2725. fFormat := tfRGB10A2ui1;
  2726. fWithAlpha := tfRGB10A2ui1;
  2727. fWithoutAlpha := tfRGB10X2ui1;
  2728. fRGBInverted := tfBGR10A2ui1;
  2729. fPrecision := glBitmapRec4ub(10, 10, 10, 2);
  2730. fShift := glBitmapRec4ub(22, 12, 2, 0);
  2731. {$IFNDEF OPENGL_ES}
  2732. fOpenGLFormat := tfRGB10A2ui1;
  2733. fglFormat := GL_RGBA;
  2734. fglInternalFormat := GL_RGB10_A2;
  2735. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  2736. {$ELSE}
  2737. fOpenGLFormat := tfA2RGB10ui1;
  2738. {$ENDIF}
  2739. end;
  2740. procedure TfdA2RGB10ui1.SetValues;
  2741. begin
  2742. inherited SetValues;
  2743. fBitsPerPixel := 32;
  2744. fFormat := tfA2RGB10ui1;
  2745. fWithAlpha := tfA2RGB10ui1;
  2746. fWithoutAlpha := tfX2RGB10ui1;
  2747. fRGBInverted := tfA2BGR10ui1;
  2748. fPrecision := glBitmapRec4ub(10, 10, 10, 2);
  2749. fShift := glBitmapRec4ub(20, 10, 0, 30);
  2750. {$IF NOT DEFINED(OPENGL_ES)}
  2751. fOpenGLFormat := tfA2RGB10ui1;
  2752. fglFormat := GL_BGRA;
  2753. fglInternalFormat := GL_RGB10_A2;
  2754. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2755. {$ELSEIF DEFINED(OPENGL_ES_3_0)}
  2756. fOpenGLFormat := tfA2RGB10ui1;
  2757. fglFormat := GL_RGBA;
  2758. fglInternalFormat := GL_RGB10_A2;
  2759. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2760. {$ELSE}
  2761. fOpenGLFormat := tfRGBA8ui1;
  2762. {$IFEND}
  2763. end;
  2764. procedure TfdRGBA16us4.SetValues;
  2765. begin
  2766. inherited SetValues;
  2767. fBitsPerPixel := 64;
  2768. fFormat := tfRGBA16us4;
  2769. fWithAlpha := tfRGBA16us4;
  2770. fWithoutAlpha := tfRGB16us3;
  2771. fRGBInverted := tfBGRA16us4;
  2772. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  2773. fShift := glBitmapRec4ub( 0, 16, 32, 48);
  2774. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  2775. fOpenGLFormat := tfRGBA16us4;
  2776. fglFormat := GL_RGBA;
  2777. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGBA16{$ELSE}GL_RGBA16UI{$ENDIF};
  2778. fglDataFormat := GL_UNSIGNED_SHORT;
  2779. {$ELSE}
  2780. fOpenGLFormat := tfRGBA8ub4;
  2781. {$IFEND}
  2782. end;
  2783. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2784. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2785. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2786. procedure TfdBGRX4us1.SetValues;
  2787. begin
  2788. inherited SetValues;
  2789. fBitsPerPixel := 16;
  2790. fFormat := tfBGRX4us1;
  2791. fWithAlpha := tfBGRA4us1;
  2792. fWithoutAlpha := tfBGRX4us1;
  2793. fRGBInverted := tfRGBX4us1;
  2794. fPrecision := glBitmapRec4ub( 4, 4, 4, 0);
  2795. fShift := glBitmapRec4ub( 4, 8, 12, 0);
  2796. {$IFNDEF OPENGL_ES}
  2797. fOpenGLFormat := tfBGRX4us1;
  2798. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2799. fglInternalFormat := GL_RGB4;
  2800. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  2801. {$ELSE}
  2802. fOpenGLFormat := tfR5G6B5us1;
  2803. {$ENDIF}
  2804. end;
  2805. procedure TfdXBGR4us1.SetValues;
  2806. begin
  2807. inherited SetValues;
  2808. fBitsPerPixel := 16;
  2809. fFormat := tfXBGR4us1;
  2810. fWithAlpha := tfABGR4us1;
  2811. fWithoutAlpha := tfXBGR4us1;
  2812. fRGBInverted := tfXRGB4us1;
  2813. fPrecision := glBitmapRec4ub( 4, 4, 4, 0);
  2814. fShift := glBitmapRec4ub( 0, 4, 8, 0);
  2815. {$IFNDEF OPENGL_ES}
  2816. fOpenGLFormat := tfXBGR4us1;
  2817. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2818. fglInternalFormat := GL_RGB4;
  2819. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2820. {$ELSE}
  2821. fOpenGLFormat := tfR5G6B5us1;
  2822. {$ENDIF}
  2823. end;
  2824. procedure TfdB5G6R5us1.SetValues;
  2825. begin
  2826. inherited SetValues;
  2827. fBitsPerPixel := 16;
  2828. fFormat := tfB5G6R5us1;
  2829. fWithAlpha := tfBGR5A1us1;
  2830. fWithoutAlpha := tfB5G6R5us1;
  2831. fRGBInverted := tfR5G6B5us1;
  2832. fPrecision := glBitmapRec4ub( 5, 6, 5, 0);
  2833. fShift := glBitmapRec4ub( 0, 5, 11, 0);
  2834. {$IFNDEF OPENGL_ES}
  2835. fOpenGLFormat := tfB5G6R5us1;
  2836. fglFormat := GL_RGB;
  2837. fglInternalFormat := GL_RGB565;
  2838. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5_REV;
  2839. {$ELSE}
  2840. fOpenGLFormat := tfR5G6B5us1;
  2841. {$ENDIF}
  2842. end;
  2843. procedure TfdBGR5X1us1.SetValues;
  2844. begin
  2845. inherited SetValues;
  2846. fBitsPerPixel := 16;
  2847. fFormat := tfBGR5X1us1;
  2848. fWithAlpha := tfBGR5A1us1;
  2849. fWithoutAlpha := tfBGR5X1us1;
  2850. fRGBInverted := tfRGB5X1us1;
  2851. fPrecision := glBitmapRec4ub( 5, 5, 5, 0);
  2852. fShift := glBitmapRec4ub( 1, 6, 11, 0);
  2853. {$IFNDEF OPENGL_ES}
  2854. fOpenGLFormat := tfBGR5X1us1;
  2855. fglFormat := GL_BGRA;
  2856. fglInternalFormat := GL_RGB5;
  2857. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  2858. {$ELSE}
  2859. fOpenGLFormat := tfR5G6B5us1;
  2860. {$ENDIF}
  2861. end;
  2862. procedure TfdX1BGR5us1.SetValues;
  2863. begin
  2864. inherited SetValues;
  2865. fBitsPerPixel := 16;
  2866. fFormat := tfX1BGR5us1;
  2867. fWithAlpha := tfA1BGR5us1;
  2868. fWithoutAlpha := tfX1BGR5us1;
  2869. fRGBInverted := tfX1RGB5us1;
  2870. fPrecision := glBitmapRec4ub( 5, 5, 5, 0);
  2871. fShift := glBitmapRec4ub( 0, 5, 10, 0);
  2872. {$IFNDEF OPENGL_ES}
  2873. fOpenGLFormat := tfX1BGR5us1;
  2874. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2875. fglInternalFormat := GL_RGB5;
  2876. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2877. {$ELSE}
  2878. fOpenGLFormat := tfR5G6B5us1;
  2879. {$ENDIF}
  2880. end;
  2881. procedure TfdBGR8ub3.SetValues;
  2882. begin
  2883. inherited SetValues;
  2884. fBitsPerPixel := 24;
  2885. fFormat := tfBGR8ub3;
  2886. fWithAlpha := tfBGRA8ub4;
  2887. fWithoutAlpha := tfBGR8ub3;
  2888. fRGBInverted := tfRGB8ub3;
  2889. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  2890. fShift := glBitmapRec4ub(16, 8, 0, 0);
  2891. {$IFNDEF OPENGL_ES}
  2892. fOpenGLFormat := tfBGR8ub3;
  2893. fglFormat := GL_BGR;
  2894. fglInternalFormat := GL_RGB8;
  2895. fglDataFormat := GL_UNSIGNED_BYTE;
  2896. {$ELSE}
  2897. fOpenGLFormat := tfRGB8ub3;
  2898. {$ENDIF}
  2899. end;
  2900. procedure TfdBGRX8ui1.SetValues;
  2901. begin
  2902. inherited SetValues;
  2903. fBitsPerPixel := 32;
  2904. fFormat := tfBGRX8ui1;
  2905. fWithAlpha := tfBGRA8ui1;
  2906. fWithoutAlpha := tfBGRX8ui1;
  2907. fRGBInverted := tfRGBX8ui1;
  2908. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  2909. fShift := glBitmapRec4ub( 8, 16, 24, 0);
  2910. {$IFNDEF OPENGL_ES}
  2911. fOpenGLFormat := tfBGRX8ui1;
  2912. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2913. fglInternalFormat := GL_RGB8;
  2914. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  2915. {$ELSE}
  2916. fOpenGLFormat := tfRGB8ub3;
  2917. {$ENDIF}
  2918. end;
  2919. procedure TfdXBGR8ui1.SetValues;
  2920. begin
  2921. inherited SetValues;
  2922. fBitsPerPixel := 32;
  2923. fFormat := tfXBGR8ui1;
  2924. fWithAlpha := tfABGR8ui1;
  2925. fWithoutAlpha := tfXBGR8ui1;
  2926. fRGBInverted := tfXRGB8ui1;
  2927. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  2928. fShift := glBitmapRec4ub( 0, 8, 16, 0);
  2929. {$IFNDEF OPENGL_ES}
  2930. fOpenGLFormat := tfXBGR8ui1;
  2931. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2932. fglInternalFormat := GL_RGB8;
  2933. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  2934. {$ELSE}
  2935. fOpenGLFormat := tfRGB8ub3;
  2936. {$ENDIF}
  2937. end;
  2938. procedure TfdBGR10X2ui1.SetValues;
  2939. begin
  2940. inherited SetValues;
  2941. fBitsPerPixel := 32;
  2942. fFormat := tfBGR10X2ui1;
  2943. fWithAlpha := tfBGR10A2ui1;
  2944. fWithoutAlpha := tfBGR10X2ui1;
  2945. fRGBInverted := tfRGB10X2ui1;
  2946. fPrecision := glBitmapRec4ub(10, 10, 10, 0);
  2947. fShift := glBitmapRec4ub( 2, 12, 22, 0);
  2948. {$IFNDEF OPENGL_ES}
  2949. fOpenGLFormat := tfBGR10X2ui1;
  2950. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2951. fglInternalFormat := GL_RGB10;
  2952. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  2953. {$ELSE}
  2954. fOpenGLFormat := tfRGB16us3;
  2955. {$ENDIF}
  2956. end;
  2957. procedure TfdX2BGR10ui1.SetValues;
  2958. begin
  2959. inherited SetValues;
  2960. fBitsPerPixel := 32;
  2961. fFormat := tfX2BGR10ui1;
  2962. fWithAlpha := tfA2BGR10ui1;
  2963. fWithoutAlpha := tfX2BGR10ui1;
  2964. fRGBInverted := tfX2RGB10ui1;
  2965. fPrecision := glBitmapRec4ub(10, 10, 10, 0);
  2966. fShift := glBitmapRec4ub( 0, 10, 20, 0);
  2967. {$IFNDEF OPENGL_ES}
  2968. fOpenGLFormat := tfX2BGR10ui1;
  2969. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2970. fglInternalFormat := GL_RGB10;
  2971. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2972. {$ELSE}
  2973. fOpenGLFormat := tfRGB16us3;
  2974. {$ENDIF}
  2975. end;
  2976. procedure TfdBGR16us3.SetValues;
  2977. begin
  2978. inherited SetValues;
  2979. fBitsPerPixel := 48;
  2980. fFormat := tfBGR16us3;
  2981. fWithAlpha := tfBGRA16us4;
  2982. fWithoutAlpha := tfBGR16us3;
  2983. fRGBInverted := tfRGB16us3;
  2984. fPrecision := glBitmapRec4ub(16, 16, 16, 0);
  2985. fShift := glBitmapRec4ub(32, 16, 0, 0);
  2986. {$IFNDEF OPENGL_ES}
  2987. fOpenGLFormat := tfBGR16us3;
  2988. fglFormat := GL_BGR;
  2989. fglInternalFormat := GL_RGB16;
  2990. fglDataFormat := GL_UNSIGNED_SHORT;
  2991. {$ELSE}
  2992. fOpenGLFormat := tfRGB16us3;
  2993. {$ENDIF}
  2994. end;
  2995. procedure TfdBGRA4us1.SetValues;
  2996. begin
  2997. inherited SetValues;
  2998. fBitsPerPixel := 16;
  2999. fFormat := tfBGRA4us1;
  3000. fWithAlpha := tfBGRA4us1;
  3001. fWithoutAlpha := tfBGRX4us1;
  3002. fRGBInverted := tfRGBA4us1;
  3003. fPrecision := glBitmapRec4ub( 4, 4, 4, 4);
  3004. fShift := glBitmapRec4ub( 4, 8, 12, 0);
  3005. {$IFNDEF OPENGL_ES}
  3006. fOpenGLFormat := tfBGRA4us1;
  3007. fglFormat := GL_BGRA;
  3008. fglInternalFormat := GL_RGBA4;
  3009. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  3010. {$ELSE}
  3011. fOpenGLFormat := tfRGBA4us1;
  3012. {$ENDIF}
  3013. end;
  3014. procedure TfdABGR4us1.SetValues;
  3015. begin
  3016. inherited SetValues;
  3017. fBitsPerPixel := 16;
  3018. fFormat := tfABGR4us1;
  3019. fWithAlpha := tfABGR4us1;
  3020. fWithoutAlpha := tfXBGR4us1;
  3021. fRGBInverted := tfARGB4us1;
  3022. fPrecision := glBitmapRec4ub( 4, 4, 4, 4);
  3023. fShift := glBitmapRec4ub( 0, 4, 8, 12);
  3024. {$IFNDEF OPENGL_ES}
  3025. fOpenGLFormat := tfABGR4us1;
  3026. fglFormat := GL_RGBA;
  3027. fglInternalFormat := GL_RGBA4;
  3028. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  3029. {$ELSE}
  3030. fOpenGLFormat := tfRGBA4us1;
  3031. {$ENDIF}
  3032. end;
  3033. procedure TfdBGR5A1us1.SetValues;
  3034. begin
  3035. inherited SetValues;
  3036. fBitsPerPixel := 16;
  3037. fFormat := tfBGR5A1us1;
  3038. fWithAlpha := tfBGR5A1us1;
  3039. fWithoutAlpha := tfBGR5X1us1;
  3040. fRGBInverted := tfRGB5A1us1;
  3041. fPrecision := glBitmapRec4ub( 5, 5, 5, 1);
  3042. fShift := glBitmapRec4ub( 1, 6, 11, 0);
  3043. {$IFNDEF OPENGL_ES}
  3044. fOpenGLFormat := tfBGR5A1us1;
  3045. fglFormat := GL_BGRA;
  3046. fglInternalFormat := GL_RGB5_A1;
  3047. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  3048. {$ELSE}
  3049. fOpenGLFormat := tfRGB5A1us1;
  3050. {$ENDIF}
  3051. end;
  3052. procedure TfdA1BGR5us1.SetValues;
  3053. begin
  3054. inherited SetValues;
  3055. fBitsPerPixel := 16;
  3056. fFormat := tfA1BGR5us1;
  3057. fWithAlpha := tfA1BGR5us1;
  3058. fWithoutAlpha := tfX1BGR5us1;
  3059. fRGBInverted := tfA1RGB5us1;
  3060. fPrecision := glBitmapRec4ub( 5, 5, 5, 1);
  3061. fShift := glBitmapRec4ub( 0, 5, 10, 15);
  3062. {$IFNDEF OPENGL_ES}
  3063. fOpenGLFormat := tfA1BGR5us1;
  3064. fglFormat := GL_RGBA;
  3065. fglInternalFormat := GL_RGB5_A1;
  3066. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  3067. {$ELSE}
  3068. fOpenGLFormat := tfRGB5A1us1;
  3069. {$ENDIF}
  3070. end;
  3071. procedure TfdBGRA8ui1.SetValues;
  3072. begin
  3073. inherited SetValues;
  3074. fBitsPerPixel := 32;
  3075. fFormat := tfBGRA8ui1;
  3076. fWithAlpha := tfBGRA8ui1;
  3077. fWithoutAlpha := tfBGRX8ui1;
  3078. fRGBInverted := tfRGBA8ui1;
  3079. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  3080. fShift := glBitmapRec4ub( 8, 16, 24, 0);
  3081. {$IFNDEF OPENGL_ES}
  3082. fOpenGLFormat := tfBGRA8ui1;
  3083. fglFormat := GL_BGRA;
  3084. fglInternalFormat := GL_RGBA8;
  3085. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  3086. {$ELSE}
  3087. fOpenGLFormat := tfRGBA8ub4;
  3088. {$ENDIF}
  3089. end;
  3090. procedure TfdABGR8ui1.SetValues;
  3091. begin
  3092. inherited SetValues;
  3093. fBitsPerPixel := 32;
  3094. fFormat := tfABGR8ui1;
  3095. fWithAlpha := tfABGR8ui1;
  3096. fWithoutAlpha := tfXBGR8ui1;
  3097. fRGBInverted := tfARGB8ui1;
  3098. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  3099. fShift := glBitmapRec4ub( 0, 8, 16, 24);
  3100. {$IFNDEF OPENGL_ES}
  3101. fOpenGLFormat := tfABGR8ui1;
  3102. fglFormat := GL_RGBA;
  3103. fglInternalFormat := GL_RGBA8;
  3104. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  3105. {$ELSE}
  3106. fOpenGLFormat := tfRGBA8ub4
  3107. {$ENDIF}
  3108. end;
  3109. procedure TfdBGRA8ub4.SetValues;
  3110. begin
  3111. inherited SetValues;
  3112. fBitsPerPixel := 32;
  3113. fFormat := tfBGRA8ub4;
  3114. fWithAlpha := tfBGRA8ub4;
  3115. fWithoutAlpha := tfBGR8ub3;
  3116. fRGBInverted := tfRGBA8ub4;
  3117. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  3118. fShift := glBitmapRec4ub(16, 8, 0, 24);
  3119. {$IFNDEF OPENGL_ES}
  3120. fOpenGLFormat := tfBGRA8ub4;
  3121. fglFormat := GL_BGRA;
  3122. fglInternalFormat := GL_RGBA8;
  3123. fglDataFormat := GL_UNSIGNED_BYTE;
  3124. {$ELSE}
  3125. fOpenGLFormat := tfRGBA8ub4;
  3126. {$ENDIF}
  3127. end;
  3128. procedure TfdBGR10A2ui1.SetValues;
  3129. begin
  3130. inherited SetValues;
  3131. fBitsPerPixel := 32;
  3132. fFormat := tfBGR10A2ui1;
  3133. fWithAlpha := tfBGR10A2ui1;
  3134. fWithoutAlpha := tfBGR10X2ui1;
  3135. fRGBInverted := tfRGB10A2ui1;
  3136. fPrecision := glBitmapRec4ub(10, 10, 10, 2);
  3137. fShift := glBitmapRec4ub( 2, 12, 22, 0);
  3138. {$IFNDEF OPENGL_ES}
  3139. fOpenGLFormat := tfBGR10A2ui1;
  3140. fglFormat := GL_BGRA;
  3141. fglInternalFormat := GL_RGB10_A2;
  3142. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  3143. {$ELSE}
  3144. fOpenGLFormat := tfA2RGB10ui1;
  3145. {$ENDIF}
  3146. end;
  3147. procedure TfdA2BGR10ui1.SetValues;
  3148. begin
  3149. inherited SetValues;
  3150. fBitsPerPixel := 32;
  3151. fFormat := tfA2BGR10ui1;
  3152. fWithAlpha := tfA2BGR10ui1;
  3153. fWithoutAlpha := tfX2BGR10ui1;
  3154. fRGBInverted := tfA2RGB10ui1;
  3155. fPrecision := glBitmapRec4ub(10, 10, 10, 2);
  3156. fShift := glBitmapRec4ub( 0, 10, 20, 30);
  3157. {$IFNDEF OPENGL_ES}
  3158. fOpenGLFormat := tfA2BGR10ui1;
  3159. fglFormat := GL_RGBA;
  3160. fglInternalFormat := GL_RGB10_A2;
  3161. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3162. {$ELSE}
  3163. fOpenGLFormat := tfA2RGB10ui1;
  3164. {$ENDIF}
  3165. end;
  3166. procedure TfdBGRA16us4.SetValues;
  3167. begin
  3168. inherited SetValues;
  3169. fBitsPerPixel := 64;
  3170. fFormat := tfBGRA16us4;
  3171. fWithAlpha := tfBGRA16us4;
  3172. fWithoutAlpha := tfBGR16us3;
  3173. fRGBInverted := tfRGBA16us4;
  3174. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  3175. fShift := glBitmapRec4ub(32, 16, 0, 48);
  3176. {$IFNDEF OPENGL_ES}
  3177. fOpenGLFormat := tfBGRA16us4;
  3178. fglFormat := GL_BGRA;
  3179. fglInternalFormat := GL_RGBA16;
  3180. fglDataFormat := GL_UNSIGNED_SHORT;
  3181. {$ELSE}
  3182. fOpenGLFormat := tfRGBA16us4;
  3183. {$ENDIF}
  3184. end;
  3185. procedure TfdDepth16us1.SetValues;
  3186. begin
  3187. inherited SetValues;
  3188. fBitsPerPixel := 16;
  3189. fFormat := tfDepth16us1;
  3190. fWithoutAlpha := tfDepth16us1;
  3191. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  3192. fShift := glBitmapRec4ub( 0, 0, 0, 0);
  3193. {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  3194. fOpenGLFormat := tfDepth16us1;
  3195. fglFormat := GL_DEPTH_COMPONENT;
  3196. fglInternalFormat := GL_DEPTH_COMPONENT16;
  3197. fglDataFormat := GL_UNSIGNED_SHORT;
  3198. {$IFEND}
  3199. end;
  3200. procedure TfdDepth24ui1.SetValues;
  3201. begin
  3202. inherited SetValues;
  3203. fBitsPerPixel := 32;
  3204. fFormat := tfDepth24ui1;
  3205. fWithoutAlpha := tfDepth24ui1;
  3206. fOpenGLFormat := tfDepth24ui1;
  3207. fPrecision := glBitmapRec4ub(32, 32, 32, 32);
  3208. fShift := glBitmapRec4ub( 0, 0, 0, 0);
  3209. {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  3210. fOpenGLFormat := tfDepth24ui1;
  3211. fglFormat := GL_DEPTH_COMPONENT;
  3212. fglInternalFormat := GL_DEPTH_COMPONENT24;
  3213. fglDataFormat := GL_UNSIGNED_INT;
  3214. {$IFEND}
  3215. end;
  3216. procedure TfdDepth32ui1.SetValues;
  3217. begin
  3218. inherited SetValues;
  3219. fBitsPerPixel := 32;
  3220. fFormat := tfDepth32ui1;
  3221. fWithoutAlpha := tfDepth32ui1;
  3222. fPrecision := glBitmapRec4ub(32, 32, 32, 32);
  3223. fShift := glBitmapRec4ub( 0, 0, 0, 0);
  3224. {$IF NOT DEFINED(OPENGL_ES)}
  3225. fOpenGLFormat := tfDepth32ui1;
  3226. fglFormat := GL_DEPTH_COMPONENT;
  3227. fglInternalFormat := GL_DEPTH_COMPONENT32;
  3228. fglDataFormat := GL_UNSIGNED_INT;
  3229. {$ELSEIF DEFINED(OPENGL_ES_3_0)}
  3230. fOpenGLFormat := tfDepth24ui1;
  3231. {$ELSEIF DEFINED(OPENGL_ES_2_0)}
  3232. fOpenGLFormat := tfDepth16us1;
  3233. {$IFEND}
  3234. end;
  3235. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3236. //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3237. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3238. procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3239. begin
  3240. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3241. end;
  3242. procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3243. begin
  3244. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3245. end;
  3246. procedure TfdS3tcDtx1RGBA.SetValues;
  3247. begin
  3248. inherited SetValues;
  3249. fFormat := tfS3tcDtx1RGBA;
  3250. fWithAlpha := tfS3tcDtx1RGBA;
  3251. fUncompressed := tfRGB5A1us1;
  3252. fBitsPerPixel := 4;
  3253. fIsCompressed := true;
  3254. {$IFNDEF OPENGL_ES}
  3255. fOpenGLFormat := tfS3tcDtx1RGBA;
  3256. fglFormat := GL_COMPRESSED_RGBA;
  3257. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
  3258. fglDataFormat := GL_UNSIGNED_BYTE;
  3259. {$ELSE}
  3260. fOpenGLFormat := fUncompressed;
  3261. {$ENDIF}
  3262. end;
  3263. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3264. //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3265. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3266. procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3267. begin
  3268. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3269. end;
  3270. procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3271. begin
  3272. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3273. end;
  3274. procedure TfdS3tcDtx3RGBA.SetValues;
  3275. begin
  3276. inherited SetValues;
  3277. fFormat := tfS3tcDtx3RGBA;
  3278. fWithAlpha := tfS3tcDtx3RGBA;
  3279. fUncompressed := tfRGBA8ub4;
  3280. fBitsPerPixel := 8;
  3281. fIsCompressed := true;
  3282. {$IFNDEF OPENGL_ES}
  3283. fOpenGLFormat := tfS3tcDtx3RGBA;
  3284. fglFormat := GL_COMPRESSED_RGBA;
  3285. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
  3286. fglDataFormat := GL_UNSIGNED_BYTE;
  3287. {$ELSE}
  3288. fOpenGLFormat := fUncompressed;
  3289. {$ENDIF}
  3290. end;
  3291. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3292. //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3293. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3294. procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3295. begin
  3296. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3297. end;
  3298. procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3299. begin
  3300. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3301. end;
  3302. procedure TfdS3tcDtx5RGBA.SetValues;
  3303. begin
  3304. inherited SetValues;
  3305. fFormat := tfS3tcDtx3RGBA;
  3306. fWithAlpha := tfS3tcDtx3RGBA;
  3307. fUncompressed := tfRGBA8ub4;
  3308. fBitsPerPixel := 8;
  3309. fIsCompressed := true;
  3310. {$IFNDEF OPENGL_ES}
  3311. fOpenGLFormat := tfS3tcDtx3RGBA;
  3312. fglFormat := GL_COMPRESSED_RGBA;
  3313. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
  3314. fglDataFormat := GL_UNSIGNED_BYTE;
  3315. {$ELSE}
  3316. fOpenGLFormat := fUncompressed;
  3317. {$ENDIF}
  3318. end;
  3319. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3320. //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3321. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3322. function TglBitmapFormatDescriptor.GetHasRed: Boolean;
  3323. begin
  3324. result := (fPrecision.r > 0);
  3325. end;
  3326. function TglBitmapFormatDescriptor.GetHasGreen: Boolean;
  3327. begin
  3328. result := (fPrecision.g > 0);
  3329. end;
  3330. function TglBitmapFormatDescriptor.GetHasBlue: Boolean;
  3331. begin
  3332. result := (fPrecision.b > 0);
  3333. end;
  3334. function TglBitmapFormatDescriptor.GetHasAlpha: Boolean;
  3335. begin
  3336. result := (fPrecision.a > 0);
  3337. end;
  3338. function TglBitmapFormatDescriptor.GetHasColor: Boolean;
  3339. begin
  3340. result := HasRed or HasGreen or HasBlue;
  3341. end;
  3342. function TglBitmapFormatDescriptor.GetIsGrayscale: Boolean;
  3343. begin
  3344. result := (Mask.r = Mask.g) and (Mask.g = Mask.b) and (Mask.r > 0);
  3345. end;
  3346. function TglBitmapFormatDescriptor.GetHasOpenGLSupport: Boolean;
  3347. begin
  3348. result := (OpenGLFormat = Format);
  3349. end;
  3350. procedure TglBitmapFormatDescriptor.SetValues;
  3351. begin
  3352. fFormat := tfEmpty;
  3353. fWithAlpha := tfEmpty;
  3354. fWithoutAlpha := tfEmpty;
  3355. fOpenGLFormat := tfEmpty;
  3356. fRGBInverted := tfEmpty;
  3357. fUncompressed := tfEmpty;
  3358. fBitsPerPixel := 0;
  3359. fIsCompressed := false;
  3360. fglFormat := 0;
  3361. fglInternalFormat := 0;
  3362. fglDataFormat := 0;
  3363. FillChar(fPrecision, 0, SizeOf(fPrecision));
  3364. FillChar(fShift, 0, SizeOf(fShift));
  3365. end;
  3366. procedure TglBitmapFormatDescriptor.CalcValues;
  3367. var
  3368. i: Integer;
  3369. begin
  3370. fBytesPerPixel := fBitsPerPixel / 8;
  3371. fChannelCount := 0;
  3372. for i := 0 to 3 do begin
  3373. if (fPrecision.arr[i] > 0) then
  3374. inc(fChannelCount);
  3375. fRange.arr[i] := (1 shl fPrecision.arr[i]) - 1;
  3376. fMask.arr[i] := fRange.arr[i] shl fShift.arr[i];
  3377. end;
  3378. end;
  3379. function TglBitmapFormatDescriptor.GetSize(const aSize: TglBitmapSize): Integer;
  3380. var
  3381. w, h: Integer;
  3382. begin
  3383. if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
  3384. w := Max(1, aSize.X);
  3385. h := Max(1, aSize.Y);
  3386. result := GetSize(w, h);
  3387. end else
  3388. result := 0;
  3389. end;
  3390. function TglBitmapFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
  3391. begin
  3392. result := 0;
  3393. if (aWidth <= 0) or (aHeight <= 0) then
  3394. exit;
  3395. result := Ceil(aWidth * aHeight * BytesPerPixel);
  3396. end;
  3397. constructor TglBitmapFormatDescriptor.Create;
  3398. begin
  3399. inherited Create;
  3400. SetValues;
  3401. CalcValues;
  3402. end;
  3403. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3404. class function TglBitmapFormatDescriptor.GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
  3405. var
  3406. f: TglBitmapFormat;
  3407. begin
  3408. for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
  3409. result := TFormatDescriptor.Get(f);
  3410. if (result.glInternalFormat = aInternalFormat) then
  3411. exit;
  3412. end;
  3413. result := TFormatDescriptor.Get(tfEmpty);
  3414. end;
  3415. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3416. class function TglBitmapFormatDescriptor.GetByFormat(const aFormat: TglBitmapFormat): TglBitmapFormatDescriptor;
  3417. begin
  3418. result := TFormatDescriptor.Get(aFormat);
  3419. if not Assigned(result) then
  3420. result := TFormatDescriptor.Get(tfEmpty);
  3421. end;
  3422. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3423. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3424. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3425. class procedure TFormatDescriptor.Init;
  3426. begin
  3427. if not Assigned(FormatDescriptorCS) then
  3428. FormatDescriptorCS := TCriticalSection.Create;
  3429. end;
  3430. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3431. class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3432. begin
  3433. FormatDescriptorCS.Enter;
  3434. try
  3435. result := FormatDescriptors[aFormat];
  3436. if not Assigned(result) then begin
  3437. result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
  3438. FormatDescriptors[aFormat] := result;
  3439. end;
  3440. finally
  3441. FormatDescriptorCS.Leave;
  3442. end;
  3443. end;
  3444. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3445. class function TFormatDescriptor.GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3446. begin
  3447. result := Get(Get(aFormat).WithAlpha);
  3448. end;
  3449. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3450. class function TFormatDescriptor.GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer): TFormatDescriptor;
  3451. var
  3452. ft: TglBitmapFormat;
  3453. begin
  3454. // find matching format with OpenGL support
  3455. for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  3456. result := Get(ft);
  3457. if (result.MaskMatch(aMask)) 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 result.MaskMatch(aMask) and ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
  3468. exit;
  3469. end;
  3470. result := TFormatDescriptor.Get(tfEmpty);
  3471. end;
  3472. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3473. class function TFormatDescriptor.GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
  3474. var
  3475. ft: TglBitmapFormat;
  3476. begin
  3477. // find matching format with OpenGL support
  3478. for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  3479. result := Get(ft);
  3480. if glBitmapRec4ubCompare(result.Shift, aShift) and
  3481. glBitmapRec4ubCompare(result.Precision, aPrec) and
  3482. (result.glFormat <> 0) and
  3483. (result.glInternalFormat <> 0) and
  3484. ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
  3485. then
  3486. exit;
  3487. end;
  3488. // find matching format without OpenGL Support
  3489. for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  3490. result := Get(ft);
  3491. if glBitmapRec4ubCompare(result.Shift, aShift) and
  3492. glBitmapRec4ubCompare(result.Precision, aPrec) and
  3493. ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
  3494. exit;
  3495. end;
  3496. result := TFormatDescriptor.Get(tfEmpty);
  3497. end;
  3498. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3499. class procedure TFormatDescriptor.Clear;
  3500. var
  3501. f: TglBitmapFormat;
  3502. begin
  3503. FormatDescriptorCS.Enter;
  3504. try
  3505. for f := low(FormatDescriptors) to high(FormatDescriptors) do
  3506. FreeAndNil(FormatDescriptors[f]);
  3507. finally
  3508. FormatDescriptorCS.Leave;
  3509. end;
  3510. end;
  3511. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3512. class procedure TFormatDescriptor.Finalize;
  3513. begin
  3514. Clear;
  3515. FreeAndNil(FormatDescriptorCS);
  3516. end;
  3517. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3518. //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3519. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3520. procedure TbmpBitfieldFormat.SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul);
  3521. var
  3522. i: Integer;
  3523. begin
  3524. for i := 0 to 3 do begin
  3525. fShift.arr[i] := 0;
  3526. while (aMask.arr[i] > 0) and ((aMask.arr[i] and 1) = 0) do begin
  3527. aMask.arr[i] := aMask.arr[i] shr 1;
  3528. inc(fShift.arr[i]);
  3529. end;
  3530. fPrecision.arr[i] := CountSetBits(aMask.arr[i]);
  3531. end;
  3532. fBitsPerPixel := aBPP;
  3533. CalcValues;
  3534. end;
  3535. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3536. procedure TbmpBitfieldFormat.SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub);
  3537. begin
  3538. fBitsPerPixel := aBBP;
  3539. fPrecision := aPrec;
  3540. fShift := aShift;
  3541. CalcValues;
  3542. end;
  3543. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3544. procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3545. var
  3546. data: QWord;
  3547. begin
  3548. data :=
  3549. ((aPixel.Data.r and Range.r) shl Shift.r) or
  3550. ((aPixel.Data.g and Range.g) shl Shift.g) or
  3551. ((aPixel.Data.b and Range.b) shl Shift.b) or
  3552. ((aPixel.Data.a and Range.a) shl Shift.a);
  3553. case BitsPerPixel of
  3554. 8: aData^ := data;
  3555. 16: PWord(aData)^ := data;
  3556. 32: PCardinal(aData)^ := data;
  3557. 64: PQWord(aData)^ := data;
  3558. else
  3559. raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
  3560. end;
  3561. inc(aData, Round(BytesPerPixel));
  3562. end;
  3563. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3564. procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3565. var
  3566. data: QWord;
  3567. i: Integer;
  3568. begin
  3569. case BitsPerPixel of
  3570. 8: data := aData^;
  3571. 16: data := PWord(aData)^;
  3572. 32: data := PCardinal(aData)^;
  3573. 64: data := PQWord(aData)^;
  3574. else
  3575. raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
  3576. end;
  3577. for i := 0 to 3 do
  3578. aPixel.Data.arr[i] := (data shr fShift.arr[i]) and Range.arr[i];
  3579. inc(aData, Round(BytesPerPixel));
  3580. end;
  3581. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3582. //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3583. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3584. procedure TbmpColorTableFormat.SetValues;
  3585. begin
  3586. inherited SetValues;
  3587. fShift := glBitmapRec4ub(8, 8, 8, 0);
  3588. end;
  3589. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3590. procedure TbmpColorTableFormat.SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub);
  3591. begin
  3592. fFormat := aFormat;
  3593. fBitsPerPixel := aBPP;
  3594. fPrecision := aPrec;
  3595. fShift := aShift;
  3596. CalcValues;
  3597. end;
  3598. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3599. procedure TbmpColorTableFormat.CalcValues;
  3600. begin
  3601. inherited CalcValues;
  3602. end;
  3603. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3604. procedure TbmpColorTableFormat.CreateColorTable;
  3605. var
  3606. i: Integer;
  3607. begin
  3608. SetLength(fColorTable, 256);
  3609. if not HasColor then begin
  3610. // alpha
  3611. for i := 0 to High(fColorTable) do begin
  3612. fColorTable[i].r := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
  3613. fColorTable[i].g := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
  3614. fColorTable[i].b := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
  3615. fColorTable[i].a := 0;
  3616. end;
  3617. end else begin
  3618. // normal
  3619. for i := 0 to High(fColorTable) do begin
  3620. fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
  3621. fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
  3622. fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
  3623. fColorTable[i].a := 0;
  3624. end;
  3625. end;
  3626. end;
  3627. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3628. function TbmpColorTableFormat.CreateMappingData: Pointer;
  3629. begin
  3630. result := Pointer(0);
  3631. end;
  3632. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3633. procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3634. begin
  3635. if (BitsPerPixel <> 8) then
  3636. raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
  3637. if not HasColor then
  3638. // alpha
  3639. aData^ := aPixel.Data.a
  3640. else
  3641. // normal
  3642. aData^ := Round(
  3643. ((aPixel.Data.r shr Shift.r) and Range.r) * LUMINANCE_WEIGHT_R +
  3644. ((aPixel.Data.g shr Shift.g) and Range.g) * LUMINANCE_WEIGHT_G +
  3645. ((aPixel.Data.b shr Shift.b) and Range.b) * LUMINANCE_WEIGHT_B);
  3646. inc(aData);
  3647. end;
  3648. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3649. procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3650. function ReadValue: Byte;
  3651. var
  3652. i: PtrUInt;
  3653. begin
  3654. if (BitsPerPixel = 8) then begin
  3655. result := aData^;
  3656. inc(aData);
  3657. end else begin
  3658. i := {%H-}PtrUInt(aMapData);
  3659. if (BitsPerPixel > 1) then
  3660. result := (aData^ shr i) and ((1 shl BitsPerPixel) - 1)
  3661. else
  3662. result := (aData^ shr (7-i)) and ((1 shl BitsPerPixel) - 1);
  3663. inc(i, BitsPerPixel);
  3664. while (i >= 8) do begin
  3665. inc(aData);
  3666. dec(i, 8);
  3667. end;
  3668. aMapData := {%H-}Pointer(i);
  3669. end;
  3670. end;
  3671. begin
  3672. if (BitsPerPixel > 8) then
  3673. raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
  3674. with fColorTable[ReadValue] do begin
  3675. aPixel.Data.r := r;
  3676. aPixel.Data.g := g;
  3677. aPixel.Data.b := b;
  3678. aPixel.Data.a := a;
  3679. end;
  3680. end;
  3681. destructor TbmpColorTableFormat.Destroy;
  3682. begin
  3683. SetLength(fColorTable, 0);
  3684. inherited Destroy;
  3685. end;
  3686. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3687. //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3688. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3689. procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
  3690. var
  3691. i: Integer;
  3692. begin
  3693. for i := 0 to 3 do begin
  3694. if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
  3695. if (aSourceFD.Range.arr[i] > 0) then
  3696. aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
  3697. else
  3698. aPixel.Data.arr[i] := 0;
  3699. end;
  3700. end;
  3701. end;
  3702. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3703. procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
  3704. begin
  3705. with aFuncRec do begin
  3706. if (Source.Range.r > 0) then
  3707. Dest.Data.r := Source.Data.r;
  3708. if (Source.Range.g > 0) then
  3709. Dest.Data.g := Source.Data.g;
  3710. if (Source.Range.b > 0) then
  3711. Dest.Data.b := Source.Data.b;
  3712. if (Source.Range.a > 0) then
  3713. Dest.Data.a := Source.Data.a;
  3714. end;
  3715. end;
  3716. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3717. procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3718. var
  3719. i: Integer;
  3720. begin
  3721. with aFuncRec do begin
  3722. for i := 0 to 3 do
  3723. if (Source.Range.arr[i] > 0) then
  3724. Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
  3725. end;
  3726. end;
  3727. type
  3728. TShiftData = packed record
  3729. case Integer of
  3730. 0: (r, g, b, a: SmallInt);
  3731. 1: (arr: array[0..3] of SmallInt);
  3732. end;
  3733. PShiftData = ^TShiftData;
  3734. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3735. procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3736. var
  3737. i: Integer;
  3738. begin
  3739. with aFuncRec do
  3740. for i := 0 to 3 do
  3741. if (Source.Range.arr[i] > 0) then
  3742. Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
  3743. end;
  3744. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3745. procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
  3746. var
  3747. i: Integer;
  3748. begin
  3749. with aFuncRec do begin
  3750. Dest.Data := Source.Data;
  3751. for i := 0 to 3 do
  3752. if ({%H-}PtrUInt(Args) and (1 shl i) > 0) then
  3753. Dest.Data.arr[i] := Dest.Data.arr[i] xor Dest.Range.arr[i];
  3754. end;
  3755. end;
  3756. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3757. procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
  3758. var
  3759. i: Integer;
  3760. begin
  3761. with aFuncRec do begin
  3762. for i := 0 to 3 do
  3763. Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
  3764. end;
  3765. end;
  3766. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3767. procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3768. var
  3769. Temp: Single;
  3770. begin
  3771. with FuncRec do begin
  3772. if (FuncRec.Args = nil) then begin //source has no alpha
  3773. Temp :=
  3774. Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
  3775. Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
  3776. Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
  3777. Dest.Data.a := Round(Dest.Range.a * Temp);
  3778. end else
  3779. Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
  3780. end;
  3781. end;
  3782. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3783. procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3784. type
  3785. PglBitmapPixelData = ^TglBitmapPixelData;
  3786. begin
  3787. with FuncRec do begin
  3788. Dest.Data.r := Source.Data.r;
  3789. Dest.Data.g := Source.Data.g;
  3790. Dest.Data.b := Source.Data.b;
  3791. with PglBitmapPixelData(Args)^ do
  3792. if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
  3793. (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
  3794. (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
  3795. Dest.Data.a := 0
  3796. else
  3797. Dest.Data.a := Dest.Range.a;
  3798. end;
  3799. end;
  3800. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3801. procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3802. begin
  3803. with FuncRec do begin
  3804. Dest.Data.r := Source.Data.r;
  3805. Dest.Data.g := Source.Data.g;
  3806. Dest.Data.b := Source.Data.b;
  3807. Dest.Data.a := PCardinal(Args)^;
  3808. end;
  3809. end;
  3810. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3811. procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
  3812. type
  3813. PRGBPix = ^TRGBPix;
  3814. TRGBPix = array [0..2] of byte;
  3815. var
  3816. Temp: Byte;
  3817. begin
  3818. while aWidth > 0 do begin
  3819. Temp := PRGBPix(aData)^[0];
  3820. PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
  3821. PRGBPix(aData)^[2] := Temp;
  3822. if aHasAlpha then
  3823. Inc(aData, 4)
  3824. else
  3825. Inc(aData, 3);
  3826. dec(aWidth);
  3827. end;
  3828. end;
  3829. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3830. //TglBitmapData///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3831. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3832. function TglBitmapData.GetFormatDescriptor: TglBitmapFormatDescriptor;
  3833. begin
  3834. result := TFormatDescriptor.Get(fFormat);
  3835. end;
  3836. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3837. function TglBitmapData.GetWidth: Integer;
  3838. begin
  3839. if (ffX in fDimension.Fields) then
  3840. result := fDimension.X
  3841. else
  3842. result := -1;
  3843. end;
  3844. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3845. function TglBitmapData.GetHeight: Integer;
  3846. begin
  3847. if (ffY in fDimension.Fields) then
  3848. result := fDimension.Y
  3849. else
  3850. result := -1;
  3851. end;
  3852. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3853. function TglBitmapData.GetScanlines(const aIndex: Integer): PByte;
  3854. begin
  3855. if fHasScanlines and (aIndex >= Low(fScanlines)) and (aIndex <= High(fScanlines)) then
  3856. result := fScanlines[aIndex]
  3857. else
  3858. result := nil;
  3859. end;
  3860. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3861. procedure TglBitmapData.SetFormat(const aValue: TglBitmapFormat);
  3862. begin
  3863. if fFormat = aValue then
  3864. exit;
  3865. if TFormatDescriptor.Get(Format).BitsPerPixel <> TFormatDescriptor.Get(aValue).BitsPerPixel then
  3866. raise EglBitmapUnsupportedFormat.Create(Format);
  3867. SetData(fData, aValue, Width, Height);
  3868. end;
  3869. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3870. procedure TglBitmapData.PrepareResType(var aResource: String; var aResType: PChar);
  3871. var
  3872. TempPos: Integer;
  3873. begin
  3874. if not Assigned(aResType) then begin
  3875. TempPos := Pos('.', aResource);
  3876. aResType := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
  3877. aResource := UpperCase(Copy(aResource, 0, TempPos -1));
  3878. end;
  3879. end;
  3880. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3881. procedure TglBitmapData.UpdateScanlines;
  3882. var
  3883. w, h, i, LineWidth: Integer;
  3884. begin
  3885. w := Width;
  3886. h := Height;
  3887. fHasScanlines := Assigned(fData) and (w > 0) and (h > 0);
  3888. if fHasScanlines then begin
  3889. SetLength(fScanlines, h);
  3890. LineWidth := Trunc(w * FormatDescriptor.BytesPerPixel);
  3891. for i := 0 to h-1 do begin
  3892. fScanlines[i] := fData;
  3893. Inc(fScanlines[i], i * LineWidth);
  3894. end;
  3895. end else
  3896. SetLength(fScanlines, 0);
  3897. end;
  3898. {$IFDEF GLB_SUPPORT_PNG_READ}
  3899. {$IF DEFINED(GLB_LAZ_PNG)}
  3900. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3901. //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3902. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3903. function TglBitmapData.LoadPNG(const aStream: TStream): Boolean;
  3904. const
  3905. MAGIC_LEN = 8;
  3906. PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
  3907. var
  3908. reader: TLazReaderPNG;
  3909. intf: TLazIntfImage;
  3910. StreamPos: Int64;
  3911. magic: String[MAGIC_LEN];
  3912. begin
  3913. result := true;
  3914. StreamPos := aStream.Position;
  3915. SetLength(magic, MAGIC_LEN);
  3916. aStream.Read(magic[1], MAGIC_LEN);
  3917. aStream.Position := StreamPos;
  3918. if (magic <> PNG_MAGIC) then begin
  3919. result := false;
  3920. exit;
  3921. end;
  3922. intf := TLazIntfImage.Create(0, 0);
  3923. reader := TLazReaderPNG.Create;
  3924. try try
  3925. reader.UpdateDescription := true;
  3926. reader.ImageRead(aStream, intf);
  3927. AssignFromLazIntfImage(intf);
  3928. except
  3929. result := false;
  3930. aStream.Position := StreamPos;
  3931. exit;
  3932. end;
  3933. finally
  3934. reader.Free;
  3935. intf.Free;
  3936. end;
  3937. end;
  3938. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
  3939. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3940. function TglBitmapData.LoadPNG(const aStream: TStream): Boolean;
  3941. var
  3942. Surface: PSDL_Surface;
  3943. RWops: PSDL_RWops;
  3944. begin
  3945. result := false;
  3946. RWops := glBitmapCreateRWops(aStream);
  3947. try
  3948. if IMG_isPNG(RWops) > 0 then begin
  3949. Surface := IMG_LoadPNG_RW(RWops);
  3950. try
  3951. AssignFromSurface(Surface);
  3952. result := true;
  3953. finally
  3954. SDL_FreeSurface(Surface);
  3955. end;
  3956. end;
  3957. finally
  3958. SDL_FreeRW(RWops);
  3959. end;
  3960. end;
  3961. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  3962. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3963. procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  3964. begin
  3965. TStream(png_get_io_ptr(png)).Read(buffer^, size);
  3966. end;
  3967. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3968. function TglBitmapData.LoadPNG(const aStream: TStream): Boolean;
  3969. var
  3970. StreamPos: Int64;
  3971. signature: array [0..7] of byte;
  3972. png: png_structp;
  3973. png_info: png_infop;
  3974. TempHeight, TempWidth: Integer;
  3975. Format: TglBitmapFormat;
  3976. png_data: pByte;
  3977. png_rows: array of pByte;
  3978. Row, LineSize: Integer;
  3979. begin
  3980. result := false;
  3981. if not init_libPNG then
  3982. raise Exception.Create('LoadPNG - unable to initialize libPNG.');
  3983. try
  3984. // signature
  3985. StreamPos := aStream.Position;
  3986. aStream.Read(signature{%H-}, 8);
  3987. aStream.Position := StreamPos;
  3988. if png_check_sig(@signature, 8) <> 0 then begin
  3989. // png read struct
  3990. png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  3991. if png = nil then
  3992. raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
  3993. // png info
  3994. png_info := png_create_info_struct(png);
  3995. if png_info = nil then begin
  3996. png_destroy_read_struct(@png, nil, nil);
  3997. raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
  3998. end;
  3999. // set read callback
  4000. png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
  4001. // read informations
  4002. png_read_info(png, png_info);
  4003. // size
  4004. TempHeight := png_get_image_height(png, png_info);
  4005. TempWidth := png_get_image_width(png, png_info);
  4006. // format
  4007. case png_get_color_type(png, png_info) of
  4008. PNG_COLOR_TYPE_GRAY:
  4009. Format := tfLuminance8ub1;
  4010. PNG_COLOR_TYPE_GRAY_ALPHA:
  4011. Format := tfLuminance8Alpha8us1;
  4012. PNG_COLOR_TYPE_RGB:
  4013. Format := tfRGB8ub3;
  4014. PNG_COLOR_TYPE_RGB_ALPHA:
  4015. Format := tfRGBA8ub4;
  4016. else
  4017. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  4018. end;
  4019. // cut upper 8 bit from 16 bit formats
  4020. if png_get_bit_depth(png, png_info) > 8 then
  4021. png_set_strip_16(png);
  4022. // expand bitdepth smaller than 8
  4023. if png_get_bit_depth(png, png_info) < 8 then
  4024. png_set_expand(png);
  4025. // allocating mem for scanlines
  4026. LineSize := png_get_rowbytes(png, png_info);
  4027. GetMem(png_data, TempHeight * LineSize);
  4028. try
  4029. SetLength(png_rows, TempHeight);
  4030. for Row := Low(png_rows) to High(png_rows) do begin
  4031. png_rows[Row] := png_data;
  4032. Inc(png_rows[Row], Row * LineSize);
  4033. end;
  4034. // read complete image into scanlines
  4035. png_read_image(png, @png_rows[0]);
  4036. // read end
  4037. png_read_end(png, png_info);
  4038. // destroy read struct
  4039. png_destroy_read_struct(@png, @png_info, nil);
  4040. SetLength(png_rows, 0);
  4041. // set new data
  4042. SetData(png_data, Format, TempWidth, TempHeight);
  4043. result := true;
  4044. except
  4045. if Assigned(png_data) then
  4046. FreeMem(png_data);
  4047. raise;
  4048. end;
  4049. end;
  4050. finally
  4051. quit_libPNG;
  4052. end;
  4053. end;
  4054. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  4055. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4056. function TglBitmapData.LoadPNG(const aStream: TStream): Boolean;
  4057. var
  4058. StreamPos: Int64;
  4059. Png: TPNGObject;
  4060. Header: String[8];
  4061. Row, Col, PixSize, LineSize: Integer;
  4062. NewImage, pSource, pDest, pAlpha: pByte;
  4063. PngFormat: TglBitmapFormat;
  4064. FormatDesc: TFormatDescriptor;
  4065. const
  4066. PngHeader: String[8] = #137#80#78#71#13#10#26#10;
  4067. begin
  4068. result := false;
  4069. StreamPos := aStream.Position;
  4070. aStream.Read(Header[0], SizeOf(Header));
  4071. aStream.Position := StreamPos;
  4072. {Test if the header matches}
  4073. if Header = PngHeader then begin
  4074. Png := TPNGObject.Create;
  4075. try
  4076. Png.LoadFromStream(aStream);
  4077. case Png.Header.ColorType of
  4078. COLOR_GRAYSCALE:
  4079. PngFormat := tfLuminance8ub1;
  4080. COLOR_GRAYSCALEALPHA:
  4081. PngFormat := tfLuminance8Alpha8us1;
  4082. COLOR_RGB:
  4083. PngFormat := tfBGR8ub3;
  4084. COLOR_RGBALPHA:
  4085. PngFormat := tfBGRA8ub4;
  4086. else
  4087. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  4088. end;
  4089. FormatDesc := TFormatDescriptor.Get(PngFormat);
  4090. PixSize := Round(FormatDesc.PixelSize);
  4091. LineSize := FormatDesc.GetSize(Png.Header.Width, 1);
  4092. GetMem(NewImage, LineSize * Integer(Png.Header.Height));
  4093. try
  4094. pDest := NewImage;
  4095. case Png.Header.ColorType of
  4096. COLOR_RGB, COLOR_GRAYSCALE:
  4097. begin
  4098. for Row := 0 to Png.Height -1 do begin
  4099. Move (Png.Scanline[Row]^, pDest^, LineSize);
  4100. Inc(pDest, LineSize);
  4101. end;
  4102. end;
  4103. COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
  4104. begin
  4105. PixSize := PixSize -1;
  4106. for Row := 0 to Png.Height -1 do begin
  4107. pSource := Png.Scanline[Row];
  4108. pAlpha := pByte(Png.AlphaScanline[Row]);
  4109. for Col := 0 to Png.Width -1 do begin
  4110. Move (pSource^, pDest^, PixSize);
  4111. Inc(pSource, PixSize);
  4112. Inc(pDest, PixSize);
  4113. pDest^ := pAlpha^;
  4114. inc(pAlpha);
  4115. Inc(pDest);
  4116. end;
  4117. end;
  4118. end;
  4119. else
  4120. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  4121. end;
  4122. SetData(NewImage, PngFormat, Png.Header.Width, Png.Header.Height);
  4123. result := true;
  4124. except
  4125. if Assigned(NewImage) then
  4126. FreeMem(NewImage);
  4127. raise;
  4128. end;
  4129. finally
  4130. Png.Free;
  4131. end;
  4132. end;
  4133. end;
  4134. {$IFEND}
  4135. {$ENDIF}
  4136. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  4137. {$IFDEF GLB_LIB_PNG}
  4138. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4139. procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  4140. begin
  4141. TStream(png_get_io_ptr(png)).Write(buffer^, size);
  4142. end;
  4143. {$ENDIF}
  4144. {$IF DEFINED(GLB_LAZ_PNG)}
  4145. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4146. procedure TglBitmapData.SavePNG(const aStream: TStream);
  4147. var
  4148. png: TPortableNetworkGraphic;
  4149. intf: TLazIntfImage;
  4150. raw: TRawImage;
  4151. begin
  4152. png := TPortableNetworkGraphic.Create;
  4153. intf := TLazIntfImage.Create(0, 0);
  4154. try
  4155. if not AssignToLazIntfImage(intf) then
  4156. raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
  4157. intf.GetRawImage(raw);
  4158. png.LoadFromRawImage(raw, false);
  4159. png.SaveToStream(aStream);
  4160. finally
  4161. png.Free;
  4162. intf.Free;
  4163. end;
  4164. end;
  4165. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  4166. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4167. procedure TglBitmapData.SavePNG(const aStream: TStream);
  4168. var
  4169. png: png_structp;
  4170. png_info: png_infop;
  4171. png_rows: array of pByte;
  4172. LineSize: Integer;
  4173. ColorType: Integer;
  4174. Row: Integer;
  4175. FormatDesc: TFormatDescriptor;
  4176. begin
  4177. if not (ftPNG in FormatGetSupportedFiles(Format)) then
  4178. raise EglBitmapUnsupportedFormat.Create(Format);
  4179. if not init_libPNG then
  4180. raise Exception.Create('unable to initialize libPNG.');
  4181. try
  4182. case Format of
  4183. tfAlpha8ub1, tfLuminance8ub1:
  4184. ColorType := PNG_COLOR_TYPE_GRAY;
  4185. tfLuminance8Alpha8us1:
  4186. ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
  4187. tfBGR8ub3, tfRGB8ub3:
  4188. ColorType := PNG_COLOR_TYPE_RGB;
  4189. tfBGRA8ub4, tfRGBA8ub4:
  4190. ColorType := PNG_COLOR_TYPE_RGBA;
  4191. else
  4192. raise EglBitmapUnsupportedFormat.Create(Format);
  4193. end;
  4194. FormatDesc := TFormatDescriptor.Get(Format);
  4195. LineSize := FormatDesc.GetSize(Width, 1);
  4196. // creating array for scanline
  4197. SetLength(png_rows, Height);
  4198. try
  4199. for Row := 0 to Height - 1 do begin
  4200. png_rows[Row] := Data;
  4201. Inc(png_rows[Row], Row * LineSize)
  4202. end;
  4203. // write struct
  4204. png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  4205. if png = nil then
  4206. raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
  4207. // create png info
  4208. png_info := png_create_info_struct(png);
  4209. if png_info = nil then begin
  4210. png_destroy_write_struct(@png, nil);
  4211. raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
  4212. end;
  4213. // set read callback
  4214. png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
  4215. // set compression
  4216. png_set_compression_level(png, 6);
  4217. if Format in [tfBGR8ub3, tfBGRA8ub4] then
  4218. png_set_bgr(png);
  4219. png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
  4220. png_write_info(png, png_info);
  4221. png_write_image(png, @png_rows[0]);
  4222. png_write_end(png, png_info);
  4223. png_destroy_write_struct(@png, @png_info);
  4224. finally
  4225. SetLength(png_rows, 0);
  4226. end;
  4227. finally
  4228. quit_libPNG;
  4229. end;
  4230. end;
  4231. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  4232. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4233. procedure TglBitmapData.SavePNG(const aStream: TStream);
  4234. var
  4235. Png: TPNGObject;
  4236. pSource, pDest: pByte;
  4237. X, Y, PixSize: Integer;
  4238. ColorType: Cardinal;
  4239. Alpha: Boolean;
  4240. pTemp: pByte;
  4241. Temp: Byte;
  4242. begin
  4243. if not (ftPNG in FormatGetSupportedFiles (Format)) then
  4244. raise EglBitmapUnsupportedFormat.Create(Format);
  4245. case Format of
  4246. tfAlpha8ub1, tfLuminance8ub1: begin
  4247. ColorType := COLOR_GRAYSCALE;
  4248. PixSize := 1;
  4249. Alpha := false;
  4250. end;
  4251. tfLuminance8Alpha8us1: begin
  4252. ColorType := COLOR_GRAYSCALEALPHA;
  4253. PixSize := 1;
  4254. Alpha := true;
  4255. end;
  4256. tfBGR8ub3, tfRGB8ub3: begin
  4257. ColorType := COLOR_RGB;
  4258. PixSize := 3;
  4259. Alpha := false;
  4260. end;
  4261. tfBGRA8ub4, tfRGBA8ub4: begin
  4262. ColorType := COLOR_RGBALPHA;
  4263. PixSize := 3;
  4264. Alpha := true
  4265. end;
  4266. else
  4267. raise EglBitmapUnsupportedFormat.Create(Format);
  4268. end;
  4269. Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
  4270. try
  4271. // Copy ImageData
  4272. pSource := Data;
  4273. for Y := 0 to Height -1 do begin
  4274. pDest := png.ScanLine[Y];
  4275. for X := 0 to Width -1 do begin
  4276. Move(pSource^, pDest^, PixSize);
  4277. Inc(pDest, PixSize);
  4278. Inc(pSource, PixSize);
  4279. if Alpha then begin
  4280. png.AlphaScanline[Y]^[X] := pSource^;
  4281. Inc(pSource);
  4282. end;
  4283. end;
  4284. // convert RGB line to BGR
  4285. if Format in [tfRGB8ub3, tfRGBA8ub4] then begin
  4286. pTemp := png.ScanLine[Y];
  4287. for X := 0 to Width -1 do begin
  4288. Temp := pByteArray(pTemp)^[0];
  4289. pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
  4290. pByteArray(pTemp)^[2] := Temp;
  4291. Inc(pTemp, 3);
  4292. end;
  4293. end;
  4294. end;
  4295. // Save to Stream
  4296. Png.CompressionLevel := 6;
  4297. Png.SaveToStream(aStream);
  4298. finally
  4299. FreeAndNil(Png);
  4300. end;
  4301. end;
  4302. {$IFEND}
  4303. {$ENDIF}
  4304. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4305. //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4306. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4307. {$IFDEF GLB_LIB_JPEG}
  4308. type
  4309. glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
  4310. glBitmap_libJPEG_source_mgr = record
  4311. pub: jpeg_source_mgr;
  4312. SrcStream: TStream;
  4313. SrcBuffer: array [1..4096] of byte;
  4314. end;
  4315. glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
  4316. glBitmap_libJPEG_dest_mgr = record
  4317. pub: jpeg_destination_mgr;
  4318. DestStream: TStream;
  4319. DestBuffer: array [1..4096] of byte;
  4320. end;
  4321. procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
  4322. begin
  4323. //DUMMY
  4324. end;
  4325. procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
  4326. begin
  4327. //DUMMY
  4328. end;
  4329. procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
  4330. begin
  4331. //DUMMY
  4332. end;
  4333. procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
  4334. begin
  4335. //DUMMY
  4336. end;
  4337. procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
  4338. begin
  4339. //DUMMY
  4340. end;
  4341. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4342. function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
  4343. var
  4344. src: glBitmap_libJPEG_source_mgr_ptr;
  4345. bytes: integer;
  4346. begin
  4347. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  4348. bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
  4349. if (bytes <= 0) then begin
  4350. src^.SrcBuffer[1] := $FF;
  4351. src^.SrcBuffer[2] := JPEG_EOI;
  4352. bytes := 2;
  4353. end;
  4354. src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
  4355. src^.pub.bytes_in_buffer := bytes;
  4356. result := true;
  4357. end;
  4358. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4359. procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
  4360. var
  4361. src: glBitmap_libJPEG_source_mgr_ptr;
  4362. begin
  4363. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  4364. if num_bytes > 0 then begin
  4365. // wanted byte isn't in buffer so set stream position and read buffer
  4366. if num_bytes > src^.pub.bytes_in_buffer then begin
  4367. src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
  4368. src^.pub.fill_input_buffer(cinfo);
  4369. end else begin
  4370. // wanted byte is in buffer so only skip
  4371. inc(src^.pub.next_input_byte, num_bytes);
  4372. dec(src^.pub.bytes_in_buffer, num_bytes);
  4373. end;
  4374. end;
  4375. end;
  4376. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4377. function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
  4378. var
  4379. dest: glBitmap_libJPEG_dest_mgr_ptr;
  4380. begin
  4381. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  4382. if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
  4383. // write complete buffer
  4384. dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
  4385. // reset buffer
  4386. dest^.pub.next_output_byte := @dest^.DestBuffer[1];
  4387. dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
  4388. end;
  4389. result := true;
  4390. end;
  4391. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4392. procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
  4393. var
  4394. Idx: Integer;
  4395. dest: glBitmap_libJPEG_dest_mgr_ptr;
  4396. begin
  4397. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  4398. for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
  4399. // check for endblock
  4400. if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
  4401. // write endblock
  4402. dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
  4403. // leave
  4404. break;
  4405. end else
  4406. dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
  4407. end;
  4408. end;
  4409. {$ENDIF}
  4410. {$IFDEF GLB_SUPPORT_JPEG_READ}
  4411. {$IF DEFINED(GLB_LAZ_JPEG)}
  4412. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4413. function TglBitmapData.LoadJPEG(const aStream: TStream): Boolean;
  4414. const
  4415. MAGIC_LEN = 2;
  4416. JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
  4417. var
  4418. intf: TLazIntfImage;
  4419. reader: TFPReaderJPEG;
  4420. StreamPos: Int64;
  4421. magic: String[MAGIC_LEN];
  4422. begin
  4423. result := true;
  4424. StreamPos := aStream.Position;
  4425. SetLength(magic, MAGIC_LEN);
  4426. aStream.Read(magic[1], MAGIC_LEN);
  4427. aStream.Position := StreamPos;
  4428. if (magic <> JPEG_MAGIC) then begin
  4429. result := false;
  4430. exit;
  4431. end;
  4432. reader := TFPReaderJPEG.Create;
  4433. intf := TLazIntfImage.Create(0, 0);
  4434. try try
  4435. intf.DataDescription := GetDescriptionFromDevice(0, 0, 0);
  4436. reader.ImageRead(aStream, intf);
  4437. AssignFromLazIntfImage(intf);
  4438. except
  4439. result := false;
  4440. aStream.Position := StreamPos;
  4441. exit;
  4442. end;
  4443. finally
  4444. reader.Free;
  4445. intf.Free;
  4446. end;
  4447. end;
  4448. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
  4449. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4450. function TglBitmapData.LoadJPEG(const aStream: TStream): Boolean;
  4451. var
  4452. Surface: PSDL_Surface;
  4453. RWops: PSDL_RWops;
  4454. begin
  4455. result := false;
  4456. RWops := glBitmapCreateRWops(aStream);
  4457. try
  4458. if IMG_isJPG(RWops) > 0 then begin
  4459. Surface := IMG_LoadJPG_RW(RWops);
  4460. try
  4461. AssignFromSurface(Surface);
  4462. result := true;
  4463. finally
  4464. SDL_FreeSurface(Surface);
  4465. end;
  4466. end;
  4467. finally
  4468. SDL_FreeRW(RWops);
  4469. end;
  4470. end;
  4471. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  4472. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4473. function TglBitmapData.LoadJPEG(const aStream: TStream): Boolean;
  4474. var
  4475. StreamPos: Int64;
  4476. Temp: array[0..1]of Byte;
  4477. jpeg: jpeg_decompress_struct;
  4478. jpeg_err: jpeg_error_mgr;
  4479. IntFormat: TglBitmapFormat;
  4480. pImage: pByte;
  4481. TempHeight, TempWidth: Integer;
  4482. pTemp: pByte;
  4483. Row: Integer;
  4484. FormatDesc: TFormatDescriptor;
  4485. begin
  4486. result := false;
  4487. if not init_libJPEG then
  4488. raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
  4489. try
  4490. // reading first two bytes to test file and set cursor back to begin
  4491. StreamPos := aStream.Position;
  4492. aStream.Read({%H-}Temp[0], 2);
  4493. aStream.Position := StreamPos;
  4494. // if Bitmap then read file.
  4495. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  4496. FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
  4497. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  4498. // error managment
  4499. jpeg.err := jpeg_std_error(@jpeg_err);
  4500. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  4501. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  4502. // decompression struct
  4503. jpeg_create_decompress(@jpeg);
  4504. // allocation space for streaming methods
  4505. jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
  4506. // seeting up custom functions
  4507. with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
  4508. pub.init_source := glBitmap_libJPEG_init_source;
  4509. pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
  4510. pub.skip_input_data := glBitmap_libJPEG_skip_input_data;
  4511. pub.resync_to_restart := jpeg_resync_to_restart; // use default method
  4512. pub.term_source := glBitmap_libJPEG_term_source;
  4513. pub.bytes_in_buffer := 0; // forces fill_input_buffer on first read
  4514. pub.next_input_byte := nil; // until buffer loaded
  4515. SrcStream := aStream;
  4516. end;
  4517. // set global decoding state
  4518. jpeg.global_state := DSTATE_START;
  4519. // read header of jpeg
  4520. jpeg_read_header(@jpeg, false);
  4521. // setting output parameter
  4522. case jpeg.jpeg_color_space of
  4523. JCS_GRAYSCALE:
  4524. begin
  4525. jpeg.out_color_space := JCS_GRAYSCALE;
  4526. IntFormat := tfLuminance8ub1;
  4527. end;
  4528. else
  4529. jpeg.out_color_space := JCS_RGB;
  4530. IntFormat := tfRGB8ub3;
  4531. end;
  4532. // reading image
  4533. jpeg_start_decompress(@jpeg);
  4534. TempHeight := jpeg.output_height;
  4535. TempWidth := jpeg.output_width;
  4536. FormatDesc := TFormatDescriptor.Get(IntFormat);
  4537. // creating new image
  4538. GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
  4539. try
  4540. pTemp := pImage;
  4541. for Row := 0 to TempHeight -1 do begin
  4542. jpeg_read_scanlines(@jpeg, @pTemp, 1);
  4543. Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
  4544. end;
  4545. // finish decompression
  4546. jpeg_finish_decompress(@jpeg);
  4547. // destroy decompression
  4548. jpeg_destroy_decompress(@jpeg);
  4549. SetData(pImage, IntFormat, TempWidth, TempHeight);
  4550. result := true;
  4551. except
  4552. if Assigned(pImage) then
  4553. FreeMem(pImage);
  4554. raise;
  4555. end;
  4556. end;
  4557. finally
  4558. quit_libJPEG;
  4559. end;
  4560. end;
  4561. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  4562. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4563. function TglBitmapData.LoadJPEG(const aStream: TStream): Boolean;
  4564. var
  4565. bmp: TBitmap;
  4566. jpg: TJPEGImage;
  4567. StreamPos: Int64;
  4568. Temp: array[0..1]of Byte;
  4569. begin
  4570. result := false;
  4571. // reading first two bytes to test file and set cursor back to begin
  4572. StreamPos := aStream.Position;
  4573. aStream.Read(Temp[0], 2);
  4574. aStream.Position := StreamPos;
  4575. // if Bitmap then read file.
  4576. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  4577. bmp := TBitmap.Create;
  4578. try
  4579. jpg := TJPEGImage.Create;
  4580. try
  4581. jpg.LoadFromStream(aStream);
  4582. bmp.Assign(jpg);
  4583. result := AssignFromBitmap(bmp);
  4584. finally
  4585. jpg.Free;
  4586. end;
  4587. finally
  4588. bmp.Free;
  4589. end;
  4590. end;
  4591. end;
  4592. {$IFEND}
  4593. {$ENDIF}
  4594. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  4595. {$IF DEFINED(GLB_LAZ_JPEG)}
  4596. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4597. procedure TglBitmapData.SaveJPEG(const aStream: TStream);
  4598. var
  4599. jpeg: TJPEGImage;
  4600. intf: TLazIntfImage;
  4601. raw: TRawImage;
  4602. begin
  4603. jpeg := TJPEGImage.Create;
  4604. intf := TLazIntfImage.Create(0, 0);
  4605. try
  4606. if not AssignToLazIntfImage(intf) then
  4607. raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
  4608. intf.GetRawImage(raw);
  4609. jpeg.LoadFromRawImage(raw, false);
  4610. jpeg.SaveToStream(aStream);
  4611. finally
  4612. intf.Free;
  4613. jpeg.Free;
  4614. end;
  4615. end;
  4616. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  4617. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4618. procedure TglBitmapData.SaveJPEG(const aStream: TStream);
  4619. var
  4620. jpeg: jpeg_compress_struct;
  4621. jpeg_err: jpeg_error_mgr;
  4622. Row: Integer;
  4623. pTemp, pTemp2: pByte;
  4624. procedure CopyRow(pDest, pSource: pByte);
  4625. var
  4626. X: Integer;
  4627. begin
  4628. for X := 0 to Width - 1 do begin
  4629. pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
  4630. pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
  4631. pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
  4632. Inc(pDest, 3);
  4633. Inc(pSource, 3);
  4634. end;
  4635. end;
  4636. begin
  4637. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  4638. raise EglBitmapUnsupportedFormat.Create(Format);
  4639. if not init_libJPEG then
  4640. raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
  4641. try
  4642. FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
  4643. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  4644. // error managment
  4645. jpeg.err := jpeg_std_error(@jpeg_err);
  4646. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  4647. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  4648. // compression struct
  4649. jpeg_create_compress(@jpeg);
  4650. // allocation space for streaming methods
  4651. jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
  4652. // seeting up custom functions
  4653. with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
  4654. pub.init_destination := glBitmap_libJPEG_init_destination;
  4655. pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
  4656. pub.term_destination := glBitmap_libJPEG_term_destination;
  4657. pub.next_output_byte := @DestBuffer[1];
  4658. pub.free_in_buffer := Length(DestBuffer);
  4659. DestStream := aStream;
  4660. end;
  4661. // very important state
  4662. jpeg.global_state := CSTATE_START;
  4663. jpeg.image_width := Width;
  4664. jpeg.image_height := Height;
  4665. case Format of
  4666. tfAlpha8ub1, tfLuminance8ub1: begin
  4667. jpeg.input_components := 1;
  4668. jpeg.in_color_space := JCS_GRAYSCALE;
  4669. end;
  4670. tfRGB8ub3, tfBGR8ub3: begin
  4671. jpeg.input_components := 3;
  4672. jpeg.in_color_space := JCS_RGB;
  4673. end;
  4674. end;
  4675. jpeg_set_defaults(@jpeg);
  4676. jpeg_set_quality(@jpeg, 95, true);
  4677. jpeg_start_compress(@jpeg, true);
  4678. pTemp := Data;
  4679. if Format = tfBGR8ub3 then
  4680. GetMem(pTemp2, fRowSize)
  4681. else
  4682. pTemp2 := pTemp;
  4683. try
  4684. for Row := 0 to jpeg.image_height -1 do begin
  4685. // prepare row
  4686. if Format = tfBGR8ub3 then
  4687. CopyRow(pTemp2, pTemp)
  4688. else
  4689. pTemp2 := pTemp;
  4690. // write row
  4691. jpeg_write_scanlines(@jpeg, @pTemp2, 1);
  4692. inc(pTemp, fRowSize);
  4693. end;
  4694. finally
  4695. // free memory
  4696. if Format = tfBGR8ub3 then
  4697. FreeMem(pTemp2);
  4698. end;
  4699. jpeg_finish_compress(@jpeg);
  4700. jpeg_destroy_compress(@jpeg);
  4701. finally
  4702. quit_libJPEG;
  4703. end;
  4704. end;
  4705. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  4706. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4707. procedure TglBitmapData.SaveJPEG(const aStream: TStream);
  4708. var
  4709. Bmp: TBitmap;
  4710. Jpg: TJPEGImage;
  4711. begin
  4712. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  4713. raise EglBitmapUnsupportedFormat.Create(Format);
  4714. Bmp := TBitmap.Create;
  4715. try
  4716. Jpg := TJPEGImage.Create;
  4717. try
  4718. AssignToBitmap(Bmp);
  4719. if (Format in [tfAlpha8ub1, tfLuminance8ub1]) then begin
  4720. Jpg.Grayscale := true;
  4721. Jpg.PixelFormat := jf8Bit;
  4722. end;
  4723. Jpg.Assign(Bmp);
  4724. Jpg.SaveToStream(aStream);
  4725. finally
  4726. FreeAndNil(Jpg);
  4727. end;
  4728. finally
  4729. FreeAndNil(Bmp);
  4730. end;
  4731. end;
  4732. {$IFEND}
  4733. {$ENDIF}
  4734. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4735. //RAW/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4736. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4737. type
  4738. RawHeader = packed record
  4739. Magic: String[5];
  4740. Version: Byte;
  4741. Width: Integer;
  4742. Height: Integer;
  4743. DataSize: Integer;
  4744. BitsPerPixel: Integer;
  4745. Precision: TglBitmapRec4ub;
  4746. Shift: TglBitmapRec4ub;
  4747. end;
  4748. function TglBitmapData.LoadRAW(const aStream: TStream): Boolean;
  4749. var
  4750. header: RawHeader;
  4751. StartPos: Int64;
  4752. fd: TFormatDescriptor;
  4753. buf: PByte;
  4754. begin
  4755. result := false;
  4756. StartPos := aStream.Position;
  4757. aStream.Read(header{%H-}, SizeOf(header));
  4758. if (header.Magic <> 'glBMP') then begin
  4759. aStream.Position := StartPos;
  4760. exit;
  4761. end;
  4762. fd := TFormatDescriptor.GetFromPrecShift(header.Precision, header.Shift, header.BitsPerPixel);
  4763. if (fd.Format = tfEmpty) then
  4764. raise EglBitmapUnsupportedFormat.Create('no supported format found');
  4765. buf := GetMemory(header.DataSize);
  4766. aStream.Read(buf^, header.DataSize);
  4767. SetData(buf, fd.Format, header.Width, header.Height);
  4768. result := true;
  4769. end;
  4770. procedure TglBitmapData.SaveRAW(const aStream: TStream);
  4771. var
  4772. header: RawHeader;
  4773. fd: TFormatDescriptor;
  4774. begin
  4775. fd := TFormatDescriptor.Get(Format);
  4776. header.Magic := 'glBMP';
  4777. header.Version := 1;
  4778. header.Width := Width;
  4779. header.Height := Height;
  4780. header.DataSize := fd.GetSize(fDimension);
  4781. header.BitsPerPixel := fd.BitsPerPixel;
  4782. header.Precision := fd.Precision;
  4783. header.Shift := fd.Shift;
  4784. aStream.Write(header, SizeOf(header));
  4785. aStream.Write(Data^, header.DataSize);
  4786. end;
  4787. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4788. //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4789. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4790. const
  4791. BMP_MAGIC = $4D42;
  4792. BMP_COMP_RGB = 0;
  4793. BMP_COMP_RLE8 = 1;
  4794. BMP_COMP_RLE4 = 2;
  4795. BMP_COMP_BITFIELDS = 3;
  4796. type
  4797. TBMPHeader = packed record
  4798. bfType: Word;
  4799. bfSize: Cardinal;
  4800. bfReserved1: Word;
  4801. bfReserved2: Word;
  4802. bfOffBits: Cardinal;
  4803. end;
  4804. TBMPInfo = packed record
  4805. biSize: Cardinal;
  4806. biWidth: Longint;
  4807. biHeight: Longint;
  4808. biPlanes: Word;
  4809. biBitCount: Word;
  4810. biCompression: Cardinal;
  4811. biSizeImage: Cardinal;
  4812. biXPelsPerMeter: Longint;
  4813. biYPelsPerMeter: Longint;
  4814. biClrUsed: Cardinal;
  4815. biClrImportant: Cardinal;
  4816. end;
  4817. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4818. function TglBitmapData.LoadBMP(const aStream: TStream): Boolean;
  4819. //////////////////////////////////////////////////////////////////////////////////////////////////
  4820. function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapRec4ul): TglBitmapFormat;
  4821. var
  4822. tmp, i: Cardinal;
  4823. begin
  4824. result := tfEmpty;
  4825. aStream.Read(aInfo{%H-}, SizeOf(aInfo));
  4826. FillChar(aMask{%H-}, SizeOf(aMask), 0);
  4827. //Read Compression
  4828. case aInfo.biCompression of
  4829. BMP_COMP_RLE4,
  4830. BMP_COMP_RLE8: begin
  4831. raise EglBitmap.Create('RLE compression is not supported');
  4832. end;
  4833. BMP_COMP_BITFIELDS: begin
  4834. if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
  4835. for i := 0 to 2 do begin
  4836. aStream.Read(tmp{%H-}, SizeOf(tmp));
  4837. aMask.arr[i] := tmp;
  4838. end;
  4839. end else
  4840. raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
  4841. end;
  4842. end;
  4843. //get suitable format
  4844. case aInfo.biBitCount of
  4845. 8: result := tfLuminance8ub1;
  4846. 16: result := tfX1RGB5us1;
  4847. 24: result := tfBGR8ub3;
  4848. 32: result := tfXRGB8ui1;
  4849. end;
  4850. end;
  4851. function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
  4852. var
  4853. i, c: Integer;
  4854. fd: TFormatDescriptor;
  4855. ColorTable: TbmpColorTable;
  4856. begin
  4857. result := nil;
  4858. if (aInfo.biBitCount >= 16) then
  4859. exit;
  4860. aFormat := tfLuminance8ub1;
  4861. c := aInfo.biClrUsed;
  4862. if (c = 0) then
  4863. c := 1 shl aInfo.biBitCount;
  4864. SetLength(ColorTable, c);
  4865. for i := 0 to c-1 do begin
  4866. aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
  4867. if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
  4868. aFormat := tfRGB8ub3;
  4869. end;
  4870. fd := TFormatDescriptor.Get(aFormat);
  4871. result := TbmpColorTableFormat.Create;
  4872. result.ColorTable := ColorTable;
  4873. result.SetCustomValues(aFormat, aInfo.biBitCount, fd.Precision, fd.Shift);
  4874. end;
  4875. //////////////////////////////////////////////////////////////////////////////////////////////////
  4876. function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapRec4ul; const aInfo: TBMPInfo): TbmpBitfieldFormat;
  4877. var
  4878. fd: TFormatDescriptor;
  4879. begin
  4880. result := nil;
  4881. if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
  4882. // find suitable format ...
  4883. fd := TFormatDescriptor.GetFromMask(aMask);
  4884. if (fd.Format <> tfEmpty) then begin
  4885. aFormat := fd.Format;
  4886. exit;
  4887. end;
  4888. // or create custom bitfield format
  4889. result := TbmpBitfieldFormat.Create;
  4890. result.SetCustomValues(aInfo.biBitCount, aMask);
  4891. end;
  4892. end;
  4893. var
  4894. //simple types
  4895. StartPos: Int64;
  4896. ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
  4897. PaddingBuff: Cardinal;
  4898. LineBuf, ImageData, TmpData: PByte;
  4899. SourceMD, DestMD: Pointer;
  4900. BmpFormat: TglBitmapFormat;
  4901. //records
  4902. Mask: TglBitmapRec4ul;
  4903. Header: TBMPHeader;
  4904. Info: TBMPInfo;
  4905. //classes
  4906. SpecialFormat: TFormatDescriptor;
  4907. FormatDesc: TFormatDescriptor;
  4908. //////////////////////////////////////////////////////////////////////////////////////////////////
  4909. procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
  4910. var
  4911. i: Integer;
  4912. Pixel: TglBitmapPixelData;
  4913. begin
  4914. aStream.Read(aLineBuf^, rbLineSize);
  4915. SpecialFormat.PreparePixel(Pixel);
  4916. for i := 0 to Info.biWidth-1 do begin
  4917. SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
  4918. glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
  4919. FormatDesc.Map(Pixel, aData, DestMD);
  4920. end;
  4921. end;
  4922. begin
  4923. result := false;
  4924. BmpFormat := tfEmpty;
  4925. SpecialFormat := nil;
  4926. LineBuf := nil;
  4927. SourceMD := nil;
  4928. DestMD := nil;
  4929. // Header
  4930. StartPos := aStream.Position;
  4931. aStream.Read(Header{%H-}, SizeOf(Header));
  4932. if Header.bfType = BMP_MAGIC then begin
  4933. try try
  4934. BmpFormat := ReadInfo(Info, Mask);
  4935. SpecialFormat := ReadColorTable(BmpFormat, Info);
  4936. if not Assigned(SpecialFormat) then
  4937. SpecialFormat := CheckBitfields(BmpFormat, Mask, Info);
  4938. aStream.Position := StartPos + Header.bfOffBits;
  4939. if (BmpFormat <> tfEmpty) then begin
  4940. FormatDesc := TFormatDescriptor.Get(BmpFormat);
  4941. rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
  4942. wbLineSize := Trunc(Info.biWidth * FormatDesc.BytesPerPixel);
  4943. Padding := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
  4944. //get Memory
  4945. DestMD := FormatDesc.CreateMappingData;
  4946. ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
  4947. GetMem(ImageData, ImageSize);
  4948. if Assigned(SpecialFormat) then begin
  4949. GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
  4950. SourceMD := SpecialFormat.CreateMappingData;
  4951. end;
  4952. //read Data
  4953. try try
  4954. FillChar(ImageData^, ImageSize, $FF);
  4955. TmpData := ImageData;
  4956. if (Info.biHeight > 0) then
  4957. Inc(TmpData, wbLineSize * (Info.biHeight-1));
  4958. for i := 0 to Abs(Info.biHeight)-1 do begin
  4959. if Assigned(SpecialFormat) then
  4960. SpecialFormatReadLine(TmpData, LineBuf) //if is special format read and convert data
  4961. else
  4962. aStream.Read(TmpData^, wbLineSize); //else only read data
  4963. if (Info.biHeight > 0) then
  4964. dec(TmpData, wbLineSize)
  4965. else
  4966. inc(TmpData, wbLineSize);
  4967. aStream.Read(PaddingBuff{%H-}, Padding);
  4968. end;
  4969. SetData(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight));
  4970. result := true;
  4971. finally
  4972. if Assigned(LineBuf) then
  4973. FreeMem(LineBuf);
  4974. if Assigned(SourceMD) then
  4975. SpecialFormat.FreeMappingData(SourceMD);
  4976. FormatDesc.FreeMappingData(DestMD);
  4977. end;
  4978. except
  4979. if Assigned(ImageData) then
  4980. FreeMem(ImageData);
  4981. raise;
  4982. end;
  4983. end else
  4984. raise EglBitmap.Create('LoadBMP - No suitable format found');
  4985. except
  4986. aStream.Position := StartPos;
  4987. raise;
  4988. end;
  4989. finally
  4990. FreeAndNil(SpecialFormat);
  4991. end;
  4992. end
  4993. else aStream.Position := StartPos;
  4994. end;
  4995. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4996. procedure TglBitmapData.SaveBMP(const aStream: TStream);
  4997. var
  4998. Header: TBMPHeader;
  4999. Info: TBMPInfo;
  5000. Converter: TFormatDescriptor;
  5001. FormatDesc: TFormatDescriptor;
  5002. SourceFD, DestFD: Pointer;
  5003. pData, srcData, dstData, ConvertBuffer: pByte;
  5004. Pixel: TglBitmapPixelData;
  5005. ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
  5006. RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
  5007. PaddingBuff: Cardinal;
  5008. function GetLineWidth : Integer;
  5009. begin
  5010. result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
  5011. end;
  5012. begin
  5013. if not (ftBMP in FormatGetSupportedFiles(Format)) then
  5014. raise EglBitmapUnsupportedFormat.Create(Format);
  5015. Converter := nil;
  5016. FormatDesc := TFormatDescriptor.Get(Format);
  5017. ImageSize := FormatDesc.GetSize(Dimension);
  5018. FillChar(Header{%H-}, SizeOf(Header), 0);
  5019. Header.bfType := BMP_MAGIC;
  5020. Header.bfSize := SizeOf(Header) + SizeOf(Info) + ImageSize;
  5021. Header.bfReserved1 := 0;
  5022. Header.bfReserved2 := 0;
  5023. Header.bfOffBits := SizeOf(Header) + SizeOf(Info);
  5024. FillChar(Info{%H-}, SizeOf(Info), 0);
  5025. Info.biSize := SizeOf(Info);
  5026. Info.biWidth := Width;
  5027. Info.biHeight := Height;
  5028. Info.biPlanes := 1;
  5029. Info.biCompression := BMP_COMP_RGB;
  5030. Info.biSizeImage := ImageSize;
  5031. try
  5032. case Format of
  5033. tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1:
  5034. begin
  5035. Info.biBitCount := 8;
  5036. Header.bfSize := Header.bfSize + 256 * SizeOf(Cardinal);
  5037. Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
  5038. Converter := TbmpColorTableFormat.Create;
  5039. with (Converter as TbmpColorTableFormat) do begin
  5040. SetCustomValues(fFormat, 8, FormatDesc.Precision, FormatDesc.Shift);
  5041. CreateColorTable;
  5042. end;
  5043. end;
  5044. tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
  5045. tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
  5046. tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1:
  5047. begin
  5048. Info.biBitCount := 16;
  5049. Info.biCompression := BMP_COMP_BITFIELDS;
  5050. end;
  5051. tfBGR8ub3, tfRGB8ub3:
  5052. begin
  5053. Info.biBitCount := 24;
  5054. if (Format = tfRGB8ub3) then
  5055. Converter := TfdBGR8ub3.Create; //use BGR8 Format Descriptor to Swap RGB Values
  5056. end;
  5057. tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
  5058. tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1:
  5059. begin
  5060. Info.biBitCount := 32;
  5061. Info.biCompression := BMP_COMP_BITFIELDS;
  5062. end;
  5063. else
  5064. raise EglBitmapUnsupportedFormat.Create(Format);
  5065. end;
  5066. Info.biXPelsPerMeter := 2835;
  5067. Info.biYPelsPerMeter := 2835;
  5068. // prepare bitmasks
  5069. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  5070. Header.bfSize := Header.bfSize + 4 * SizeOf(Cardinal);
  5071. Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
  5072. RedMask := FormatDesc.Mask.r;
  5073. GreenMask := FormatDesc.Mask.g;
  5074. BlueMask := FormatDesc.Mask.b;
  5075. AlphaMask := FormatDesc.Mask.a;
  5076. end;
  5077. // headers
  5078. aStream.Write(Header, SizeOf(Header));
  5079. aStream.Write(Info, SizeOf(Info));
  5080. // colortable
  5081. if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
  5082. with (Converter as TbmpColorTableFormat) do
  5083. aStream.Write(ColorTable[0].b,
  5084. SizeOf(TbmpColorTableEnty) * Length(ColorTable));
  5085. // bitmasks
  5086. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  5087. aStream.Write(RedMask, SizeOf(Cardinal));
  5088. aStream.Write(GreenMask, SizeOf(Cardinal));
  5089. aStream.Write(BlueMask, SizeOf(Cardinal));
  5090. aStream.Write(AlphaMask, SizeOf(Cardinal));
  5091. end;
  5092. // image data
  5093. rbLineSize := Round(Info.biWidth * FormatDesc.BytesPerPixel);
  5094. wbLineSize := Round(Info.biWidth * Info.biBitCount / 8);
  5095. Padding := GetLineWidth - wbLineSize;
  5096. PaddingBuff := 0;
  5097. pData := Data;
  5098. inc(pData, (Height-1) * rbLineSize);
  5099. // prepare row buffer. But only for RGB because RGBA supports color masks
  5100. // so it's possible to change color within the image.
  5101. if Assigned(Converter) then begin
  5102. FormatDesc.PreparePixel(Pixel);
  5103. GetMem(ConvertBuffer, wbLineSize);
  5104. SourceFD := FormatDesc.CreateMappingData;
  5105. DestFD := Converter.CreateMappingData;
  5106. end else
  5107. ConvertBuffer := nil;
  5108. try
  5109. for LineIdx := 0 to Height - 1 do begin
  5110. // preparing row
  5111. if Assigned(Converter) then begin
  5112. srcData := pData;
  5113. dstData := ConvertBuffer;
  5114. for PixelIdx := 0 to Info.biWidth-1 do begin
  5115. FormatDesc.Unmap(srcData, Pixel, SourceFD);
  5116. glBitmapConvertPixel(Pixel, FormatDesc, Converter);
  5117. Converter.Map(Pixel, dstData, DestFD);
  5118. end;
  5119. aStream.Write(ConvertBuffer^, wbLineSize);
  5120. end else begin
  5121. aStream.Write(pData^, rbLineSize);
  5122. end;
  5123. dec(pData, rbLineSize);
  5124. if (Padding > 0) then
  5125. aStream.Write(PaddingBuff, Padding);
  5126. end;
  5127. finally
  5128. // destroy row buffer
  5129. if Assigned(ConvertBuffer) then begin
  5130. FormatDesc.FreeMappingData(SourceFD);
  5131. Converter.FreeMappingData(DestFD);
  5132. FreeMem(ConvertBuffer);
  5133. end;
  5134. end;
  5135. finally
  5136. if Assigned(Converter) then
  5137. Converter.Free;
  5138. end;
  5139. end;
  5140. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5141. //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5142. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5143. type
  5144. TTGAHeader = packed record
  5145. ImageID: Byte;
  5146. ColorMapType: Byte;
  5147. ImageType: Byte;
  5148. //ColorMapSpec: Array[0..4] of Byte;
  5149. ColorMapStart: Word;
  5150. ColorMapLength: Word;
  5151. ColorMapEntrySize: Byte;
  5152. OrigX: Word;
  5153. OrigY: Word;
  5154. Width: Word;
  5155. Height: Word;
  5156. Bpp: Byte;
  5157. ImageDesc: Byte;
  5158. end;
  5159. const
  5160. TGA_UNCOMPRESSED_RGB = 2;
  5161. TGA_UNCOMPRESSED_GRAY = 3;
  5162. TGA_COMPRESSED_RGB = 10;
  5163. TGA_COMPRESSED_GRAY = 11;
  5164. TGA_NONE_COLOR_TABLE = 0;
  5165. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5166. function TglBitmapData.LoadTGA(const aStream: TStream): Boolean;
  5167. var
  5168. Header: TTGAHeader;
  5169. ImageData: System.PByte;
  5170. StartPosition: Int64;
  5171. PixelSize, LineSize: Integer;
  5172. tgaFormat: TglBitmapFormat;
  5173. FormatDesc: TFormatDescriptor;
  5174. Counter: packed record
  5175. X, Y: packed record
  5176. low, high, dir: Integer;
  5177. end;
  5178. end;
  5179. const
  5180. CACHE_SIZE = $4000;
  5181. ////////////////////////////////////////////////////////////////////////////////////////
  5182. procedure ReadUncompressed;
  5183. var
  5184. i, j: Integer;
  5185. buf, tmp1, tmp2: System.PByte;
  5186. begin
  5187. buf := nil;
  5188. if (Counter.X.dir < 0) then
  5189. GetMem(buf, LineSize);
  5190. try
  5191. while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
  5192. tmp1 := ImageData;
  5193. inc(tmp1, (Counter.Y.low * LineSize)); //pointer to LineStart
  5194. if (Counter.X.dir < 0) then begin //flip X
  5195. aStream.Read(buf^, LineSize);
  5196. tmp2 := buf;
  5197. inc(tmp2, LineSize - PixelSize); //pointer to last pixel in line
  5198. for i := 0 to Header.Width-1 do begin //for all pixels in line
  5199. for j := 0 to PixelSize-1 do begin //for all bytes in pixel
  5200. tmp1^ := tmp2^;
  5201. inc(tmp1);
  5202. inc(tmp2);
  5203. end;
  5204. dec(tmp2, 2*PixelSize); //move 2 backwards, because j-loop moved 1 forward
  5205. end;
  5206. end else
  5207. aStream.Read(tmp1^, LineSize);
  5208. inc(Counter.Y.low, Counter.Y.dir); //move to next line index
  5209. end;
  5210. finally
  5211. if Assigned(buf) then
  5212. FreeMem(buf);
  5213. end;
  5214. end;
  5215. ////////////////////////////////////////////////////////////////////////////////////////
  5216. procedure ReadCompressed;
  5217. /////////////////////////////////////////////////////////////////
  5218. var
  5219. TmpData: System.PByte;
  5220. LinePixelsRead: Integer;
  5221. procedure CheckLine;
  5222. begin
  5223. if (LinePixelsRead >= Header.Width) then begin
  5224. LinePixelsRead := 0;
  5225. inc(Counter.Y.low, Counter.Y.dir); //next line index
  5226. TmpData := ImageData;
  5227. inc(TmpData, Counter.Y.low * LineSize); //set line
  5228. if (Counter.X.dir < 0) then //if x flipped then
  5229. inc(TmpData, LineSize - PixelSize); //set last pixel
  5230. end;
  5231. end;
  5232. /////////////////////////////////////////////////////////////////
  5233. var
  5234. Cache: PByte;
  5235. CacheSize, CachePos: Integer;
  5236. procedure CachedRead(out Buffer; Count: Integer);
  5237. var
  5238. BytesRead: Integer;
  5239. begin
  5240. if (CachePos + Count > CacheSize) then begin
  5241. //if buffer overflow save non read bytes
  5242. BytesRead := 0;
  5243. if (CacheSize - CachePos > 0) then begin
  5244. BytesRead := CacheSize - CachePos;
  5245. Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
  5246. inc(CachePos, BytesRead);
  5247. end;
  5248. //load cache from file
  5249. CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
  5250. aStream.Read(Cache^, CacheSize);
  5251. CachePos := 0;
  5252. //read rest of requested bytes
  5253. if (Count - BytesRead > 0) then begin
  5254. Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
  5255. inc(CachePos, Count - BytesRead);
  5256. end;
  5257. end else begin
  5258. //if no buffer overflow just read the data
  5259. Move(PByteArray(Cache)^[CachePos], Buffer, Count);
  5260. inc(CachePos, Count);
  5261. end;
  5262. end;
  5263. procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
  5264. begin
  5265. case PixelSize of
  5266. 1: begin
  5267. aBuffer^ := aData^;
  5268. inc(aBuffer, Counter.X.dir);
  5269. end;
  5270. 2: begin
  5271. PWord(aBuffer)^ := PWord(aData)^;
  5272. inc(aBuffer, 2 * Counter.X.dir);
  5273. end;
  5274. 3: begin
  5275. PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
  5276. PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
  5277. PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
  5278. inc(aBuffer, 3 * Counter.X.dir);
  5279. end;
  5280. 4: begin
  5281. PCardinal(aBuffer)^ := PCardinal(aData)^;
  5282. inc(aBuffer, 4 * Counter.X.dir);
  5283. end;
  5284. end;
  5285. end;
  5286. var
  5287. TotalPixelsToRead, TotalPixelsRead: Integer;
  5288. Temp: Byte;
  5289. buf: array [0..3] of Byte; //1 pixel is max 32bit long
  5290. PixelRepeat: Boolean;
  5291. PixelsToRead, PixelCount: Integer;
  5292. begin
  5293. CacheSize := 0;
  5294. CachePos := 0;
  5295. TotalPixelsToRead := Header.Width * Header.Height;
  5296. TotalPixelsRead := 0;
  5297. LinePixelsRead := 0;
  5298. GetMem(Cache, CACHE_SIZE);
  5299. try
  5300. TmpData := ImageData;
  5301. inc(TmpData, Counter.Y.low * LineSize); //set line
  5302. if (Counter.X.dir < 0) then //if x flipped then
  5303. inc(TmpData, LineSize - PixelSize); //set last pixel
  5304. repeat
  5305. //read CommandByte
  5306. CachedRead(Temp, 1);
  5307. PixelRepeat := (Temp and $80) > 0;
  5308. PixelsToRead := (Temp and $7F) + 1;
  5309. inc(TotalPixelsRead, PixelsToRead);
  5310. if PixelRepeat then
  5311. CachedRead(buf[0], PixelSize);
  5312. while (PixelsToRead > 0) do begin
  5313. CheckLine;
  5314. PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
  5315. while (PixelCount > 0) do begin
  5316. if not PixelRepeat then
  5317. CachedRead(buf[0], PixelSize);
  5318. PixelToBuffer(@buf[0], TmpData);
  5319. inc(LinePixelsRead);
  5320. dec(PixelsToRead);
  5321. dec(PixelCount);
  5322. end;
  5323. end;
  5324. until (TotalPixelsRead >= TotalPixelsToRead);
  5325. finally
  5326. FreeMem(Cache);
  5327. end;
  5328. end;
  5329. function IsGrayFormat: Boolean;
  5330. begin
  5331. result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
  5332. end;
  5333. begin
  5334. result := false;
  5335. // reading header to test file and set cursor back to begin
  5336. StartPosition := aStream.Position;
  5337. aStream.Read(Header{%H-}, SizeOf(Header));
  5338. // no colormapped files
  5339. if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
  5340. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
  5341. begin
  5342. try
  5343. if Header.ImageID <> 0 then // skip image ID
  5344. aStream.Position := aStream.Position + Header.ImageID;
  5345. tgaFormat := tfEmpty;
  5346. case Header.Bpp of
  5347. 8: if IsGrayFormat then case (Header.ImageDesc and $F) of
  5348. 0: tgaFormat := tfLuminance8ub1;
  5349. 8: tgaFormat := tfAlpha8ub1;
  5350. end;
  5351. 16: if IsGrayFormat then case (Header.ImageDesc and $F) of
  5352. 0: tgaFormat := tfLuminance16us1;
  5353. 8: tgaFormat := tfLuminance8Alpha8ub2;
  5354. end else case (Header.ImageDesc and $F) of
  5355. 0: tgaFormat := tfX1RGB5us1;
  5356. 1: tgaFormat := tfA1RGB5us1;
  5357. 4: tgaFormat := tfARGB4us1;
  5358. end;
  5359. 24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  5360. 0: tgaFormat := tfBGR8ub3;
  5361. end;
  5362. 32: if IsGrayFormat then case (Header.ImageDesc and $F) of
  5363. 0: tgaFormat := tfDepth32ui1;
  5364. end else case (Header.ImageDesc and $F) of
  5365. 0: tgaFormat := tfX2RGB10ui1;
  5366. 2: tgaFormat := tfA2RGB10ui1;
  5367. 8: tgaFormat := tfARGB8ui1;
  5368. end;
  5369. end;
  5370. if (tgaFormat = tfEmpty) then
  5371. raise EglBitmap.Create('LoadTga - unsupported format');
  5372. FormatDesc := TFormatDescriptor.Get(tgaFormat);
  5373. PixelSize := FormatDesc.GetSize(1, 1);
  5374. LineSize := FormatDesc.GetSize(Header.Width, 1);
  5375. GetMem(ImageData, LineSize * Header.Height);
  5376. try
  5377. //column direction
  5378. if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
  5379. Counter.X.low := Header.Height-1;;
  5380. Counter.X.high := 0;
  5381. Counter.X.dir := -1;
  5382. end else begin
  5383. Counter.X.low := 0;
  5384. Counter.X.high := Header.Height-1;
  5385. Counter.X.dir := 1;
  5386. end;
  5387. // Row direction
  5388. if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
  5389. Counter.Y.low := 0;
  5390. Counter.Y.high := Header.Height-1;
  5391. Counter.Y.dir := 1;
  5392. end else begin
  5393. Counter.Y.low := Header.Height-1;;
  5394. Counter.Y.high := 0;
  5395. Counter.Y.dir := -1;
  5396. end;
  5397. // Read Image
  5398. case Header.ImageType of
  5399. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
  5400. ReadUncompressed;
  5401. TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
  5402. ReadCompressed;
  5403. end;
  5404. SetData(ImageData, tgaFormat, Header.Width, Header.Height);
  5405. result := true;
  5406. except
  5407. if Assigned(ImageData) then
  5408. FreeMem(ImageData);
  5409. raise;
  5410. end;
  5411. finally
  5412. aStream.Position := StartPosition;
  5413. end;
  5414. end
  5415. else aStream.Position := StartPosition;
  5416. end;
  5417. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5418. procedure TglBitmapData.SaveTGA(const aStream: TStream);
  5419. var
  5420. Header: TTGAHeader;
  5421. Size: Integer;
  5422. FormatDesc: TFormatDescriptor;
  5423. begin
  5424. if not (ftTGA in FormatGetSupportedFiles(Format)) then
  5425. raise EglBitmapUnsupportedFormat.Create(Format);
  5426. //prepare header
  5427. FormatDesc := TFormatDescriptor.Get(Format);
  5428. FillChar(Header{%H-}, SizeOf(Header), 0);
  5429. Header.ImageDesc := CountSetBits(FormatDesc.Range.a) and $F;
  5430. Header.Bpp := FormatDesc.BitsPerPixel;
  5431. Header.Width := Width;
  5432. Header.Height := Height;
  5433. Header.ImageDesc := Header.ImageDesc or $20; //flip y
  5434. if FormatDesc.IsGrayscale or (not FormatDesc.IsGrayscale and not FormatDesc.HasRed and FormatDesc.HasAlpha) then
  5435. Header.ImageType := TGA_UNCOMPRESSED_GRAY
  5436. else
  5437. Header.ImageType := TGA_UNCOMPRESSED_RGB;
  5438. aStream.Write(Header, SizeOf(Header));
  5439. // write Data
  5440. Size := FormatDesc.GetSize(Dimension);
  5441. aStream.Write(Data^, Size);
  5442. end;
  5443. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5444. //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5445. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5446. const
  5447. DDS_MAGIC: Cardinal = $20534444;
  5448. // DDS_header.dwFlags
  5449. DDSD_CAPS = $00000001;
  5450. DDSD_HEIGHT = $00000002;
  5451. DDSD_WIDTH = $00000004;
  5452. DDSD_PIXELFORMAT = $00001000;
  5453. // DDS_header.sPixelFormat.dwFlags
  5454. DDPF_ALPHAPIXELS = $00000001;
  5455. DDPF_ALPHA = $00000002;
  5456. DDPF_FOURCC = $00000004;
  5457. DDPF_RGB = $00000040;
  5458. DDPF_LUMINANCE = $00020000;
  5459. // DDS_header.sCaps.dwCaps1
  5460. DDSCAPS_TEXTURE = $00001000;
  5461. // DDS_header.sCaps.dwCaps2
  5462. DDSCAPS2_CUBEMAP = $00000200;
  5463. D3DFMT_DXT1 = $31545844;
  5464. D3DFMT_DXT3 = $33545844;
  5465. D3DFMT_DXT5 = $35545844;
  5466. type
  5467. TDDSPixelFormat = packed record
  5468. dwSize: Cardinal;
  5469. dwFlags: Cardinal;
  5470. dwFourCC: Cardinal;
  5471. dwRGBBitCount: Cardinal;
  5472. dwRBitMask: Cardinal;
  5473. dwGBitMask: Cardinal;
  5474. dwBBitMask: Cardinal;
  5475. dwABitMask: Cardinal;
  5476. end;
  5477. TDDSCaps = packed record
  5478. dwCaps1: Cardinal;
  5479. dwCaps2: Cardinal;
  5480. dwDDSX: Cardinal;
  5481. dwReserved: Cardinal;
  5482. end;
  5483. TDDSHeader = packed record
  5484. dwSize: Cardinal;
  5485. dwFlags: Cardinal;
  5486. dwHeight: Cardinal;
  5487. dwWidth: Cardinal;
  5488. dwPitchOrLinearSize: Cardinal;
  5489. dwDepth: Cardinal;
  5490. dwMipMapCount: Cardinal;
  5491. dwReserved: array[0..10] of Cardinal;
  5492. PixelFormat: TDDSPixelFormat;
  5493. Caps: TDDSCaps;
  5494. dwReserved2: Cardinal;
  5495. end;
  5496. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5497. function TglBitmapData.LoadDDS(const aStream: TStream): Boolean;
  5498. var
  5499. Header: TDDSHeader;
  5500. Converter: TbmpBitfieldFormat;
  5501. function GetDDSFormat: TglBitmapFormat;
  5502. var
  5503. fd: TFormatDescriptor;
  5504. i: Integer;
  5505. Mask: TglBitmapRec4ul;
  5506. Range: TglBitmapRec4ui;
  5507. match: Boolean;
  5508. begin
  5509. result := tfEmpty;
  5510. with Header.PixelFormat do begin
  5511. // Compresses
  5512. if ((dwFlags and DDPF_FOURCC) > 0) then begin
  5513. case Header.PixelFormat.dwFourCC of
  5514. D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
  5515. D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
  5516. D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
  5517. end;
  5518. end else if ((dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE or DDPF_ALPHA)) > 0) then begin
  5519. // prepare masks
  5520. if ((dwFlags and DDPF_LUMINANCE) = 0) then begin
  5521. Mask.r := dwRBitMask;
  5522. Mask.g := dwGBitMask;
  5523. Mask.b := dwBBitMask;
  5524. end else begin
  5525. Mask.r := dwRBitMask;
  5526. Mask.g := dwRBitMask;
  5527. Mask.b := dwRBitMask;
  5528. end;
  5529. if (dwFlags and DDPF_ALPHAPIXELS > 0) then
  5530. Mask.a := dwABitMask
  5531. else
  5532. Mask.a := 0;;
  5533. //find matching format
  5534. fd := TFormatDescriptor.GetFromMask(Mask, dwRGBBitCount);
  5535. result := fd.Format;
  5536. if (result <> tfEmpty) then
  5537. exit;
  5538. //find format with same Range
  5539. for i := 0 to 3 do
  5540. Range.arr[i] := (2 shl CountSetBits(Mask.arr[i])) - 1;
  5541. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  5542. fd := TFormatDescriptor.Get(result);
  5543. match := true;
  5544. for i := 0 to 3 do
  5545. if (fd.Range.arr[i] <> Range.arr[i]) then begin
  5546. match := false;
  5547. break;
  5548. end;
  5549. if match then
  5550. break;
  5551. end;
  5552. //no format with same range found -> use default
  5553. if (result = tfEmpty) then begin
  5554. if (dwABitMask > 0) then
  5555. result := tfRGBA8ui1
  5556. else
  5557. result := tfRGB8ub3;
  5558. end;
  5559. Converter := TbmpBitfieldFormat.Create;
  5560. Converter.SetCustomValues(dwRGBBitCount, glBitmapRec4ul(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask));
  5561. end;
  5562. end;
  5563. end;
  5564. var
  5565. StreamPos: Int64;
  5566. x, y, LineSize, RowSize, Magic: Cardinal;
  5567. NewImage, TmpData, RowData, SrcData: System.PByte;
  5568. SourceMD, DestMD: Pointer;
  5569. Pixel: TglBitmapPixelData;
  5570. ddsFormat: TglBitmapFormat;
  5571. FormatDesc: TFormatDescriptor;
  5572. begin
  5573. result := false;
  5574. Converter := nil;
  5575. StreamPos := aStream.Position;
  5576. // Magic
  5577. aStream.Read(Magic{%H-}, sizeof(Magic));
  5578. if (Magic <> DDS_MAGIC) then begin
  5579. aStream.Position := StreamPos;
  5580. exit;
  5581. end;
  5582. //Header
  5583. aStream.Read(Header{%H-}, sizeof(Header));
  5584. if (Header.dwSize <> SizeOf(Header)) or
  5585. ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
  5586. (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
  5587. begin
  5588. aStream.Position := StreamPos;
  5589. exit;
  5590. end;
  5591. if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
  5592. raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
  5593. ddsFormat := GetDDSFormat;
  5594. try
  5595. if (ddsFormat = tfEmpty) then
  5596. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  5597. FormatDesc := TFormatDescriptor.Get(ddsFormat);
  5598. LineSize := Trunc(Header.dwWidth * FormatDesc.BytesPerPixel);
  5599. GetMem(NewImage, Header.dwHeight * LineSize);
  5600. try
  5601. TmpData := NewImage;
  5602. //Converter needed
  5603. if Assigned(Converter) then begin
  5604. RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
  5605. GetMem(RowData, RowSize);
  5606. SourceMD := Converter.CreateMappingData;
  5607. DestMD := FormatDesc.CreateMappingData;
  5608. try
  5609. for y := 0 to Header.dwHeight-1 do begin
  5610. TmpData := NewImage;
  5611. inc(TmpData, y * LineSize);
  5612. SrcData := RowData;
  5613. aStream.Read(SrcData^, RowSize);
  5614. for x := 0 to Header.dwWidth-1 do begin
  5615. Converter.Unmap(SrcData, Pixel, SourceMD);
  5616. glBitmapConvertPixel(Pixel, Converter, FormatDesc);
  5617. FormatDesc.Map(Pixel, TmpData, DestMD);
  5618. end;
  5619. end;
  5620. finally
  5621. Converter.FreeMappingData(SourceMD);
  5622. FormatDesc.FreeMappingData(DestMD);
  5623. FreeMem(RowData);
  5624. end;
  5625. end else
  5626. // Compressed
  5627. if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
  5628. RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
  5629. for Y := 0 to Header.dwHeight-1 do begin
  5630. aStream.Read(TmpData^, RowSize);
  5631. Inc(TmpData, LineSize);
  5632. end;
  5633. end else
  5634. // Uncompressed
  5635. if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
  5636. RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
  5637. for Y := 0 to Header.dwHeight-1 do begin
  5638. aStream.Read(TmpData^, RowSize);
  5639. Inc(TmpData, LineSize);
  5640. end;
  5641. end else
  5642. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  5643. SetData(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight);
  5644. result := true;
  5645. except
  5646. if Assigned(NewImage) then
  5647. FreeMem(NewImage);
  5648. raise;
  5649. end;
  5650. finally
  5651. FreeAndNil(Converter);
  5652. end;
  5653. end;
  5654. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5655. procedure TglBitmapData.SaveDDS(const aStream: TStream);
  5656. var
  5657. Header: TDDSHeader;
  5658. FormatDesc: TFormatDescriptor;
  5659. begin
  5660. if not (ftDDS in FormatGetSupportedFiles(Format)) then
  5661. raise EglBitmapUnsupportedFormat.Create(Format);
  5662. FormatDesc := TFormatDescriptor.Get(Format);
  5663. // Generell
  5664. FillChar(Header{%H-}, SizeOf(Header), 0);
  5665. Header.dwSize := SizeOf(Header);
  5666. Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
  5667. Header.dwWidth := Max(1, Width);
  5668. Header.dwHeight := Max(1, Height);
  5669. // Caps
  5670. Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
  5671. // Pixelformat
  5672. Header.PixelFormat.dwSize := sizeof(Header);
  5673. if (FormatDesc.IsCompressed) then begin
  5674. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
  5675. case Format of
  5676. tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
  5677. tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
  5678. tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
  5679. end;
  5680. end else if not FormatDesc.HasColor and FormatDesc.HasAlpha then begin
  5681. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHA;
  5682. Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
  5683. Header.PixelFormat.dwABitMask := FormatDesc.Mask.a;
  5684. end else if FormatDesc.IsGrayscale then begin
  5685. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
  5686. Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
  5687. Header.PixelFormat.dwRBitMask := FormatDesc.Mask.r;
  5688. Header.PixelFormat.dwABitMask := FormatDesc.Mask.a;
  5689. end else begin
  5690. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
  5691. Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
  5692. Header.PixelFormat.dwRBitMask := FormatDesc.Mask.r;
  5693. Header.PixelFormat.dwGBitMask := FormatDesc.Mask.g;
  5694. Header.PixelFormat.dwBBitMask := FormatDesc.Mask.b;
  5695. Header.PixelFormat.dwABitMask := FormatDesc.Mask.a;
  5696. end;
  5697. if (FormatDesc.HasAlpha) then
  5698. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
  5699. aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
  5700. aStream.Write(Header, SizeOf(Header));
  5701. aStream.Write(Data^, FormatDesc.GetSize(Dimension));
  5702. end;
  5703. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5704. function TglBitmapData.FlipHorz: Boolean;
  5705. var
  5706. fd: TglBitmapFormatDescriptor;
  5707. Col, RowSize, PixelSize: Integer;
  5708. pTempDest, pDest, pSource: PByte;
  5709. begin
  5710. result := false;
  5711. fd := FormatDescriptor;
  5712. PixelSize := Ceil(fd.BytesPerPixel);
  5713. RowSize := fd.GetSize(Width, 1);
  5714. if Assigned(Data) and not fd.IsCompressed then begin
  5715. pSource := Data;
  5716. GetMem(pDest, RowSize);
  5717. try
  5718. pTempDest := pDest;
  5719. Inc(pTempDest, RowSize);
  5720. for Col := 0 to Width-1 do begin
  5721. dec(pTempDest, PixelSize); //dec before, because ptr is behind last byte of data
  5722. Move(pSource^, pTempDest^, PixelSize);
  5723. Inc(pSource, PixelSize);
  5724. end;
  5725. SetData(pDest, Format, Width);
  5726. result := true;
  5727. except
  5728. if Assigned(pDest) then
  5729. FreeMem(pDest);
  5730. raise;
  5731. end;
  5732. end;
  5733. end;
  5734. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5735. function TglBitmapData.FlipVert: Boolean;
  5736. var
  5737. fd: TglBitmapFormatDescriptor;
  5738. Row, RowSize, PixelSize: Integer;
  5739. TempDestData, DestData, SourceData: PByte;
  5740. begin
  5741. result := false;
  5742. fd := FormatDescriptor;
  5743. PixelSize := Ceil(fd.BytesPerPixel);
  5744. RowSize := fd.GetSize(Width, 1);
  5745. if Assigned(Data) then begin
  5746. SourceData := Data;
  5747. GetMem(DestData, Height * RowSize);
  5748. try
  5749. TempDestData := DestData;
  5750. Inc(TempDestData, Width * (Height -1) * PixelSize);
  5751. for Row := 0 to Height -1 do begin
  5752. Move(SourceData^, TempDestData^, RowSize);
  5753. Dec(TempDestData, RowSize);
  5754. Inc(SourceData, RowSize);
  5755. end;
  5756. SetData(DestData, Format, Width, Height);
  5757. result := true;
  5758. except
  5759. if Assigned(DestData) then
  5760. FreeMem(DestData);
  5761. raise;
  5762. end;
  5763. end;
  5764. end;
  5765. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5766. procedure TglBitmapData.LoadFromFile(const aFilename: String);
  5767. var
  5768. fs: TFileStream;
  5769. begin
  5770. if not FileExists(aFilename) then
  5771. raise EglBitmap.Create('file does not exist: ' + aFilename);
  5772. fs := TFileStream.Create(aFilename, fmOpenRead);
  5773. try
  5774. fs.Position := 0;
  5775. LoadFromStream(fs);
  5776. fFilename := aFilename;
  5777. finally
  5778. fs.Free;
  5779. end;
  5780. end;
  5781. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5782. procedure TglBitmapData.LoadFromStream(const aStream: TStream);
  5783. begin
  5784. {$IFDEF GLB_SUPPORT_PNG_READ}
  5785. if not LoadPNG(aStream) then
  5786. {$ENDIF}
  5787. {$IFDEF GLB_SUPPORT_JPEG_READ}
  5788. if not LoadJPEG(aStream) then
  5789. {$ENDIF}
  5790. if not LoadDDS(aStream) then
  5791. if not LoadTGA(aStream) then
  5792. if not LoadBMP(aStream) then
  5793. if not LoadRAW(aStream) then
  5794. raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
  5795. end;
  5796. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5797. procedure TglBitmapData.LoadFromFunc(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat;
  5798. const aFunc: TglBitmapFunction; const aArgs: Pointer);
  5799. var
  5800. tmpData: PByte;
  5801. size: Integer;
  5802. begin
  5803. size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  5804. GetMem(tmpData, size);
  5805. try
  5806. FillChar(tmpData^, size, #$FF);
  5807. SetData(tmpData, aFormat, aSize.X, aSize.Y);
  5808. except
  5809. if Assigned(tmpData) then
  5810. FreeMem(tmpData);
  5811. raise;
  5812. end;
  5813. Convert(Self, aFunc, false, aFormat, aArgs);
  5814. end;
  5815. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5816. procedure TglBitmapData.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
  5817. var
  5818. rs: TResourceStream;
  5819. begin
  5820. PrepareResType(aResource, aResType);
  5821. rs := TResourceStream.Create(aInstance, aResource, aResType);
  5822. try
  5823. LoadFromStream(rs);
  5824. finally
  5825. rs.Free;
  5826. end;
  5827. end;
  5828. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5829. procedure TglBitmapData.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  5830. var
  5831. rs: TResourceStream;
  5832. begin
  5833. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  5834. try
  5835. LoadFromStream(rs);
  5836. finally
  5837. rs.Free;
  5838. end;
  5839. end;
  5840. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5841. procedure TglBitmapData.SaveToFile(const aFilename: String; const aFileType: TglBitmapFileType);
  5842. var
  5843. fs: TFileStream;
  5844. begin
  5845. fs := TFileStream.Create(aFileName, fmCreate);
  5846. try
  5847. fs.Position := 0;
  5848. SaveToStream(fs, aFileType);
  5849. finally
  5850. fs.Free;
  5851. end;
  5852. end;
  5853. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5854. procedure TglBitmapData.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
  5855. begin
  5856. case aFileType of
  5857. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  5858. ftPNG: SavePNG(aStream);
  5859. {$ENDIF}
  5860. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  5861. ftJPEG: SaveJPEG(aStream);
  5862. {$ENDIF}
  5863. ftDDS: SaveDDS(aStream);
  5864. ftTGA: SaveTGA(aStream);
  5865. ftBMP: SaveBMP(aStream);
  5866. ftRAW: SaveRAW(aStream);
  5867. end;
  5868. end;
  5869. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5870. function TglBitmapData.Convert(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
  5871. begin
  5872. result := Convert(Self, aFunc, aCreateTemp, Format, aArgs);
  5873. end;
  5874. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5875. function TglBitmapData.Convert(const aSource: TglBitmapData; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  5876. const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
  5877. var
  5878. DestData, TmpData, SourceData: pByte;
  5879. TempHeight, TempWidth: Integer;
  5880. SourceFD, DestFD: TFormatDescriptor;
  5881. SourceMD, DestMD: Pointer;
  5882. FuncRec: TglBitmapFunctionRec;
  5883. begin
  5884. Assert(Assigned(Data));
  5885. Assert(Assigned(aSource));
  5886. Assert(Assigned(aSource.Data));
  5887. result := false;
  5888. if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
  5889. SourceFD := TFormatDescriptor.Get(aSource.Format);
  5890. DestFD := TFormatDescriptor.Get(aFormat);
  5891. if (SourceFD.IsCompressed) then
  5892. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
  5893. if (DestFD.IsCompressed) then
  5894. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
  5895. // inkompatible Formats so CreateTemp
  5896. if (SourceFD.BitsPerPixel <> DestFD.BitsPerPixel) then
  5897. aCreateTemp := true;
  5898. // Values
  5899. TempHeight := Max(1, aSource.Height);
  5900. TempWidth := Max(1, aSource.Width);
  5901. FuncRec.Sender := Self;
  5902. FuncRec.Args := aArgs;
  5903. TmpData := nil;
  5904. if aCreateTemp then begin
  5905. GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
  5906. DestData := TmpData;
  5907. end else
  5908. DestData := Data;
  5909. try
  5910. SourceFD.PreparePixel(FuncRec.Source);
  5911. DestFD.PreparePixel (FuncRec.Dest);
  5912. SourceMD := SourceFD.CreateMappingData;
  5913. DestMD := DestFD.CreateMappingData;
  5914. FuncRec.Size := aSource.Dimension;
  5915. FuncRec.Position.Fields := FuncRec.Size.Fields;
  5916. try
  5917. SourceData := aSource.Data;
  5918. FuncRec.Position.Y := 0;
  5919. while FuncRec.Position.Y < TempHeight do begin
  5920. FuncRec.Position.X := 0;
  5921. while FuncRec.Position.X < TempWidth do begin
  5922. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  5923. aFunc(FuncRec);
  5924. DestFD.Map(FuncRec.Dest, DestData, DestMD);
  5925. inc(FuncRec.Position.X);
  5926. end;
  5927. inc(FuncRec.Position.Y);
  5928. end;
  5929. // Updating Image or InternalFormat
  5930. if aCreateTemp then
  5931. SetData(TmpData, aFormat, aSource.Width, aSource.Height)
  5932. else if (aFormat <> fFormat) then
  5933. Format := aFormat;
  5934. result := true;
  5935. finally
  5936. SourceFD.FreeMappingData(SourceMD);
  5937. DestFD.FreeMappingData(DestMD);
  5938. end;
  5939. except
  5940. if aCreateTemp and Assigned(TmpData) then
  5941. FreeMem(TmpData);
  5942. raise;
  5943. end;
  5944. end;
  5945. end;
  5946. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5947. function TglBitmapData.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
  5948. var
  5949. SourceFD, DestFD: TFormatDescriptor;
  5950. SourcePD, DestPD: TglBitmapPixelData;
  5951. ShiftData: TShiftData;
  5952. function DataIsIdentical: Boolean;
  5953. begin
  5954. result := SourceFD.MaskMatch(DestFD.Mask);
  5955. end;
  5956. function CanCopyDirect: Boolean;
  5957. begin
  5958. result :=
  5959. ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  5960. ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  5961. ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  5962. ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  5963. end;
  5964. function CanShift: Boolean;
  5965. begin
  5966. result :=
  5967. ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  5968. ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  5969. ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  5970. ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  5971. end;
  5972. function GetShift(aSource, aDest: Cardinal) : ShortInt;
  5973. begin
  5974. result := 0;
  5975. while (aSource > aDest) and (aSource > 0) do begin
  5976. inc(result);
  5977. aSource := aSource shr 1;
  5978. end;
  5979. end;
  5980. begin
  5981. if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
  5982. SourceFD := TFormatDescriptor.Get(Format);
  5983. DestFD := TFormatDescriptor.Get(aFormat);
  5984. if DataIsIdentical then begin
  5985. result := true;
  5986. Format := aFormat;
  5987. exit;
  5988. end;
  5989. SourceFD.PreparePixel(SourcePD);
  5990. DestFD.PreparePixel (DestPD);
  5991. if CanCopyDirect then
  5992. result := Convert(Self, glBitmapConvertCopyFunc, false, aFormat)
  5993. else if CanShift then begin
  5994. ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
  5995. ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
  5996. ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
  5997. ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
  5998. result := Convert(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
  5999. end else
  6000. result := Convert(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
  6001. end else
  6002. result := true;
  6003. end;
  6004. {$IFDEF GLB_SDL}
  6005. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6006. function TglBitmapData.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  6007. var
  6008. Row, RowSize: Integer;
  6009. SourceData, TmpData: PByte;
  6010. TempDepth: Integer;
  6011. FormatDesc: TFormatDescriptor;
  6012. function GetRowPointer(Row: Integer): pByte;
  6013. begin
  6014. result := aSurface.pixels;
  6015. Inc(result, Row * RowSize);
  6016. end;
  6017. begin
  6018. result := false;
  6019. FormatDesc := TFormatDescriptor.Get(Format);
  6020. if FormatDesc.IsCompressed then
  6021. raise EglBitmapUnsupportedFormat.Create(Format);
  6022. if Assigned(Data) then begin
  6023. case Trunc(FormatDesc.PixelSize) of
  6024. 1: TempDepth := 8;
  6025. 2: TempDepth := 16;
  6026. 3: TempDepth := 24;
  6027. 4: TempDepth := 32;
  6028. else
  6029. raise EglBitmapUnsupportedFormat.Create(Format);
  6030. end;
  6031. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
  6032. FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
  6033. SourceData := Data;
  6034. RowSize := FormatDesc.GetSize(FileWidth, 1);
  6035. for Row := 0 to FileHeight-1 do begin
  6036. TmpData := GetRowPointer(Row);
  6037. if Assigned(TmpData) then begin
  6038. Move(SourceData^, TmpData^, RowSize);
  6039. inc(SourceData, RowSize);
  6040. end;
  6041. end;
  6042. result := true;
  6043. end;
  6044. end;
  6045. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6046. function TglBitmapData.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  6047. var
  6048. pSource, pData, pTempData: PByte;
  6049. Row, RowSize, TempWidth, TempHeight: Integer;
  6050. IntFormat: TglBitmapFormat;
  6051. fd: TFormatDescriptor;
  6052. Mask: TglBitmapMask;
  6053. function GetRowPointer(Row: Integer): pByte;
  6054. begin
  6055. result := aSurface^.pixels;
  6056. Inc(result, Row * RowSize);
  6057. end;
  6058. begin
  6059. result := false;
  6060. if (Assigned(aSurface)) then begin
  6061. with aSurface^.format^ do begin
  6062. Mask.r := RMask;
  6063. Mask.g := GMask;
  6064. Mask.b := BMask;
  6065. Mask.a := AMask;
  6066. IntFormat := TFormatDescriptor.GetFromMask(Mask).Format;
  6067. if (IntFormat = tfEmpty) then
  6068. raise EglBitmap.Create('AssignFromSurface - Invalid Pixelformat.');
  6069. end;
  6070. fd := TFormatDescriptor.Get(IntFormat);
  6071. TempWidth := aSurface^.w;
  6072. TempHeight := aSurface^.h;
  6073. RowSize := fd.GetSize(TempWidth, 1);
  6074. GetMem(pData, TempHeight * RowSize);
  6075. try
  6076. pTempData := pData;
  6077. for Row := 0 to TempHeight -1 do begin
  6078. pSource := GetRowPointer(Row);
  6079. if (Assigned(pSource)) then begin
  6080. Move(pSource^, pTempData^, RowSize);
  6081. Inc(pTempData, RowSize);
  6082. end;
  6083. end;
  6084. SetData(pData, IntFormat, TempWidth, TempHeight);
  6085. result := true;
  6086. except
  6087. if Assigned(pData) then
  6088. FreeMem(pData);
  6089. raise;
  6090. end;
  6091. end;
  6092. end;
  6093. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6094. function TglBitmapData.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  6095. var
  6096. Row, Col, AlphaInterleave: Integer;
  6097. pSource, pDest: PByte;
  6098. function GetRowPointer(Row: Integer): pByte;
  6099. begin
  6100. result := aSurface.pixels;
  6101. Inc(result, Row * Width);
  6102. end;
  6103. begin
  6104. result := false;
  6105. if Assigned(Data) then begin
  6106. if Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfBGRA8ub4, tfRGBA8ub4] then begin
  6107. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
  6108. AlphaInterleave := 0;
  6109. case Format of
  6110. tfLuminance8Alpha8ub2:
  6111. AlphaInterleave := 1;
  6112. tfBGRA8ub4, tfRGBA8ub4:
  6113. AlphaInterleave := 3;
  6114. end;
  6115. pSource := Data;
  6116. for Row := 0 to Height -1 do begin
  6117. pDest := GetRowPointer(Row);
  6118. if Assigned(pDest) then begin
  6119. for Col := 0 to Width -1 do begin
  6120. Inc(pSource, AlphaInterleave);
  6121. pDest^ := pSource^;
  6122. Inc(pDest);
  6123. Inc(pSource);
  6124. end;
  6125. end;
  6126. end;
  6127. result := true;
  6128. end;
  6129. end;
  6130. end;
  6131. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6132. function TglBitmapData.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  6133. var
  6134. bmp: TglBitmap2D;
  6135. begin
  6136. bmp := TglBitmap2D.Create;
  6137. try
  6138. bmp.AssignFromSurface(aSurface);
  6139. result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
  6140. finally
  6141. bmp.Free;
  6142. end;
  6143. end;
  6144. {$ENDIF}
  6145. {$IFDEF GLB_DELPHI}
  6146. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6147. function CreateGrayPalette: HPALETTE;
  6148. var
  6149. Idx: Integer;
  6150. Pal: PLogPalette;
  6151. begin
  6152. GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
  6153. Pal.palVersion := $300;
  6154. Pal.palNumEntries := 256;
  6155. for Idx := 0 to Pal.palNumEntries - 1 do begin
  6156. Pal.palPalEntry[Idx].peRed := Idx;
  6157. Pal.palPalEntry[Idx].peGreen := Idx;
  6158. Pal.palPalEntry[Idx].peBlue := Idx;
  6159. Pal.palPalEntry[Idx].peFlags := 0;
  6160. end;
  6161. Result := CreatePalette(Pal^);
  6162. FreeMem(Pal);
  6163. end;
  6164. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6165. function TglBitmapData.AssignToBitmap(const aBitmap: TBitmap): Boolean;
  6166. var
  6167. Row, RowSize: Integer;
  6168. pSource, pData: PByte;
  6169. begin
  6170. result := false;
  6171. if Assigned(Data) then begin
  6172. if Assigned(aBitmap) then begin
  6173. aBitmap.Width := Width;
  6174. aBitmap.Height := Height;
  6175. case Format of
  6176. tfAlpha8ub1, tfLuminance8ub1: begin
  6177. aBitmap.PixelFormat := pf8bit;
  6178. aBitmap.Palette := CreateGrayPalette;
  6179. end;
  6180. tfRGB5A1us1:
  6181. aBitmap.PixelFormat := pf15bit;
  6182. tfR5G6B5us1:
  6183. aBitmap.PixelFormat := pf16bit;
  6184. tfRGB8ub3, tfBGR8ub3:
  6185. aBitmap.PixelFormat := pf24bit;
  6186. tfRGBA8ub4, tfBGRA8ub4:
  6187. aBitmap.PixelFormat := pf32bit;
  6188. else
  6189. raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
  6190. end;
  6191. RowSize := FormatDescriptor.GetSize(Width, 1);
  6192. pSource := Data;
  6193. for Row := 0 to Height-1 do begin
  6194. pData := aBitmap.Scanline[Row];
  6195. Move(pSource^, pData^, RowSize);
  6196. Inc(pSource, RowSize);
  6197. if (Format in [tfRGB8ub3, tfRGBA8ub4]) then // swap RGB(A) to BGR(A)
  6198. SwapRGB(pData, Width, Format = tfRGBA8ub4);
  6199. end;
  6200. result := true;
  6201. end;
  6202. end;
  6203. end;
  6204. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6205. function TglBitmapData.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  6206. var
  6207. pSource, pData, pTempData: PByte;
  6208. Row, RowSize, TempWidth, TempHeight: Integer;
  6209. IntFormat: TglBitmapFormat;
  6210. begin
  6211. result := false;
  6212. if (Assigned(aBitmap)) then begin
  6213. case aBitmap.PixelFormat of
  6214. pf8bit:
  6215. IntFormat := tfLuminance8ub1;
  6216. pf15bit:
  6217. IntFormat := tfRGB5A1us1;
  6218. pf16bit:
  6219. IntFormat := tfR5G6B5us1;
  6220. pf24bit:
  6221. IntFormat := tfBGR8ub3;
  6222. pf32bit:
  6223. IntFormat := tfBGRA8ub4;
  6224. else
  6225. raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
  6226. end;
  6227. TempWidth := aBitmap.Width;
  6228. TempHeight := aBitmap.Height;
  6229. RowSize := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
  6230. GetMem(pData, TempHeight * RowSize);
  6231. try
  6232. pTempData := pData;
  6233. for Row := 0 to TempHeight -1 do begin
  6234. pSource := aBitmap.Scanline[Row];
  6235. if (Assigned(pSource)) then begin
  6236. Move(pSource^, pTempData^, RowSize);
  6237. Inc(pTempData, RowSize);
  6238. end;
  6239. end;
  6240. SetData(pData, IntFormat, TempWidth, TempHeight);
  6241. result := true;
  6242. except
  6243. if Assigned(pData) then
  6244. FreeMem(pData);
  6245. raise;
  6246. end;
  6247. end;
  6248. end;
  6249. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6250. function TglBitmapData.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  6251. var
  6252. Row, Col, AlphaInterleave: Integer;
  6253. pSource, pDest: PByte;
  6254. begin
  6255. result := false;
  6256. if Assigned(Data) then begin
  6257. if (Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfRGBA8ub4, tfBGRA8ub4]) then begin
  6258. if Assigned(aBitmap) then begin
  6259. aBitmap.PixelFormat := pf8bit;
  6260. aBitmap.Palette := CreateGrayPalette;
  6261. aBitmap.Width := Width;
  6262. aBitmap.Height := Height;
  6263. case Format of
  6264. tfLuminance8Alpha8ub2:
  6265. AlphaInterleave := 1;
  6266. tfRGBA8ub4, tfBGRA8ub4:
  6267. AlphaInterleave := 3;
  6268. else
  6269. AlphaInterleave := 0;
  6270. end;
  6271. // Copy Data
  6272. pSource := Data;
  6273. for Row := 0 to Height -1 do begin
  6274. pDest := aBitmap.Scanline[Row];
  6275. if Assigned(pDest) then begin
  6276. for Col := 0 to Width -1 do begin
  6277. Inc(pSource, AlphaInterleave);
  6278. pDest^ := pSource^;
  6279. Inc(pDest);
  6280. Inc(pSource);
  6281. end;
  6282. end;
  6283. end;
  6284. result := true;
  6285. end;
  6286. end;
  6287. end;
  6288. end;
  6289. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6290. function TglBitmapData.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  6291. var
  6292. data: TglBitmapData;
  6293. begin
  6294. data := TglBitmapData.Create;
  6295. try
  6296. data.AssignFromBitmap(aBitmap);
  6297. result := AddAlphaFromDataObj(data, aFunc, aArgs);
  6298. finally
  6299. data.Free;
  6300. end;
  6301. end;
  6302. {$ENDIF}
  6303. {$IFDEF GLB_LAZARUS}
  6304. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6305. function TglBitmapData.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  6306. var
  6307. rid: TRawImageDescription;
  6308. FormatDesc: TFormatDescriptor;
  6309. begin
  6310. if not Assigned(Data) then
  6311. raise EglBitmap.Create('no pixel data assigned. load data before save');
  6312. result := false;
  6313. if not Assigned(aImage) or (Format = tfEmpty) then
  6314. exit;
  6315. FormatDesc := TFormatDescriptor.Get(Format);
  6316. if FormatDesc.IsCompressed then
  6317. exit;
  6318. FillChar(rid{%H-}, SizeOf(rid), 0);
  6319. if FormatDesc.IsGrayscale then
  6320. rid.Format := ricfGray
  6321. else
  6322. rid.Format := ricfRGBA;
  6323. rid.Width := Width;
  6324. rid.Height := Height;
  6325. rid.Depth := FormatDesc.BitsPerPixel;
  6326. rid.BitOrder := riboBitsInOrder;
  6327. rid.ByteOrder := riboLSBFirst;
  6328. rid.LineOrder := riloTopToBottom;
  6329. rid.LineEnd := rileTight;
  6330. rid.BitsPerPixel := FormatDesc.BitsPerPixel;
  6331. rid.RedPrec := CountSetBits(FormatDesc.Range.r);
  6332. rid.GreenPrec := CountSetBits(FormatDesc.Range.g);
  6333. rid.BluePrec := CountSetBits(FormatDesc.Range.b);
  6334. rid.AlphaPrec := CountSetBits(FormatDesc.Range.a);
  6335. rid.RedShift := FormatDesc.Shift.r;
  6336. rid.GreenShift := FormatDesc.Shift.g;
  6337. rid.BlueShift := FormatDesc.Shift.b;
  6338. rid.AlphaShift := FormatDesc.Shift.a;
  6339. rid.MaskBitsPerPixel := 0;
  6340. rid.PaletteColorCount := 0;
  6341. aImage.DataDescription := rid;
  6342. aImage.CreateData;
  6343. if not Assigned(aImage.PixelData) then
  6344. raise EglBitmap.Create('error while creating LazIntfImage');
  6345. Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
  6346. result := true;
  6347. end;
  6348. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6349. function TglBitmapData.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  6350. var
  6351. f: TglBitmapFormat;
  6352. FormatDesc: TFormatDescriptor;
  6353. ImageData: PByte;
  6354. ImageSize: Integer;
  6355. CanCopy: Boolean;
  6356. Mask: TglBitmapRec4ul;
  6357. procedure CopyConvert;
  6358. var
  6359. bfFormat: TbmpBitfieldFormat;
  6360. pSourceLine, pDestLine: PByte;
  6361. pSourceMD, pDestMD: Pointer;
  6362. Shift, Prec: TglBitmapRec4ub;
  6363. x, y: Integer;
  6364. pixel: TglBitmapPixelData;
  6365. begin
  6366. bfFormat := TbmpBitfieldFormat.Create;
  6367. with aImage.DataDescription do begin
  6368. Prec.r := RedPrec;
  6369. Prec.g := GreenPrec;
  6370. Prec.b := BluePrec;
  6371. Prec.a := AlphaPrec;
  6372. Shift.r := RedShift;
  6373. Shift.g := GreenShift;
  6374. Shift.b := BlueShift;
  6375. Shift.a := AlphaShift;
  6376. bfFormat.SetCustomValues(BitsPerPixel, Prec, Shift);
  6377. end;
  6378. pSourceMD := bfFormat.CreateMappingData;
  6379. pDestMD := FormatDesc.CreateMappingData;
  6380. try
  6381. for y := 0 to aImage.Height-1 do begin
  6382. pSourceLine := aImage.PixelData + y {%H-}* aImage.DataDescription.BytesPerLine;
  6383. pDestLine := ImageData + y * Round(FormatDesc.BytesPerPixel * aImage.Width);
  6384. for x := 0 to aImage.Width-1 do begin
  6385. bfFormat.Unmap(pSourceLine, pixel, pSourceMD);
  6386. FormatDesc.Map(pixel, pDestLine, pDestMD);
  6387. end;
  6388. end;
  6389. finally
  6390. FormatDesc.FreeMappingData(pDestMD);
  6391. bfFormat.FreeMappingData(pSourceMD);
  6392. bfFormat.Free;
  6393. end;
  6394. end;
  6395. begin
  6396. result := false;
  6397. if not Assigned(aImage) then
  6398. exit;
  6399. with aImage.DataDescription do begin
  6400. Mask.r := (QWord(1 shl RedPrec )-1) shl RedShift;
  6401. Mask.g := (QWord(1 shl GreenPrec)-1) shl GreenShift;
  6402. Mask.b := (QWord(1 shl BluePrec )-1) shl BlueShift;
  6403. Mask.a := (QWord(1 shl AlphaPrec)-1) shl AlphaShift;
  6404. end;
  6405. FormatDesc := TFormatDescriptor.GetFromMask(Mask);
  6406. f := FormatDesc.Format;
  6407. if (f = tfEmpty) then
  6408. exit;
  6409. CanCopy :=
  6410. (FormatDesc.BitsPerPixel = aImage.DataDescription.Depth) and
  6411. (aImage.DataDescription.BitsPerPixel = aImage.DataDescription.Depth);
  6412. ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
  6413. ImageData := GetMem(ImageSize);
  6414. try
  6415. if CanCopy then
  6416. Move(aImage.PixelData^, ImageData^, ImageSize)
  6417. else
  6418. CopyConvert;
  6419. SetData(ImageData, f, aImage.Width, aImage.Height);
  6420. except
  6421. if Assigned(ImageData) then
  6422. FreeMem(ImageData);
  6423. raise;
  6424. end;
  6425. result := true;
  6426. end;
  6427. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6428. function TglBitmapData.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  6429. var
  6430. rid: TRawImageDescription;
  6431. FormatDesc: TFormatDescriptor;
  6432. Pixel: TglBitmapPixelData;
  6433. x, y: Integer;
  6434. srcMD: Pointer;
  6435. src, dst: PByte;
  6436. begin
  6437. result := false;
  6438. if not Assigned(aImage) or (Format = tfEmpty) then
  6439. exit;
  6440. FormatDesc := TFormatDescriptor.Get(Format);
  6441. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  6442. exit;
  6443. FillChar(rid{%H-}, SizeOf(rid), 0);
  6444. rid.Format := ricfGray;
  6445. rid.Width := Width;
  6446. rid.Height := Height;
  6447. rid.Depth := CountSetBits(FormatDesc.Range.a);
  6448. rid.BitOrder := riboBitsInOrder;
  6449. rid.ByteOrder := riboLSBFirst;
  6450. rid.LineOrder := riloTopToBottom;
  6451. rid.LineEnd := rileTight;
  6452. rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
  6453. rid.RedPrec := CountSetBits(FormatDesc.Range.a);
  6454. rid.GreenPrec := 0;
  6455. rid.BluePrec := 0;
  6456. rid.AlphaPrec := 0;
  6457. rid.RedShift := 0;
  6458. rid.GreenShift := 0;
  6459. rid.BlueShift := 0;
  6460. rid.AlphaShift := 0;
  6461. rid.MaskBitsPerPixel := 0;
  6462. rid.PaletteColorCount := 0;
  6463. aImage.DataDescription := rid;
  6464. aImage.CreateData;
  6465. srcMD := FormatDesc.CreateMappingData;
  6466. try
  6467. FormatDesc.PreparePixel(Pixel);
  6468. src := Data;
  6469. dst := aImage.PixelData;
  6470. for y := 0 to Height-1 do
  6471. for x := 0 to Width-1 do begin
  6472. FormatDesc.Unmap(src, Pixel, srcMD);
  6473. case rid.BitsPerPixel of
  6474. 8: begin
  6475. dst^ := Pixel.Data.a;
  6476. inc(dst);
  6477. end;
  6478. 16: begin
  6479. PWord(dst)^ := Pixel.Data.a;
  6480. inc(dst, 2);
  6481. end;
  6482. 24: begin
  6483. PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
  6484. PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
  6485. PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
  6486. inc(dst, 3);
  6487. end;
  6488. 32: begin
  6489. PCardinal(dst)^ := Pixel.Data.a;
  6490. inc(dst, 4);
  6491. end;
  6492. else
  6493. raise EglBitmapUnsupportedFormat.Create(Format);
  6494. end;
  6495. end;
  6496. finally
  6497. FormatDesc.FreeMappingData(srcMD);
  6498. end;
  6499. result := true;
  6500. end;
  6501. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6502. function TglBitmapData.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  6503. var
  6504. data: TglBitmapData;
  6505. begin
  6506. data := TglBitmapData.Create;
  6507. try
  6508. data.AssignFromLazIntfImage(aImage);
  6509. result := AddAlphaFromDataObj(data, aFunc, aArgs);
  6510. finally
  6511. data.Free;
  6512. end;
  6513. end;
  6514. {$ENDIF}
  6515. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6516. function TglBitmapData.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
  6517. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  6518. var
  6519. rs: TResourceStream;
  6520. begin
  6521. PrepareResType(aResource, aResType);
  6522. rs := TResourceStream.Create(aInstance, aResource, aResType);
  6523. try
  6524. result := AddAlphaFromStream(rs, aFunc, aArgs);
  6525. finally
  6526. rs.Free;
  6527. end;
  6528. end;
  6529. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6530. function TglBitmapData.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  6531. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  6532. var
  6533. rs: TResourceStream;
  6534. begin
  6535. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  6536. try
  6537. result := AddAlphaFromStream(rs, aFunc, aArgs);
  6538. finally
  6539. rs.Free;
  6540. end;
  6541. end;
  6542. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6543. function TglBitmapData.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  6544. begin
  6545. if TFormatDescriptor.Get(Format).IsCompressed then
  6546. raise EglBitmapUnsupportedFormat.Create(Format);
  6547. result := Convert(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
  6548. end;
  6549. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6550. function TglBitmapData.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  6551. var
  6552. FS: TFileStream;
  6553. begin
  6554. FS := TFileStream.Create(aFileName, fmOpenRead);
  6555. try
  6556. result := AddAlphaFromStream(FS, aFunc, aArgs);
  6557. finally
  6558. FS.Free;
  6559. end;
  6560. end;
  6561. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6562. function TglBitmapData.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  6563. var
  6564. data: TglBitmapData;
  6565. begin
  6566. data := TglBitmapData.Create(aStream);
  6567. try
  6568. result := AddAlphaFromDataObj(data, aFunc, aArgs);
  6569. finally
  6570. data.Free;
  6571. end;
  6572. end;
  6573. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6574. function TglBitmapData.AddAlphaFromDataObj(const aDataObj: TglBitmapData; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  6575. var
  6576. DestData, DestData2, SourceData: pByte;
  6577. TempHeight, TempWidth: Integer;
  6578. SourceFD, DestFD: TFormatDescriptor;
  6579. SourceMD, DestMD, DestMD2: Pointer;
  6580. FuncRec: TglBitmapFunctionRec;
  6581. begin
  6582. result := false;
  6583. Assert(Assigned(Data));
  6584. Assert(Assigned(aDataObj));
  6585. Assert(Assigned(aDataObj.Data));
  6586. if ((aDataObj.Width = Width) and (aDataObj.Height = Height)) then begin
  6587. result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
  6588. SourceFD := TFormatDescriptor.Get(aDataObj.Format);
  6589. DestFD := TFormatDescriptor.Get(Format);
  6590. if not Assigned(aFunc) then begin
  6591. aFunc := glBitmapAlphaFunc;
  6592. FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
  6593. end else
  6594. FuncRec.Args := aArgs;
  6595. // Values
  6596. TempWidth := aDataObj.Width;
  6597. TempHeight := aDataObj.Height;
  6598. if (TempWidth <= 0) or (TempHeight <= 0) then
  6599. exit;
  6600. FuncRec.Sender := Self;
  6601. FuncRec.Size := Dimension;
  6602. FuncRec.Position.Fields := FuncRec.Size.Fields;
  6603. DestData := Data;
  6604. DestData2 := Data;
  6605. SourceData := aDataObj.Data;
  6606. // Mapping
  6607. SourceFD.PreparePixel(FuncRec.Source);
  6608. DestFD.PreparePixel (FuncRec.Dest);
  6609. SourceMD := SourceFD.CreateMappingData;
  6610. DestMD := DestFD.CreateMappingData;
  6611. DestMD2 := DestFD.CreateMappingData;
  6612. try
  6613. FuncRec.Position.Y := 0;
  6614. while FuncRec.Position.Y < TempHeight do begin
  6615. FuncRec.Position.X := 0;
  6616. while FuncRec.Position.X < TempWidth do begin
  6617. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  6618. DestFD.Unmap (DestData, FuncRec.Dest, DestMD);
  6619. aFunc(FuncRec);
  6620. DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
  6621. inc(FuncRec.Position.X);
  6622. end;
  6623. inc(FuncRec.Position.Y);
  6624. end;
  6625. finally
  6626. SourceFD.FreeMappingData(SourceMD);
  6627. DestFD.FreeMappingData(DestMD);
  6628. DestFD.FreeMappingData(DestMD2);
  6629. end;
  6630. end;
  6631. end;
  6632. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6633. function TglBitmapData.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
  6634. begin
  6635. result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
  6636. end;
  6637. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6638. function TglBitmapData.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
  6639. var
  6640. PixelData: TglBitmapPixelData;
  6641. begin
  6642. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  6643. result := AddAlphaFromColorKeyFloat(
  6644. aRed / PixelData.Range.r,
  6645. aGreen / PixelData.Range.g,
  6646. aBlue / PixelData.Range.b,
  6647. aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
  6648. end;
  6649. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6650. function TglBitmapData.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
  6651. var
  6652. values: array[0..2] of Single;
  6653. tmp: Cardinal;
  6654. i: Integer;
  6655. PixelData: TglBitmapPixelData;
  6656. begin
  6657. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  6658. with PixelData do begin
  6659. values[0] := aRed;
  6660. values[1] := aGreen;
  6661. values[2] := aBlue;
  6662. for i := 0 to 2 do begin
  6663. tmp := Trunc(Range.arr[i] * aDeviation);
  6664. Data.arr[i] := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
  6665. Range.arr[i] := Max(0, Trunc(Range.arr[i] * values[i] - tmp));
  6666. end;
  6667. Data.a := 0;
  6668. Range.a := 0;
  6669. end;
  6670. result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
  6671. end;
  6672. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6673. function TglBitmapData.AddAlphaFromValue(const aAlpha: Byte): Boolean;
  6674. begin
  6675. result := AddAlphaFromValueFloat(aAlpha / $FF);
  6676. end;
  6677. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6678. function TglBitmapData.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  6679. var
  6680. PixelData: TglBitmapPixelData;
  6681. begin
  6682. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  6683. result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
  6684. end;
  6685. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6686. function TglBitmapData.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  6687. var
  6688. PixelData: TglBitmapPixelData;
  6689. begin
  6690. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  6691. with PixelData do
  6692. Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
  6693. result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
  6694. end;
  6695. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6696. function TglBitmapData.RemoveAlpha: Boolean;
  6697. var
  6698. FormatDesc: TFormatDescriptor;
  6699. begin
  6700. result := false;
  6701. FormatDesc := TFormatDescriptor.Get(Format);
  6702. if Assigned(Data) then begin
  6703. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  6704. raise EglBitmapUnsupportedFormat.Create(Format);
  6705. result := ConvertTo(FormatDesc.WithoutAlpha);
  6706. end;
  6707. end;
  6708. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6709. procedure TglBitmapData.FillWithColor(const aRed, aGreen, aBlue: Byte;
  6710. const aAlpha: Byte);
  6711. begin
  6712. FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
  6713. end;
  6714. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6715. procedure TglBitmapData.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
  6716. var
  6717. PixelData: TglBitmapPixelData;
  6718. begin
  6719. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  6720. FillWithColorFloat(
  6721. aRed / PixelData.Range.r,
  6722. aGreen / PixelData.Range.g,
  6723. aBlue / PixelData.Range.b,
  6724. aAlpha / PixelData.Range.a);
  6725. end;
  6726. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6727. procedure TglBitmapData.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
  6728. var
  6729. PixelData: TglBitmapPixelData;
  6730. begin
  6731. TFormatDescriptor.Get(Format).PreparePixel(PixelData);
  6732. with PixelData do begin
  6733. Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
  6734. Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
  6735. Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
  6736. Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
  6737. end;
  6738. Convert(glBitmapFillWithColorFunc, false, @PixelData);
  6739. end;
  6740. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6741. procedure TglBitmapData.SetData(const aData: PByte; const aFormat: TglBitmapFormat; const aWidth: Integer; const aHeight: Integer);
  6742. begin
  6743. if (Data <> aData) then begin
  6744. if (Assigned(Data)) then
  6745. FreeMem(Data);
  6746. fData := aData;
  6747. end;
  6748. if Assigned(fData) then begin
  6749. FillChar(fDimension, SizeOf(fDimension), 0);
  6750. if aWidth <> -1 then begin
  6751. fDimension.Fields := fDimension.Fields + [ffX];
  6752. fDimension.X := aWidth;
  6753. end;
  6754. if aHeight <> -1 then begin
  6755. fDimension.Fields := fDimension.Fields + [ffY];
  6756. fDimension.Y := aHeight;
  6757. end;
  6758. fFormat := aFormat;
  6759. end else
  6760. fFormat := tfEmpty;
  6761. UpdateScanlines;
  6762. end;
  6763. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6764. function TglBitmapData.Clone: TglBitmapData;
  6765. var
  6766. Temp: TglBitmapData;
  6767. TempPtr: PByte;
  6768. Size: Integer;
  6769. begin
  6770. result := nil;
  6771. Temp := (ClassType.Create as TglBitmapData);
  6772. try
  6773. // copy texture data if assigned
  6774. if Assigned(Data) then begin
  6775. Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
  6776. GetMem(TempPtr, Size);
  6777. try
  6778. Move(Data^, TempPtr^, Size);
  6779. Temp.SetData(TempPtr, Format, Width, Height);
  6780. except
  6781. if Assigned(TempPtr) then
  6782. FreeMem(TempPtr);
  6783. raise;
  6784. end;
  6785. end else begin
  6786. TempPtr := nil;
  6787. Temp.SetData(TempPtr, Format, Width, Height);
  6788. end;
  6789. // copy properties
  6790. Temp.fFormat := Format;
  6791. result := Temp;
  6792. except
  6793. FreeAndNil(Temp);
  6794. raise;
  6795. end;
  6796. end;
  6797. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6798. procedure TglBitmapData.Invert(const aRed, aGreen, aBlue, aAlpha: Boolean);
  6799. var
  6800. mask: PtrInt;
  6801. begin
  6802. mask :=
  6803. (Byte(aRed) and 1) or
  6804. ((Byte(aGreen) and 1) shl 1) or
  6805. ((Byte(aBlue) and 1) shl 2) or
  6806. ((Byte(aAlpha) and 1) shl 3);
  6807. if (mask > 0) then
  6808. Convert(glBitmapInvertFunc, false, {%H-}Pointer(mask));
  6809. end;
  6810. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6811. type
  6812. TMatrixItem = record
  6813. X, Y: Integer;
  6814. W: Single;
  6815. end;
  6816. PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
  6817. TglBitmapToNormalMapRec = Record
  6818. Scale: Single;
  6819. Heights: array of Single;
  6820. MatrixU : array of TMatrixItem;
  6821. MatrixV : array of TMatrixItem;
  6822. end;
  6823. const
  6824. ONE_OVER_255 = 1 / 255;
  6825. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6826. procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
  6827. var
  6828. Val: Single;
  6829. begin
  6830. with FuncRec do begin
  6831. Val :=
  6832. Source.Data.r * LUMINANCE_WEIGHT_R +
  6833. Source.Data.g * LUMINANCE_WEIGHT_G +
  6834. Source.Data.b * LUMINANCE_WEIGHT_B;
  6835. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
  6836. end;
  6837. end;
  6838. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6839. procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  6840. begin
  6841. with FuncRec do
  6842. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
  6843. end;
  6844. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6845. procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
  6846. type
  6847. TVec = Array[0..2] of Single;
  6848. var
  6849. Idx: Integer;
  6850. du, dv: Double;
  6851. Len: Single;
  6852. Vec: TVec;
  6853. function GetHeight(X, Y: Integer): Single;
  6854. begin
  6855. with FuncRec do begin
  6856. X := Max(0, Min(Size.X -1, X));
  6857. Y := Max(0, Min(Size.Y -1, Y));
  6858. result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
  6859. end;
  6860. end;
  6861. begin
  6862. with FuncRec do begin
  6863. with PglBitmapToNormalMapRec(Args)^ do begin
  6864. du := 0;
  6865. for Idx := Low(MatrixU) to High(MatrixU) do
  6866. du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
  6867. dv := 0;
  6868. for Idx := Low(MatrixU) to High(MatrixU) do
  6869. dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
  6870. Vec[0] := -du * Scale;
  6871. Vec[1] := -dv * Scale;
  6872. Vec[2] := 1;
  6873. end;
  6874. // Normalize
  6875. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  6876. if Len <> 0 then begin
  6877. Vec[0] := Vec[0] * Len;
  6878. Vec[1] := Vec[1] * Len;
  6879. Vec[2] := Vec[2] * Len;
  6880. end;
  6881. // Farbe zuweisem
  6882. Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
  6883. Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
  6884. Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
  6885. end;
  6886. end;
  6887. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6888. procedure TglBitmapData.GenerateNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
  6889. var
  6890. Rec: TglBitmapToNormalMapRec;
  6891. procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
  6892. begin
  6893. if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
  6894. Matrix[Index].X := X;
  6895. Matrix[Index].Y := Y;
  6896. Matrix[Index].W := W;
  6897. end;
  6898. end;
  6899. begin
  6900. if TFormatDescriptor.Get(Format).IsCompressed then
  6901. raise EglBitmapUnsupportedFormat.Create(Format);
  6902. if aScale > 100 then
  6903. Rec.Scale := 100
  6904. else if aScale < -100 then
  6905. Rec.Scale := -100
  6906. else
  6907. Rec.Scale := aScale;
  6908. SetLength(Rec.Heights, Width * Height);
  6909. try
  6910. case aFunc of
  6911. nm4Samples: begin
  6912. SetLength(Rec.MatrixU, 2);
  6913. SetEntry(Rec.MatrixU, 0, -1, 0, -0.5);
  6914. SetEntry(Rec.MatrixU, 1, 1, 0, 0.5);
  6915. SetLength(Rec.MatrixV, 2);
  6916. SetEntry(Rec.MatrixV, 0, 0, 1, 0.5);
  6917. SetEntry(Rec.MatrixV, 1, 0, -1, -0.5);
  6918. end;
  6919. nmSobel: begin
  6920. SetLength(Rec.MatrixU, 6);
  6921. SetEntry(Rec.MatrixU, 0, -1, 1, -1.0);
  6922. SetEntry(Rec.MatrixU, 1, -1, 0, -2.0);
  6923. SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
  6924. SetEntry(Rec.MatrixU, 3, 1, 1, 1.0);
  6925. SetEntry(Rec.MatrixU, 4, 1, 0, 2.0);
  6926. SetEntry(Rec.MatrixU, 5, 1, -1, 1.0);
  6927. SetLength(Rec.MatrixV, 6);
  6928. SetEntry(Rec.MatrixV, 0, -1, 1, 1.0);
  6929. SetEntry(Rec.MatrixV, 1, 0, 1, 2.0);
  6930. SetEntry(Rec.MatrixV, 2, 1, 1, 1.0);
  6931. SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
  6932. SetEntry(Rec.MatrixV, 4, 0, -1, -2.0);
  6933. SetEntry(Rec.MatrixV, 5, 1, -1, -1.0);
  6934. end;
  6935. nm3x3: begin
  6936. SetLength(Rec.MatrixU, 6);
  6937. SetEntry(Rec.MatrixU, 0, -1, 1, -1/6);
  6938. SetEntry(Rec.MatrixU, 1, -1, 0, -1/6);
  6939. SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
  6940. SetEntry(Rec.MatrixU, 3, 1, 1, 1/6);
  6941. SetEntry(Rec.MatrixU, 4, 1, 0, 1/6);
  6942. SetEntry(Rec.MatrixU, 5, 1, -1, 1/6);
  6943. SetLength(Rec.MatrixV, 6);
  6944. SetEntry(Rec.MatrixV, 0, -1, 1, 1/6);
  6945. SetEntry(Rec.MatrixV, 1, 0, 1, 1/6);
  6946. SetEntry(Rec.MatrixV, 2, 1, 1, 1/6);
  6947. SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
  6948. SetEntry(Rec.MatrixV, 4, 0, -1, -1/6);
  6949. SetEntry(Rec.MatrixV, 5, 1, -1, -1/6);
  6950. end;
  6951. nm5x5: begin
  6952. SetLength(Rec.MatrixU, 20);
  6953. SetEntry(Rec.MatrixU, 0, -2, 2, -1 / 16);
  6954. SetEntry(Rec.MatrixU, 1, -1, 2, -1 / 10);
  6955. SetEntry(Rec.MatrixU, 2, 1, 2, 1 / 10);
  6956. SetEntry(Rec.MatrixU, 3, 2, 2, 1 / 16);
  6957. SetEntry(Rec.MatrixU, 4, -2, 1, -1 / 10);
  6958. SetEntry(Rec.MatrixU, 5, -1, 1, -1 / 8);
  6959. SetEntry(Rec.MatrixU, 6, 1, 1, 1 / 8);
  6960. SetEntry(Rec.MatrixU, 7, 2, 1, 1 / 10);
  6961. SetEntry(Rec.MatrixU, 8, -2, 0, -1 / 2.8);
  6962. SetEntry(Rec.MatrixU, 9, -1, 0, -0.5);
  6963. SetEntry(Rec.MatrixU, 10, 1, 0, 0.5);
  6964. SetEntry(Rec.MatrixU, 11, 2, 0, 1 / 2.8);
  6965. SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
  6966. SetEntry(Rec.MatrixU, 13, -1, -1, -1 / 8);
  6967. SetEntry(Rec.MatrixU, 14, 1, -1, 1 / 8);
  6968. SetEntry(Rec.MatrixU, 15, 2, -1, 1 / 10);
  6969. SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
  6970. SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
  6971. SetEntry(Rec.MatrixU, 18, 1, -2, 1 / 10);
  6972. SetEntry(Rec.MatrixU, 19, 2, -2, 1 / 16);
  6973. SetLength(Rec.MatrixV, 20);
  6974. SetEntry(Rec.MatrixV, 0, -2, 2, 1 / 16);
  6975. SetEntry(Rec.MatrixV, 1, -1, 2, 1 / 10);
  6976. SetEntry(Rec.MatrixV, 2, 0, 2, 0.25);
  6977. SetEntry(Rec.MatrixV, 3, 1, 2, 1 / 10);
  6978. SetEntry(Rec.MatrixV, 4, 2, 2, 1 / 16);
  6979. SetEntry(Rec.MatrixV, 5, -2, 1, 1 / 10);
  6980. SetEntry(Rec.MatrixV, 6, -1, 1, 1 / 8);
  6981. SetEntry(Rec.MatrixV, 7, 0, 1, 0.5);
  6982. SetEntry(Rec.MatrixV, 8, 1, 1, 1 / 8);
  6983. SetEntry(Rec.MatrixV, 9, 2, 1, 1 / 16);
  6984. SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
  6985. SetEntry(Rec.MatrixV, 11, -1, -1, -1 / 8);
  6986. SetEntry(Rec.MatrixV, 12, 0, -1, -0.5);
  6987. SetEntry(Rec.MatrixV, 13, 1, -1, -1 / 8);
  6988. SetEntry(Rec.MatrixV, 14, 2, -1, -1 / 10);
  6989. SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
  6990. SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
  6991. SetEntry(Rec.MatrixV, 17, 0, -2, -0.25);
  6992. SetEntry(Rec.MatrixV, 18, 1, -2, -1 / 10);
  6993. SetEntry(Rec.MatrixV, 19, 2, -2, -1 / 16);
  6994. end;
  6995. end;
  6996. // Daten Sammeln
  6997. if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
  6998. Convert(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
  6999. else
  7000. Convert(glBitmapToNormalMapPrepareFunc, false, @Rec);
  7001. Convert(glBitmapToNormalMapFunc, false, @Rec);
  7002. finally
  7003. SetLength(Rec.Heights, 0);
  7004. end;
  7005. end;
  7006. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7007. constructor TglBitmapData.Create;
  7008. begin
  7009. inherited Create;
  7010. fFormat := glBitmapDefaultFormat;
  7011. end;
  7012. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7013. constructor TglBitmapData.Create(const aFileName: String);
  7014. begin
  7015. Create;
  7016. LoadFromFile(aFileName);
  7017. end;
  7018. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7019. constructor TglBitmapData.Create(const aStream: TStream);
  7020. begin
  7021. Create;
  7022. LoadFromStream(aStream);
  7023. end;
  7024. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7025. constructor TglBitmapData.Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; aData: PByte);
  7026. var
  7027. ImageSize: Integer;
  7028. begin
  7029. Create;
  7030. if not Assigned(aData) then begin
  7031. ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  7032. GetMem(aData, ImageSize);
  7033. try
  7034. FillChar(aData^, ImageSize, #$FF);
  7035. SetData(aData, aFormat, aSize.X, aSize.Y);
  7036. except
  7037. if Assigned(aData) then
  7038. FreeMem(aData);
  7039. raise;
  7040. end;
  7041. end else begin
  7042. SetData(aData, aFormat, aSize.X, aSize.Y);
  7043. end;
  7044. end;
  7045. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7046. constructor TglBitmapData.Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer);
  7047. begin
  7048. Create;
  7049. LoadFromFunc(aSize, aFormat, aFunc, aArgs);
  7050. end;
  7051. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7052. constructor TglBitmapData.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
  7053. begin
  7054. Create;
  7055. LoadFromResource(aInstance, aResource, aResType);
  7056. end;
  7057. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7058. constructor TglBitmapData.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  7059. begin
  7060. Create;
  7061. LoadFromResourceID(aInstance, aResourceID, aResType);
  7062. end;
  7063. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7064. destructor TglBitmapData.Destroy;
  7065. begin
  7066. SetData(nil, tfEmpty);
  7067. inherited Destroy;
  7068. end;
  7069. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7070. //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7071. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7072. function TglBitmap.GetWidth: Integer;
  7073. begin
  7074. if (ffX in fDimension.Fields) then
  7075. result := fDimension.X
  7076. else
  7077. result := -1;
  7078. end;
  7079. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7080. function TglBitmap.GetHeight: Integer;
  7081. begin
  7082. if (ffY in fDimension.Fields) then
  7083. result := fDimension.Y
  7084. else
  7085. result := -1;
  7086. end;
  7087. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7088. procedure TglBitmap.SetCustomData(const aValue: Pointer);
  7089. begin
  7090. if fCustomData = aValue then
  7091. exit;
  7092. fCustomData := aValue;
  7093. end;
  7094. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7095. procedure TglBitmap.SetCustomName(const aValue: String);
  7096. begin
  7097. if fCustomName = aValue then
  7098. exit;
  7099. fCustomName := aValue;
  7100. end;
  7101. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7102. procedure TglBitmap.SetCustomNameW(const aValue: WideString);
  7103. begin
  7104. if fCustomNameW = aValue then
  7105. exit;
  7106. fCustomNameW := aValue;
  7107. end;
  7108. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7109. procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
  7110. begin
  7111. if fDeleteTextureOnFree = aValue then
  7112. exit;
  7113. fDeleteTextureOnFree := aValue;
  7114. end;
  7115. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7116. procedure TglBitmap.SetID(const aValue: Cardinal);
  7117. begin
  7118. if fID = aValue then
  7119. exit;
  7120. fID := aValue;
  7121. end;
  7122. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7123. procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
  7124. begin
  7125. if fMipMap = aValue then
  7126. exit;
  7127. fMipMap := aValue;
  7128. end;
  7129. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7130. procedure TglBitmap.SetTarget(const aValue: Cardinal);
  7131. begin
  7132. if fTarget = aValue then
  7133. exit;
  7134. fTarget := aValue;
  7135. end;
  7136. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7137. procedure TglBitmap.SetAnisotropic(const aValue: Integer);
  7138. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)}
  7139. var
  7140. MaxAnisotropic: Integer;
  7141. {$IFEND}
  7142. begin
  7143. fAnisotropic := aValue;
  7144. if (ID > 0) then begin
  7145. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)}
  7146. if GL_EXT_texture_filter_anisotropic then begin
  7147. if fAnisotropic > 0 then begin
  7148. Bind({$IFNDEF OPENGL_ES}false{$ENDIF});
  7149. glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
  7150. if aValue > MaxAnisotropic then
  7151. fAnisotropic := MaxAnisotropic;
  7152. glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
  7153. end;
  7154. end else begin
  7155. fAnisotropic := 0;
  7156. end;
  7157. {$ELSE}
  7158. fAnisotropic := 0;
  7159. {$IFEND}
  7160. end;
  7161. end;
  7162. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7163. procedure TglBitmap.Init;
  7164. begin
  7165. fID := 0;
  7166. fTarget := 0;
  7167. {$IFNDEF OPENGL_ES}
  7168. fIsResident := false;
  7169. {$ENDIF}
  7170. fMipMap := glBitmapDefaultMipmap;
  7171. fDeleteTextureOnFree := glBitmapGetDefaultDeleteTextureOnFree;
  7172. glBitmapGetDefaultFilter (fFilterMin, fFilterMag);
  7173. glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
  7174. {$IFNDEF OPENGL_ES}
  7175. glBitmapGetDefaultSwizzle (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  7176. {$ENDIF}
  7177. end;
  7178. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7179. procedure TglBitmap.Finish;
  7180. begin
  7181. if (fID > 0) and fDeleteTextureOnFree then
  7182. glDeleteTextures(1, @fID);
  7183. end;
  7184. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7185. procedure TglBitmap.CreateID;
  7186. begin
  7187. if (ID <> 0) then
  7188. glDeleteTextures(1, @fID);
  7189. glGenTextures(1, @fID);
  7190. Bind({$IFNDEF OPENGL_ES}false{$ENDIF});
  7191. end;
  7192. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7193. procedure TglBitmap.SetupParameters({$IFNDEF OPENGL_ES}out aRealMipMapMode: TglBitmapMipMap{$ENDIF});
  7194. begin
  7195. // Set Up Parameters
  7196. SetWrap(fWrapS, fWrapT, fWrapR);
  7197. SetFilter(fFilterMin, fFilterMag);
  7198. SetAnisotropic(fAnisotropic);
  7199. {$IFNDEF OPENGL_ES}
  7200. SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
  7201. if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  7202. SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  7203. {$ENDIF}
  7204. {$IFNDEF OPENGL_ES}
  7205. // Mip Maps Generation Mode
  7206. aRealMipMapMode:= mmNone;
  7207. case MipMap of
  7208. mmNone: begin
  7209. glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_BASE_LEVEL, 0);
  7210. glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAX_LEVEL, 0);
  7211. end;
  7212. mmMipmap: begin
  7213. if GL_VERSION_3_0 or GL_ARB_framebuffer_object then
  7214. aRealMipMapMode:= mmMipmap
  7215. else if GL_VERSION_1_4 or GL_SGIS_generate_mipmap then begin
  7216. glTexParameteri(GL_TEXTURE_2D, GL_GENERATE_MIPMAP, GLint(GL_TRUE));
  7217. aRealMipMapMode:= mmNone;
  7218. end else
  7219. aRealMipMapMode:= mmMipmapGlu;
  7220. end;
  7221. mmMipmapGlu: aRealMipMapMode:= mmMipmapGlu;
  7222. end;
  7223. {$ELSE}
  7224. if MipMap <> mmNone then
  7225. aRealMipMapMode:= mmMipmap;
  7226. {$ENDIF}
  7227. end;
  7228. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7229. //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7230. {$IFNDEF OPENGL_ES}
  7231. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7232. procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  7233. begin
  7234. fBorderColor[0] := aRed;
  7235. fBorderColor[1] := aGreen;
  7236. fBorderColor[2] := aBlue;
  7237. fBorderColor[3] := aAlpha;
  7238. if (ID > 0) then begin
  7239. Bind(false);
  7240. glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
  7241. end;
  7242. end;
  7243. {$ENDIF}
  7244. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7245. procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
  7246. begin
  7247. //check MIN filter
  7248. case aMin of
  7249. GL_NEAREST:
  7250. fFilterMin := GL_NEAREST;
  7251. GL_LINEAR:
  7252. fFilterMin := GL_LINEAR;
  7253. GL_NEAREST_MIPMAP_NEAREST:
  7254. fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
  7255. GL_LINEAR_MIPMAP_NEAREST:
  7256. fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
  7257. GL_NEAREST_MIPMAP_LINEAR:
  7258. fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
  7259. GL_LINEAR_MIPMAP_LINEAR:
  7260. fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
  7261. else
  7262. raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
  7263. end;
  7264. //check MAG filter
  7265. case aMag of
  7266. GL_NEAREST:
  7267. fFilterMag := GL_NEAREST;
  7268. GL_LINEAR:
  7269. fFilterMag := GL_LINEAR;
  7270. else
  7271. raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
  7272. end;
  7273. //apply filter
  7274. if (ID > 0) then begin
  7275. Bind({$IFNDEF OPENGL_ES}false{$ENDIF});
  7276. glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
  7277. if (MipMap = mmNone) {$IFNDEF OPENGL_ES}or (Target = GL_TEXTURE_RECTANGLE){$ENDIF} then begin
  7278. case fFilterMin of
  7279. GL_NEAREST, GL_LINEAR:
  7280. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  7281. GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
  7282. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
  7283. GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
  7284. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
  7285. end;
  7286. end else
  7287. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  7288. end;
  7289. end;
  7290. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7291. procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
  7292. procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
  7293. begin
  7294. case aValue of
  7295. {$IFNDEF OPENGL_ES}
  7296. GL_CLAMP:
  7297. aTarget := GL_CLAMP;
  7298. {$ENDIF}
  7299. GL_REPEAT:
  7300. aTarget := GL_REPEAT;
  7301. GL_CLAMP_TO_EDGE: begin
  7302. {$IFNDEF OPENGL_ES}
  7303. if not GL_VERSION_1_2 and not GL_EXT_texture_edge_clamp then
  7304. aTarget := GL_CLAMP
  7305. else
  7306. {$ENDIF}
  7307. aTarget := GL_CLAMP_TO_EDGE;
  7308. end;
  7309. {$IFNDEF OPENGL_ES}
  7310. GL_CLAMP_TO_BORDER: begin
  7311. if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
  7312. aTarget := GL_CLAMP_TO_BORDER
  7313. else
  7314. aTarget := GL_CLAMP;
  7315. end;
  7316. {$ENDIF}
  7317. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  7318. GL_MIRRORED_REPEAT: begin
  7319. {$IFNDEF OPENGL_ES}
  7320. if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
  7321. {$ELSE}
  7322. if GL_VERSION_2_0 then
  7323. {$ENDIF}
  7324. aTarget := GL_MIRRORED_REPEAT
  7325. else
  7326. raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
  7327. end;
  7328. {$IFEND}
  7329. else
  7330. raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
  7331. end;
  7332. end;
  7333. begin
  7334. CheckAndSetWrap(S, fWrapS);
  7335. CheckAndSetWrap(T, fWrapT);
  7336. CheckAndSetWrap(R, fWrapR);
  7337. if (ID > 0) then begin
  7338. Bind({$IFNDEF OPENGL_ES}false{$ENDIF});
  7339. glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
  7340. glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
  7341. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  7342. {$IFDEF OPENGL_ES} if GL_VERSION_3_0 then{$ENDIF}
  7343. glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
  7344. {$IFEND}
  7345. end;
  7346. end;
  7347. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  7348. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7349. procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
  7350. procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
  7351. begin
  7352. if (aValue = GL_ZERO) or (aValue = GL_ONE) or (aValue = GL_ALPHA) or
  7353. (aValue = GL_RED) or (aValue = GL_GREEN) or (aValue = GL_BLUE) then
  7354. fSwizzle[aIndex] := aValue
  7355. else
  7356. raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
  7357. end;
  7358. begin
  7359. {$IFNDEF OPENGL_ES}
  7360. if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  7361. raise EglBitmapNotSupported.Create('texture swizzle is not supported');
  7362. {$ELSE}
  7363. if not GL_VERSION_3_0 then
  7364. raise EglBitmapNotSupported.Create('texture swizzle is not supported');
  7365. {$ENDIF}
  7366. CheckAndSetValue(r, 0);
  7367. CheckAndSetValue(g, 1);
  7368. CheckAndSetValue(b, 2);
  7369. CheckAndSetValue(a, 3);
  7370. if (ID > 0) then begin
  7371. Bind(false);
  7372. {$IFNDEF OPENGL_ES}
  7373. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, PGLint(@fSwizzle[0]));
  7374. {$ELSE}
  7375. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_R, PGLint(@fSwizzle[0]));
  7376. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_G, PGLint(@fSwizzle[1]));
  7377. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_B, PGLint(@fSwizzle[2]));
  7378. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_A, PGLint(@fSwizzle[3]));
  7379. {$ENDIF}
  7380. end;
  7381. end;
  7382. {$IFEND}
  7383. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7384. procedure TglBitmap.Bind({$IFNDEF OPENGL_ES}const aEnableTextureUnit: Boolean{$ENDIF});
  7385. begin
  7386. {$IFNDEF OPENGL_ES}
  7387. if aEnableTextureUnit then
  7388. glEnable(Target);
  7389. {$ENDIF}
  7390. if (ID > 0) then
  7391. glBindTexture(Target, ID);
  7392. end;
  7393. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7394. procedure TglBitmap.Unbind({$IFNDEF OPENGL_ES}const aDisableTextureUnit: Boolean{$ENDIF});
  7395. begin
  7396. {$IFNDEF OPENGL_ES}
  7397. if aDisableTextureUnit then
  7398. glDisable(Target);
  7399. {$ENDIF}
  7400. glBindTexture(Target, 0);
  7401. end;
  7402. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7403. procedure TglBitmap.UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean);
  7404. var
  7405. w, h: Integer;
  7406. begin
  7407. w := aDataObj.Width;
  7408. h := aDataObj.Height;
  7409. fDimension.Fields := [];
  7410. if (w > 0) then
  7411. fDimension.Fields := fDimension.Fields + [ffX];
  7412. if (h > 0) then
  7413. fDimension.Fields := fDimension.Fields + [ffY];
  7414. fDimension.X := w;
  7415. fDimension.Y := h;
  7416. end;
  7417. {$IFNDEF OPENGL_ES}
  7418. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7419. function TglBitmap.DownloadData(const aDataObj: TglBitmapData): Boolean;
  7420. var
  7421. Temp: PByte;
  7422. TempWidth, TempHeight: Integer;
  7423. TempIntFormat: GLint;
  7424. IntFormat: TglBitmapFormat;
  7425. FormatDesc: TFormatDescriptor;
  7426. begin
  7427. result := false;
  7428. Bind;
  7429. // Request Data
  7430. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH, @TempWidth);
  7431. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT, @TempHeight);
  7432. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
  7433. FormatDesc := (TglBitmapFormatDescriptor.GetByFormat(TempIntFormat) as TFormatDescriptor);
  7434. IntFormat := FormatDesc.Format;
  7435. // Getting data from OpenGL
  7436. FormatDesc := TFormatDescriptor.Get(IntFormat);
  7437. GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
  7438. try
  7439. glPixelStorei(GL_PACK_ALIGNMENT, 1);
  7440. if FormatDesc.IsCompressed then begin
  7441. if not Assigned(glGetCompressedTexImage) then
  7442. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7443. glGetCompressedTexImage(Target, 0, Temp)
  7444. end else
  7445. glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  7446. aDataObj.SetData(Temp, IntFormat, TempWidth, TempHeight);
  7447. result := true;
  7448. except
  7449. if Assigned(Temp) then
  7450. FreeMem(Temp);
  7451. raise;
  7452. end;
  7453. end;
  7454. {$ENDIF}
  7455. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7456. constructor TglBitmap.Create;
  7457. begin
  7458. if (ClassType = TglBitmap) then
  7459. raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
  7460. inherited Create;
  7461. Init;
  7462. end;
  7463. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7464. constructor TglBitmap.Create(const aData: TglBitmapData);
  7465. begin
  7466. Create;
  7467. UploadData(aData);
  7468. end;
  7469. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7470. destructor TglBitmap.Destroy;
  7471. begin
  7472. Finish;
  7473. inherited Destroy;
  7474. end;
  7475. {$IFNDEF OPENGL_ES}
  7476. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7477. //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7478. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7479. procedure TglBitmap1D.Init;
  7480. begin
  7481. inherited;
  7482. Target := GL_TEXTURE_1D;
  7483. end;
  7484. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7485. procedure TglBitmap1D.UploadDataIntern(const aDataObj: TglBitmapData; const aRealMipMapMode: TglBitmapMipMap);
  7486. var
  7487. fd: TglBitmapFormatDescriptor;
  7488. begin
  7489. // Upload data
  7490. fd := aDataObj.FormatDescriptor;
  7491. if (fd.glFormat = 0) or (fd.glInternalFormat = 0) or (fd.glDataFormat = 0) then
  7492. raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data');
  7493. if fd.IsCompressed then begin
  7494. if not Assigned(glCompressedTexImage1D) then
  7495. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7496. glCompressedTexImage1D(Target, 0, fd.glInternalFormat, aDataObj.Width, 0, fd.GetSize(aDataObj.Width, 1), aDataObj.Data);
  7497. if aRealMipMapMode = mmMipmap then
  7498. glGenerateMipmap(Target);
  7499. end else if aRealMipMapMode = mmMipmapGlu then
  7500. gluBuild1DMipmaps(Target, fd.glInternalFormat, aDataObj.Width, fd.glFormat, fd.glDataFormat, aDataObj.Data)
  7501. else begin
  7502. glTexImage1D(Target, 0, fd.glInternalFormat, aDataObj.Width, 0, fd.glFormat, fd.glDataFormat, aDataObj.Data);
  7503. if aRealMipMapMode = mmMipmap then
  7504. glGenerateMipmap(Target);
  7505. end;
  7506. end;
  7507. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7508. procedure TglBitmap1D.UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean);
  7509. var
  7510. TexRec: Boolean;
  7511. TexSize: Integer;
  7512. realMM: TglBitmapMipMap;
  7513. begin
  7514. if not Assigned(aDataObj) then
  7515. exit;
  7516. // Check Texture Size
  7517. if (aCheckSize) then begin
  7518. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  7519. if (aDataObj.Width > TexSize) then
  7520. raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  7521. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
  7522. (Target = GL_TEXTURE_RECTANGLE);
  7523. if not (IsPowerOfTwo(aDataObj.Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  7524. raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7525. end;
  7526. inherited UploadData(aDataObj, aCheckSize);
  7527. if (fID = 0) then
  7528. CreateID;
  7529. SetupParameters(realMM);
  7530. UploadDataIntern(aDataObj, realMM);
  7531. glAreTexturesResident(1, @fID, @fIsResident);
  7532. end;
  7533. {$ENDIF}
  7534. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7535. //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7536. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7537. procedure TglBitmap2D.Init;
  7538. begin
  7539. inherited;
  7540. Target := GL_TEXTURE_2D;
  7541. end;
  7542. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7543. procedure TglBitmap2D.UploadDataIntern(const aDataObj: TglBitmapData; const aTarget: GLenum{$IFNDEF OPENGL_ES}; const aRealMipMap: TglBitmapMipMap{$ENDIF});
  7544. var
  7545. fd: TglBitmapFormatDescriptor;
  7546. begin
  7547. fd := aDataObj.FormatDescriptor;
  7548. if (fd.glFormat = 0) or (fd.glInternalFormat = 0) or (fd.glDataFormat = 0) then
  7549. raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data');
  7550. glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
  7551. if fd.IsCompressed then begin
  7552. if not Assigned(glCompressedTexImage2D) then
  7553. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7554. glCompressedTexImage2D(aTarget, 0, fd.glInternalFormat, aDataObj.Width, aDataObj.Height, 0, fd.GetSize(fDimension), aDataObj.Data);
  7555. if aRealMipMap = mmMipmap then
  7556. glGenerateMipmap(aTarget);
  7557. {$IFNDEF OPENGL_ES}
  7558. end else if aRealMipMap = mmMipmapGlu then begin
  7559. gluBuild2DMipmaps(aTarget, fd.ChannelCount, aDataObj.Width, aDataObj.Height, fd.glFormat, fd.glDataFormat, aDataObj.Data)
  7560. {$ENDIF}
  7561. end else begin
  7562. glTexImage2D(aTarget, 0, fd.glInternalFormat, aDataObj.Width, aDataObj.Height, 0, fd.glFormat, fd.glDataFormat, aDataObj.Data);
  7563. if aRealMipMap = mmMipmap then
  7564. glGenerateMipmap(aTarget);
  7565. end;
  7566. end;
  7567. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7568. procedure TglBitmap2D.UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean);
  7569. var
  7570. {$IFNDEF OPENGL_ES}
  7571. TexRec: Boolean;
  7572. realMM: TglBitmapMipMap;
  7573. {$ENDIF}
  7574. PotTex: Boolean;
  7575. TexSize: Integer;
  7576. begin
  7577. if not Assigned(aDataObj) then
  7578. exit;
  7579. // Check Texture Size
  7580. if (aCheckSize) then begin
  7581. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  7582. if ((aDataObj.Width > TexSize) or (aDataObj.Height > TexSize)) then
  7583. raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  7584. PotTex := IsPowerOfTwo(aDataObj.Width) and IsPowerOfTwo(aDataObj.Height);
  7585. {$IF NOT DEFINED(OPENGL_ES)}
  7586. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
  7587. if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  7588. raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7589. {$ELSEIF DEFINED(OPENGL_ES_EXT)}
  7590. if not PotTex and not GL_OES_texture_npot then
  7591. raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7592. {$ELSE}
  7593. if not PotTex then
  7594. raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7595. {$IFEND}
  7596. end;
  7597. inherited UploadData(aDataObj, aCheckSize);
  7598. if (fID = 0) then
  7599. CreateID;
  7600. SetupParameters({$IFNDEF OPENGL_ES}realMM{$ENDIF});
  7601. UploadDataIntern(aDataObj, Target{$IFNDEF OPENGL_ES}, realMM{$ENDIF});
  7602. {$IFNDEF OPENGL_ES}
  7603. glAreTexturesResident(1, @fID, @fIsResident);
  7604. {$ENDIF}
  7605. end;
  7606. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7607. class procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat; const aDataObj: TglBitmapData);
  7608. var
  7609. Temp: pByte;
  7610. Size, w, h: Integer;
  7611. FormatDesc: TFormatDescriptor;
  7612. begin
  7613. FormatDesc := TFormatDescriptor.Get(aFormat);
  7614. if FormatDesc.IsCompressed then
  7615. raise EglBitmapUnsupportedFormat.Create(aFormat);
  7616. w := aRight - aLeft;
  7617. h := aBottom - aTop;
  7618. Size := FormatDesc.GetSize(w, h);
  7619. GetMem(Temp, Size);
  7620. try
  7621. glPixelStorei(GL_PACK_ALIGNMENT, 1);
  7622. glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  7623. aDataObj.SetData(Temp, aFormat, w, h);
  7624. aDataObj.FlipVert;
  7625. except
  7626. if Assigned(Temp) then
  7627. FreeMem(Temp);
  7628. raise;
  7629. end;
  7630. end;
  7631. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  7632. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7633. //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7634. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7635. procedure TglBitmapCubeMap.Init;
  7636. begin
  7637. inherited;
  7638. {$IFNDEF OPENGL_ES}
  7639. if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
  7640. raise EglBitmap.Create('TglBitmapCubeMap.Init - CubeMaps are unsupported.');
  7641. {$ELSE}
  7642. if not (GL_VERSION_2_0) then
  7643. raise EglBitmap.Create('TglBitmapCubeMap.Init - CubeMaps are unsupported.');
  7644. {$ENDIF}
  7645. SetWrap;
  7646. Target := GL_TEXTURE_CUBE_MAP;
  7647. {$IFNDEF OPENGL_ES}
  7648. fGenMode := GL_REFLECTION_MAP;
  7649. {$ENDIF}
  7650. end;
  7651. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7652. procedure TglBitmapCubeMap.UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean);
  7653. begin
  7654. Assert(false, 'TglBitmapCubeMap.UploadData - Don''t call UploadData directly, use UploadCubeMap instead');
  7655. end;
  7656. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7657. procedure TglBitmapCubeMap.UploadCubeMap(const aDataObj: TglBitmapData; const aCubeTarget: Cardinal; const aCheckSize: Boolean);
  7658. var
  7659. {$IFNDEF OPENGL_ES}
  7660. realMM: TglBitmapMipMap;
  7661. {$ENDIF}
  7662. TexSize: Integer;
  7663. begin
  7664. if (aCheckSize) then begin
  7665. glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
  7666. if (aDataObj.Width > TexSize) or (aDataObj.Height > TexSize) then
  7667. raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenerateCubeMap - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
  7668. {$IF NOT DEFINED(OPENGL_ES)}
  7669. if not ((IsPowerOfTwo(aDataObj.Width) and IsPowerOfTwo(aDataObj.Height)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
  7670. raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
  7671. {$ELSEIF DEFINED(OPENGL_ES_EXT)}
  7672. if not (IsPowerOfTwo(aDataObj.Width) and IsPowerOfTwo(aDataObj.Height)) and not GL_OES_texture_npot then
  7673. raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
  7674. {$ELSE}
  7675. if not (IsPowerOfTwo(aDataObj.Width) and IsPowerOfTwo(aDataObj.Height)) then
  7676. raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
  7677. {$IFEND}
  7678. end;
  7679. inherited UploadData(aDataObj, aCheckSize);
  7680. if (fID = 0) then
  7681. CreateID;
  7682. SetupParameters({$IFNDEF OPENGL_ES}realMM{$ENDIF});
  7683. UploadDataIntern(aDataObj, aCubeTarget{$IFNDEF OPENGL_ES}, realMM{$ENDIF});
  7684. end;
  7685. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7686. procedure TglBitmapCubeMap.Bind({$IFNDEF OPENGL_ES}const aEnableTexCoordsGen: Boolean; const aEnableTextureUnit: Boolean{$ENDIF});
  7687. begin
  7688. inherited Bind({$IFNDEF OPENGL_ES}aEnableTextureUnit{$ENDIF});
  7689. {$IFNDEF OPENGL_ES}
  7690. if aEnableTexCoordsGen then begin
  7691. glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
  7692. glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
  7693. glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
  7694. glEnable(GL_TEXTURE_GEN_S);
  7695. glEnable(GL_TEXTURE_GEN_T);
  7696. glEnable(GL_TEXTURE_GEN_R);
  7697. end;
  7698. {$ENDIF}
  7699. end;
  7700. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7701. procedure TglBitmapCubeMap.Unbind({$IFNDEF OPENGL_ES}const aDisableTexCoordsGen: Boolean; const aDisableTextureUnit: Boolean{$ENDIF});
  7702. begin
  7703. inherited Unbind({$IFNDEF OPENGL_ES}aDisableTextureUnit{$ENDIF});
  7704. {$IFNDEF OPENGL_ES}
  7705. if aDisableTexCoordsGen then begin
  7706. glDisable(GL_TEXTURE_GEN_S);
  7707. glDisable(GL_TEXTURE_GEN_T);
  7708. glDisable(GL_TEXTURE_GEN_R);
  7709. end;
  7710. {$ENDIF}
  7711. end;
  7712. {$IFEND}
  7713. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  7714. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7715. //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7716. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7717. type
  7718. TVec = Array[0..2] of Single;
  7719. TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7720. PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
  7721. TglBitmapNormalMapRec = record
  7722. HalfSize : Integer;
  7723. Func: TglBitmapNormalMapGetVectorFunc;
  7724. end;
  7725. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7726. procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7727. begin
  7728. aVec[0] := aHalfSize;
  7729. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7730. aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
  7731. end;
  7732. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7733. procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7734. begin
  7735. aVec[0] := - aHalfSize;
  7736. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7737. aVec[2] := aPosition.X + 0.5 - aHalfSize;
  7738. end;
  7739. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7740. procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7741. begin
  7742. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7743. aVec[1] := aHalfSize;
  7744. aVec[2] := aPosition.Y + 0.5 - aHalfSize;
  7745. end;
  7746. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7747. procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7748. begin
  7749. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7750. aVec[1] := - aHalfSize;
  7751. aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
  7752. end;
  7753. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7754. procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7755. begin
  7756. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7757. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7758. aVec[2] := aHalfSize;
  7759. end;
  7760. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7761. procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7762. begin
  7763. aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
  7764. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7765. aVec[2] := - aHalfSize;
  7766. end;
  7767. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7768. procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
  7769. var
  7770. i: Integer;
  7771. Vec: TVec;
  7772. Len: Single;
  7773. begin
  7774. with FuncRec do begin
  7775. with PglBitmapNormalMapRec(Args)^ do begin
  7776. Func(Vec, Position, HalfSize);
  7777. // Normalize
  7778. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  7779. if Len <> 0 then begin
  7780. Vec[0] := Vec[0] * Len;
  7781. Vec[1] := Vec[1] * Len;
  7782. Vec[2] := Vec[2] * Len;
  7783. end;
  7784. // Scale Vector and AddVectro
  7785. Vec[0] := Vec[0] * 0.5 + 0.5;
  7786. Vec[1] := Vec[1] * 0.5 + 0.5;
  7787. Vec[2] := Vec[2] * 0.5 + 0.5;
  7788. end;
  7789. // Set Color
  7790. for i := 0 to 2 do
  7791. Dest.Data.arr[i] := Round(Vec[i] * 255);
  7792. end;
  7793. end;
  7794. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7795. procedure TglBitmapNormalMap.Init;
  7796. begin
  7797. inherited;
  7798. {$IFNDEF OPENGL_ES}
  7799. fGenMode := GL_NORMAL_MAP;
  7800. {$ENDIF}
  7801. end;
  7802. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7803. procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aCheckSize: Boolean);
  7804. var
  7805. Rec: TglBitmapNormalMapRec;
  7806. SizeRec: TglBitmapSize;
  7807. DataObj: TglBitmapData;
  7808. begin
  7809. Rec.HalfSize := aSize div 2;
  7810. SizeRec.Fields := [ffX, ffY];
  7811. SizeRec.X := aSize;
  7812. SizeRec.Y := aSize;
  7813. DataObj := TglBitmapData.Create;
  7814. try
  7815. // Positive X
  7816. Rec.Func := glBitmapNormalMapPosX;
  7817. DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
  7818. UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_POSITIVE_X, aCheckSize);
  7819. // Negative X
  7820. Rec.Func := glBitmapNormalMapNegX;
  7821. DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
  7822. UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aCheckSize);
  7823. // Positive Y
  7824. Rec.Func := glBitmapNormalMapPosY;
  7825. DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
  7826. UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aCheckSize);
  7827. // Negative Y
  7828. Rec.Func := glBitmapNormalMapNegY;
  7829. DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
  7830. UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aCheckSize);
  7831. // Positive Z
  7832. Rec.Func := glBitmapNormalMapPosZ;
  7833. DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
  7834. UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aCheckSize);
  7835. // Negative Z
  7836. Rec.Func := glBitmapNormalMapNegZ;
  7837. DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
  7838. UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aCheckSize);
  7839. finally
  7840. FreeAndNil(DataObj);
  7841. end;
  7842. end;
  7843. {$IFEND}
  7844. initialization
  7845. glBitmapSetDefaultFormat (tfEmpty);
  7846. glBitmapSetDefaultMipmap (mmMipmap);
  7847. glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
  7848. glBitmapSetDefaultWrap (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
  7849. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  7850. glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
  7851. {$IFEND}
  7852. glBitmapSetDefaultFreeDataAfterGenTexture(true);
  7853. glBitmapSetDefaultDeleteTextureOnFree (true);
  7854. TFormatDescriptor.Init;
  7855. finalization
  7856. TFormatDescriptor.Finalize;
  7857. end.