Du kannst nicht mehr als 25 Themen auswählen Themen müssen entweder mit einem Buchstaben oder einer Ziffer beginnen. Sie können Bindestriche („-“) enthalten und bis zu 35 Zeichen lang sein.

8922 Zeilen
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. {$IFDEF CPUI386}
  27. {$DEFINE CPU386}
  28. {$ASMMODE INTEL}
  29. {$ENDIF}
  30. {$IFNDEF WINDOWS}
  31. {$linklib c}
  32. {$ENDIF}
  33. {$ENDIF}
  34. // Operation System
  35. {$IF DEFINED(WIN32) or DEFINED(WIN64) or DEFINED(WINDOWS)}
  36. {$DEFINE GLB_WIN}
  37. {$ELSEIF DEFINED(LINUX)}
  38. {$DEFINE GLB_LINUX}
  39. {$IFEND}
  40. // OpenGL ES
  41. {$IF DEFINED(OPENGL_ES_EXT)} {$DEFINE OPENGL_ES_1_1} {$IFEND}
  42. {$IF DEFINED(OPENGL_ES_3_0)} {$DEFINE OPENGL_ES_2_0} {$IFEND}
  43. {$IF DEFINED(OPENGL_ES_2_0)} {$DEFINE OPENGL_ES_1_1} {$IFEND}
  44. {$IF DEFINED(OPENGL_ES_1_1)} {$DEFINE OPENGL_ES} {$IFEND}
  45. // checking define combinations
  46. //SDL Image
  47. {$IFDEF GLB_SDL_IMAGE}
  48. {$IFNDEF GLB_SDL}
  49. {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}
  50. {$DEFINE GLB_SDL}
  51. {$ENDIF}
  52. {$IFDEF GLB_LAZ_PNG}
  53. {$MESSAGE warn 'The Lazarus TPortableNetworkGraphics will be ignored because you are using SDL_image.'}
  54. {$undef GLB_LAZ_PNG}
  55. {$ENDIF}
  56. {$IFDEF GLB_PNGIMAGE}
  57. {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}
  58. {$undef GLB_PNGIMAGE}
  59. {$ENDIF}
  60. {$IFDEF GLB_LAZ_JPEG}
  61. {$MESSAGE warn 'The Lazarus TJPEGImage will be ignored because you are using SDL_image.'}
  62. {$undef GLB_LAZ_JPEG}
  63. {$ENDIF}
  64. {$IFDEF GLB_DELPHI_JPEG}
  65. {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}
  66. {$undef GLB_DELPHI_JPEG}
  67. {$ENDIF}
  68. {$IFDEF GLB_LIB_PNG}
  69. {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}
  70. {$undef GLB_LIB_PNG}
  71. {$ENDIF}
  72. {$IFDEF GLB_LIB_JPEG}
  73. {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}
  74. {$undef GLB_LIB_JPEG}
  75. {$ENDIF}
  76. {$DEFINE GLB_SUPPORT_PNG_READ}
  77. {$DEFINE GLB_SUPPORT_JPEG_READ}
  78. {$ENDIF}
  79. // Lazarus TPortableNetworkGraphic
  80. {$IFDEF GLB_LAZ_PNG}
  81. {$IFNDEF GLB_LAZARUS}
  82. {$MESSAGE warn 'Lazarus TPortableNetworkGraphic won''t work without Lazarus. Lazarus will be activated.'}
  83. {$DEFINE GLB_LAZARUS}
  84. {$ENDIF}
  85. {$IFDEF GLB_PNGIMAGE}
  86. {$MESSAGE warn 'The pngimage will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
  87. {$undef GLB_PNGIMAGE}
  88. {$ENDIF}
  89. {$IFDEF GLB_LIB_PNG}
  90. {$MESSAGE warn 'The library libPNG will be ignored if you are using Lazarus TPortableNetworkGraphic.'}
  91. {$undef GLB_LIB_PNG}
  92. {$ENDIF}
  93. {$DEFINE GLB_SUPPORT_PNG_READ}
  94. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  95. {$ENDIF}
  96. // PNG Image
  97. {$IFDEF GLB_PNGIMAGE}
  98. {$IFDEF GLB_LIB_PNG}
  99. {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}
  100. {$undef GLB_LIB_PNG}
  101. {$ENDIF}
  102. {$DEFINE GLB_SUPPORT_PNG_READ}
  103. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  104. {$ENDIF}
  105. // libPNG
  106. {$IFDEF GLB_LIB_PNG}
  107. {$DEFINE GLB_SUPPORT_PNG_READ}
  108. {$DEFINE GLB_SUPPORT_PNG_WRITE}
  109. {$ENDIF}
  110. // Lazarus TJPEGImage
  111. {$IFDEF GLB_LAZ_JPEG}
  112. {$IFNDEF GLB_LAZARUS}
  113. {$MESSAGE warn 'Lazarus TJPEGImage won''t work without Lazarus. Lazarus will be activated.'}
  114. {$DEFINE GLB_LAZARUS}
  115. {$ENDIF}
  116. {$IFDEF GLB_DELPHI_JPEG}
  117. {$MESSAGE warn 'The Delphi JPEGImage will be ignored if you are using the Lazarus TJPEGImage.'}
  118. {$undef GLB_DELPHI_JPEG}
  119. {$ENDIF}
  120. {$IFDEF GLB_LIB_JPEG}
  121. {$MESSAGE warn 'The library libJPEG will be ignored if you are using the Lazarus TJPEGImage.'}
  122. {$undef GLB_LIB_JPEG}
  123. {$ENDIF}
  124. {$DEFINE GLB_SUPPORT_JPEG_READ}
  125. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  126. {$ENDIF}
  127. // JPEG Image
  128. {$IFDEF GLB_DELPHI_JPEG}
  129. {$IFDEF GLB_LIB_JPEG}
  130. {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}
  131. {$undef GLB_LIB_JPEG}
  132. {$ENDIF}
  133. {$DEFINE GLB_SUPPORT_JPEG_READ}
  134. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  135. {$ENDIF}
  136. // libJPEG
  137. {$IFDEF GLB_LIB_JPEG}
  138. {$DEFINE GLB_SUPPORT_JPEG_READ}
  139. {$DEFINE GLB_SUPPORT_JPEG_WRITE}
  140. {$ENDIF}
  141. // general options
  142. {$EXTENDEDSYNTAX ON}
  143. {$LONGSTRINGS ON}
  144. {$ALIGN ON}
  145. {$IFNDEF FPC}
  146. {$OPTIMIZATION ON}
  147. {$ENDIF}
  148. interface
  149. uses
  150. {$IFDEF OPENGL_ES} dglOpenGLES,
  151. {$ELSE} dglOpenGL, {$ENDIF}
  152. {$IF DEFINED(GLB_WIN) AND
  153. DEFINED(GLB_DELPHI)} windows, {$IFEND}
  154. {$IFDEF GLB_SDL} SDL, {$ENDIF}
  155. {$IFDEF GLB_LAZARUS} IntfGraphics, GraphType, Graphics, {$ENDIF}
  156. {$IFDEF GLB_DELPHI} Dialogs, Graphics, Types, {$ENDIF}
  157. {$IFDEF GLB_SDL_IMAGE} SDL_image, {$ENDIF}
  158. {$IFDEF GLB_PNGIMAGE} pngimage, {$ENDIF}
  159. {$IFDEF GLB_LIB_PNG} libPNG, {$ENDIF}
  160. {$IFDEF GLB_DELPHI_JPEG} JPEG, {$ENDIF}
  161. {$IFDEF GLB_LIB_JPEG} libJPEG, {$ENDIF}
  162. Classes, SysUtils;
  163. type
  164. {$IFNDEF fpc}
  165. QWord = System.UInt64;
  166. PQWord = ^QWord;
  167. PtrInt = Longint;
  168. PtrUInt = DWord;
  169. {$ENDIF}
  170. { type that describes the format of the data stored in a texture.
  171. the name of formats is composed of the following constituents:
  172. - multiple channels:
  173. - channel (e.g. R, G, B, A or Alpha, Luminance or X (reserved))
  174. - width of the chanel in bit (4, 8, 16, ...)
  175. - data type (e.g. ub, us, ui)
  176. - number of elements of data types }
  177. TglBitmapFormat = (
  178. tfEmpty = 0,
  179. tfAlpha4ub1, //< 1 x unsigned byte
  180. tfAlpha8ub1, //< 1 x unsigned byte
  181. tfAlpha16us1, //< 1 x unsigned short
  182. tfLuminance4ub1, //< 1 x unsigned byte
  183. tfLuminance8ub1, //< 1 x unsigned byte
  184. tfLuminance16us1, //< 1 x unsigned short
  185. tfLuminance4Alpha4ub2, //< 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
  186. tfLuminance6Alpha2ub2, //< 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
  187. tfLuminance8Alpha8ub2, //< 1 x unsigned byte (lum), 1 x unsigned byte (alpha)
  188. tfLuminance12Alpha4us2, //< 1 x unsigned short (lum), 1 x unsigned short (alpha)
  189. tfLuminance16Alpha16us2, //< 1 x unsigned short (lum), 1 x unsigned short (alpha)
  190. tfR3G3B2ub1, //< 1 x unsigned byte (3bit red, 3bit green, 2bit blue)
  191. tfRGBX4us1, //< 1 x unsigned short (4bit red, 4bit green, 4bit blue, 4bit reserverd)
  192. tfXRGB4us1, //< 1 x unsigned short (4bit reserved, 4bit red, 4bit green, 4bit blue)
  193. tfR5G6B5us1, //< 1 x unsigned short (5bit red, 6bit green, 5bit blue)
  194. tfRGB5X1us1, //< 1 x unsigned short (5bit red, 5bit green, 5bit blue, 1bit reserved)
  195. tfX1RGB5us1, //< 1 x unsigned short (1bit reserved, 5bit red, 5bit green, 5bit blue)
  196. tfRGB8ub3, //< 1 x unsigned byte (red), 1 x unsigned byte (green), 1 x unsigned byte (blue)
  197. tfRGBX8ui1, //< 1 x unsigned int (8bit red, 8bit green, 8bit blue, 8bit reserved)
  198. tfXRGB8ui1, //< 1 x unsigned int (8bit reserved, 8bit red, 8bit green, 8bit blue)
  199. tfRGB10X2ui1, //< 1 x unsigned int (10bit red, 10bit green, 10bit blue, 2bit reserved)
  200. tfX2RGB10ui1, //< 1 x unsigned int (2bit reserved, 10bit red, 10bit green, 10bit blue)
  201. tfRGB16us3, //< 1 x unsigned short (red), 1 x unsigned short (green), 1 x unsigned short (blue)
  202. tfRGBA4us1, //< 1 x unsigned short (4bit red, 4bit green, 4bit blue, 4bit alpha)
  203. tfARGB4us1, //< 1 x unsigned short (4bit alpha, 4bit red, 4bit green, 4bit blue)
  204. tfRGB5A1us1, //< 1 x unsigned short (5bit red, 5bit green, 5bit blue, 1bit alpha)
  205. tfA1RGB5us1, //< 1 x unsigned short (1bit alpha, 5bit red, 5bit green, 5bit blue)
  206. tfRGBA8ub4, //< 1 x unsigned byte (red), 1 x unsigned byte (green), 1 x unsigned byte (blue), 1 x unsigned byte (alpha)
  207. tfRGBA8ui1, //< 1 x unsigned int (8bit red, 8bit green, 8bit blue, 8 bit alpha)
  208. tfARGB8ui1, //< 1 x unsigned int (8 bit alpha, 8bit red, 8bit green, 8bit blue)
  209. tfRGB10A2ui1, //< 1 x unsigned int (10bit red, 10bit green, 10bit blue, 2bit alpha)
  210. tfA2RGB10ui1, //< 1 x unsigned int (2bit alpha, 10bit red, 10bit green, 10bit blue)
  211. tfRGBA16us4, //< 1 x unsigned short (red), 1 x unsigned short (green), 1 x unsigned short (blue), 1 x unsigned short (alpha)
  212. tfBGRX4us1, //< 1 x unsigned short (4bit blue, 4bit green, 4bit red, 4bit reserved)
  213. tfXBGR4us1, //< 1 x unsigned short (4bit reserved, 4bit blue, 4bit green, 4bit red)
  214. tfB5G6R5us1, //< 1 x unsigned short (5bit blue, 6bit green, 5bit red)
  215. tfBGR5X1us1, //< 1 x unsigned short (5bit blue, 5bit green, 5bit red, 1bit reserved)
  216. tfX1BGR5us1, //< 1 x unsigned short (1bit reserved, 5bit blue, 5bit green, 5bit red)
  217. tfBGR8ub3, //< 1 x unsigned byte (blue), 1 x unsigned byte (green), 1 x unsigned byte (red)
  218. tfBGRX8ui1, //< 1 x unsigned int (8bit blue, 8bit green, 8bit red, 8bit reserved)
  219. tfXBGR8ui1, //< 1 x unsigned int (8bit reserved, 8bit blue, 8bit green, 8bit red)
  220. tfBGR10X2ui1, //< 1 x unsigned int (10bit blue, 10bit green, 10bit red, 2bit reserved)
  221. tfX2BGR10ui1, //< 1 x unsigned int (2bit reserved, 10bit blue, 10bit green, 10bit red)
  222. tfBGR16us3, //< 1 x unsigned short (blue), 1 x unsigned short (green), 1 x unsigned short (red)
  223. tfBGRA4us1, //< 1 x unsigned short (4bit blue, 4bit green, 4bit red, 4bit alpha)
  224. tfABGR4us1, //< 1 x unsigned short (4bit alpha, 4bit blue, 4bit green, 4bit red)
  225. tfBGR5A1us1, //< 1 x unsigned short (5bit blue, 5bit green, 5bit red, 1bit alpha)
  226. tfA1BGR5us1, //< 1 x unsigned short (1bit alpha, 5bit blue, 5bit green, 5bit red)
  227. tfBGRA8ub4, //< 1 x unsigned byte (blue), 1 x unsigned byte (green), 1 x unsigned byte (red), 1 x unsigned byte (alpha)
  228. tfBGRA8ui1, //< 1 x unsigned int (8bit blue, 8bit green, 8bit red, 8bit alpha)
  229. tfABGR8ui1, //< 1 x unsigned int (8bit alpha, 8bit blue, 8bit green, 8bit red)
  230. tfBGR10A2ui1, //< 1 x unsigned int (10bit blue, 10bit green, 10bit red, 2bit alpha)
  231. tfA2BGR10ui1, //< 1 x unsigned int (2bit alpha, 10bit blue, 10bit green, 10bit red)
  232. tfBGRA16us4, //< 1 x unsigned short (blue), 1 x unsigned short (green), 1 x unsigned short (red), 1 x unsigned short (alpha)
  233. tfDepth16us1, //< 1 x unsigned short (depth)
  234. tfDepth24ui1, //< 1 x unsigned int (depth)
  235. tfDepth32ui1, //< 1 x unsigned int (depth)
  236. tfS3tcDtx1RGBA,
  237. tfS3tcDtx3RGBA,
  238. tfS3tcDtx5RGBA
  239. );
  240. { type to define suitable file formats }
  241. TglBitmapFileType = (
  242. {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG, {$ENDIF} //< Portable Network Graphic file (PNG)
  243. {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF} //< JPEG file
  244. ftDDS, //< Direct Draw Surface file (DDS)
  245. ftTGA, //< Targa Image File (TGA)
  246. ftBMP, //< Windows Bitmap File (BMP)
  247. ftRAW); //< glBitmap RAW file format
  248. TglBitmapFileTypes = set of TglBitmapFileType;
  249. { possible mipmap types }
  250. TglBitmapMipMap = (
  251. mmNone, //< no mipmaps
  252. mmMipmap, //< normal mipmaps
  253. mmMipmapGlu); //< mipmaps generated with glu functions
  254. { possible normal map functions }
  255. TglBitmapNormalMapFunc = (
  256. nm4Samples,
  257. nmSobel,
  258. nm3x3,
  259. nm5x5);
  260. ////////////////////////////////////////////////////////////////////////////////////////////////////
  261. EglBitmap = class(Exception); //< glBitmap exception
  262. EglBitmapNotSupported = class(Exception); //< exception for not supported functions
  263. EglBitmapSizeToLarge = class(EglBitmap); //< exception for to large textures
  264. EglBitmapNonPowerOfTwo = class(EglBitmap); //< exception for non power of two textures
  265. EglBitmapUnsupportedFormat = class(EglBitmap) //< exception for unsupporetd formats
  266. public
  267. constructor Create(const aFormat: TglBitmapFormat); overload;
  268. constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;
  269. end;
  270. ////////////////////////////////////////////////////////////////////////////////////////////////////
  271. { record that stores 4 unsigned integer values }
  272. TglBitmapRec4ui = packed record
  273. case Integer of
  274. 0: (r, g, b, a: Cardinal);
  275. 1: (arr: array[0..3] of Cardinal);
  276. end;
  277. { record that stores 4 unsigned byte values }
  278. TglBitmapRec4ub = packed record
  279. case Integer of
  280. 0: (r, g, b, a: Byte);
  281. 1: (arr: array[0..3] of Byte);
  282. end;
  283. { record that stores 4 unsigned long integer values }
  284. TglBitmapRec4ul = packed record
  285. case Integer of
  286. 0: (r, g, b, a: QWord);
  287. 1: (arr: array[0..3] of QWord);
  288. end;
  289. { structure to store pixel data in }
  290. TglBitmapPixelData = packed record
  291. Data: TglBitmapRec4ui; //< color data for each color channel
  292. Range: TglBitmapRec4ui; //< maximal color value for each channel
  293. Format: TglBitmapFormat; //< format of the pixel
  294. end;
  295. PglBitmapPixelData = ^TglBitmapPixelData;
  296. TglBitmapSizeFields = set of (ffX, ffY);
  297. TglBitmapSize = packed record
  298. Fields: TglBitmapSizeFields;
  299. X: Word;
  300. Y: Word;
  301. end;
  302. TglBitmapPixelPosition = TglBitmapSize;
  303. { describes the properties of a given texture data format }
  304. TglBitmapFormatDescriptor = class(TObject)
  305. private
  306. // cached properties
  307. fBytesPerPixel: Single; //< number of bytes for each pixel
  308. fChannelCount: Integer; //< number of color channels
  309. fMask: TglBitmapRec4ul; //< bitmask for each color channel
  310. fRange: TglBitmapRec4ui; //< maximal value of each color channel
  311. { @return @true if the format has a red color channel, @false otherwise }
  312. function GetHasRed: Boolean;
  313. { @return @true if the format has a green color channel, @false otherwise }
  314. function GetHasGreen: Boolean;
  315. { @return @true if the format has a blue color channel, @false otherwise }
  316. function GetHasBlue: Boolean;
  317. { @return @true if the format has a alpha color channel, @false otherwise }
  318. function GetHasAlpha: Boolean;
  319. { @return @true if the format has any color color channel, @false otherwise }
  320. function GetHasColor: Boolean;
  321. { @return @true if the format is a grayscale format, @false otherwise }
  322. function GetIsGrayscale: Boolean;
  323. { @return @true if the format is supported by OpenGL, @false otherwise }
  324. function GetHasOpenGLSupport: Boolean;
  325. protected
  326. fFormat: TglBitmapFormat; //< format this descriptor belongs to
  327. fWithAlpha: TglBitmapFormat; //< suitable format with alpha channel
  328. fWithoutAlpha: TglBitmapFormat; //< suitable format without alpha channel
  329. fOpenGLFormat: TglBitmapFormat; //< suitable format that is supported by OpenGL
  330. fRGBInverted: TglBitmapFormat; //< suitable format with inverted RGB channels
  331. fUncompressed: TglBitmapFormat; //< suitable format with uncompressed data
  332. fBitsPerPixel: Integer; //< number of bits per pixel
  333. fIsCompressed: Boolean; //< @true if the format is compressed, @false otherwise
  334. fPrecision: TglBitmapRec4ub; //< number of bits for each color channel
  335. fShift: TglBitmapRec4ub; //< bit offset for each color channel
  336. fglFormat: GLenum; //< OpenGL format enum (e.g. GL_RGB)
  337. fglInternalFormat: GLenum; //< OpenGL internal format enum (e.g. GL_RGB8)
  338. fglDataFormat: GLenum; //< OpenGL data format enum (e.g. GL_UNSIGNED_BYTE)
  339. { set values for this format descriptor }
  340. procedure SetValues; virtual;
  341. { calculate cached values }
  342. procedure CalcValues;
  343. public
  344. property Format: TglBitmapFormat read fFormat; //< format this descriptor belongs to
  345. property ChannelCount: Integer read fChannelCount; //< number of color channels
  346. property IsCompressed: Boolean read fIsCompressed; //< @true if the format is compressed, @false otherwise
  347. property BitsPerPixel: Integer read fBitsPerPixel; //< number of bytes per pixel
  348. property BytesPerPixel: Single read fBytesPerPixel; //< number of bits per pixel
  349. property Precision: TglBitmapRec4ub read fPrecision; //< number of bits for each color channel
  350. property Shift: TglBitmapRec4ub read fShift; //< bit offset for each color channel
  351. property Range: TglBitmapRec4ui read fRange; //< maximal value of each color channel
  352. property Mask: TglBitmapRec4ul read fMask; //< bitmask for each color channel
  353. property RGBInverted: TglBitmapFormat read fRGBInverted; //< suitable format with inverted RGB channels
  354. property WithAlpha: TglBitmapFormat read fWithAlpha; //< suitable format with alpha channel
  355. property WithoutAlpha: TglBitmapFormat read fWithAlpha; //< suitable format without alpha channel
  356. property OpenGLFormat: TglBitmapFormat read fOpenGLFormat; //< suitable format that is supported by OpenGL
  357. property Uncompressed: TglBitmapFormat read fUncompressed; //< suitable format with uncompressed data
  358. property glFormat: GLenum read fglFormat; //< OpenGL format enum (e.g. GL_RGB)
  359. property glInternalFormat: GLenum read fglInternalFormat; //< OpenGL internal format enum (e.g. GL_RGB8)
  360. property glDataFormat: GLenum read fglDataFormat; //< OpenGL data format enum (e.g. GL_UNSIGNED_BYTE)
  361. property HasRed: Boolean read GetHasRed; //< @true if the format has a red color channel, @false otherwise
  362. property HasGreen: Boolean read GetHasGreen; //< @true if the format has a green color channel, @false otherwise
  363. property HasBlue: Boolean read GetHasBlue; //< @true if the format has a blue color channel, @false otherwise
  364. property HasAlpha: Boolean read GetHasAlpha; //< @true if the format has a alpha color channel, @false otherwise
  365. property HasColor: Boolean read GetHasColor; //< @true if the format has any color color channel, @false otherwise
  366. property IsGrayscale: Boolean read GetIsGrayscale; //< @true if the format is a grayscale format, @false otherwise
  367. property HasOpenGLSupport: Boolean read GetHasOpenGLSupport; //< @true if the format is supported by OpenGL, @false otherwise
  368. function GetSize(const aSize: TglBitmapSize): Integer; overload; virtual;
  369. function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual;
  370. { constructor }
  371. constructor Create;
  372. public
  373. { get the format descriptor by a given OpenGL internal format
  374. @param aInternalFormat OpenGL internal format to get format descriptor for
  375. @returns suitable format descriptor or tfEmpty-Descriptor }
  376. class function GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor; overload;
  377. { get the format descriptor by the given format
  378. @param aFormat format to get descriptor for
  379. @return suitable format descriptor or tfEmpty-Descriptor }
  380. class function GetByFormat(const aFormat: TglBitmapFormat): TglBitmapFormatDescriptor; overload;
  381. end;
  382. ////////////////////////////////////////////////////////////////////////////////////////////////////
  383. TglBitmapData = class;
  384. { structure to store data for converting in }
  385. TglBitmapFunctionRec = record
  386. Sender: TglBitmapData; //< texture object that stores the data to convert
  387. Size: TglBitmapSize; //< size of the texture
  388. Position: TglBitmapPixelPosition; //< position of the currently pixel
  389. Source: TglBitmapPixelData; //< pixel data of the current pixel
  390. Dest: TglBitmapPixelData; //< new data of the pixel (must be filled in)
  391. Args: Pointer; //< user defined args that was passed to the convert function
  392. end;
  393. { callback to use for converting texture data }
  394. TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);
  395. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  396. { class to store texture data in. used to load, save and
  397. manipulate data before assigned to texture object
  398. all operations on a data object can be done from a background thread }
  399. TglBitmapData = class
  400. private { fields }
  401. fData: PByte; //< texture data
  402. fDimension: TglBitmapSize; //< pixel size of the data
  403. fFormat: TglBitmapFormat; //< format the texture data is stored in
  404. fFilename: String; //< file the data was load from
  405. fScanlines: array of PByte; //< pointer to begin of each line
  406. fHasScanlines: Boolean; //< @true if scanlines are initialized, @false otherwise
  407. private { getter / setter }
  408. { @returns the format descriptor suitable to the texture data format }
  409. function GetFormatDescriptor: TglBitmapFormatDescriptor;
  410. { @returns the width of the texture data (in pixel) or -1 if no data is set }
  411. function GetWidth: Integer;
  412. { @returns the height of the texture data (in pixel) or -1 if no data is set }
  413. function GetHeight: Integer;
  414. { get scanline at index aIndex
  415. @returns Pointer to start of line or @nil }
  416. function GetScanlines(const aIndex: Integer): PByte;
  417. { set new value for the data format. only possible if new format has the same pixel size.
  418. if you want to convert the texture data, see ConvertTo function }
  419. procedure SetFormat(const aValue: TglBitmapFormat);
  420. private { internal misc }
  421. { splits a resource identifier into the resource and it's type
  422. @param aResource resource identifier to split and store name in
  423. @param aResType type of the resource }
  424. procedure PrepareResType(var aResource: String; var aResType: PChar);
  425. { updates scanlines array }
  426. procedure UpdateScanlines;
  427. private { internal load and save }
  428. {$IFDEF GLB_SUPPORT_PNG_READ}
  429. { try to load a PNG from a stream
  430. @param aStream stream to load PNG from
  431. @returns @true on success, @false otherwise }
  432. function LoadPNG(const aStream: TStream): Boolean; virtual;
  433. {$ENDIF}
  434. {$ifdef GLB_SUPPORT_PNG_WRITE}
  435. { save texture data as PNG to stream
  436. @param aStream stream to save data to}
  437. procedure SavePNG(const aStream: TStream); virtual;
  438. {$ENDIF}
  439. {$IFDEF GLB_SUPPORT_JPEG_READ}
  440. { try to load a JPEG from a stream
  441. @param aStream stream to load JPEG from
  442. @returns @true on success, @false otherwise }
  443. function LoadJPEG(const aStream: TStream): Boolean; virtual;
  444. {$ENDIF}
  445. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  446. { save texture data as JPEG to stream
  447. @param aStream stream to save data to}
  448. procedure SaveJPEG(const aStream: TStream); virtual;
  449. {$ENDIF}
  450. { try to load a RAW image from a stream
  451. @param aStream stream to load RAW image from
  452. @returns @true on success, @false otherwise }
  453. function LoadRAW(const aStream: TStream): Boolean;
  454. { save texture data as RAW image to stream
  455. @param aStream stream to save data to}
  456. procedure SaveRAW(const aStream: TStream);
  457. { try to load a BMP from a stream
  458. @param aStream stream to load BMP from
  459. @returns @true on success, @false otherwise }
  460. function LoadBMP(const aStream: TStream): Boolean;
  461. { save texture data as BMP to stream
  462. @param aStream stream to save data to}
  463. procedure SaveBMP(const aStream: TStream);
  464. { try to load a TGA from a stream
  465. @param aStream stream to load TGA from
  466. @returns @true on success, @false otherwise }
  467. function LoadTGA(const aStream: TStream): Boolean;
  468. { save texture data as TGA to stream
  469. @param aStream stream to save data to}
  470. procedure SaveTGA(const aStream: TStream);
  471. { try to load a DDS from a stream
  472. @param aStream stream to load DDS from
  473. @returns @true on success, @false otherwise }
  474. function LoadDDS(const aStream: TStream): Boolean;
  475. { save texture data as DDS to stream
  476. @param aStream stream to save data to}
  477. procedure SaveDDS(const aStream: TStream);
  478. public { properties }
  479. property Data: PByte read fData; //< texture data (be carefull with this!)
  480. property Dimension: TglBitmapSize read fDimension; //< size of the texture data (in pixel)
  481. property Filename: String read fFilename; //< file the data was loaded from
  482. property Width: Integer read GetWidth; //< width of the texture data (in pixel)
  483. property Height: Integer read GetHeight; //< height of the texture data (in pixel)
  484. property Format: TglBitmapFormat read fFormat write SetFormat; //< format the texture data is stored in
  485. property Scanlines[const aIndex: Integer]: PByte read GetScanlines; //< pointer to begin of line at given index or @nil
  486. property FormatDescriptor: TglBitmapFormatDescriptor read GetFormatDescriptor; //< descriptor object that describes the format of the stored data
  487. public { flip }
  488. { flip texture horizontal
  489. @returns @true in success, @false otherwise }
  490. function FlipHorz: Boolean; virtual;
  491. { flip texture vertical
  492. @returns @true in success, @false otherwise }
  493. function FlipVert: Boolean; virtual;
  494. public { load }
  495. { load a texture from a file
  496. @param aFilename file to load texuture from }
  497. procedure LoadFromFile(const aFilename: String);
  498. { load a texture from a stream
  499. @param aStream stream to load texture from }
  500. procedure LoadFromStream(const aStream: TStream); virtual;
  501. { use a function to generate texture data
  502. @param aSize size of the texture
  503. @param aFormat format of the texture data
  504. @param aFunc callback to use for generation
  505. @param aArgs user defined paramaters (use at will) }
  506. procedure LoadFromFunc(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil);
  507. { load a texture from a resource
  508. @param aInstance resource handle
  509. @param aResource resource indentifier
  510. @param aResType resource type (if known) }
  511. procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
  512. { load a texture from a resource id
  513. @param aInstance resource handle
  514. @param aResource resource ID
  515. @param aResType resource type }
  516. procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  517. public { save }
  518. { save texture data to a file
  519. @param aFilename filename to store texture in
  520. @param aFileType file type to store data into }
  521. procedure SaveToFile(const aFilename: String; const aFileType: TglBitmapFileType);
  522. { save texture data to a stream
  523. @param aFilename filename to store texture in
  524. @param aFileType file type to store data into }
  525. procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;
  526. public { convert }
  527. { convert texture data using a user defined callback
  528. @param aFunc callback to use for converting
  529. @param aCreateTemp create a temporary buffer to use for converting
  530. @param aArgs user defined paramters (use at will)
  531. @returns @true if converting was successful, @false otherwise }
  532. function Convert(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;
  533. { convert texture data using a user defined callback
  534. @param aSource glBitmap to read data from
  535. @param aFunc callback to use for converting
  536. @param aCreateTemp create a temporary buffer to use for converting
  537. @param aFormat format of the new data
  538. @param aArgs user defined paramters (use at will)
  539. @returns @true if converting was successful, @false otherwise }
  540. function Convert(const aSource: TglBitmapData; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  541. const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;
  542. { convert texture data using a specific format
  543. @param aFormat new format of texture data
  544. @returns @true if converting was successful, @false otherwise }
  545. function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;
  546. {$IFDEF GLB_SDL}
  547. public { SDL }
  548. { assign texture data to SDL surface
  549. @param aSurface SDL surface to write data to
  550. @returns @true on success, @false otherwise }
  551. function AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  552. { assign texture data from SDL surface
  553. @param aSurface SDL surface to read data from
  554. @returns @true on success, @false otherwise }
  555. function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  556. { assign alpha channel data to SDL surface
  557. @param aSurface SDL surface to write alpha channel data to
  558. @returns @true on success, @false otherwise }
  559. function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  560. { assign alpha channel data from SDL surface
  561. @param aSurface SDL surface to read data from
  562. @param aFunc callback to use for converting
  563. @param aArgs user defined parameters (use at will)
  564. @returns @true on success, @false otherwise }
  565. function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  566. {$ENDIF}
  567. {$IFDEF GLB_DELPHI}
  568. public { Delphi }
  569. { assign texture data to TBitmap object
  570. @param aBitmap TBitmap to write data to
  571. @returns @true on success, @false otherwise }
  572. function AssignToBitmap(const aBitmap: TBitmap): Boolean;
  573. { assign texture data from TBitmap object
  574. @param aBitmap TBitmap to read data from
  575. @returns @true on success, @false otherwise }
  576. function AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  577. { assign alpha channel data to TBitmap object
  578. @param aBitmap TBitmap to write data to
  579. @returns @true on success, @false otherwise }
  580. function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  581. { assign alpha channel data from TBitmap object
  582. @param aBitmap TBitmap to read data from
  583. @param aFunc callback to use for converting
  584. @param aArgs user defined parameters (use at will)
  585. @returns @true on success, @false otherwise }
  586. function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  587. {$ENDIF}
  588. {$IFDEF GLB_LAZARUS}
  589. public { Lazarus }
  590. { assign texture data to TLazIntfImage object
  591. @param aImage TLazIntfImage to write data to
  592. @returns @true on success, @false otherwise }
  593. function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  594. { assign texture data from TLazIntfImage object
  595. @param aImage TLazIntfImage to read data from
  596. @returns @true on success, @false otherwise }
  597. function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  598. { assign alpha channel data to TLazIntfImage object
  599. @param aImage TLazIntfImage to write data to
  600. @returns @true on success, @false otherwise }
  601. function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  602. { assign alpha channel data from TLazIntfImage object
  603. @param aImage TLazIntfImage to read data from
  604. @param aFunc callback to use for converting
  605. @param aArgs user defined parameters (use at will)
  606. @returns @true on success, @false otherwise }
  607. function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  608. {$ENDIF}
  609. public { Alpha }
  610. { load alpha channel data from resource
  611. @param aInstance resource handle
  612. @param aResource resource ID
  613. @param aResType resource type
  614. @param aFunc callback to use for converting
  615. @param aArgs user defined parameters (use at will)
  616. @returns @true on success, @false otherwise }
  617. function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  618. { load alpha channel data from resource ID
  619. @param aInstance resource handle
  620. @param aResourceID resource ID
  621. @param aResType resource type
  622. @param aFunc callback to use for converting
  623. @param aArgs user defined parameters (use at will)
  624. @returns @true on success, @false otherwise }
  625. function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  626. { add alpha channel data from function
  627. @param aFunc callback to get data from
  628. @param aArgs user defined parameters (use at will)
  629. @returns @true on success, @false otherwise }
  630. function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
  631. { add alpha channel data from file (macro for: new glBitmap, LoadFromFile, AddAlphaFromGlBitmap)
  632. @param aFilename file to load alpha channel data from
  633. @param aFunc callback to use for converting
  634. @param aArgs SetFormat user defined parameters (use at will)
  635. @returns @true on success, @false otherwise }
  636. function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  637. { add alpha channel data from stream (macro for: new glBitmap, LoadFromStream, AddAlphaFromGlBitmap)
  638. @param aStream stream to load alpha channel data from
  639. @param aFunc callback to use for converting
  640. @param aArgs user defined parameters (use at will)
  641. @returns @true on success, @false otherwise }
  642. function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  643. { add alpha channel data from existing glBitmap object
  644. @param aBitmap TglBitmap to copy alpha channel data from
  645. @param aFunc callback to use for converting
  646. @param aArgs user defined parameters (use at will)
  647. @returns @true on success, @false otherwise }
  648. function AddAlphaFromDataObj(const aDataObj: TglBitmapData; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  649. { add alpha to pixel if the pixels color is greter than the given color value
  650. @param aRed red threshold (0-255)
  651. @param aGreen green threshold (0-255)
  652. @param aBlue blue threshold (0-255)
  653. @param aDeviatation accepted deviatation (0-255)
  654. @returns @true on success, @false otherwise }
  655. function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;
  656. { add alpha to pixel if the pixels color is greter than the given color value
  657. @param aRed red threshold (0-Range.r)
  658. @param aGreen green threshold (0-Range.g)
  659. @param aBlue blue threshold (0-Range.b)
  660. @param aDeviatation accepted deviatation (0-max(Range.rgb))
  661. @returns @true on success, @false otherwise }
  662. function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;
  663. { add alpha to pixel if the pixels color is greter than the given color value
  664. @param aRed red threshold (0.0-1.0)
  665. @param aGreen green threshold (0.0-1.0)
  666. @param aBlue blue threshold (0.0-1.0)
  667. @param aDeviatation accepted deviatation (0.0-1.0)
  668. @returns @true on success, @false otherwise }
  669. function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;
  670. { add a constand alpha value to all pixels
  671. @param aAlpha alpha value to add (0-255)
  672. @returns @true on success, @false otherwise }
  673. function AddAlphaFromValue(const aAlpha: Byte): Boolean;
  674. { add a constand alpha value to all pixels
  675. @param aAlpha alpha value to add (0-max(Range.rgb))
  676. @returns @true on success, @false otherwise }
  677. function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  678. { add a constand alpha value to all pixels
  679. @param aAlpha alpha value to add (0.0-1.0)
  680. @returns @true on success, @false otherwise }
  681. function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  682. { remove alpha channel
  683. @returns @true on success, @false otherwise }
  684. function RemoveAlpha: Boolean; virtual;
  685. public { fill }
  686. { fill complete texture with one color
  687. @param aRed red color for border (0-255)
  688. @param aGreen green color for border (0-255)
  689. @param aBlue blue color for border (0-255)
  690. @param aAlpha alpha color for border (0-255) }
  691. procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);
  692. { fill complete texture with one color
  693. @param aRed red color for border (0-Range.r)
  694. @param aGreen green color for border (0-Range.g)
  695. @param aBlue blue color for border (0-Range.b)
  696. @param aAlpha alpha color for border (0-Range.a) }
  697. procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);
  698. { fill complete texture with one color
  699. @param aRed red color for border (0.0-1.0)
  700. @param aGreen green color for border (0.0-1.0)
  701. @param aBlue blue color for border (0.0-1.0)
  702. @param aAlpha alpha color for border (0.0-1.0) }
  703. procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single = 1.0);
  704. public { Misc }
  705. { set data pointer of texture data
  706. @param aData pointer to new texture data
  707. @param aFormat format of the data stored at aData
  708. @param aWidth width of the texture data
  709. @param aHeight height of the texture data }
  710. procedure SetData(const aData: PByte; const aFormat: TglBitmapFormat;
  711. const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;
  712. { create a clone of the current object
  713. @returns clone of this object}
  714. function Clone: TglBitmapData;
  715. { invert color data (bitwise not)
  716. @param aRed invert red channel
  717. @param aGreen invert green channel
  718. @param aBlue invert blue channel
  719. @param aAlpha invert alpha channel }
  720. procedure Invert(const aRed, aGreen, aBlue, aAlpha: Boolean);
  721. { create normal map from texture data
  722. @param aFunc normal map function to generate normalmap with
  723. @param aScale scale of the normale stored in the normal map
  724. @param aUseAlpha generate normalmap from alpha channel data (if present) }
  725. procedure GenerateNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;
  726. const aScale: Single = 2; const aUseAlpha: Boolean = false);
  727. public { constructor }
  728. { constructor - creates a texutre data object }
  729. constructor Create; overload;
  730. { constructor - creates a texture data object and loads it from a file
  731. @param aFilename file to load texture from }
  732. constructor Create(const aFileName: String); overload;
  733. { constructor - creates a texture data object and loads it from a stream
  734. @param aStream stream to load texture from }
  735. constructor Create(const aStream: TStream); overload;
  736. { constructor - creates a texture data object with the given size, format and data
  737. @param aSize size of the texture
  738. @param aFormat format of the given data
  739. @param aData texture data - be carefull: the data will now be managed by the texture data object }
  740. constructor Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; aData: PByte = nil); overload;
  741. { constructor - creates a texture data object with the given size and format and uses the given callback to create the data
  742. @param aSize size of the texture
  743. @param aFormat format of the given data
  744. @param aFunc callback to use for generating the data
  745. @param aArgs user defined parameters (use at will) }
  746. constructor Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
  747. { constructor - creates a texture data object and loads it from a resource
  748. @param aInstance resource handle
  749. @param aResource resource indentifier
  750. @param aResType resource type (if known) }
  751. constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
  752. { constructor - creates a texture data object and loads it from a resource
  753. @param aInstance resource handle
  754. @param aResourceID resource ID
  755. @param aResType resource type (if known) }
  756. constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
  757. { destructor }
  758. destructor Destroy; override;
  759. end;
  760. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  761. { base class for all glBitmap classes. used to manage OpenGL texture objects
  762. all operations on a bitmap object must be done from the render thread }
  763. TglBitmap = class
  764. protected
  765. fID: GLuint; //< name of the OpenGL texture object
  766. fTarget: GLuint; //< texture target (e.g. GL_TEXTURE_2D)
  767. fDeleteTextureOnFree: Boolean; //< delete OpenGL texture object when this object is destroyed
  768. // texture properties
  769. fFilterMin: GLenum; //< min filter to apply to the texture
  770. fFilterMag: GLenum; //< mag filter to apply to the texture
  771. fWrapS: GLenum; //< texture wrapping for x axis
  772. fWrapT: GLenum; //< texture wrapping for y axis
  773. fWrapR: GLenum; //< texture wrapping for z axis
  774. fAnisotropic: Integer; //< anisotropic level
  775. fBorderColor: array[0..3] of Single; //< color of the texture border
  776. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  777. //Swizzle
  778. fSwizzle: array[0..3] of GLenum; //< color channel swizzle
  779. {$IFEND}
  780. {$IFNDEF OPENGL_ES}
  781. fIsResident: GLboolean; //< @true if OpenGL texture object has data, @false otherwise
  782. {$ENDIF}
  783. fDimension: TglBitmapSize; //< size of this texture
  784. fMipMap: TglBitmapMipMap; //< mipmap type
  785. // CustomData
  786. fCustomData: Pointer; //< user defined data
  787. fCustomName: String; //< user defined name
  788. fCustomNameW: WideString; //< user defined name
  789. protected
  790. { @returns the actual width of the texture }
  791. function GetWidth: Integer; virtual;
  792. { @returns the actual height of the texture }
  793. function GetHeight: Integer; virtual;
  794. protected
  795. { set a new value for fCustomData }
  796. procedure SetCustomData(const aValue: Pointer);
  797. { set a new value for fCustomName }
  798. procedure SetCustomName(const aValue: String);
  799. { set a new value for fCustomNameW }
  800. procedure SetCustomNameW(const aValue: WideString);
  801. { set new value for fDeleteTextureOnFree }
  802. procedure SetDeleteTextureOnFree(const aValue: Boolean);
  803. { set name of OpenGL texture object }
  804. procedure SetID(const aValue: Cardinal);
  805. { set new value for fMipMap }
  806. procedure SetMipMap(const aValue: TglBitmapMipMap);
  807. { set new value for target }
  808. procedure SetTarget(const aValue: Cardinal);
  809. { set new value for fAnisotrophic }
  810. procedure SetAnisotropic(const aValue: Integer);
  811. protected
  812. { initialize variables }
  813. procedure Init; virtual;
  814. { finalize variables }
  815. procedure Finish; virtual;
  816. { create OpenGL texture object (delete exisiting object if exists) }
  817. procedure CreateID;
  818. { setup texture parameters }
  819. procedure SetupParameters({$IFNDEF OPENGL_ES}out aBuildWithGlu: Boolean{$ENDIF});
  820. protected
  821. property Width: Integer read GetWidth; //< the actual width of the texture
  822. property Height: Integer read GetHeight; //< the actual height of the texture
  823. public
  824. property ID: Cardinal read fID write SetID; //< name of the OpenGL texture object
  825. property Target: Cardinal read fTarget write SetTarget; //< texture target (e.g. GL_TEXTURE_2D)
  826. property DeleteTextureOnFree: Boolean read fDeleteTextureOnFree write SetDeleteTextureOnFree; //< delete texture object when this object is destroyed
  827. property MipMap: TglBitmapMipMap read fMipMap write SetMipMap; //< mipmap type
  828. property Anisotropic: Integer read fAnisotropic write SetAnisotropic; //< anisotropic level
  829. property CustomData: Pointer read fCustomData write SetCustomData; //< user defined data (use at will)
  830. property CustomName: String read fCustomName write SetCustomName; //< user defined name (use at will)
  831. property CustomNameW: WideString read fCustomNameW write SetCustomNameW; //< user defined name (as WideString; use at will)
  832. property Dimension: TglBitmapSize read fDimension; //< size of the texture
  833. {$IFNDEF OPENGL_ES}
  834. property IsResident: GLboolean read fIsResident; //< @true if OpenGL texture object has data, @false otherwise
  835. {$ENDIF}
  836. public
  837. {$IFNDEF OPENGL_ES}
  838. { set the new value for texture border color
  839. @param aRed red color for border (0.0-1.0)
  840. @param aGreen green color for border (0.0-1.0)
  841. @param aBlue blue color for border (0.0-1.0)
  842. @param aAlpha alpha color for border (0.0-1.0) }
  843. procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  844. {$ENDIF}
  845. public
  846. { set new texture filer
  847. @param aMin min filter
  848. @param aMag mag filter }
  849. procedure SetFilter(const aMin, aMag: GLenum);
  850. { set new texture wrapping
  851. @param S texture wrapping for x axis
  852. @param T texture wrapping for y axis
  853. @param R texture wrapping for z axis }
  854. procedure SetWrap(
  855. const S: GLenum = GL_CLAMP_TO_EDGE;
  856. const T: GLenum = GL_CLAMP_TO_EDGE;
  857. const R: GLenum = GL_CLAMP_TO_EDGE);
  858. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  859. { set new swizzle
  860. @param r swizzle for red channel
  861. @param g swizzle for green channel
  862. @param b swizzle for blue channel
  863. @param a swizzle for alpha channel }
  864. procedure SetSwizzle(const r, g, b, a: GLenum);
  865. {$IFEND}
  866. public
  867. { bind texture
  868. @param aEnableTextureUnit enable texture unit for this texture (e.g. glEnable(GL_TEXTURE_2D)) }
  869. procedure Bind({$IFNDEF OPENGL_ES}const aEnableTextureUnit: Boolean = true{$ENDIF}); virtual;
  870. { bind texture
  871. @param aDisableTextureUnit disable texture unit for this texture (e.g. glEnable(GL_TEXTURE_2D)) }
  872. procedure Unbind({$IFNDEF OPENGL_ES}const aDisableTextureUnit: Boolean = true{$ENDIF}); virtual;
  873. { upload texture data from given data object to video card
  874. @param aData texture data object that contains the actual data
  875. @param aCheckSize check size before upload and throw exception if something is wrong }
  876. procedure UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean = true); virtual;
  877. {$IFNDEF OPENGL_ES}
  878. { download texture data from video card and store it into given data object
  879. @returns @true when download was successfull, @false otherwise }
  880. function DownloadData(const aDataObj: TglBitmapData): Boolean; virtual;
  881. {$ENDIF}
  882. public
  883. { constructor - creates an empty texture }
  884. constructor Create; overload;
  885. { constructor - creates an texture object and uploads the given data }
  886. constructor Create(const aData: TglBitmapData); overload;
  887. { destructor }
  888. destructor Destroy; override;
  889. end;
  890. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  891. {$IF NOT DEFINED(OPENGL_ES)}
  892. { wrapper class for 1-dimensional textures (OpenGL target = GL_TEXTURE_1D
  893. all operations on a bitmap object must be done from the render thread }
  894. TglBitmap1D = class(TglBitmap)
  895. protected
  896. { this method is called after constructor and initializes the object }
  897. procedure Init; override;
  898. { upload the texture data to video card
  899. @param aDataObj texture data object that contains the actual data
  900. @param aBuildWithGlu use glu functions to build mipmaps }
  901. procedure UploadDataIntern(const aDataObj: TglBitmapData; const aBuildWithGlu: Boolean);
  902. public
  903. property Width; //< actual with of the texture
  904. { upload texture data from given data object to video card
  905. @param aData texture data object that contains the actual data
  906. @param aCheckSize check size before upload and throw exception if something is wrong }
  907. procedure UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean = true); override;
  908. end;
  909. {$IFEND}
  910. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  911. { wrapper class for 2-dimensional textures (OpenGL target = GL_TEXTURE_2D)
  912. all operations on a bitmap object must be done from the render thread }
  913. TglBitmap2D = class(TglBitmap)
  914. protected
  915. { this method is called after constructor and initializes the object }
  916. procedure Init; override;
  917. { upload the texture data to video card
  918. @param aDataObj texture data object that contains the actual data
  919. @param aTarget target o upload data to (e.g. GL_TEXTURE_2D)
  920. @param aBuildWithGlu use glu functions to build mipmaps }
  921. procedure UploadDataIntern(const aDataObj: TglBitmapData; const aTarget: GLenum
  922. {$IFNDEF OPENGL_ES}; const aBuildWithGlu: Boolean{$ENDIF});
  923. public
  924. property Width; //< actual width of the texture
  925. property Height; //< actual height of the texture
  926. { upload texture data from given data object to video card
  927. @param aData texture data object that contains the actual data
  928. @param aCheckSize check size before upload and throw exception if something is wrong }
  929. procedure UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean = true); override;
  930. public
  931. { copy a part of the frame buffer to the texture
  932. @param aTop topmost pixel to copy
  933. @param aLeft leftmost pixel to copy
  934. @param aRight rightmost pixel to copy
  935. @param aBottom bottommost pixel to copy
  936. @param aFormat format to store data in
  937. @param aDataObj texture data object to store the data in }
  938. class procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat; const aDataObj: TglBitmapData);
  939. end;
  940. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  941. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  942. { wrapper class for cube maps (OpenGL target = GL_TEXTURE_CUBE_MAP)
  943. all operations on a bitmap object must be done from the render thread }
  944. TglBitmapCubeMap = class(TglBitmap2D)
  945. protected
  946. {$IFNDEF OPENGL_ES}
  947. fGenMode: Integer; //< generation mode for the cube map (e.g. GL_REFLECTION_MAP)
  948. {$ENDIF}
  949. { this method is called after constructor and initializes the object }
  950. procedure Init; override;
  951. public
  952. { upload texture data from given data object to video card
  953. @param aData texture data object that contains the actual data
  954. @param aCheckSize check size before upload and throw exception if something is wrong }
  955. procedure UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean = true); override;
  956. { upload texture data from given data object to video card
  957. @param aData texture data object that contains the actual data
  958. @param aCubeTarget cube map target to upload data to (e.g. GL_TEXTURE_CUBE_MAP_POSITIVE_X)
  959. @param aCheckSize check size before upload and throw exception if something is wrong }
  960. procedure UploadCubeMap(const aDataObj: TglBitmapData; const aCubeTarget: Cardinal; const aCheckSize: Boolean);
  961. { bind texture
  962. @param aEnableTexCoordsGen enable cube map generator
  963. @param aEnableTextureUnit enable texture unit }
  964. procedure Bind({$IFNDEF OPENGL_ES}const aEnableTexCoordsGen: Boolean = true; const aEnableTextureUnit: Boolean = true{$ENDIF}); reintroduce; virtual;
  965. { unbind texture
  966. @param aDisableTexCoordsGen disable cube map generator
  967. @param aDisableTextureUnit disable texture unit }
  968. procedure Unbind({$IFNDEF OPENGL_ES}const aDisableTexCoordsGen: Boolean = true; const aDisableTextureUnit: Boolean = true{$ENDIF}); reintroduce; virtual;
  969. end;
  970. {$IFEND}
  971. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  972. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  973. { wrapper class for cube normal maps
  974. all operations on a bitmap object must be done from the render thread }
  975. TglBitmapNormalMap = class(TglBitmapCubeMap)
  976. public
  977. { this method is called after constructor and initializes the object }
  978. procedure Init; override;
  979. { create cube normal map from texture data and upload it to video card
  980. @param aSize size of each cube map texture
  981. @param aCheckSize check size before upload and throw exception if something is wrong }
  982. procedure GenerateNormalMap(const aSize: Integer = 32; const aCheckSize: Boolean = true);
  983. end;
  984. {$IFEND}
  985. TglcBitmapFormat = TglBitmapFormat;
  986. TglcBitmap2D = TglBitmap2D;
  987. TglcBitmapData = TglBitmapData;
  988. {$IF NOT DEFINED(OPENGL_ES)}
  989. TglcBitmap1D = TglBitmap1D;
  990. TglcBitmapCubeMap = TglBitmapCubeMap;
  991. TglcBitmapNormalMap = TglBitmapNormalMap;
  992. {$ELSEIF DEFINED(OPENGL_ES_2_0)}
  993. TglcBitmapCubeMap = TglBitmapCubeMap;
  994. TglcBitmapNormalMap = TglBitmapNormalMap;
  995. {$IFEND}
  996. const
  997. NULL_SIZE: TglBitmapSize = (Fields: []; X: 0; Y: 0);
  998. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  999. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1000. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1001. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1002. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1003. procedure glBitmapSetDefaultWrap(
  1004. const S: Cardinal = GL_CLAMP_TO_EDGE;
  1005. const T: Cardinal = GL_CLAMP_TO_EDGE;
  1006. const R: Cardinal = GL_CLAMP_TO_EDGE);
  1007. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  1008. procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
  1009. {$IFEND}
  1010. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1011. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1012. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1013. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1014. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  1015. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  1016. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  1017. procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
  1018. {$IFEND}
  1019. function glBitmapSize(X: Integer = -1; Y: Integer = -1): TglBitmapSize;
  1020. function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;
  1021. function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
  1022. function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
  1023. function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
  1024. function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
  1025. function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
  1026. function glBitmapCreateTestData(const aFormat: TglBitmapFormat): TglBitmapData;
  1027. {$IFDEF GLB_DELPHI}
  1028. function CreateGrayPalette: HPALETTE;
  1029. {$ENDIF}
  1030. implementation
  1031. uses
  1032. Math, syncobjs, typinfo
  1033. {$IF DEFINED(GLB_SUPPORT_JPEG_READ) AND DEFINED(GLB_LAZ_JPEG)}, FPReadJPEG{$IFEND};
  1034. var
  1035. glBitmapDefaultDeleteTextureOnFree: Boolean;
  1036. glBitmapDefaultFreeDataAfterGenTextures: Boolean;
  1037. glBitmapDefaultFormat: TglBitmapFormat;
  1038. glBitmapDefaultMipmap: TglBitmapMipMap;
  1039. glBitmapDefaultFilterMin: Cardinal;
  1040. glBitmapDefaultFilterMag: Cardinal;
  1041. glBitmapDefaultWrapS: Cardinal;
  1042. glBitmapDefaultWrapT: Cardinal;
  1043. glBitmapDefaultWrapR: Cardinal;
  1044. glDefaultSwizzle: array[0..3] of GLenum;
  1045. ////////////////////////////////////////////////////////////////////////////////////////////////////
  1046. type
  1047. TFormatDescriptor = class(TglBitmapFormatDescriptor)
  1048. public
  1049. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;
  1050. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;
  1051. function CreateMappingData: Pointer; virtual;
  1052. procedure FreeMappingData(var aMappingData: Pointer); virtual;
  1053. function IsEmpty: Boolean; virtual;
  1054. function MaskMatch(const aMask: TglBitmapRec4ul): Boolean; virtual;
  1055. procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;
  1056. constructor Create; virtual;
  1057. public
  1058. class procedure Init;
  1059. class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1060. class function GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  1061. class function GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer = 0): TFormatDescriptor;
  1062. class function GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
  1063. class procedure Clear;
  1064. class procedure Finalize;
  1065. end;
  1066. TFormatDescriptorClass = class of TFormatDescriptor;
  1067. TfdEmpty = class(TFormatDescriptor);
  1068. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1069. TfdAlphaUB1 = class(TFormatDescriptor) //1* unsigned byte
  1070. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1071. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1072. end;
  1073. TfdLuminanceUB1 = class(TFormatDescriptor) //1* unsigned byte
  1074. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1075. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1076. end;
  1077. TfdUniversalUB1 = class(TFormatDescriptor) //1* unsigned byte
  1078. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1079. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1080. end;
  1081. TfdLuminanceAlphaUB2 = class(TfdLuminanceUB1) //2* unsigned byte
  1082. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1083. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1084. end;
  1085. TfdRGBub3 = class(TFormatDescriptor) //3* unsigned byte
  1086. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1087. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1088. end;
  1089. TfdBGRub3 = class(TFormatDescriptor) //3* unsigned byte (inverse)
  1090. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1091. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1092. end;
  1093. TfdRGBAub4 = class(TfdRGBub3) //3* unsigned byte
  1094. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1095. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1096. end;
  1097. TfdBGRAub4 = class(TfdBGRub3) //3* unsigned byte (inverse)
  1098. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1099. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1100. end;
  1101. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1102. TfdAlphaUS1 = class(TFormatDescriptor) //1* unsigned short
  1103. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1104. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1105. end;
  1106. TfdLuminanceUS1 = class(TFormatDescriptor) //1* unsigned short
  1107. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1108. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1109. end;
  1110. TfdUniversalUS1 = class(TFormatDescriptor) //1* unsigned short
  1111. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1112. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1113. end;
  1114. TfdDepthUS1 = class(TFormatDescriptor) //1* unsigned short
  1115. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1116. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1117. end;
  1118. TfdLuminanceAlphaUS2 = class(TfdLuminanceUS1) //2* unsigned short
  1119. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1120. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1121. end;
  1122. TfdRGBus3 = class(TFormatDescriptor) //3* unsigned short
  1123. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1124. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1125. end;
  1126. TfdBGRus3 = class(TFormatDescriptor) //3* unsigned short (inverse)
  1127. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1128. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1129. end;
  1130. TfdRGBAus4 = class(TfdRGBus3) //4* unsigned short
  1131. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1132. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1133. end;
  1134. TfdARGBus4 = class(TfdRGBus3) //4* unsigned short
  1135. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1136. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1137. end;
  1138. TfdBGRAus4 = class(TfdBGRus3) //4* unsigned short (inverse)
  1139. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1140. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1141. end;
  1142. TfdABGRus4 = class(TfdBGRus3) //4* unsigned short (inverse)
  1143. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1144. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1145. end;
  1146. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1147. TfdUniversalUI1 = class(TFormatDescriptor) //1* unsigned int
  1148. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1149. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1150. end;
  1151. TfdDepthUI1 = class(TFormatDescriptor) //1* unsigned int
  1152. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1153. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1154. end;
  1155. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1156. TfdAlpha4ub1 = class(TfdAlphaUB1)
  1157. procedure SetValues; override;
  1158. end;
  1159. TfdAlpha8ub1 = class(TfdAlphaUB1)
  1160. procedure SetValues; override;
  1161. end;
  1162. TfdAlpha16us1 = class(TfdAlphaUS1)
  1163. procedure SetValues; override;
  1164. end;
  1165. TfdLuminance4ub1 = class(TfdLuminanceUB1)
  1166. procedure SetValues; override;
  1167. end;
  1168. TfdLuminance8ub1 = class(TfdLuminanceUB1)
  1169. procedure SetValues; override;
  1170. end;
  1171. TfdLuminance16us1 = class(TfdLuminanceUS1)
  1172. procedure SetValues; override;
  1173. end;
  1174. TfdLuminance4Alpha4ub2 = class(TfdLuminanceAlphaUB2)
  1175. procedure SetValues; override;
  1176. end;
  1177. TfdLuminance6Alpha2ub2 = class(TfdLuminanceAlphaUB2)
  1178. procedure SetValues; override;
  1179. end;
  1180. TfdLuminance8Alpha8ub2 = class(TfdLuminanceAlphaUB2)
  1181. procedure SetValues; override;
  1182. end;
  1183. TfdLuminance12Alpha4us2 = class(TfdLuminanceAlphaUS2)
  1184. procedure SetValues; override;
  1185. end;
  1186. TfdLuminance16Alpha16us2 = class(TfdLuminanceAlphaUS2)
  1187. procedure SetValues; override;
  1188. end;
  1189. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1190. TfdR3G3B2ub1 = class(TfdUniversalUB1)
  1191. procedure SetValues; override;
  1192. end;
  1193. TfdRGBX4us1 = class(TfdUniversalUS1)
  1194. procedure SetValues; override;
  1195. end;
  1196. TfdXRGB4us1 = class(TfdUniversalUS1)
  1197. procedure SetValues; override;
  1198. end;
  1199. TfdR5G6B5us1 = class(TfdUniversalUS1)
  1200. procedure SetValues; override;
  1201. end;
  1202. TfdRGB5X1us1 = class(TfdUniversalUS1)
  1203. procedure SetValues; override;
  1204. end;
  1205. TfdX1RGB5us1 = class(TfdUniversalUS1)
  1206. procedure SetValues; override;
  1207. end;
  1208. TfdRGB8ub3 = class(TfdRGBub3)
  1209. procedure SetValues; override;
  1210. end;
  1211. TfdRGBX8ui1 = class(TfdUniversalUI1)
  1212. procedure SetValues; override;
  1213. end;
  1214. TfdXRGB8ui1 = class(TfdUniversalUI1)
  1215. procedure SetValues; override;
  1216. end;
  1217. TfdRGB10X2ui1 = class(TfdUniversalUI1)
  1218. procedure SetValues; override;
  1219. end;
  1220. TfdX2RGB10ui1 = class(TfdUniversalUI1)
  1221. procedure SetValues; override;
  1222. end;
  1223. TfdRGB16us3 = class(TfdRGBus3)
  1224. procedure SetValues; override;
  1225. end;
  1226. TfdRGBA4us1 = class(TfdUniversalUS1)
  1227. procedure SetValues; override;
  1228. end;
  1229. TfdARGB4us1 = class(TfdUniversalUS1)
  1230. procedure SetValues; override;
  1231. end;
  1232. TfdRGB5A1us1 = class(TfdUniversalUS1)
  1233. procedure SetValues; override;
  1234. end;
  1235. TfdA1RGB5us1 = class(TfdUniversalUS1)
  1236. procedure SetValues; override;
  1237. end;
  1238. TfdRGBA8ui1 = class(TfdUniversalUI1)
  1239. procedure SetValues; override;
  1240. end;
  1241. TfdARGB8ui1 = class(TfdUniversalUI1)
  1242. procedure SetValues; override;
  1243. end;
  1244. TfdRGBA8ub4 = class(TfdRGBAub4)
  1245. procedure SetValues; override;
  1246. end;
  1247. TfdRGB10A2ui1 = class(TfdUniversalUI1)
  1248. procedure SetValues; override;
  1249. end;
  1250. TfdA2RGB10ui1 = class(TfdUniversalUI1)
  1251. procedure SetValues; override;
  1252. end;
  1253. TfdRGBA16us4 = class(TfdRGBAus4)
  1254. procedure SetValues; override;
  1255. end;
  1256. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1257. TfdBGRX4us1 = class(TfdUniversalUS1)
  1258. procedure SetValues; override;
  1259. end;
  1260. TfdXBGR4us1 = class(TfdUniversalUS1)
  1261. procedure SetValues; override;
  1262. end;
  1263. TfdB5G6R5us1 = class(TfdUniversalUS1)
  1264. procedure SetValues; override;
  1265. end;
  1266. TfdBGR5X1us1 = class(TfdUniversalUS1)
  1267. procedure SetValues; override;
  1268. end;
  1269. TfdX1BGR5us1 = class(TfdUniversalUS1)
  1270. procedure SetValues; override;
  1271. end;
  1272. TfdBGR8ub3 = class(TfdBGRub3)
  1273. procedure SetValues; override;
  1274. end;
  1275. TfdBGRX8ui1 = class(TfdUniversalUI1)
  1276. procedure SetValues; override;
  1277. end;
  1278. TfdXBGR8ui1 = class(TfdUniversalUI1)
  1279. procedure SetValues; override;
  1280. end;
  1281. TfdBGR10X2ui1 = class(TfdUniversalUI1)
  1282. procedure SetValues; override;
  1283. end;
  1284. TfdX2BGR10ui1 = class(TfdUniversalUI1)
  1285. procedure SetValues; override;
  1286. end;
  1287. TfdBGR16us3 = class(TfdBGRus3)
  1288. procedure SetValues; override;
  1289. end;
  1290. TfdBGRA4us1 = class(TfdUniversalUS1)
  1291. procedure SetValues; override;
  1292. end;
  1293. TfdABGR4us1 = class(TfdUniversalUS1)
  1294. procedure SetValues; override;
  1295. end;
  1296. TfdBGR5A1us1 = class(TfdUniversalUS1)
  1297. procedure SetValues; override;
  1298. end;
  1299. TfdA1BGR5us1 = class(TfdUniversalUS1)
  1300. procedure SetValues; override;
  1301. end;
  1302. TfdBGRA8ui1 = class(TfdUniversalUI1)
  1303. procedure SetValues; override;
  1304. end;
  1305. TfdABGR8ui1 = class(TfdUniversalUI1)
  1306. procedure SetValues; override;
  1307. end;
  1308. TfdBGRA8ub4 = class(TfdBGRAub4)
  1309. procedure SetValues; override;
  1310. end;
  1311. TfdBGR10A2ui1 = class(TfdUniversalUI1)
  1312. procedure SetValues; override;
  1313. end;
  1314. TfdA2BGR10ui1 = class(TfdUniversalUI1)
  1315. procedure SetValues; override;
  1316. end;
  1317. TfdBGRA16us4 = class(TfdBGRAus4)
  1318. procedure SetValues; override;
  1319. end;
  1320. TfdDepth16us1 = class(TfdDepthUS1)
  1321. procedure SetValues; override;
  1322. end;
  1323. TfdDepth24ui1 = class(TfdDepthUI1)
  1324. procedure SetValues; override;
  1325. end;
  1326. TfdDepth32ui1 = class(TfdDepthUI1)
  1327. procedure SetValues; override;
  1328. end;
  1329. TfdS3tcDtx1RGBA = class(TFormatDescriptor)
  1330. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1331. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1332. procedure SetValues; override;
  1333. end;
  1334. TfdS3tcDtx3RGBA = class(TFormatDescriptor)
  1335. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1336. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1337. procedure SetValues; override;
  1338. end;
  1339. TfdS3tcDtx5RGBA = class(TFormatDescriptor)
  1340. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1341. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1342. procedure SetValues; override;
  1343. end;
  1344. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1345. TbmpBitfieldFormat = class(TFormatDescriptor)
  1346. public
  1347. procedure SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul); overload;
  1348. procedure SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
  1349. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1350. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1351. end;
  1352. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1353. TbmpColorTableEnty = packed record
  1354. b, g, r, a: Byte;
  1355. end;
  1356. TbmpColorTable = array of TbmpColorTableEnty;
  1357. TbmpColorTableFormat = class(TFormatDescriptor)
  1358. private
  1359. fColorTable: TbmpColorTable;
  1360. protected
  1361. procedure SetValues; override;
  1362. public
  1363. property ColorTable: TbmpColorTable read fColorTable write fColorTable;
  1364. procedure SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;
  1365. procedure CalcValues;
  1366. procedure CreateColorTable;
  1367. function CreateMappingData: Pointer; override;
  1368. procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
  1369. procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
  1370. destructor Destroy; override;
  1371. end;
  1372. const
  1373. LUMINANCE_WEIGHT_R = 0.30;
  1374. LUMINANCE_WEIGHT_G = 0.59;
  1375. LUMINANCE_WEIGHT_B = 0.11;
  1376. ALPHA_WEIGHT_R = 0.30;
  1377. ALPHA_WEIGHT_G = 0.59;
  1378. ALPHA_WEIGHT_B = 0.11;
  1379. DEPTH_WEIGHT_R = 0.333333333;
  1380. DEPTH_WEIGHT_G = 0.333333333;
  1381. DEPTH_WEIGHT_B = 0.333333333;
  1382. FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (
  1383. TfdEmpty,
  1384. TfdAlpha4ub1,
  1385. TfdAlpha8ub1,
  1386. TfdAlpha16us1,
  1387. TfdLuminance4ub1,
  1388. TfdLuminance8ub1,
  1389. TfdLuminance16us1,
  1390. TfdLuminance4Alpha4ub2,
  1391. TfdLuminance6Alpha2ub2,
  1392. TfdLuminance8Alpha8ub2,
  1393. TfdLuminance12Alpha4us2,
  1394. TfdLuminance16Alpha16us2,
  1395. TfdR3G3B2ub1,
  1396. TfdRGBX4us1,
  1397. TfdXRGB4us1,
  1398. TfdR5G6B5us1,
  1399. TfdRGB5X1us1,
  1400. TfdX1RGB5us1,
  1401. TfdRGB8ub3,
  1402. TfdRGBX8ui1,
  1403. TfdXRGB8ui1,
  1404. TfdRGB10X2ui1,
  1405. TfdX2RGB10ui1,
  1406. TfdRGB16us3,
  1407. TfdRGBA4us1,
  1408. TfdARGB4us1,
  1409. TfdRGB5A1us1,
  1410. TfdA1RGB5us1,
  1411. TfdRGBA8ub4,
  1412. TfdRGBA8ui1,
  1413. TfdARGB8ui1,
  1414. TfdRGB10A2ui1,
  1415. TfdA2RGB10ui1,
  1416. TfdRGBA16us4,
  1417. TfdBGRX4us1,
  1418. TfdXBGR4us1,
  1419. TfdB5G6R5us1,
  1420. TfdBGR5X1us1,
  1421. TfdX1BGR5us1,
  1422. TfdBGR8ub3,
  1423. TfdBGRX8ui1,
  1424. TfdXBGR8ui1,
  1425. TfdBGR10X2ui1,
  1426. TfdX2BGR10ui1,
  1427. TfdBGR16us3,
  1428. TfdBGRA4us1,
  1429. TfdABGR4us1,
  1430. TfdBGR5A1us1,
  1431. TfdA1BGR5us1,
  1432. TfdBGRA8ub4,
  1433. TfdBGRA8ui1,
  1434. TfdABGR8ui1,
  1435. TfdBGR10A2ui1,
  1436. TfdA2BGR10ui1,
  1437. TfdBGRA16us4,
  1438. TfdDepth16us1,
  1439. TfdDepth24ui1,
  1440. TfdDepth32ui1,
  1441. TfdS3tcDtx1RGBA,
  1442. TfdS3tcDtx3RGBA,
  1443. TfdS3tcDtx5RGBA
  1444. );
  1445. var
  1446. FormatDescriptorCS: TCriticalSection;
  1447. FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;
  1448. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1449. constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);
  1450. begin
  1451. inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1452. end;
  1453. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1454. constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
  1455. begin
  1456. inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
  1457. end;
  1458. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1459. function glBitmapSize(X: Integer; Y: Integer): TglBitmapSize;
  1460. begin
  1461. result.Fields := [];
  1462. if (X >= 0) then
  1463. result.Fields := result.Fields + [ffX];
  1464. if (Y >= 0) then
  1465. result.Fields := result.Fields + [ffY];
  1466. result.X := Max(0, X);
  1467. result.Y := Max(0, Y);
  1468. end;
  1469. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1470. function glBitmapPosition(X: Integer; Y: Integer): TglBitmapPixelPosition;
  1471. begin
  1472. result := glBitmapSize(X, Y);
  1473. end;
  1474. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1475. function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;
  1476. begin
  1477. result.r := r;
  1478. result.g := g;
  1479. result.b := b;
  1480. result.a := a;
  1481. end;
  1482. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1483. function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;
  1484. begin
  1485. result.r := r;
  1486. result.g := g;
  1487. result.b := b;
  1488. result.a := a;
  1489. end;
  1490. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1491. function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;
  1492. begin
  1493. result.r := r;
  1494. result.g := g;
  1495. result.b := b;
  1496. result.a := a;
  1497. end;
  1498. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1499. function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;
  1500. var
  1501. i: Integer;
  1502. begin
  1503. result := false;
  1504. for i := 0 to high(r1.arr) do
  1505. if (r1.arr[i] <> r2.arr[i]) then
  1506. exit;
  1507. result := true;
  1508. end;
  1509. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1510. function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;
  1511. var
  1512. i: Integer;
  1513. begin
  1514. result := false;
  1515. for i := 0 to high(r1.arr) do
  1516. if (r1.arr[i] <> r2.arr[i]) then
  1517. exit;
  1518. result := true;
  1519. end;
  1520. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1521. function glBitmapCreateTestData(const aFormat: TglBitmapFormat): TglBitmapData;
  1522. var
  1523. desc: TFormatDescriptor;
  1524. p, tmp: PByte;
  1525. x, y, i: Integer;
  1526. md: Pointer;
  1527. px: TglBitmapPixelData;
  1528. begin
  1529. result := nil;
  1530. desc := TFormatDescriptor.Get(aFormat);
  1531. if (desc.IsCompressed) or (desc.glFormat = 0) then
  1532. exit;
  1533. p := GetMemory(ceil(25 * desc.BytesPerPixel)); // 5 x 5 pixel
  1534. md := desc.CreateMappingData;
  1535. try
  1536. tmp := p;
  1537. desc.PreparePixel(px);
  1538. for y := 0 to 4 do
  1539. for x := 0 to 4 do begin
  1540. px.Data := glBitmapRec4ui(0, 0, 0, 0);
  1541. for i := 0 to 3 do begin
  1542. if ((y < 3) and (y = i)) or
  1543. ((y = 3) and (i < 3)) or
  1544. ((y = 4) and (i = 3))
  1545. then
  1546. px.Data.arr[i] := Trunc(px.Range.arr[i] / 4 * x)
  1547. else if ((y < 4) and (i = 3)) or
  1548. ((y = 4) and (i < 3))
  1549. then
  1550. px.Data.arr[i] := px.Range.arr[i]
  1551. else
  1552. px.Data.arr[i] := 0; //px.Range.arr[i];
  1553. end;
  1554. desc.Map(px, tmp, md);
  1555. end;
  1556. finally
  1557. desc.FreeMappingData(md);
  1558. end;
  1559. result := TglBitmapData.Create(glBitmapPosition(5, 5), aFormat, p);
  1560. end;
  1561. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1562. function glBitmapShiftRec(const r, g, b, a: Byte): TglBitmapRec4ub;
  1563. begin
  1564. result.r := r;
  1565. result.g := g;
  1566. result.b := b;
  1567. result.a := a;
  1568. end;
  1569. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1570. function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
  1571. begin
  1572. result := [];
  1573. if (aFormat in [
  1574. //8bpp
  1575. tfAlpha4ub1, tfAlpha8ub1,
  1576. tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1,
  1577. //16bpp
  1578. tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
  1579. tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
  1580. tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1,
  1581. //24bpp
  1582. tfBGR8ub3, tfRGB8ub3,
  1583. //32bpp
  1584. tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
  1585. tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1])
  1586. then
  1587. result := result + [ ftBMP ];
  1588. if (aFormat in [
  1589. //8bbp
  1590. tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1,
  1591. //16bbp
  1592. tfAlpha16us1, tfLuminance16us1,
  1593. tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
  1594. tfX1RGB5us1, tfARGB4us1, tfA1RGB5us1, tfDepth16us1,
  1595. //24bbp
  1596. tfBGR8ub3,
  1597. //32bbp
  1598. tfX2RGB10ui1, tfARGB8ui1, tfBGRA8ub4, tfA2RGB10ui1,
  1599. tfDepth24ui1, tfDepth32ui1])
  1600. then
  1601. result := result + [ftTGA];
  1602. if not (aFormat in [tfEmpty, tfRGB16us3, tfBGR16us3]) then
  1603. result := result + [ftDDS];
  1604. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  1605. if aFormat in [
  1606. tfAlpha8ub1, tfLuminance8ub1, tfLuminance8Alpha8ub2,
  1607. tfRGB8ub3, tfRGBA8ui1,
  1608. tfBGR8ub3, tfBGRA8ui1] then
  1609. result := result + [ftPNG];
  1610. {$ENDIF}
  1611. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  1612. if aFormat in [tfAlpha8ub1, tfLuminance8ub1, tfRGB8ub3, tfBGR8ub3] then
  1613. result := result + [ftJPEG];
  1614. {$ENDIF}
  1615. end;
  1616. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1617. function IsPowerOfTwo(aNumber: Integer): Boolean;
  1618. begin
  1619. while (aNumber and 1) = 0 do
  1620. aNumber := aNumber shr 1;
  1621. result := aNumber = 1;
  1622. end;
  1623. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1624. function GetTopMostBit(aBitSet: QWord): Integer;
  1625. begin
  1626. result := 0;
  1627. while aBitSet > 0 do begin
  1628. inc(result);
  1629. aBitSet := aBitSet shr 1;
  1630. end;
  1631. end;
  1632. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1633. function CountSetBits(aBitSet: QWord): Integer;
  1634. begin
  1635. result := 0;
  1636. while aBitSet > 0 do begin
  1637. if (aBitSet and 1) = 1 then
  1638. inc(result);
  1639. aBitSet := aBitSet shr 1;
  1640. end;
  1641. end;
  1642. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1643. function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1644. begin
  1645. result := Trunc(
  1646. LUMINANCE_WEIGHT_R * aPixel.Data.r +
  1647. LUMINANCE_WEIGHT_G * aPixel.Data.g +
  1648. LUMINANCE_WEIGHT_B * aPixel.Data.b);
  1649. end;
  1650. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1651. function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;
  1652. begin
  1653. result := Trunc(
  1654. DEPTH_WEIGHT_R * aPixel.Data.r +
  1655. DEPTH_WEIGHT_G * aPixel.Data.g +
  1656. DEPTH_WEIGHT_B * aPixel.Data.b);
  1657. end;
  1658. {$IFDEF GLB_SDL_IMAGE}
  1659. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1660. // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1661. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1662. function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;
  1663. begin
  1664. result := TStream(context^.unknown.data1).Seek(offset, whence);
  1665. end;
  1666. function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;
  1667. begin
  1668. result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);
  1669. end;
  1670. function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;
  1671. begin
  1672. result := TStream(context^.unknown.data1).Write(Ptr^, size * num);
  1673. end;
  1674. function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;
  1675. begin
  1676. result := 0;
  1677. end;
  1678. function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;
  1679. begin
  1680. result := SDL_AllocRW;
  1681. if result = nil then
  1682. raise EglBitmap.Create('glBitmapCreateRWops - SDL_AllocRW failed.');
  1683. result^.seek := glBitmapRWseek;
  1684. result^.read := glBitmapRWread;
  1685. result^.write := glBitmapRWwrite;
  1686. result^.close := glBitmapRWclose;
  1687. result^.unknown.data1 := Stream;
  1688. end;
  1689. {$ENDIF}
  1690. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1691. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
  1692. begin
  1693. glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;
  1694. end;
  1695. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1696. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);
  1697. begin
  1698. glBitmapDefaultFreeDataAfterGenTextures := aFreeData;
  1699. end;
  1700. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1701. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);
  1702. begin
  1703. glBitmapDefaultMipmap := aValue;
  1704. end;
  1705. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1706. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);
  1707. begin
  1708. glBitmapDefaultFormat := aFormat;
  1709. end;
  1710. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1711. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);
  1712. begin
  1713. glBitmapDefaultFilterMin := aMin;
  1714. glBitmapDefaultFilterMag := aMag;
  1715. end;
  1716. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1717. procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);
  1718. begin
  1719. glBitmapDefaultWrapS := S;
  1720. glBitmapDefaultWrapT := T;
  1721. glBitmapDefaultWrapR := R;
  1722. end;
  1723. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1724. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  1725. procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);
  1726. begin
  1727. glDefaultSwizzle[0] := r;
  1728. glDefaultSwizzle[1] := g;
  1729. glDefaultSwizzle[2] := b;
  1730. glDefaultSwizzle[3] := a;
  1731. end;
  1732. {$IFEND}
  1733. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1734. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;
  1735. begin
  1736. result := glBitmapDefaultDeleteTextureOnFree;
  1737. end;
  1738. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1739. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;
  1740. begin
  1741. result := glBitmapDefaultFreeDataAfterGenTextures;
  1742. end;
  1743. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1744. function glBitmapGetDefaultMipmap: TglBitmapMipMap;
  1745. begin
  1746. result := glBitmapDefaultMipmap;
  1747. end;
  1748. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1749. function glBitmapGetDefaultFormat: TglBitmapFormat;
  1750. begin
  1751. result := glBitmapDefaultFormat;
  1752. end;
  1753. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1754. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);
  1755. begin
  1756. aMin := glBitmapDefaultFilterMin;
  1757. aMag := glBitmapDefaultFilterMag;
  1758. end;
  1759. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1760. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);
  1761. begin
  1762. S := glBitmapDefaultWrapS;
  1763. T := glBitmapDefaultWrapT;
  1764. R := glBitmapDefaultWrapR;
  1765. end;
  1766. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  1767. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1768. procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);
  1769. begin
  1770. r := glDefaultSwizzle[0];
  1771. g := glDefaultSwizzle[1];
  1772. b := glDefaultSwizzle[2];
  1773. a := glDefaultSwizzle[3];
  1774. end;
  1775. {$IFEND}
  1776. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1777. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1778. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1779. function TFormatDescriptor.CreateMappingData: Pointer;
  1780. begin
  1781. result := nil;
  1782. end;
  1783. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1784. procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);
  1785. begin
  1786. //DUMMY
  1787. end;
  1788. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1789. function TFormatDescriptor.IsEmpty: Boolean;
  1790. begin
  1791. result := (fFormat = tfEmpty);
  1792. end;
  1793. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1794. function TFormatDescriptor.MaskMatch(const aMask: TglBitmapRec4ul): Boolean;
  1795. var
  1796. i: Integer;
  1797. m: TglBitmapRec4ul;
  1798. begin
  1799. result := false;
  1800. if (aMask.r = 0) and (aMask.g = 0) and (aMask.b = 0) and (aMask.a = 0) then
  1801. raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');
  1802. m := Mask;
  1803. for i := 0 to 3 do
  1804. if (aMask.arr[i] <> m.arr[i]) then
  1805. exit;
  1806. result := true;
  1807. end;
  1808. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1809. procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);
  1810. begin
  1811. FillChar(aPixel{%H-}, SizeOf(aPixel), 0);
  1812. aPixel.Data := Range;
  1813. aPixel.Format := fFormat;
  1814. aPixel.Range := Range;
  1815. end;
  1816. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1817. constructor TFormatDescriptor.Create;
  1818. begin
  1819. inherited Create;
  1820. end;
  1821. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1822. //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1823. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1824. procedure TfdAlphaUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1825. begin
  1826. aData^ := aPixel.Data.a;
  1827. inc(aData);
  1828. end;
  1829. procedure TfdAlphaUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1830. begin
  1831. aPixel.Data.r := 0;
  1832. aPixel.Data.g := 0;
  1833. aPixel.Data.b := 0;
  1834. aPixel.Data.a := aData^;
  1835. inc(aData);
  1836. end;
  1837. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1838. //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1839. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1840. procedure TfdLuminanceUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1841. begin
  1842. aData^ := LuminanceWeight(aPixel);
  1843. inc(aData);
  1844. end;
  1845. procedure TfdLuminanceUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1846. begin
  1847. aPixel.Data.r := aData^;
  1848. aPixel.Data.g := aData^;
  1849. aPixel.Data.b := aData^;
  1850. aPixel.Data.a := 0;
  1851. inc(aData);
  1852. end;
  1853. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1854. //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1855. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1856. procedure TfdUniversalUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1857. var
  1858. i: Integer;
  1859. begin
  1860. aData^ := 0;
  1861. for i := 0 to 3 do
  1862. if (Range.arr[i] > 0) then
  1863. aData^ := aData^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
  1864. inc(aData);
  1865. end;
  1866. procedure TfdUniversalUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1867. var
  1868. i: Integer;
  1869. begin
  1870. for i := 0 to 3 do
  1871. aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and Range.arr[i];
  1872. inc(aData);
  1873. end;
  1874. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1875. //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1876. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1877. procedure TfdLuminanceAlphaUB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1878. begin
  1879. inherited Map(aPixel, aData, aMapData);
  1880. aData^ := aPixel.Data.a;
  1881. inc(aData);
  1882. end;
  1883. procedure TfdLuminanceAlphaUB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1884. begin
  1885. inherited Unmap(aData, aPixel, aMapData);
  1886. aPixel.Data.a := aData^;
  1887. inc(aData);
  1888. end;
  1889. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1890. //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1891. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1892. procedure TfdRGBub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1893. begin
  1894. aData^ := aPixel.Data.r;
  1895. inc(aData);
  1896. aData^ := aPixel.Data.g;
  1897. inc(aData);
  1898. aData^ := aPixel.Data.b;
  1899. inc(aData);
  1900. end;
  1901. procedure TfdRGBub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1902. begin
  1903. aPixel.Data.r := aData^;
  1904. inc(aData);
  1905. aPixel.Data.g := aData^;
  1906. inc(aData);
  1907. aPixel.Data.b := aData^;
  1908. inc(aData);
  1909. aPixel.Data.a := 0;
  1910. end;
  1911. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1912. //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1913. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1914. procedure TfdBGRub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1915. begin
  1916. aData^ := aPixel.Data.b;
  1917. inc(aData);
  1918. aData^ := aPixel.Data.g;
  1919. inc(aData);
  1920. aData^ := aPixel.Data.r;
  1921. inc(aData);
  1922. end;
  1923. procedure TfdBGRub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1924. begin
  1925. aPixel.Data.b := aData^;
  1926. inc(aData);
  1927. aPixel.Data.g := aData^;
  1928. inc(aData);
  1929. aPixel.Data.r := aData^;
  1930. inc(aData);
  1931. aPixel.Data.a := 0;
  1932. end;
  1933. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1934. //TfdRGBA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1935. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1936. procedure TfdRGBAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1937. begin
  1938. inherited Map(aPixel, aData, aMapData);
  1939. aData^ := aPixel.Data.a;
  1940. inc(aData);
  1941. end;
  1942. procedure TfdRGBAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1943. begin
  1944. inherited Unmap(aData, aPixel, aMapData);
  1945. aPixel.Data.a := aData^;
  1946. inc(aData);
  1947. end;
  1948. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1949. //TfdBGRA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1950. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1951. procedure TfdBGRAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1952. begin
  1953. inherited Map(aPixel, aData, aMapData);
  1954. aData^ := aPixel.Data.a;
  1955. inc(aData);
  1956. end;
  1957. procedure TfdBGRAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1958. begin
  1959. inherited Unmap(aData, aPixel, aMapData);
  1960. aPixel.Data.a := aData^;
  1961. inc(aData);
  1962. end;
  1963. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1964. //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1965. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1966. procedure TfdAlphaUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1967. begin
  1968. PWord(aData)^ := aPixel.Data.a;
  1969. inc(aData, 2);
  1970. end;
  1971. procedure TfdAlphaUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1972. begin
  1973. aPixel.Data.r := 0;
  1974. aPixel.Data.g := 0;
  1975. aPixel.Data.b := 0;
  1976. aPixel.Data.a := PWord(aData)^;
  1977. inc(aData, 2);
  1978. end;
  1979. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1980. //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1981. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1982. procedure TfdLuminanceUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1983. begin
  1984. PWord(aData)^ := LuminanceWeight(aPixel);
  1985. inc(aData, 2);
  1986. end;
  1987. procedure TfdLuminanceUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  1988. begin
  1989. aPixel.Data.r := PWord(aData)^;
  1990. aPixel.Data.g := PWord(aData)^;
  1991. aPixel.Data.b := PWord(aData)^;
  1992. aPixel.Data.a := 0;
  1993. inc(aData, 2);
  1994. end;
  1995. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1996. //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1997. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  1998. procedure TfdUniversalUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  1999. var
  2000. i: Integer;
  2001. begin
  2002. PWord(aData)^ := 0;
  2003. for i := 0 to 3 do
  2004. if (Range.arr[i] > 0) then
  2005. PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
  2006. inc(aData, 2);
  2007. end;
  2008. procedure TfdUniversalUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2009. var
  2010. i: Integer;
  2011. begin
  2012. for i := 0 to 3 do
  2013. aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and Range.arr[i];
  2014. inc(aData, 2);
  2015. end;
  2016. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2017. //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2018. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2019. procedure TfdDepthUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2020. begin
  2021. PWord(aData)^ := DepthWeight(aPixel);
  2022. inc(aData, 2);
  2023. end;
  2024. procedure TfdDepthUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2025. begin
  2026. aPixel.Data.r := PWord(aData)^;
  2027. aPixel.Data.g := PWord(aData)^;
  2028. aPixel.Data.b := PWord(aData)^;
  2029. aPixel.Data.a := PWord(aData)^;;
  2030. inc(aData, 2);
  2031. end;
  2032. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2033. //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2034. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2035. procedure TfdLuminanceAlphaUS2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2036. begin
  2037. inherited Map(aPixel, aData, aMapData);
  2038. PWord(aData)^ := aPixel.Data.a;
  2039. inc(aData, 2);
  2040. end;
  2041. procedure TfdLuminanceAlphaUS2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2042. begin
  2043. inherited Unmap(aData, aPixel, aMapData);
  2044. aPixel.Data.a := PWord(aData)^;
  2045. inc(aData, 2);
  2046. end;
  2047. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2048. //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2049. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2050. procedure TfdRGBus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2051. begin
  2052. PWord(aData)^ := aPixel.Data.r;
  2053. inc(aData, 2);
  2054. PWord(aData)^ := aPixel.Data.g;
  2055. inc(aData, 2);
  2056. PWord(aData)^ := aPixel.Data.b;
  2057. inc(aData, 2);
  2058. end;
  2059. procedure TfdRGBus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2060. begin
  2061. aPixel.Data.r := PWord(aData)^;
  2062. inc(aData, 2);
  2063. aPixel.Data.g := PWord(aData)^;
  2064. inc(aData, 2);
  2065. aPixel.Data.b := PWord(aData)^;
  2066. inc(aData, 2);
  2067. aPixel.Data.a := 0;
  2068. end;
  2069. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2070. //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2071. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2072. procedure TfdBGRus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2073. begin
  2074. PWord(aData)^ := aPixel.Data.b;
  2075. inc(aData, 2);
  2076. PWord(aData)^ := aPixel.Data.g;
  2077. inc(aData, 2);
  2078. PWord(aData)^ := aPixel.Data.r;
  2079. inc(aData, 2);
  2080. end;
  2081. procedure TfdBGRus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2082. begin
  2083. aPixel.Data.b := PWord(aData)^;
  2084. inc(aData, 2);
  2085. aPixel.Data.g := PWord(aData)^;
  2086. inc(aData, 2);
  2087. aPixel.Data.r := PWord(aData)^;
  2088. inc(aData, 2);
  2089. aPixel.Data.a := 0;
  2090. end;
  2091. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2092. //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2093. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2094. procedure TfdRGBAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2095. begin
  2096. inherited Map(aPixel, aData, aMapData);
  2097. PWord(aData)^ := aPixel.Data.a;
  2098. inc(aData, 2);
  2099. end;
  2100. procedure TfdRGBAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2101. begin
  2102. inherited Unmap(aData, aPixel, aMapData);
  2103. aPixel.Data.a := PWord(aData)^;
  2104. inc(aData, 2);
  2105. end;
  2106. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2107. //TfdARGB_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2108. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2109. procedure TfdARGBus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2110. begin
  2111. PWord(aData)^ := aPixel.Data.a;
  2112. inc(aData, 2);
  2113. inherited Map(aPixel, aData, aMapData);
  2114. end;
  2115. procedure TfdARGBus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2116. begin
  2117. aPixel.Data.a := PWord(aData)^;
  2118. inc(aData, 2);
  2119. inherited Unmap(aData, aPixel, aMapData);
  2120. end;
  2121. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2122. //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2123. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2124. procedure TfdBGRAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2125. begin
  2126. inherited Map(aPixel, aData, aMapData);
  2127. PWord(aData)^ := aPixel.Data.a;
  2128. inc(aData, 2);
  2129. end;
  2130. procedure TfdBGRAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2131. begin
  2132. inherited Unmap(aData, aPixel, aMapData);
  2133. aPixel.Data.a := PWord(aData)^;
  2134. inc(aData, 2);
  2135. end;
  2136. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2137. //TfdABGR_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2138. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2139. procedure TfdABGRus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2140. begin
  2141. PWord(aData)^ := aPixel.Data.a;
  2142. inc(aData, 2);
  2143. inherited Map(aPixel, aData, aMapData);
  2144. end;
  2145. procedure TfdABGRus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2146. begin
  2147. aPixel.Data.a := PWord(aData)^;
  2148. inc(aData, 2);
  2149. inherited Unmap(aData, aPixel, aMapData);
  2150. end;
  2151. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2152. //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2153. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2154. procedure TfdUniversalUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2155. var
  2156. i: Integer;
  2157. begin
  2158. PCardinal(aData)^ := 0;
  2159. for i := 0 to 3 do
  2160. if (Range.arr[i] > 0) then
  2161. PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and Range.arr[i]) shl fShift.arr[i]);
  2162. inc(aData, 4);
  2163. end;
  2164. procedure TfdUniversalUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2165. var
  2166. i: Integer;
  2167. begin
  2168. for i := 0 to 3 do
  2169. aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and Range.arr[i];
  2170. inc(aData, 2);
  2171. end;
  2172. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2173. //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2174. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2175. procedure TfdDepthUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  2176. begin
  2177. PCardinal(aData)^ := DepthWeight(aPixel);
  2178. inc(aData, 4);
  2179. end;
  2180. procedure TfdDepthUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  2181. begin
  2182. aPixel.Data.r := PCardinal(aData)^;
  2183. aPixel.Data.g := PCardinal(aData)^;
  2184. aPixel.Data.b := PCardinal(aData)^;
  2185. aPixel.Data.a := PCardinal(aData)^;
  2186. inc(aData, 4);
  2187. end;
  2188. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2189. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2190. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2191. procedure TfdAlpha4ub1.SetValues;
  2192. begin
  2193. inherited SetValues;
  2194. fBitsPerPixel := 8;
  2195. fFormat := tfAlpha4ub1;
  2196. fWithAlpha := tfAlpha4ub1;
  2197. fPrecision := glBitmapRec4ub(0, 0, 0, 8);
  2198. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2199. {$IFNDEF OPENGL_ES}
  2200. fOpenGLFormat := tfAlpha4ub1;
  2201. fglFormat := GL_ALPHA;
  2202. fglInternalFormat := GL_ALPHA4;
  2203. fglDataFormat := GL_UNSIGNED_BYTE;
  2204. {$ELSE}
  2205. fOpenGLFormat := tfAlpha8ub1;
  2206. {$ENDIF}
  2207. end;
  2208. procedure TfdAlpha8ub1.SetValues;
  2209. begin
  2210. inherited SetValues;
  2211. fBitsPerPixel := 8;
  2212. fFormat := tfAlpha8ub1;
  2213. fWithAlpha := tfAlpha8ub1;
  2214. fPrecision := glBitmapRec4ub(0, 0, 0, 8);
  2215. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2216. fOpenGLFormat := tfAlpha8ub1;
  2217. fglFormat := GL_ALPHA;
  2218. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_ALPHA8{$ELSE}GL_ALPHA{$ENDIF};
  2219. fglDataFormat := GL_UNSIGNED_BYTE;
  2220. end;
  2221. procedure TfdAlpha16us1.SetValues;
  2222. begin
  2223. inherited SetValues;
  2224. fBitsPerPixel := 16;
  2225. fFormat := tfAlpha16us1;
  2226. fWithAlpha := tfAlpha16us1;
  2227. fPrecision := glBitmapRec4ub(0, 0, 0, 16);
  2228. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2229. {$IFNDEF OPENGL_ES}
  2230. fOpenGLFormat := tfAlpha16us1;
  2231. fglFormat := GL_ALPHA;
  2232. fglInternalFormat := GL_ALPHA16;
  2233. fglDataFormat := GL_UNSIGNED_SHORT;
  2234. {$ELSE}
  2235. fOpenGLFormat := tfAlpha8ub1;
  2236. {$ENDIF}
  2237. end;
  2238. procedure TfdLuminance4ub1.SetValues;
  2239. begin
  2240. inherited SetValues;
  2241. fBitsPerPixel := 8;
  2242. fFormat := tfLuminance4ub1;
  2243. fWithAlpha := tfLuminance4Alpha4ub2;
  2244. fWithoutAlpha := tfLuminance4ub1;
  2245. fPrecision := glBitmapRec4ub(8, 8, 8, 0);
  2246. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2247. {$IFNDEF OPENGL_ES}
  2248. fOpenGLFormat := tfLuminance4ub1;
  2249. fglFormat := GL_LUMINANCE;
  2250. fglInternalFormat := GL_LUMINANCE4;
  2251. fglDataFormat := GL_UNSIGNED_BYTE;
  2252. {$ELSE}
  2253. fOpenGLFormat := tfLuminance8ub1;
  2254. {$ENDIF}
  2255. end;
  2256. procedure TfdLuminance8ub1.SetValues;
  2257. begin
  2258. inherited SetValues;
  2259. fBitsPerPixel := 8;
  2260. fFormat := tfLuminance8ub1;
  2261. fWithAlpha := tfLuminance8Alpha8ub2;
  2262. fWithoutAlpha := tfLuminance8ub1;
  2263. fOpenGLFormat := tfLuminance8ub1;
  2264. fPrecision := glBitmapRec4ub(8, 8, 8, 0);
  2265. fShift := glBitmapRec4ub(0, 0, 0, 0);
  2266. fglFormat := GL_LUMINANCE;
  2267. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8{$ELSE}GL_LUMINANCE{$ENDIF};
  2268. fglDataFormat := GL_UNSIGNED_BYTE;
  2269. end;
  2270. procedure TfdLuminance16us1.SetValues;
  2271. begin
  2272. inherited SetValues;
  2273. fBitsPerPixel := 16;
  2274. fFormat := tfLuminance16us1;
  2275. fWithAlpha := tfLuminance16Alpha16us2;
  2276. fWithoutAlpha := tfLuminance16us1;
  2277. fPrecision := glBitmapRec4ub(16, 16, 16, 0);
  2278. fShift := glBitmapRec4ub( 0, 0, 0, 0);
  2279. {$IFNDEF OPENGL_ES}
  2280. fOpenGLFormat := tfLuminance16us1;
  2281. fglFormat := GL_LUMINANCE;
  2282. fglInternalFormat := GL_LUMINANCE16;
  2283. fglDataFormat := GL_UNSIGNED_SHORT;
  2284. {$ELSE}
  2285. fOpenGLFormat := tfLuminance8ub1;
  2286. {$ENDIF}
  2287. end;
  2288. procedure TfdLuminance4Alpha4ub2.SetValues;
  2289. begin
  2290. inherited SetValues;
  2291. fBitsPerPixel := 16;
  2292. fFormat := tfLuminance4Alpha4ub2;
  2293. fWithAlpha := tfLuminance4Alpha4ub2;
  2294. fWithoutAlpha := tfLuminance4ub1;
  2295. fPrecision := glBitmapRec4ub(8, 8, 8, 8);
  2296. fShift := glBitmapRec4ub(0, 0, 0, 8);
  2297. {$IFNDEF OPENGL_ES}
  2298. fOpenGLFormat := tfLuminance4Alpha4ub2;
  2299. fglFormat := GL_LUMINANCE_ALPHA;
  2300. fglInternalFormat := GL_LUMINANCE4_ALPHA4;
  2301. fglDataFormat := GL_UNSIGNED_BYTE;
  2302. {$ELSE}
  2303. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2304. {$ENDIF}
  2305. end;
  2306. procedure TfdLuminance6Alpha2ub2.SetValues;
  2307. begin
  2308. inherited SetValues;
  2309. fBitsPerPixel := 16;
  2310. fFormat := tfLuminance6Alpha2ub2;
  2311. fWithAlpha := tfLuminance6Alpha2ub2;
  2312. fWithoutAlpha := tfLuminance8ub1;
  2313. fPrecision := glBitmapRec4ub(8, 8, 8, 8);
  2314. fShift := glBitmapRec4ub(0, 0, 0, 8);
  2315. {$IFNDEF OPENGL_ES}
  2316. fOpenGLFormat := tfLuminance6Alpha2ub2;
  2317. fglFormat := GL_LUMINANCE_ALPHA;
  2318. fglInternalFormat := GL_LUMINANCE6_ALPHA2;
  2319. fglDataFormat := GL_UNSIGNED_BYTE;
  2320. {$ELSE}
  2321. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2322. {$ENDIF}
  2323. end;
  2324. procedure TfdLuminance8Alpha8ub2.SetValues;
  2325. begin
  2326. inherited SetValues;
  2327. fBitsPerPixel := 16;
  2328. fFormat := tfLuminance8Alpha8ub2;
  2329. fWithAlpha := tfLuminance8Alpha8ub2;
  2330. fWithoutAlpha := tfLuminance8ub1;
  2331. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2332. fPrecision := glBitmapRec4ub(8, 8, 8, 8);
  2333. fShift := glBitmapRec4ub(0, 0, 0, 8);
  2334. fglFormat := GL_LUMINANCE_ALPHA;
  2335. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8_ALPHA8{$ELSE}GL_LUMINANCE_ALPHA{$ENDIF};
  2336. fglDataFormat := GL_UNSIGNED_BYTE;
  2337. end;
  2338. procedure TfdLuminance12Alpha4us2.SetValues;
  2339. begin
  2340. inherited SetValues;
  2341. fBitsPerPixel := 32;
  2342. fFormat := tfLuminance12Alpha4us2;
  2343. fWithAlpha := tfLuminance12Alpha4us2;
  2344. fWithoutAlpha := tfLuminance16us1;
  2345. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  2346. fShift := glBitmapRec4ub( 0, 0, 0, 16);
  2347. {$IFNDEF OPENGL_ES}
  2348. fOpenGLFormat := tfLuminance12Alpha4us2;
  2349. fglFormat := GL_LUMINANCE_ALPHA;
  2350. fglInternalFormat := GL_LUMINANCE12_ALPHA4;
  2351. fglDataFormat := GL_UNSIGNED_SHORT;
  2352. {$ELSE}
  2353. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2354. {$ENDIF}
  2355. end;
  2356. procedure TfdLuminance16Alpha16us2.SetValues;
  2357. begin
  2358. inherited SetValues;
  2359. fBitsPerPixel := 32;
  2360. fFormat := tfLuminance16Alpha16us2;
  2361. fWithAlpha := tfLuminance16Alpha16us2;
  2362. fWithoutAlpha := tfLuminance16us1;
  2363. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  2364. fShift := glBitmapRec4ub( 0, 0, 0, 16);
  2365. {$IFNDEF OPENGL_ES}
  2366. fOpenGLFormat := tfLuminance16Alpha16us2;
  2367. fglFormat := GL_LUMINANCE_ALPHA;
  2368. fglInternalFormat := GL_LUMINANCE16_ALPHA16;
  2369. fglDataFormat := GL_UNSIGNED_SHORT;
  2370. {$ELSE}
  2371. fOpenGLFormat := tfLuminance8Alpha8ub2;
  2372. {$ENDIF}
  2373. end;
  2374. procedure TfdR3G3B2ub1.SetValues;
  2375. begin
  2376. inherited SetValues;
  2377. fBitsPerPixel := 8;
  2378. fFormat := tfR3G3B2ub1;
  2379. fWithAlpha := tfRGBA4us1;
  2380. fWithoutAlpha := tfR3G3B2ub1;
  2381. fRGBInverted := tfEmpty;
  2382. fPrecision := glBitmapRec4ub(3, 3, 2, 0);
  2383. fShift := glBitmapRec4ub(5, 2, 0, 0);
  2384. {$IFNDEF OPENGL_ES}
  2385. fOpenGLFormat := tfR3G3B2ub1;
  2386. fglFormat := GL_RGB;
  2387. fglInternalFormat := GL_R3_G3_B2;
  2388. fglDataFormat := GL_UNSIGNED_BYTE_3_3_2;
  2389. {$ELSE}
  2390. fOpenGLFormat := tfR5G6B5us1;
  2391. {$ENDIF}
  2392. end;
  2393. procedure TfdRGBX4us1.SetValues;
  2394. begin
  2395. inherited SetValues;
  2396. fBitsPerPixel := 16;
  2397. fFormat := tfRGBX4us1;
  2398. fWithAlpha := tfRGBA4us1;
  2399. fWithoutAlpha := tfRGBX4us1;
  2400. fRGBInverted := tfBGRX4us1;
  2401. fPrecision := glBitmapRec4ub( 4, 4, 4, 0);
  2402. fShift := glBitmapRec4ub(12, 8, 4, 0);
  2403. {$IFNDEF OPENGL_ES}
  2404. fOpenGLFormat := tfRGBX4us1;
  2405. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2406. fglInternalFormat := GL_RGB4;
  2407. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  2408. {$ELSE}
  2409. fOpenGLFormat := tfR5G6B5us1;
  2410. {$ENDIF}
  2411. end;
  2412. procedure TfdXRGB4us1.SetValues;
  2413. begin
  2414. inherited SetValues;
  2415. fBitsPerPixel := 16;
  2416. fFormat := tfXRGB4us1;
  2417. fWithAlpha := tfARGB4us1;
  2418. fWithoutAlpha := tfXRGB4us1;
  2419. fRGBInverted := tfXBGR4us1;
  2420. fPrecision := glBitmapRec4ub(4, 4, 4, 0);
  2421. fShift := glBitmapRec4ub(8, 4, 0, 0);
  2422. {$IFNDEF OPENGL_ES}
  2423. fOpenGLFormat := tfXRGB4us1;
  2424. fglFormat := GL_BGRA;
  2425. fglInternalFormat := GL_RGB4;
  2426. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2427. {$ELSE}
  2428. fOpenGLFormat := tfR5G6B5us1;
  2429. {$ENDIF}
  2430. end;
  2431. procedure TfdR5G6B5us1.SetValues;
  2432. begin
  2433. inherited SetValues;
  2434. fBitsPerPixel := 16;
  2435. fFormat := tfR5G6B5us1;
  2436. fWithAlpha := tfRGB5A1us1;
  2437. fWithoutAlpha := tfR5G6B5us1;
  2438. fRGBInverted := tfB5G6R5us1;
  2439. fPrecision := glBitmapRec4ub( 5, 6, 5, 0);
  2440. fShift := glBitmapRec4ub(11, 5, 0, 0);
  2441. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  2442. fOpenGLFormat := tfR5G6B5us1;
  2443. fglFormat := GL_RGB;
  2444. fglInternalFormat := GL_RGB565;
  2445. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5;
  2446. {$ELSE}
  2447. fOpenGLFormat := tfRGB8ub3;
  2448. {$IFEND}
  2449. end;
  2450. procedure TfdRGB5X1us1.SetValues;
  2451. begin
  2452. inherited SetValues;
  2453. fBitsPerPixel := 16;
  2454. fFormat := tfRGB5X1us1;
  2455. fWithAlpha := tfRGB5A1us1;
  2456. fWithoutAlpha := tfRGB5X1us1;
  2457. fRGBInverted := tfBGR5X1us1;
  2458. fPrecision := glBitmapRec4ub( 5, 5, 5, 0);
  2459. fShift := glBitmapRec4ub(11, 6, 1, 0);
  2460. {$IFNDEF OPENGL_ES}
  2461. fOpenGLFormat := tfRGB5X1us1;
  2462. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2463. fglInternalFormat := GL_RGB5;
  2464. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  2465. {$ELSE}
  2466. fOpenGLFormat := tfR5G6B5us1;
  2467. {$ENDIF}
  2468. end;
  2469. procedure TfdX1RGB5us1.SetValues;
  2470. begin
  2471. inherited SetValues;
  2472. fBitsPerPixel := 16;
  2473. fFormat := tfX1RGB5us1;
  2474. fWithAlpha := tfA1RGB5us1;
  2475. fWithoutAlpha := tfX1RGB5us1;
  2476. fRGBInverted := tfX1BGR5us1;
  2477. fPrecision := glBitmapRec4ub( 5, 5, 5, 0);
  2478. fShift := glBitmapRec4ub(10, 5, 0, 0);
  2479. {$IFNDEF OPENGL_ES}
  2480. fOpenGLFormat := tfX1RGB5us1;
  2481. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2482. fglInternalFormat := GL_RGB5;
  2483. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2484. {$ELSE}
  2485. fOpenGLFormat := tfR5G6B5us1;
  2486. {$ENDIF}
  2487. end;
  2488. procedure TfdRGB8ub3.SetValues;
  2489. begin
  2490. inherited SetValues;
  2491. fBitsPerPixel := 24;
  2492. fFormat := tfRGB8ub3;
  2493. fWithAlpha := tfRGBA8ub4;
  2494. fWithoutAlpha := tfRGB8ub3;
  2495. fRGBInverted := tfBGR8ub3;
  2496. fPrecision := glBitmapRec4ub(8, 8, 8, 0);
  2497. fShift := glBitmapRec4ub(0, 8, 16, 0);
  2498. fOpenGLFormat := tfRGB8ub3;
  2499. fglFormat := GL_RGB;
  2500. fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGB8{$ELSE}GL_RGB{$IFEND};
  2501. fglDataFormat := GL_UNSIGNED_BYTE;
  2502. end;
  2503. procedure TfdRGBX8ui1.SetValues;
  2504. begin
  2505. inherited SetValues;
  2506. fBitsPerPixel := 32;
  2507. fFormat := tfRGBX8ui1;
  2508. fWithAlpha := tfRGBA8ui1;
  2509. fWithoutAlpha := tfRGBX8ui1;
  2510. fRGBInverted := tfBGRX8ui1;
  2511. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  2512. fShift := glBitmapRec4ub(24, 16, 8, 0);
  2513. {$IFNDEF OPENGL_ES}
  2514. fOpenGLFormat := tfRGBX8ui1;
  2515. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2516. fglInternalFormat := GL_RGB8;
  2517. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  2518. {$ELSE}
  2519. fOpenGLFormat := tfRGB8ub3;
  2520. {$ENDIF}
  2521. end;
  2522. procedure TfdXRGB8ui1.SetValues;
  2523. begin
  2524. inherited SetValues;
  2525. fBitsPerPixel := 32;
  2526. fFormat := tfXRGB8ui1;
  2527. fWithAlpha := tfXRGB8ui1;
  2528. fWithoutAlpha := tfXRGB8ui1;
  2529. fOpenGLFormat := tfXRGB8ui1;
  2530. fRGBInverted := tfXBGR8ui1;
  2531. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  2532. fShift := glBitmapRec4ub(16, 8, 0, 0);
  2533. {$IFNDEF OPENGL_ES}
  2534. fOpenGLFormat := tfXRGB8ui1;
  2535. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2536. fglInternalFormat := GL_RGB8;
  2537. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  2538. {$ELSE}
  2539. fOpenGLFormat := tfRGB8ub3;
  2540. {$ENDIF}
  2541. end;
  2542. procedure TfdRGB10X2ui1.SetValues;
  2543. begin
  2544. inherited SetValues;
  2545. fBitsPerPixel := 32;
  2546. fFormat := tfRGB10X2ui1;
  2547. fWithAlpha := tfRGB10A2ui1;
  2548. fWithoutAlpha := tfRGB10X2ui1;
  2549. fRGBInverted := tfBGR10X2ui1;
  2550. fPrecision := glBitmapRec4ub(10, 10, 10, 0);
  2551. fShift := glBitmapRec4ub(22, 12, 2, 0);
  2552. {$IFNDEF OPENGL_ES}
  2553. fOpenGLFormat := tfRGB10X2ui1;
  2554. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2555. fglInternalFormat := GL_RGB10;
  2556. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  2557. {$ELSE}
  2558. fOpenGLFormat := tfRGB16us3;
  2559. {$ENDIF}
  2560. end;
  2561. procedure TfdX2RGB10ui1.SetValues;
  2562. begin
  2563. inherited SetValues;
  2564. fBitsPerPixel := 32;
  2565. fFormat := tfX2RGB10ui1;
  2566. fWithAlpha := tfA2RGB10ui1;
  2567. fWithoutAlpha := tfX2RGB10ui1;
  2568. fRGBInverted := tfX2BGR10ui1;
  2569. fPrecision := glBitmapRec4ub(10, 10, 10, 0);
  2570. fShift := glBitmapRec4ub(20, 10, 0, 0);
  2571. {$IFNDEF OPENGL_ES}
  2572. fOpenGLFormat := tfX2RGB10ui1;
  2573. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2574. fglInternalFormat := GL_RGB10;
  2575. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2576. {$ELSE}
  2577. fOpenGLFormat := tfRGB16us3;
  2578. {$ENDIF}
  2579. end;
  2580. procedure TfdRGB16us3.SetValues;
  2581. begin
  2582. inherited SetValues;
  2583. fBitsPerPixel := 48;
  2584. fFormat := tfRGB16us3;
  2585. fWithAlpha := tfRGBA16us4;
  2586. fWithoutAlpha := tfRGB16us3;
  2587. fRGBInverted := tfBGR16us3;
  2588. fPrecision := glBitmapRec4ub(16, 16, 16, 0);
  2589. fShift := glBitmapRec4ub( 0, 16, 32, 0);
  2590. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  2591. fOpenGLFormat := tfRGB16us3;
  2592. fglFormat := GL_RGB;
  2593. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGB16{$ELSE}GL_RGB16UI{$ENDIF};
  2594. fglDataFormat := GL_UNSIGNED_SHORT;
  2595. {$ELSE}
  2596. fOpenGLFormat := tfRGB8ub3;
  2597. {$IFEND}
  2598. end;
  2599. procedure TfdRGBA4us1.SetValues;
  2600. begin
  2601. inherited SetValues;
  2602. fBitsPerPixel := 16;
  2603. fFormat := tfRGBA4us1;
  2604. fWithAlpha := tfRGBA4us1;
  2605. fWithoutAlpha := tfRGBX4us1;
  2606. fOpenGLFormat := tfRGBA4us1;
  2607. fRGBInverted := tfBGRA4us1;
  2608. fPrecision := glBitmapRec4ub( 4, 4, 4, 4);
  2609. fShift := glBitmapRec4ub(12, 8, 4, 0);
  2610. fglFormat := GL_RGBA;
  2611. fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA4{$ELSE}GL_RGBA{$IFEND};
  2612. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  2613. end;
  2614. procedure TfdARGB4us1.SetValues;
  2615. begin
  2616. inherited SetValues;
  2617. fBitsPerPixel := 16;
  2618. fFormat := tfARGB4us1;
  2619. fWithAlpha := tfARGB4us1;
  2620. fWithoutAlpha := tfXRGB4us1;
  2621. fRGBInverted := tfABGR4us1;
  2622. fPrecision := glBitmapRec4ub( 4, 4, 4, 4);
  2623. fShift := glBitmapRec4ub( 8, 4, 0, 12);
  2624. {$IFNDEF OPENGL_ES}
  2625. fOpenGLFormat := tfARGB4us1;
  2626. fglFormat := GL_BGRA;
  2627. fglInternalFormat := GL_RGBA4;
  2628. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2629. {$ELSE}
  2630. fOpenGLFormat := tfRGBA4us1;
  2631. {$ENDIF}
  2632. end;
  2633. procedure TfdRGB5A1us1.SetValues;
  2634. begin
  2635. inherited SetValues;
  2636. fBitsPerPixel := 16;
  2637. fFormat := tfRGB5A1us1;
  2638. fWithAlpha := tfRGB5A1us1;
  2639. fWithoutAlpha := tfRGB5X1us1;
  2640. fOpenGLFormat := tfRGB5A1us1;
  2641. fRGBInverted := tfBGR5A1us1;
  2642. fPrecision := glBitmapRec4ub( 5, 5, 5, 1);
  2643. fShift := glBitmapRec4ub(11, 6, 1, 0);
  2644. fglFormat := GL_RGBA;
  2645. fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}GL_RGB5_A1{$ELSE}GL_RGBA{$IFEND};
  2646. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  2647. end;
  2648. procedure TfdA1RGB5us1.SetValues;
  2649. begin
  2650. inherited SetValues;
  2651. fBitsPerPixel := 16;
  2652. fFormat := tfA1RGB5us1;
  2653. fWithAlpha := tfA1RGB5us1;
  2654. fWithoutAlpha := tfX1RGB5us1;
  2655. fRGBInverted := tfA1BGR5us1;
  2656. fPrecision := glBitmapRec4ub( 5, 5, 5, 1);
  2657. fShift := glBitmapRec4ub(10, 5, 0, 15);
  2658. {$IFNDEF OPENGL_ES}
  2659. fOpenGLFormat := tfA1RGB5us1;
  2660. fglFormat := GL_BGRA;
  2661. fglInternalFormat := GL_RGB5_A1;
  2662. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2663. {$ELSE}
  2664. fOpenGLFormat := tfRGB5A1us1;
  2665. {$ENDIF}
  2666. end;
  2667. procedure TfdRGBA8ui1.SetValues;
  2668. begin
  2669. inherited SetValues;
  2670. fBitsPerPixel := 32;
  2671. fFormat := tfRGBA8ui1;
  2672. fWithAlpha := tfRGBA8ui1;
  2673. fWithoutAlpha := tfRGBX8ui1;
  2674. fRGBInverted := tfBGRA8ui1;
  2675. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  2676. fShift := glBitmapRec4ub(24, 16, 8, 0);
  2677. {$IFNDEF OPENGL_ES}
  2678. fOpenGLFormat := tfRGBA8ui1;
  2679. fglFormat := GL_RGBA;
  2680. fglInternalFormat := GL_RGBA8;
  2681. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  2682. {$ELSE}
  2683. fOpenGLFormat := tfRGBA8ub4;
  2684. {$ENDIF}
  2685. end;
  2686. procedure TfdARGB8ui1.SetValues;
  2687. begin
  2688. inherited SetValues;
  2689. fBitsPerPixel := 32;
  2690. fFormat := tfARGB8ui1;
  2691. fWithAlpha := tfARGB8ui1;
  2692. fWithoutAlpha := tfXRGB8ui1;
  2693. fRGBInverted := tfABGR8ui1;
  2694. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  2695. fShift := glBitmapRec4ub(16, 8, 0, 24);
  2696. {$IFNDEF OPENGL_ES}
  2697. fOpenGLFormat := tfARGB8ui1;
  2698. fglFormat := GL_BGRA;
  2699. fglInternalFormat := GL_RGBA8;
  2700. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  2701. {$ELSE}
  2702. fOpenGLFormat := tfRGBA8ub4;
  2703. {$ENDIF}
  2704. end;
  2705. procedure TfdRGBA8ub4.SetValues;
  2706. begin
  2707. inherited SetValues;
  2708. fBitsPerPixel := 32;
  2709. fFormat := tfRGBA8ub4;
  2710. fWithAlpha := tfRGBA8ub4;
  2711. fWithoutAlpha := tfRGB8ub3;
  2712. fOpenGLFormat := tfRGBA8ub4;
  2713. fRGBInverted := tfBGRA8ub4;
  2714. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  2715. fShift := glBitmapRec4ub( 0, 8, 16, 24);
  2716. fglFormat := GL_RGBA;
  2717. fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA8{$ELSE}GL_RGBA{$IFEND};
  2718. fglDataFormat := GL_UNSIGNED_BYTE;
  2719. end;
  2720. procedure TfdRGB10A2ui1.SetValues;
  2721. begin
  2722. inherited SetValues;
  2723. fBitsPerPixel := 32;
  2724. fFormat := tfRGB10A2ui1;
  2725. fWithAlpha := tfRGB10A2ui1;
  2726. fWithoutAlpha := tfRGB10X2ui1;
  2727. fRGBInverted := tfBGR10A2ui1;
  2728. fPrecision := glBitmapRec4ub(10, 10, 10, 2);
  2729. fShift := glBitmapRec4ub(22, 12, 2, 0);
  2730. {$IFNDEF OPENGL_ES}
  2731. fOpenGLFormat := tfRGB10A2ui1;
  2732. fglFormat := GL_RGBA;
  2733. fglInternalFormat := GL_RGB10_A2;
  2734. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  2735. {$ELSE}
  2736. fOpenGLFormat := tfA2RGB10ui1;
  2737. {$ENDIF}
  2738. end;
  2739. procedure TfdA2RGB10ui1.SetValues;
  2740. begin
  2741. inherited SetValues;
  2742. fBitsPerPixel := 32;
  2743. fFormat := tfA2RGB10ui1;
  2744. fWithAlpha := tfA2RGB10ui1;
  2745. fWithoutAlpha := tfX2RGB10ui1;
  2746. fRGBInverted := tfA2BGR10ui1;
  2747. fPrecision := glBitmapRec4ub(10, 10, 10, 2);
  2748. fShift := glBitmapRec4ub(20, 10, 0, 30);
  2749. {$IF NOT DEFINED(OPENGL_ES)}
  2750. fOpenGLFormat := tfA2RGB10ui1;
  2751. fglFormat := GL_BGRA;
  2752. fglInternalFormat := GL_RGB10_A2;
  2753. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2754. {$ELSEIF DEFINED(OPENGL_ES_3_0)}
  2755. fOpenGLFormat := tfA2RGB10ui1;
  2756. fglFormat := GL_RGBA;
  2757. fglInternalFormat := GL_RGB10_A2;
  2758. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2759. {$ELSE}
  2760. fOpenGLFormat := tfRGBA8ui1;
  2761. {$IFEND}
  2762. end;
  2763. procedure TfdRGBA16us4.SetValues;
  2764. begin
  2765. inherited SetValues;
  2766. fBitsPerPixel := 64;
  2767. fFormat := tfRGBA16us4;
  2768. fWithAlpha := tfRGBA16us4;
  2769. fWithoutAlpha := tfRGB16us3;
  2770. fRGBInverted := tfBGRA16us4;
  2771. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  2772. fShift := glBitmapRec4ub( 0, 16, 32, 48);
  2773. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  2774. fOpenGLFormat := tfRGBA16us4;
  2775. fglFormat := GL_RGBA;
  2776. fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGBA16{$ELSE}GL_RGBA16UI{$ENDIF};
  2777. fglDataFormat := GL_UNSIGNED_SHORT;
  2778. {$ELSE}
  2779. fOpenGLFormat := tfRGBA8ub4;
  2780. {$IFEND}
  2781. end;
  2782. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2783. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2784. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  2785. procedure TfdBGRX4us1.SetValues;
  2786. begin
  2787. inherited SetValues;
  2788. fBitsPerPixel := 16;
  2789. fFormat := tfBGRX4us1;
  2790. fWithAlpha := tfBGRA4us1;
  2791. fWithoutAlpha := tfBGRX4us1;
  2792. fRGBInverted := tfRGBX4us1;
  2793. fPrecision := glBitmapRec4ub( 4, 4, 4, 0);
  2794. fShift := glBitmapRec4ub( 4, 8, 12, 0);
  2795. {$IFNDEF OPENGL_ES}
  2796. fOpenGLFormat := tfBGRX4us1;
  2797. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2798. fglInternalFormat := GL_RGB4;
  2799. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  2800. {$ELSE}
  2801. fOpenGLFormat := tfR5G6B5us1;
  2802. {$ENDIF}
  2803. end;
  2804. procedure TfdXBGR4us1.SetValues;
  2805. begin
  2806. inherited SetValues;
  2807. fBitsPerPixel := 16;
  2808. fFormat := tfXBGR4us1;
  2809. fWithAlpha := tfABGR4us1;
  2810. fWithoutAlpha := tfXBGR4us1;
  2811. fRGBInverted := tfXRGB4us1;
  2812. fPrecision := glBitmapRec4ub( 4, 4, 4, 0);
  2813. fShift := glBitmapRec4ub( 0, 4, 8, 0);
  2814. {$IFNDEF OPENGL_ES}
  2815. fOpenGLFormat := tfXBGR4us1;
  2816. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2817. fglInternalFormat := GL_RGB4;
  2818. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  2819. {$ELSE}
  2820. fOpenGLFormat := tfR5G6B5us1;
  2821. {$ENDIF}
  2822. end;
  2823. procedure TfdB5G6R5us1.SetValues;
  2824. begin
  2825. inherited SetValues;
  2826. fBitsPerPixel := 16;
  2827. fFormat := tfB5G6R5us1;
  2828. fWithAlpha := tfBGR5A1us1;
  2829. fWithoutAlpha := tfB5G6R5us1;
  2830. fRGBInverted := tfR5G6B5us1;
  2831. fPrecision := glBitmapRec4ub( 5, 6, 5, 0);
  2832. fShift := glBitmapRec4ub( 0, 5, 11, 0);
  2833. {$IFNDEF OPENGL_ES}
  2834. fOpenGLFormat := tfB5G6R5us1;
  2835. fglFormat := GL_RGB;
  2836. fglInternalFormat := GL_RGB565;
  2837. fglDataFormat := GL_UNSIGNED_SHORT_5_6_5_REV;
  2838. {$ELSE}
  2839. fOpenGLFormat := tfR5G6B5us1;
  2840. {$ENDIF}
  2841. end;
  2842. procedure TfdBGR5X1us1.SetValues;
  2843. begin
  2844. inherited SetValues;
  2845. fBitsPerPixel := 16;
  2846. fFormat := tfBGR5X1us1;
  2847. fWithAlpha := tfBGR5A1us1;
  2848. fWithoutAlpha := tfBGR5X1us1;
  2849. fRGBInverted := tfRGB5X1us1;
  2850. fPrecision := glBitmapRec4ub( 5, 5, 5, 0);
  2851. fShift := glBitmapRec4ub( 1, 6, 11, 0);
  2852. {$IFNDEF OPENGL_ES}
  2853. fOpenGLFormat := tfBGR5X1us1;
  2854. fglFormat := GL_BGRA;
  2855. fglInternalFormat := GL_RGB5;
  2856. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  2857. {$ELSE}
  2858. fOpenGLFormat := tfR5G6B5us1;
  2859. {$ENDIF}
  2860. end;
  2861. procedure TfdX1BGR5us1.SetValues;
  2862. begin
  2863. inherited SetValues;
  2864. fBitsPerPixel := 16;
  2865. fFormat := tfX1BGR5us1;
  2866. fWithAlpha := tfA1BGR5us1;
  2867. fWithoutAlpha := tfX1BGR5us1;
  2868. fRGBInverted := tfX1RGB5us1;
  2869. fPrecision := glBitmapRec4ub( 5, 5, 5, 0);
  2870. fShift := glBitmapRec4ub( 0, 5, 10, 0);
  2871. {$IFNDEF OPENGL_ES}
  2872. fOpenGLFormat := tfX1BGR5us1;
  2873. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2874. fglInternalFormat := GL_RGB5;
  2875. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  2876. {$ELSE}
  2877. fOpenGLFormat := tfR5G6B5us1;
  2878. {$ENDIF}
  2879. end;
  2880. procedure TfdBGR8ub3.SetValues;
  2881. begin
  2882. inherited SetValues;
  2883. fBitsPerPixel := 24;
  2884. fFormat := tfBGR8ub3;
  2885. fWithAlpha := tfBGRA8ub4;
  2886. fWithoutAlpha := tfBGR8ub3;
  2887. fRGBInverted := tfRGB8ub3;
  2888. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  2889. fShift := glBitmapRec4ub(16, 8, 0, 0);
  2890. {$IFNDEF OPENGL_ES}
  2891. fOpenGLFormat := tfBGR8ub3;
  2892. fglFormat := GL_BGR;
  2893. fglInternalFormat := GL_RGB8;
  2894. fglDataFormat := GL_UNSIGNED_BYTE;
  2895. {$ELSE}
  2896. fOpenGLFormat := tfRGB8ub3;
  2897. {$ENDIF}
  2898. end;
  2899. procedure TfdBGRX8ui1.SetValues;
  2900. begin
  2901. inherited SetValues;
  2902. fBitsPerPixel := 32;
  2903. fFormat := tfBGRX8ui1;
  2904. fWithAlpha := tfBGRA8ui1;
  2905. fWithoutAlpha := tfBGRX8ui1;
  2906. fRGBInverted := tfRGBX8ui1;
  2907. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  2908. fShift := glBitmapRec4ub( 8, 16, 24, 0);
  2909. {$IFNDEF OPENGL_ES}
  2910. fOpenGLFormat := tfBGRX8ui1;
  2911. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2912. fglInternalFormat := GL_RGB8;
  2913. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  2914. {$ELSE}
  2915. fOpenGLFormat := tfRGB8ub3;
  2916. {$ENDIF}
  2917. end;
  2918. procedure TfdXBGR8ui1.SetValues;
  2919. begin
  2920. inherited SetValues;
  2921. fBitsPerPixel := 32;
  2922. fFormat := tfXBGR8ui1;
  2923. fWithAlpha := tfABGR8ui1;
  2924. fWithoutAlpha := tfXBGR8ui1;
  2925. fRGBInverted := tfXRGB8ui1;
  2926. fPrecision := glBitmapRec4ub( 8, 8, 8, 0);
  2927. fShift := glBitmapRec4ub( 0, 8, 16, 0);
  2928. {$IFNDEF OPENGL_ES}
  2929. fOpenGLFormat := tfXBGR8ui1;
  2930. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2931. fglInternalFormat := GL_RGB8;
  2932. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  2933. {$ELSE}
  2934. fOpenGLFormat := tfRGB8ub3;
  2935. {$ENDIF}
  2936. end;
  2937. procedure TfdBGR10X2ui1.SetValues;
  2938. begin
  2939. inherited SetValues;
  2940. fBitsPerPixel := 32;
  2941. fFormat := tfBGR10X2ui1;
  2942. fWithAlpha := tfBGR10A2ui1;
  2943. fWithoutAlpha := tfBGR10X2ui1;
  2944. fRGBInverted := tfRGB10X2ui1;
  2945. fPrecision := glBitmapRec4ub(10, 10, 10, 0);
  2946. fShift := glBitmapRec4ub( 2, 12, 22, 0);
  2947. {$IFNDEF OPENGL_ES}
  2948. fOpenGLFormat := tfBGR10X2ui1;
  2949. fglFormat := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2950. fglInternalFormat := GL_RGB10;
  2951. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  2952. {$ELSE}
  2953. fOpenGLFormat := tfRGB16us3;
  2954. {$ENDIF}
  2955. end;
  2956. procedure TfdX2BGR10ui1.SetValues;
  2957. begin
  2958. inherited SetValues;
  2959. fBitsPerPixel := 32;
  2960. fFormat := tfX2BGR10ui1;
  2961. fWithAlpha := tfA2BGR10ui1;
  2962. fWithoutAlpha := tfX2BGR10ui1;
  2963. fRGBInverted := tfX2RGB10ui1;
  2964. fPrecision := glBitmapRec4ub(10, 10, 10, 0);
  2965. fShift := glBitmapRec4ub( 0, 10, 20, 0);
  2966. {$IFNDEF OPENGL_ES}
  2967. fOpenGLFormat := tfX2BGR10ui1;
  2968. fglFormat := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA
  2969. fglInternalFormat := GL_RGB10;
  2970. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  2971. {$ELSE}
  2972. fOpenGLFormat := tfRGB16us3;
  2973. {$ENDIF}
  2974. end;
  2975. procedure TfdBGR16us3.SetValues;
  2976. begin
  2977. inherited SetValues;
  2978. fBitsPerPixel := 48;
  2979. fFormat := tfBGR16us3;
  2980. fWithAlpha := tfBGRA16us4;
  2981. fWithoutAlpha := tfBGR16us3;
  2982. fRGBInverted := tfRGB16us3;
  2983. fPrecision := glBitmapRec4ub(16, 16, 16, 0);
  2984. fShift := glBitmapRec4ub(32, 16, 0, 0);
  2985. {$IFNDEF OPENGL_ES}
  2986. fOpenGLFormat := tfBGR16us3;
  2987. fglFormat := GL_BGR;
  2988. fglInternalFormat := GL_RGB16;
  2989. fglDataFormat := GL_UNSIGNED_SHORT;
  2990. {$ELSE}
  2991. fOpenGLFormat := tfRGB16us3;
  2992. {$ENDIF}
  2993. end;
  2994. procedure TfdBGRA4us1.SetValues;
  2995. begin
  2996. inherited SetValues;
  2997. fBitsPerPixel := 16;
  2998. fFormat := tfBGRA4us1;
  2999. fWithAlpha := tfBGRA4us1;
  3000. fWithoutAlpha := tfBGRX4us1;
  3001. fRGBInverted := tfRGBA4us1;
  3002. fPrecision := glBitmapRec4ub( 4, 4, 4, 4);
  3003. fShift := glBitmapRec4ub( 4, 8, 12, 0);
  3004. {$IFNDEF OPENGL_ES}
  3005. fOpenGLFormat := tfBGRA4us1;
  3006. fglFormat := GL_BGRA;
  3007. fglInternalFormat := GL_RGBA4;
  3008. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4;
  3009. {$ELSE}
  3010. fOpenGLFormat := tfRGBA4us1;
  3011. {$ENDIF}
  3012. end;
  3013. procedure TfdABGR4us1.SetValues;
  3014. begin
  3015. inherited SetValues;
  3016. fBitsPerPixel := 16;
  3017. fFormat := tfABGR4us1;
  3018. fWithAlpha := tfABGR4us1;
  3019. fWithoutAlpha := tfXBGR4us1;
  3020. fRGBInverted := tfARGB4us1;
  3021. fPrecision := glBitmapRec4ub( 4, 4, 4, 4);
  3022. fShift := glBitmapRec4ub( 0, 4, 8, 12);
  3023. {$IFNDEF OPENGL_ES}
  3024. fOpenGLFormat := tfABGR4us1;
  3025. fglFormat := GL_RGBA;
  3026. fglInternalFormat := GL_RGBA4;
  3027. fglDataFormat := GL_UNSIGNED_SHORT_4_4_4_4_REV;
  3028. {$ELSE}
  3029. fOpenGLFormat := tfRGBA4us1;
  3030. {$ENDIF}
  3031. end;
  3032. procedure TfdBGR5A1us1.SetValues;
  3033. begin
  3034. inherited SetValues;
  3035. fBitsPerPixel := 16;
  3036. fFormat := tfBGR5A1us1;
  3037. fWithAlpha := tfBGR5A1us1;
  3038. fWithoutAlpha := tfBGR5X1us1;
  3039. fRGBInverted := tfRGB5A1us1;
  3040. fPrecision := glBitmapRec4ub( 5, 5, 5, 1);
  3041. fShift := glBitmapRec4ub( 1, 6, 11, 0);
  3042. {$IFNDEF OPENGL_ES}
  3043. fOpenGLFormat := tfBGR5A1us1;
  3044. fglFormat := GL_BGRA;
  3045. fglInternalFormat := GL_RGB5_A1;
  3046. fglDataFormat := GL_UNSIGNED_SHORT_5_5_5_1;
  3047. {$ELSE}
  3048. fOpenGLFormat := tfRGB5A1us1;
  3049. {$ENDIF}
  3050. end;
  3051. procedure TfdA1BGR5us1.SetValues;
  3052. begin
  3053. inherited SetValues;
  3054. fBitsPerPixel := 16;
  3055. fFormat := tfA1BGR5us1;
  3056. fWithAlpha := tfA1BGR5us1;
  3057. fWithoutAlpha := tfX1BGR5us1;
  3058. fRGBInverted := tfA1RGB5us1;
  3059. fPrecision := glBitmapRec4ub( 5, 5, 5, 1);
  3060. fShift := glBitmapRec4ub( 0, 5, 10, 15);
  3061. {$IFNDEF OPENGL_ES}
  3062. fOpenGLFormat := tfA1BGR5us1;
  3063. fglFormat := GL_RGBA;
  3064. fglInternalFormat := GL_RGB5_A1;
  3065. fglDataFormat := GL_UNSIGNED_SHORT_1_5_5_5_REV;
  3066. {$ELSE}
  3067. fOpenGLFormat := tfRGB5A1us1;
  3068. {$ENDIF}
  3069. end;
  3070. procedure TfdBGRA8ui1.SetValues;
  3071. begin
  3072. inherited SetValues;
  3073. fBitsPerPixel := 32;
  3074. fFormat := tfBGRA8ui1;
  3075. fWithAlpha := tfBGRA8ui1;
  3076. fWithoutAlpha := tfBGRX8ui1;
  3077. fRGBInverted := tfRGBA8ui1;
  3078. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  3079. fShift := glBitmapRec4ub( 8, 16, 24, 0);
  3080. {$IFNDEF OPENGL_ES}
  3081. fOpenGLFormat := tfBGRA8ui1;
  3082. fglFormat := GL_BGRA;
  3083. fglInternalFormat := GL_RGBA8;
  3084. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8;
  3085. {$ELSE}
  3086. fOpenGLFormat := tfRGBA8ub4;
  3087. {$ENDIF}
  3088. end;
  3089. procedure TfdABGR8ui1.SetValues;
  3090. begin
  3091. inherited SetValues;
  3092. fBitsPerPixel := 32;
  3093. fFormat := tfABGR8ui1;
  3094. fWithAlpha := tfABGR8ui1;
  3095. fWithoutAlpha := tfXBGR8ui1;
  3096. fRGBInverted := tfARGB8ui1;
  3097. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  3098. fShift := glBitmapRec4ub( 0, 8, 16, 24);
  3099. {$IFNDEF OPENGL_ES}
  3100. fOpenGLFormat := tfABGR8ui1;
  3101. fglFormat := GL_RGBA;
  3102. fglInternalFormat := GL_RGBA8;
  3103. fglDataFormat := GL_UNSIGNED_INT_8_8_8_8_REV;
  3104. {$ELSE}
  3105. fOpenGLFormat := tfRGBA8ub4
  3106. {$ENDIF}
  3107. end;
  3108. procedure TfdBGRA8ub4.SetValues;
  3109. begin
  3110. inherited SetValues;
  3111. fBitsPerPixel := 32;
  3112. fFormat := tfBGRA8ub4;
  3113. fWithAlpha := tfBGRA8ub4;
  3114. fWithoutAlpha := tfBGR8ub3;
  3115. fRGBInverted := tfRGBA8ub4;
  3116. fPrecision := glBitmapRec4ub( 8, 8, 8, 8);
  3117. fShift := glBitmapRec4ub(16, 8, 0, 24);
  3118. {$IFNDEF OPENGL_ES}
  3119. fOpenGLFormat := tfBGRA8ub4;
  3120. fglFormat := GL_BGRA;
  3121. fglInternalFormat := GL_RGBA8;
  3122. fglDataFormat := GL_UNSIGNED_BYTE;
  3123. {$ELSE}
  3124. fOpenGLFormat := tfRGBA8ub4;
  3125. {$ENDIF}
  3126. end;
  3127. procedure TfdBGR10A2ui1.SetValues;
  3128. begin
  3129. inherited SetValues;
  3130. fBitsPerPixel := 32;
  3131. fFormat := tfBGR10A2ui1;
  3132. fWithAlpha := tfBGR10A2ui1;
  3133. fWithoutAlpha := tfBGR10X2ui1;
  3134. fRGBInverted := tfRGB10A2ui1;
  3135. fPrecision := glBitmapRec4ub(10, 10, 10, 2);
  3136. fShift := glBitmapRec4ub( 2, 12, 22, 0);
  3137. {$IFNDEF OPENGL_ES}
  3138. fOpenGLFormat := tfBGR10A2ui1;
  3139. fglFormat := GL_BGRA;
  3140. fglInternalFormat := GL_RGB10_A2;
  3141. fglDataFormat := GL_UNSIGNED_INT_10_10_10_2;
  3142. {$ELSE}
  3143. fOpenGLFormat := tfA2RGB10ui1;
  3144. {$ENDIF}
  3145. end;
  3146. procedure TfdA2BGR10ui1.SetValues;
  3147. begin
  3148. inherited SetValues;
  3149. fBitsPerPixel := 32;
  3150. fFormat := tfA2BGR10ui1;
  3151. fWithAlpha := tfA2BGR10ui1;
  3152. fWithoutAlpha := tfX2BGR10ui1;
  3153. fRGBInverted := tfA2RGB10ui1;
  3154. fPrecision := glBitmapRec4ub(10, 10, 10, 2);
  3155. fShift := glBitmapRec4ub( 0, 10, 20, 30);
  3156. {$IFNDEF OPENGL_ES}
  3157. fOpenGLFormat := tfA2BGR10ui1;
  3158. fglFormat := GL_RGBA;
  3159. fglInternalFormat := GL_RGB10_A2;
  3160. fglDataFormat := GL_UNSIGNED_INT_2_10_10_10_REV;
  3161. {$ELSE}
  3162. fOpenGLFormat := tfA2RGB10ui1;
  3163. {$ENDIF}
  3164. end;
  3165. procedure TfdBGRA16us4.SetValues;
  3166. begin
  3167. inherited SetValues;
  3168. fBitsPerPixel := 64;
  3169. fFormat := tfBGRA16us4;
  3170. fWithAlpha := tfBGRA16us4;
  3171. fWithoutAlpha := tfBGR16us3;
  3172. fRGBInverted := tfRGBA16us4;
  3173. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  3174. fShift := glBitmapRec4ub(32, 16, 0, 48);
  3175. {$IFNDEF OPENGL_ES}
  3176. fOpenGLFormat := tfBGRA16us4;
  3177. fglFormat := GL_BGRA;
  3178. fglInternalFormat := GL_RGBA16;
  3179. fglDataFormat := GL_UNSIGNED_SHORT;
  3180. {$ELSE}
  3181. fOpenGLFormat := tfRGBA16us4;
  3182. {$ENDIF}
  3183. end;
  3184. procedure TfdDepth16us1.SetValues;
  3185. begin
  3186. inherited SetValues;
  3187. fBitsPerPixel := 16;
  3188. fFormat := tfDepth16us1;
  3189. fWithoutAlpha := tfDepth16us1;
  3190. fPrecision := glBitmapRec4ub(16, 16, 16, 16);
  3191. fShift := glBitmapRec4ub( 0, 0, 0, 0);
  3192. {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  3193. fOpenGLFormat := tfDepth16us1;
  3194. fglFormat := GL_DEPTH_COMPONENT;
  3195. fglInternalFormat := GL_DEPTH_COMPONENT16;
  3196. fglDataFormat := GL_UNSIGNED_SHORT;
  3197. {$IFEND}
  3198. end;
  3199. procedure TfdDepth24ui1.SetValues;
  3200. begin
  3201. inherited SetValues;
  3202. fBitsPerPixel := 32;
  3203. fFormat := tfDepth24ui1;
  3204. fWithoutAlpha := tfDepth24ui1;
  3205. fOpenGLFormat := tfDepth24ui1;
  3206. fPrecision := glBitmapRec4ub(32, 32, 32, 32);
  3207. fShift := glBitmapRec4ub( 0, 0, 0, 0);
  3208. {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  3209. fOpenGLFormat := tfDepth24ui1;
  3210. fglFormat := GL_DEPTH_COMPONENT;
  3211. fglInternalFormat := GL_DEPTH_COMPONENT24;
  3212. fglDataFormat := GL_UNSIGNED_INT;
  3213. {$IFEND}
  3214. end;
  3215. procedure TfdDepth32ui1.SetValues;
  3216. begin
  3217. inherited SetValues;
  3218. fBitsPerPixel := 32;
  3219. fFormat := tfDepth32ui1;
  3220. fWithoutAlpha := tfDepth32ui1;
  3221. fPrecision := glBitmapRec4ub(32, 32, 32, 32);
  3222. fShift := glBitmapRec4ub( 0, 0, 0, 0);
  3223. {$IF NOT DEFINED(OPENGL_ES)}
  3224. fOpenGLFormat := tfDepth32ui1;
  3225. fglFormat := GL_DEPTH_COMPONENT;
  3226. fglInternalFormat := GL_DEPTH_COMPONENT32;
  3227. fglDataFormat := GL_UNSIGNED_INT;
  3228. {$ELSEIF DEFINED(OPENGL_ES_3_0)}
  3229. fOpenGLFormat := tfDepth24ui1;
  3230. {$ELSEIF DEFINED(OPENGL_ES_2_0)}
  3231. fOpenGLFormat := tfDepth16us1;
  3232. {$IFEND}
  3233. end;
  3234. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3235. //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3236. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3237. procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3238. begin
  3239. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3240. end;
  3241. procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3242. begin
  3243. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3244. end;
  3245. procedure TfdS3tcDtx1RGBA.SetValues;
  3246. begin
  3247. inherited SetValues;
  3248. fFormat := tfS3tcDtx1RGBA;
  3249. fWithAlpha := tfS3tcDtx1RGBA;
  3250. fUncompressed := tfRGB5A1us1;
  3251. fBitsPerPixel := 4;
  3252. fIsCompressed := true;
  3253. {$IFNDEF OPENGL_ES}
  3254. fOpenGLFormat := tfS3tcDtx1RGBA;
  3255. fglFormat := GL_COMPRESSED_RGBA;
  3256. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
  3257. fglDataFormat := GL_UNSIGNED_BYTE;
  3258. {$ELSE}
  3259. fOpenGLFormat := fUncompressed;
  3260. {$ENDIF}
  3261. end;
  3262. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3263. //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3264. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3265. procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3266. begin
  3267. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3268. end;
  3269. procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3270. begin
  3271. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3272. end;
  3273. procedure TfdS3tcDtx3RGBA.SetValues;
  3274. begin
  3275. inherited SetValues;
  3276. fFormat := tfS3tcDtx3RGBA;
  3277. fWithAlpha := tfS3tcDtx3RGBA;
  3278. fUncompressed := tfRGBA8ub4;
  3279. fBitsPerPixel := 8;
  3280. fIsCompressed := true;
  3281. {$IFNDEF OPENGL_ES}
  3282. fOpenGLFormat := tfS3tcDtx3RGBA;
  3283. fglFormat := GL_COMPRESSED_RGBA;
  3284. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
  3285. fglDataFormat := GL_UNSIGNED_BYTE;
  3286. {$ELSE}
  3287. fOpenGLFormat := fUncompressed;
  3288. {$ENDIF}
  3289. end;
  3290. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3291. //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3292. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3293. procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3294. begin
  3295. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3296. end;
  3297. procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3298. begin
  3299. raise EglBitmap.Create('mapping for compressed formats is not supported');
  3300. end;
  3301. procedure TfdS3tcDtx5RGBA.SetValues;
  3302. begin
  3303. inherited SetValues;
  3304. fFormat := tfS3tcDtx3RGBA;
  3305. fWithAlpha := tfS3tcDtx3RGBA;
  3306. fUncompressed := tfRGBA8ub4;
  3307. fBitsPerPixel := 8;
  3308. fIsCompressed := true;
  3309. {$IFNDEF OPENGL_ES}
  3310. fOpenGLFormat := tfS3tcDtx3RGBA;
  3311. fglFormat := GL_COMPRESSED_RGBA;
  3312. fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
  3313. fglDataFormat := GL_UNSIGNED_BYTE;
  3314. {$ELSE}
  3315. fOpenGLFormat := fUncompressed;
  3316. {$ENDIF}
  3317. end;
  3318. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3319. //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3320. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3321. function TglBitmapFormatDescriptor.GetHasRed: Boolean;
  3322. begin
  3323. result := (fPrecision.r > 0);
  3324. end;
  3325. function TglBitmapFormatDescriptor.GetHasGreen: Boolean;
  3326. begin
  3327. result := (fPrecision.g > 0);
  3328. end;
  3329. function TglBitmapFormatDescriptor.GetHasBlue: Boolean;
  3330. begin
  3331. result := (fPrecision.b > 0);
  3332. end;
  3333. function TglBitmapFormatDescriptor.GetHasAlpha: Boolean;
  3334. begin
  3335. result := (fPrecision.a > 0);
  3336. end;
  3337. function TglBitmapFormatDescriptor.GetHasColor: Boolean;
  3338. begin
  3339. result := HasRed or HasGreen or HasBlue;
  3340. end;
  3341. function TglBitmapFormatDescriptor.GetIsGrayscale: Boolean;
  3342. begin
  3343. result := (Mask.r = Mask.g) and (Mask.g = Mask.b) and (Mask.r > 0);
  3344. end;
  3345. function TglBitmapFormatDescriptor.GetHasOpenGLSupport: Boolean;
  3346. begin
  3347. result := (OpenGLFormat = Format);
  3348. end;
  3349. procedure TglBitmapFormatDescriptor.SetValues;
  3350. begin
  3351. fFormat := tfEmpty;
  3352. fWithAlpha := tfEmpty;
  3353. fWithoutAlpha := tfEmpty;
  3354. fOpenGLFormat := tfEmpty;
  3355. fRGBInverted := tfEmpty;
  3356. fUncompressed := tfEmpty;
  3357. fBitsPerPixel := 0;
  3358. fIsCompressed := false;
  3359. fglFormat := 0;
  3360. fglInternalFormat := 0;
  3361. fglDataFormat := 0;
  3362. FillChar(fPrecision, 0, SizeOf(fPrecision));
  3363. FillChar(fShift, 0, SizeOf(fShift));
  3364. end;
  3365. procedure TglBitmapFormatDescriptor.CalcValues;
  3366. var
  3367. i: Integer;
  3368. begin
  3369. fBytesPerPixel := fBitsPerPixel / 8;
  3370. fChannelCount := 0;
  3371. for i := 0 to 3 do begin
  3372. if (fPrecision.arr[i] > 0) then
  3373. inc(fChannelCount);
  3374. fRange.arr[i] := (1 shl fPrecision.arr[i]) - 1;
  3375. fMask.arr[i] := fRange.arr[i] shl fShift.arr[i];
  3376. end;
  3377. end;
  3378. function TglBitmapFormatDescriptor.GetSize(const aSize: TglBitmapSize): Integer;
  3379. var
  3380. w, h: Integer;
  3381. begin
  3382. if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin
  3383. w := Max(1, aSize.X);
  3384. h := Max(1, aSize.Y);
  3385. result := GetSize(w, h);
  3386. end else
  3387. result := 0;
  3388. end;
  3389. function TglBitmapFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;
  3390. begin
  3391. result := 0;
  3392. if (aWidth <= 0) or (aHeight <= 0) then
  3393. exit;
  3394. result := Ceil(aWidth * aHeight * BytesPerPixel);
  3395. end;
  3396. constructor TglBitmapFormatDescriptor.Create;
  3397. begin
  3398. inherited Create;
  3399. SetValues;
  3400. CalcValues;
  3401. end;
  3402. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3403. class function TglBitmapFormatDescriptor.GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;
  3404. var
  3405. f: TglBitmapFormat;
  3406. begin
  3407. for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin
  3408. result := TFormatDescriptor.Get(f);
  3409. if (result.glInternalFormat = aInternalFormat) then
  3410. exit;
  3411. end;
  3412. result := TFormatDescriptor.Get(tfEmpty);
  3413. end;
  3414. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3415. class function TglBitmapFormatDescriptor.GetByFormat(const aFormat: TglBitmapFormat): TglBitmapFormatDescriptor;
  3416. begin
  3417. result := TFormatDescriptor.Get(aFormat);
  3418. if not Assigned(result) then
  3419. result := TFormatDescriptor.Get(tfEmpty);
  3420. end;
  3421. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3422. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3423. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3424. class procedure TFormatDescriptor.Init;
  3425. begin
  3426. if not Assigned(FormatDescriptorCS) then
  3427. FormatDescriptorCS := TCriticalSection.Create;
  3428. end;
  3429. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3430. class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3431. begin
  3432. FormatDescriptorCS.Enter;
  3433. try
  3434. result := FormatDescriptors[aFormat];
  3435. if not Assigned(result) then begin
  3436. result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;
  3437. FormatDescriptors[aFormat] := result;
  3438. end;
  3439. finally
  3440. FormatDescriptorCS.Leave;
  3441. end;
  3442. end;
  3443. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3444. class function TFormatDescriptor.GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;
  3445. begin
  3446. result := Get(Get(aFormat).WithAlpha);
  3447. end;
  3448. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3449. class function TFormatDescriptor.GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer): TFormatDescriptor;
  3450. var
  3451. ft: TglBitmapFormat;
  3452. begin
  3453. // find matching format with OpenGL support
  3454. for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  3455. result := Get(ft);
  3456. if (result.MaskMatch(aMask)) and
  3457. (result.glFormat <> 0) and
  3458. (result.glInternalFormat <> 0) and
  3459. ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
  3460. then
  3461. exit;
  3462. end;
  3463. // find matching format without OpenGL Support
  3464. for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  3465. result := Get(ft);
  3466. if result.MaskMatch(aMask) and ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
  3467. exit;
  3468. end;
  3469. result := TFormatDescriptor.Get(tfEmpty);
  3470. end;
  3471. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3472. class function TFormatDescriptor.GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;
  3473. var
  3474. ft: TglBitmapFormat;
  3475. begin
  3476. // find matching format with OpenGL support
  3477. for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  3478. result := Get(ft);
  3479. if glBitmapRec4ubCompare(result.Shift, aShift) and
  3480. glBitmapRec4ubCompare(result.Precision, aPrec) and
  3481. (result.glFormat <> 0) and
  3482. (result.glInternalFormat <> 0) and
  3483. ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))
  3484. then
  3485. exit;
  3486. end;
  3487. // find matching format without OpenGL Support
  3488. for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  3489. result := Get(ft);
  3490. if glBitmapRec4ubCompare(result.Shift, aShift) and
  3491. glBitmapRec4ubCompare(result.Precision, aPrec) and
  3492. ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then
  3493. exit;
  3494. end;
  3495. result := TFormatDescriptor.Get(tfEmpty);
  3496. end;
  3497. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3498. class procedure TFormatDescriptor.Clear;
  3499. var
  3500. f: TglBitmapFormat;
  3501. begin
  3502. FormatDescriptorCS.Enter;
  3503. try
  3504. for f := low(FormatDescriptors) to high(FormatDescriptors) do
  3505. FreeAndNil(FormatDescriptors[f]);
  3506. finally
  3507. FormatDescriptorCS.Leave;
  3508. end;
  3509. end;
  3510. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3511. class procedure TFormatDescriptor.Finalize;
  3512. begin
  3513. Clear;
  3514. FreeAndNil(FormatDescriptorCS);
  3515. end;
  3516. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3517. //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3518. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3519. procedure TbmpBitfieldFormat.SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul);
  3520. var
  3521. i: Integer;
  3522. begin
  3523. for i := 0 to 3 do begin
  3524. fShift.arr[i] := 0;
  3525. while (aMask.arr[i] > 0) and ((aMask.arr[i] and 1) = 0) do begin
  3526. aMask.arr[i] := aMask.arr[i] shr 1;
  3527. inc(fShift.arr[i]);
  3528. end;
  3529. fPrecision.arr[i] := CountSetBits(aMask.arr[i]);
  3530. end;
  3531. fBitsPerPixel := aBPP;
  3532. CalcValues;
  3533. end;
  3534. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3535. procedure TbmpBitfieldFormat.SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub);
  3536. begin
  3537. fBitsPerPixel := aBBP;
  3538. fPrecision := aPrec;
  3539. fShift := aShift;
  3540. CalcValues;
  3541. end;
  3542. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3543. procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3544. var
  3545. data: QWord;
  3546. begin
  3547. data :=
  3548. ((aPixel.Data.r and Range.r) shl Shift.r) or
  3549. ((aPixel.Data.g and Range.g) shl Shift.g) or
  3550. ((aPixel.Data.b and Range.b) shl Shift.b) or
  3551. ((aPixel.Data.a and Range.a) shl Shift.a);
  3552. case BitsPerPixel of
  3553. 8: aData^ := data;
  3554. 16: PWord(aData)^ := data;
  3555. 32: PCardinal(aData)^ := data;
  3556. 64: PQWord(aData)^ := data;
  3557. else
  3558. raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
  3559. end;
  3560. inc(aData, Round(BytesPerPixel));
  3561. end;
  3562. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3563. procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3564. var
  3565. data: QWord;
  3566. i: Integer;
  3567. begin
  3568. case BitsPerPixel of
  3569. 8: data := aData^;
  3570. 16: data := PWord(aData)^;
  3571. 32: data := PCardinal(aData)^;
  3572. 64: data := PQWord(aData)^;
  3573. else
  3574. raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);
  3575. end;
  3576. for i := 0 to 3 do
  3577. aPixel.Data.arr[i] := (data shr fShift.arr[i]) and Range.arr[i];
  3578. inc(aData, Round(BytesPerPixel));
  3579. end;
  3580. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3581. //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3582. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3583. procedure TbmpColorTableFormat.SetValues;
  3584. begin
  3585. inherited SetValues;
  3586. fShift := glBitmapRec4ub(8, 8, 8, 0);
  3587. end;
  3588. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3589. procedure TbmpColorTableFormat.SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub);
  3590. begin
  3591. fFormat := aFormat;
  3592. fBitsPerPixel := aBPP;
  3593. fPrecision := aPrec;
  3594. fShift := aShift;
  3595. CalcValues;
  3596. end;
  3597. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3598. procedure TbmpColorTableFormat.CalcValues;
  3599. begin
  3600. inherited CalcValues;
  3601. end;
  3602. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3603. procedure TbmpColorTableFormat.CreateColorTable;
  3604. var
  3605. i: Integer;
  3606. begin
  3607. SetLength(fColorTable, 256);
  3608. if not HasColor then begin
  3609. // alpha
  3610. for i := 0 to High(fColorTable) do begin
  3611. fColorTable[i].r := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
  3612. fColorTable[i].g := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
  3613. fColorTable[i].b := Round(((i shr Shift.a) and Range.a) / Range.a * 255);
  3614. fColorTable[i].a := 0;
  3615. end;
  3616. end else begin
  3617. // normal
  3618. for i := 0 to High(fColorTable) do begin
  3619. fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
  3620. fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
  3621. fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
  3622. fColorTable[i].a := 0;
  3623. end;
  3624. end;
  3625. end;
  3626. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3627. function TbmpColorTableFormat.CreateMappingData: Pointer;
  3628. begin
  3629. result := Pointer(0);
  3630. end;
  3631. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3632. procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
  3633. begin
  3634. if (BitsPerPixel <> 8) then
  3635. raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
  3636. if not HasColor then
  3637. // alpha
  3638. aData^ := aPixel.Data.a
  3639. else
  3640. // normal
  3641. aData^ := Round(
  3642. ((aPixel.Data.r shr Shift.r) and Range.r) * LUMINANCE_WEIGHT_R +
  3643. ((aPixel.Data.g shr Shift.g) and Range.g) * LUMINANCE_WEIGHT_G +
  3644. ((aPixel.Data.b shr Shift.b) and Range.b) * LUMINANCE_WEIGHT_B);
  3645. inc(aData);
  3646. end;
  3647. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3648. procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);
  3649. function ReadValue: Byte;
  3650. var
  3651. i: PtrUInt;
  3652. begin
  3653. if (BitsPerPixel = 8) then begin
  3654. result := aData^;
  3655. inc(aData);
  3656. end else begin
  3657. i := {%H-}PtrUInt(aMapData);
  3658. if (BitsPerPixel > 1) then
  3659. result := (aData^ shr i) and ((1 shl BitsPerPixel) - 1)
  3660. else
  3661. result := (aData^ shr (7-i)) and ((1 shl BitsPerPixel) - 1);
  3662. inc(i, BitsPerPixel);
  3663. while (i >= 8) do begin
  3664. inc(aData);
  3665. dec(i, 8);
  3666. end;
  3667. aMapData := {%H-}Pointer(i);
  3668. end;
  3669. end;
  3670. begin
  3671. if (BitsPerPixel > 8) then
  3672. raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');
  3673. with fColorTable[ReadValue] do begin
  3674. aPixel.Data.r := r;
  3675. aPixel.Data.g := g;
  3676. aPixel.Data.b := b;
  3677. aPixel.Data.a := a;
  3678. end;
  3679. end;
  3680. destructor TbmpColorTableFormat.Destroy;
  3681. begin
  3682. SetLength(fColorTable, 0);
  3683. inherited Destroy;
  3684. end;
  3685. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3686. //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3687. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3688. procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);
  3689. var
  3690. i: Integer;
  3691. begin
  3692. for i := 0 to 3 do begin
  3693. if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin
  3694. if (aSourceFD.Range.arr[i] > 0) then
  3695. aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])
  3696. else
  3697. aPixel.Data.arr[i] := 0;
  3698. end;
  3699. end;
  3700. end;
  3701. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3702. procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);
  3703. begin
  3704. with aFuncRec do begin
  3705. if (Source.Range.r > 0) then
  3706. Dest.Data.r := Source.Data.r;
  3707. if (Source.Range.g > 0) then
  3708. Dest.Data.g := Source.Data.g;
  3709. if (Source.Range.b > 0) then
  3710. Dest.Data.b := Source.Data.b;
  3711. if (Source.Range.a > 0) then
  3712. Dest.Data.a := Source.Data.a;
  3713. end;
  3714. end;
  3715. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3716. procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3717. var
  3718. i: Integer;
  3719. begin
  3720. with aFuncRec do begin
  3721. for i := 0 to 3 do
  3722. if (Source.Range.arr[i] > 0) then
  3723. Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);
  3724. end;
  3725. end;
  3726. type
  3727. TShiftData = packed record
  3728. case Integer of
  3729. 0: (r, g, b, a: SmallInt);
  3730. 1: (arr: array[0..3] of SmallInt);
  3731. end;
  3732. PShiftData = ^TShiftData;
  3733. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3734. procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);
  3735. var
  3736. i: Integer;
  3737. begin
  3738. with aFuncRec do
  3739. for i := 0 to 3 do
  3740. if (Source.Range.arr[i] > 0) then
  3741. Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];
  3742. end;
  3743. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3744. procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);
  3745. var
  3746. i: Integer;
  3747. begin
  3748. with aFuncRec do begin
  3749. Dest.Data := Source.Data;
  3750. for i := 0 to 3 do
  3751. if ({%H-}PtrUInt(Args) and (1 shl i) > 0) then
  3752. Dest.Data.arr[i] := Dest.Data.arr[i] xor Dest.Range.arr[i];
  3753. end;
  3754. end;
  3755. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3756. procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);
  3757. var
  3758. i: Integer;
  3759. begin
  3760. with aFuncRec do begin
  3761. for i := 0 to 3 do
  3762. Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];
  3763. end;
  3764. end;
  3765. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3766. procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3767. var
  3768. Temp: Single;
  3769. begin
  3770. with FuncRec do begin
  3771. if (FuncRec.Args = nil) then begin //source has no alpha
  3772. Temp :=
  3773. Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +
  3774. Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +
  3775. Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;
  3776. Dest.Data.a := Round(Dest.Range.a * Temp);
  3777. end else
  3778. Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);
  3779. end;
  3780. end;
  3781. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3782. procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3783. type
  3784. PglBitmapPixelData = ^TglBitmapPixelData;
  3785. begin
  3786. with FuncRec do begin
  3787. Dest.Data.r := Source.Data.r;
  3788. Dest.Data.g := Source.Data.g;
  3789. Dest.Data.b := Source.Data.b;
  3790. with PglBitmapPixelData(Args)^ do
  3791. if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and
  3792. (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and
  3793. (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then
  3794. Dest.Data.a := 0
  3795. else
  3796. Dest.Data.a := Dest.Range.a;
  3797. end;
  3798. end;
  3799. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3800. procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  3801. begin
  3802. with FuncRec do begin
  3803. Dest.Data.r := Source.Data.r;
  3804. Dest.Data.g := Source.Data.g;
  3805. Dest.Data.b := Source.Data.b;
  3806. Dest.Data.a := PCardinal(Args)^;
  3807. end;
  3808. end;
  3809. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3810. procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);
  3811. type
  3812. PRGBPix = ^TRGBPix;
  3813. TRGBPix = array [0..2] of byte;
  3814. var
  3815. Temp: Byte;
  3816. begin
  3817. while aWidth > 0 do begin
  3818. Temp := PRGBPix(aData)^[0];
  3819. PRGBPix(aData)^[0] := PRGBPix(aData)^[2];
  3820. PRGBPix(aData)^[2] := Temp;
  3821. if aHasAlpha then
  3822. Inc(aData, 4)
  3823. else
  3824. Inc(aData, 3);
  3825. dec(aWidth);
  3826. end;
  3827. end;
  3828. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3829. //TglBitmapData///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3830. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3831. function TglBitmapData.GetFormatDescriptor: TglBitmapFormatDescriptor;
  3832. begin
  3833. result := TFormatDescriptor.Get(fFormat);
  3834. end;
  3835. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3836. function TglBitmapData.GetWidth: Integer;
  3837. begin
  3838. if (ffX in fDimension.Fields) then
  3839. result := fDimension.X
  3840. else
  3841. result := -1;
  3842. end;
  3843. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3844. function TglBitmapData.GetHeight: Integer;
  3845. begin
  3846. if (ffY in fDimension.Fields) then
  3847. result := fDimension.Y
  3848. else
  3849. result := -1;
  3850. end;
  3851. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3852. function TglBitmapData.GetScanlines(const aIndex: Integer): PByte;
  3853. begin
  3854. if fHasScanlines and (aIndex >= Low(fScanlines)) and (aIndex <= High(fScanlines)) then
  3855. result := fScanlines[aIndex]
  3856. else
  3857. result := nil;
  3858. end;
  3859. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3860. procedure TglBitmapData.SetFormat(const aValue: TglBitmapFormat);
  3861. begin
  3862. if fFormat = aValue then
  3863. exit;
  3864. if TFormatDescriptor.Get(Format).BitsPerPixel <> TFormatDescriptor.Get(aValue).BitsPerPixel then
  3865. raise EglBitmapUnsupportedFormat.Create(Format);
  3866. SetData(fData, aValue, Width, Height);
  3867. end;
  3868. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3869. procedure TglBitmapData.PrepareResType(var aResource: String; var aResType: PChar);
  3870. var
  3871. TempPos: Integer;
  3872. begin
  3873. if not Assigned(aResType) then begin
  3874. TempPos := Pos('.', aResource);
  3875. aResType := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
  3876. aResource := UpperCase(Copy(aResource, 0, TempPos -1));
  3877. end;
  3878. end;
  3879. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3880. procedure TglBitmapData.UpdateScanlines;
  3881. var
  3882. w, h, i, LineWidth: Integer;
  3883. begin
  3884. w := Width;
  3885. h := Height;
  3886. fHasScanlines := Assigned(fData) and (w > 0) and (h > 0);
  3887. if fHasScanlines then begin
  3888. SetLength(fScanlines, h);
  3889. LineWidth := Trunc(w * FormatDescriptor.BytesPerPixel);
  3890. for i := 0 to h-1 do begin
  3891. fScanlines[i] := fData;
  3892. Inc(fScanlines[i], i * LineWidth);
  3893. end;
  3894. end else
  3895. SetLength(fScanlines, 0);
  3896. end;
  3897. {$IFDEF GLB_SUPPORT_PNG_READ}
  3898. {$IF DEFINED(GLB_LAZ_PNG)}
  3899. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3900. //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3901. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3902. function TglBitmapData.LoadPNG(const aStream: TStream): Boolean;
  3903. const
  3904. MAGIC_LEN = 8;
  3905. PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;
  3906. var
  3907. reader: TLazReaderPNG;
  3908. intf: TLazIntfImage;
  3909. StreamPos: Int64;
  3910. magic: String[MAGIC_LEN];
  3911. begin
  3912. result := true;
  3913. StreamPos := aStream.Position;
  3914. SetLength(magic, MAGIC_LEN);
  3915. aStream.Read(magic[1], MAGIC_LEN);
  3916. aStream.Position := StreamPos;
  3917. if (magic <> PNG_MAGIC) then begin
  3918. result := false;
  3919. exit;
  3920. end;
  3921. intf := TLazIntfImage.Create(0, 0);
  3922. reader := TLazReaderPNG.Create;
  3923. try try
  3924. reader.UpdateDescription := true;
  3925. reader.ImageRead(aStream, intf);
  3926. AssignFromLazIntfImage(intf);
  3927. except
  3928. result := false;
  3929. aStream.Position := StreamPos;
  3930. exit;
  3931. end;
  3932. finally
  3933. reader.Free;
  3934. intf.Free;
  3935. end;
  3936. end;
  3937. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
  3938. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3939. function TglBitmapData.LoadPNG(const aStream: TStream): Boolean;
  3940. var
  3941. Surface: PSDL_Surface;
  3942. RWops: PSDL_RWops;
  3943. begin
  3944. result := false;
  3945. RWops := glBitmapCreateRWops(aStream);
  3946. try
  3947. if IMG_isPNG(RWops) > 0 then begin
  3948. Surface := IMG_LoadPNG_RW(RWops);
  3949. try
  3950. AssignFromSurface(Surface);
  3951. result := true;
  3952. finally
  3953. SDL_FreeSurface(Surface);
  3954. end;
  3955. end;
  3956. finally
  3957. SDL_FreeRW(RWops);
  3958. end;
  3959. end;
  3960. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  3961. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3962. procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  3963. begin
  3964. TStream(png_get_io_ptr(png)).Read(buffer^, size);
  3965. end;
  3966. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  3967. function TglBitmapData.LoadPNG(const aStream: TStream): Boolean;
  3968. var
  3969. StreamPos: Int64;
  3970. signature: array [0..7] of byte;
  3971. png: png_structp;
  3972. png_info: png_infop;
  3973. TempHeight, TempWidth: Integer;
  3974. Format: TglBitmapFormat;
  3975. png_data: pByte;
  3976. png_rows: array of pByte;
  3977. Row, LineSize: Integer;
  3978. begin
  3979. result := false;
  3980. if not init_libPNG then
  3981. raise Exception.Create('LoadPNG - unable to initialize libPNG.');
  3982. try
  3983. // signature
  3984. StreamPos := aStream.Position;
  3985. aStream.Read(signature{%H-}, 8);
  3986. aStream.Position := StreamPos;
  3987. if png_check_sig(@signature, 8) <> 0 then begin
  3988. // png read struct
  3989. png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  3990. if png = nil then
  3991. raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');
  3992. // png info
  3993. png_info := png_create_info_struct(png);
  3994. if png_info = nil then begin
  3995. png_destroy_read_struct(@png, nil, nil);
  3996. raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');
  3997. end;
  3998. // set read callback
  3999. png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);
  4000. // read informations
  4001. png_read_info(png, png_info);
  4002. // size
  4003. TempHeight := png_get_image_height(png, png_info);
  4004. TempWidth := png_get_image_width(png, png_info);
  4005. // format
  4006. case png_get_color_type(png, png_info) of
  4007. PNG_COLOR_TYPE_GRAY:
  4008. Format := tfLuminance8ub1;
  4009. PNG_COLOR_TYPE_GRAY_ALPHA:
  4010. Format := tfLuminance8Alpha8us1;
  4011. PNG_COLOR_TYPE_RGB:
  4012. Format := tfRGB8ub3;
  4013. PNG_COLOR_TYPE_RGB_ALPHA:
  4014. Format := tfRGBA8ub4;
  4015. else
  4016. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  4017. end;
  4018. // cut upper 8 bit from 16 bit formats
  4019. if png_get_bit_depth(png, png_info) > 8 then
  4020. png_set_strip_16(png);
  4021. // expand bitdepth smaller than 8
  4022. if png_get_bit_depth(png, png_info) < 8 then
  4023. png_set_expand(png);
  4024. // allocating mem for scanlines
  4025. LineSize := png_get_rowbytes(png, png_info);
  4026. GetMem(png_data, TempHeight * LineSize);
  4027. try
  4028. SetLength(png_rows, TempHeight);
  4029. for Row := Low(png_rows) to High(png_rows) do begin
  4030. png_rows[Row] := png_data;
  4031. Inc(png_rows[Row], Row * LineSize);
  4032. end;
  4033. // read complete image into scanlines
  4034. png_read_image(png, @png_rows[0]);
  4035. // read end
  4036. png_read_end(png, png_info);
  4037. // destroy read struct
  4038. png_destroy_read_struct(@png, @png_info, nil);
  4039. SetLength(png_rows, 0);
  4040. // set new data
  4041. SetData(png_data, Format, TempWidth, TempHeight);
  4042. result := true;
  4043. except
  4044. if Assigned(png_data) then
  4045. FreeMem(png_data);
  4046. raise;
  4047. end;
  4048. end;
  4049. finally
  4050. quit_libPNG;
  4051. end;
  4052. end;
  4053. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  4054. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4055. function TglBitmapData.LoadPNG(const aStream: TStream): Boolean;
  4056. var
  4057. StreamPos: Int64;
  4058. Png: TPNGObject;
  4059. Header: String[8];
  4060. Row, Col, PixSize, LineSize: Integer;
  4061. NewImage, pSource, pDest, pAlpha: pByte;
  4062. PngFormat: TglBitmapFormat;
  4063. FormatDesc: TFormatDescriptor;
  4064. const
  4065. PngHeader: String[8] = #137#80#78#71#13#10#26#10;
  4066. begin
  4067. result := false;
  4068. StreamPos := aStream.Position;
  4069. aStream.Read(Header[0], SizeOf(Header));
  4070. aStream.Position := StreamPos;
  4071. {Test if the header matches}
  4072. if Header = PngHeader then begin
  4073. Png := TPNGObject.Create;
  4074. try
  4075. Png.LoadFromStream(aStream);
  4076. case Png.Header.ColorType of
  4077. COLOR_GRAYSCALE:
  4078. PngFormat := tfLuminance8ub1;
  4079. COLOR_GRAYSCALEALPHA:
  4080. PngFormat := tfLuminance8Alpha8us1;
  4081. COLOR_RGB:
  4082. PngFormat := tfBGR8ub3;
  4083. COLOR_RGBALPHA:
  4084. PngFormat := tfBGRA8ub4;
  4085. else
  4086. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  4087. end;
  4088. FormatDesc := TFormatDescriptor.Get(PngFormat);
  4089. PixSize := Round(FormatDesc.PixelSize);
  4090. LineSize := FormatDesc.GetSize(Png.Header.Width, 1);
  4091. GetMem(NewImage, LineSize * Integer(Png.Header.Height));
  4092. try
  4093. pDest := NewImage;
  4094. case Png.Header.ColorType of
  4095. COLOR_RGB, COLOR_GRAYSCALE:
  4096. begin
  4097. for Row := 0 to Png.Height -1 do begin
  4098. Move (Png.Scanline[Row]^, pDest^, LineSize);
  4099. Inc(pDest, LineSize);
  4100. end;
  4101. end;
  4102. COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
  4103. begin
  4104. PixSize := PixSize -1;
  4105. for Row := 0 to Png.Height -1 do begin
  4106. pSource := Png.Scanline[Row];
  4107. pAlpha := pByte(Png.AlphaScanline[Row]);
  4108. for Col := 0 to Png.Width -1 do begin
  4109. Move (pSource^, pDest^, PixSize);
  4110. Inc(pSource, PixSize);
  4111. Inc(pDest, PixSize);
  4112. pDest^ := pAlpha^;
  4113. inc(pAlpha);
  4114. Inc(pDest);
  4115. end;
  4116. end;
  4117. end;
  4118. else
  4119. raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');
  4120. end;
  4121. SetData(NewImage, PngFormat, Png.Header.Width, Png.Header.Height);
  4122. result := true;
  4123. except
  4124. if Assigned(NewImage) then
  4125. FreeMem(NewImage);
  4126. raise;
  4127. end;
  4128. finally
  4129. Png.Free;
  4130. end;
  4131. end;
  4132. end;
  4133. {$IFEND}
  4134. {$ENDIF}
  4135. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  4136. {$IFDEF GLB_LIB_PNG}
  4137. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4138. procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;
  4139. begin
  4140. TStream(png_get_io_ptr(png)).Write(buffer^, size);
  4141. end;
  4142. {$ENDIF}
  4143. {$IF DEFINED(GLB_LAZ_PNG)}
  4144. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4145. procedure TglBitmapData.SavePNG(const aStream: TStream);
  4146. var
  4147. png: TPortableNetworkGraphic;
  4148. intf: TLazIntfImage;
  4149. raw: TRawImage;
  4150. begin
  4151. png := TPortableNetworkGraphic.Create;
  4152. intf := TLazIntfImage.Create(0, 0);
  4153. try
  4154. if not AssignToLazIntfImage(intf) then
  4155. raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
  4156. intf.GetRawImage(raw);
  4157. png.LoadFromRawImage(raw, false);
  4158. png.SaveToStream(aStream);
  4159. finally
  4160. png.Free;
  4161. intf.Free;
  4162. end;
  4163. end;
  4164. {$ELSEIF DEFINED(GLB_LIB_PNG)}
  4165. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4166. procedure TglBitmapData.SavePNG(const aStream: TStream);
  4167. var
  4168. png: png_structp;
  4169. png_info: png_infop;
  4170. png_rows: array of pByte;
  4171. LineSize: Integer;
  4172. ColorType: Integer;
  4173. Row: Integer;
  4174. FormatDesc: TFormatDescriptor;
  4175. begin
  4176. if not (ftPNG in FormatGetSupportedFiles(Format)) then
  4177. raise EglBitmapUnsupportedFormat.Create(Format);
  4178. if not init_libPNG then
  4179. raise Exception.Create('unable to initialize libPNG.');
  4180. try
  4181. case Format of
  4182. tfAlpha8ub1, tfLuminance8ub1:
  4183. ColorType := PNG_COLOR_TYPE_GRAY;
  4184. tfLuminance8Alpha8us1:
  4185. ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;
  4186. tfBGR8ub3, tfRGB8ub3:
  4187. ColorType := PNG_COLOR_TYPE_RGB;
  4188. tfBGRA8ub4, tfRGBA8ub4:
  4189. ColorType := PNG_COLOR_TYPE_RGBA;
  4190. else
  4191. raise EglBitmapUnsupportedFormat.Create(Format);
  4192. end;
  4193. FormatDesc := TFormatDescriptor.Get(Format);
  4194. LineSize := FormatDesc.GetSize(Width, 1);
  4195. // creating array for scanline
  4196. SetLength(png_rows, Height);
  4197. try
  4198. for Row := 0 to Height - 1 do begin
  4199. png_rows[Row] := Data;
  4200. Inc(png_rows[Row], Row * LineSize)
  4201. end;
  4202. // write struct
  4203. png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);
  4204. if png = nil then
  4205. raise EglBitmapException.Create('SavePng - couldn''t create write struct.');
  4206. // create png info
  4207. png_info := png_create_info_struct(png);
  4208. if png_info = nil then begin
  4209. png_destroy_write_struct(@png, nil);
  4210. raise EglBitmapException.Create('SavePng - couldn''t create info struct.');
  4211. end;
  4212. // set read callback
  4213. png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);
  4214. // set compression
  4215. png_set_compression_level(png, 6);
  4216. if Format in [tfBGR8ub3, tfBGRA8ub4] then
  4217. png_set_bgr(png);
  4218. png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
  4219. png_write_info(png, png_info);
  4220. png_write_image(png, @png_rows[0]);
  4221. png_write_end(png, png_info);
  4222. png_destroy_write_struct(@png, @png_info);
  4223. finally
  4224. SetLength(png_rows, 0);
  4225. end;
  4226. finally
  4227. quit_libPNG;
  4228. end;
  4229. end;
  4230. {$ELSEIF DEFINED(GLB_PNGIMAGE)}
  4231. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4232. procedure TglBitmapData.SavePNG(const aStream: TStream);
  4233. var
  4234. Png: TPNGObject;
  4235. pSource, pDest: pByte;
  4236. X, Y, PixSize: Integer;
  4237. ColorType: Cardinal;
  4238. Alpha: Boolean;
  4239. pTemp: pByte;
  4240. Temp: Byte;
  4241. begin
  4242. if not (ftPNG in FormatGetSupportedFiles (Format)) then
  4243. raise EglBitmapUnsupportedFormat.Create(Format);
  4244. case Format of
  4245. tfAlpha8ub1, tfLuminance8ub1: begin
  4246. ColorType := COLOR_GRAYSCALE;
  4247. PixSize := 1;
  4248. Alpha := false;
  4249. end;
  4250. tfLuminance8Alpha8us1: begin
  4251. ColorType := COLOR_GRAYSCALEALPHA;
  4252. PixSize := 1;
  4253. Alpha := true;
  4254. end;
  4255. tfBGR8ub3, tfRGB8ub3: begin
  4256. ColorType := COLOR_RGB;
  4257. PixSize := 3;
  4258. Alpha := false;
  4259. end;
  4260. tfBGRA8ub4, tfRGBA8ub4: begin
  4261. ColorType := COLOR_RGBALPHA;
  4262. PixSize := 3;
  4263. Alpha := true
  4264. end;
  4265. else
  4266. raise EglBitmapUnsupportedFormat.Create(Format);
  4267. end;
  4268. Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);
  4269. try
  4270. // Copy ImageData
  4271. pSource := Data;
  4272. for Y := 0 to Height -1 do begin
  4273. pDest := png.ScanLine[Y];
  4274. for X := 0 to Width -1 do begin
  4275. Move(pSource^, pDest^, PixSize);
  4276. Inc(pDest, PixSize);
  4277. Inc(pSource, PixSize);
  4278. if Alpha then begin
  4279. png.AlphaScanline[Y]^[X] := pSource^;
  4280. Inc(pSource);
  4281. end;
  4282. end;
  4283. // convert RGB line to BGR
  4284. if Format in [tfRGB8ub3, tfRGBA8ub4] then begin
  4285. pTemp := png.ScanLine[Y];
  4286. for X := 0 to Width -1 do begin
  4287. Temp := pByteArray(pTemp)^[0];
  4288. pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];
  4289. pByteArray(pTemp)^[2] := Temp;
  4290. Inc(pTemp, 3);
  4291. end;
  4292. end;
  4293. end;
  4294. // Save to Stream
  4295. Png.CompressionLevel := 6;
  4296. Png.SaveToStream(aStream);
  4297. finally
  4298. FreeAndNil(Png);
  4299. end;
  4300. end;
  4301. {$IFEND}
  4302. {$ENDIF}
  4303. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4304. //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4305. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4306. {$IFDEF GLB_LIB_JPEG}
  4307. type
  4308. glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;
  4309. glBitmap_libJPEG_source_mgr = record
  4310. pub: jpeg_source_mgr;
  4311. SrcStream: TStream;
  4312. SrcBuffer: array [1..4096] of byte;
  4313. end;
  4314. glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;
  4315. glBitmap_libJPEG_dest_mgr = record
  4316. pub: jpeg_destination_mgr;
  4317. DestStream: TStream;
  4318. DestBuffer: array [1..4096] of byte;
  4319. end;
  4320. procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;
  4321. begin
  4322. //DUMMY
  4323. end;
  4324. procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;
  4325. begin
  4326. //DUMMY
  4327. end;
  4328. procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;
  4329. begin
  4330. //DUMMY
  4331. end;
  4332. procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;
  4333. begin
  4334. //DUMMY
  4335. end;
  4336. procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;
  4337. begin
  4338. //DUMMY
  4339. end;
  4340. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4341. function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;
  4342. var
  4343. src: glBitmap_libJPEG_source_mgr_ptr;
  4344. bytes: integer;
  4345. begin
  4346. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  4347. bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);
  4348. if (bytes <= 0) then begin
  4349. src^.SrcBuffer[1] := $FF;
  4350. src^.SrcBuffer[2] := JPEG_EOI;
  4351. bytes := 2;
  4352. end;
  4353. src^.pub.next_input_byte := @(src^.SrcBuffer[1]);
  4354. src^.pub.bytes_in_buffer := bytes;
  4355. result := true;
  4356. end;
  4357. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4358. procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;
  4359. var
  4360. src: glBitmap_libJPEG_source_mgr_ptr;
  4361. begin
  4362. src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);
  4363. if num_bytes > 0 then begin
  4364. // wanted byte isn't in buffer so set stream position and read buffer
  4365. if num_bytes > src^.pub.bytes_in_buffer then begin
  4366. src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;
  4367. src^.pub.fill_input_buffer(cinfo);
  4368. end else begin
  4369. // wanted byte is in buffer so only skip
  4370. inc(src^.pub.next_input_byte, num_bytes);
  4371. dec(src^.pub.bytes_in_buffer, num_bytes);
  4372. end;
  4373. end;
  4374. end;
  4375. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4376. function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;
  4377. var
  4378. dest: glBitmap_libJPEG_dest_mgr_ptr;
  4379. begin
  4380. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  4381. if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin
  4382. // write complete buffer
  4383. dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));
  4384. // reset buffer
  4385. dest^.pub.next_output_byte := @dest^.DestBuffer[1];
  4386. dest^.pub.free_in_buffer := Length(dest^.DestBuffer);
  4387. end;
  4388. result := true;
  4389. end;
  4390. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4391. procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;
  4392. var
  4393. Idx: Integer;
  4394. dest: glBitmap_libJPEG_dest_mgr_ptr;
  4395. begin
  4396. dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);
  4397. for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin
  4398. // check for endblock
  4399. if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin
  4400. // write endblock
  4401. dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);
  4402. // leave
  4403. break;
  4404. end else
  4405. dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);
  4406. end;
  4407. end;
  4408. {$ENDIF}
  4409. {$IFDEF GLB_SUPPORT_JPEG_READ}
  4410. {$IF DEFINED(GLB_LAZ_JPEG)}
  4411. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4412. function TglBitmapData.LoadJPEG(const aStream: TStream): Boolean;
  4413. const
  4414. MAGIC_LEN = 2;
  4415. JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;
  4416. var
  4417. intf: TLazIntfImage;
  4418. reader: TFPReaderJPEG;
  4419. StreamPos: Int64;
  4420. magic: String[MAGIC_LEN];
  4421. begin
  4422. result := true;
  4423. StreamPos := aStream.Position;
  4424. SetLength(magic, MAGIC_LEN);
  4425. aStream.Read(magic[1], MAGIC_LEN);
  4426. aStream.Position := StreamPos;
  4427. if (magic <> JPEG_MAGIC) then begin
  4428. result := false;
  4429. exit;
  4430. end;
  4431. reader := TFPReaderJPEG.Create;
  4432. intf := TLazIntfImage.Create(0, 0);
  4433. try try
  4434. intf.DataDescription := GetDescriptionFromDevice(0, 0, 0);
  4435. reader.ImageRead(aStream, intf);
  4436. AssignFromLazIntfImage(intf);
  4437. except
  4438. result := false;
  4439. aStream.Position := StreamPos;
  4440. exit;
  4441. end;
  4442. finally
  4443. reader.Free;
  4444. intf.Free;
  4445. end;
  4446. end;
  4447. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}
  4448. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4449. function TglBitmapData.LoadJPEG(const aStream: TStream): Boolean;
  4450. var
  4451. Surface: PSDL_Surface;
  4452. RWops: PSDL_RWops;
  4453. begin
  4454. result := false;
  4455. RWops := glBitmapCreateRWops(aStream);
  4456. try
  4457. if IMG_isJPG(RWops) > 0 then begin
  4458. Surface := IMG_LoadJPG_RW(RWops);
  4459. try
  4460. AssignFromSurface(Surface);
  4461. result := true;
  4462. finally
  4463. SDL_FreeSurface(Surface);
  4464. end;
  4465. end;
  4466. finally
  4467. SDL_FreeRW(RWops);
  4468. end;
  4469. end;
  4470. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  4471. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4472. function TglBitmapData.LoadJPEG(const aStream: TStream): Boolean;
  4473. var
  4474. StreamPos: Int64;
  4475. Temp: array[0..1]of Byte;
  4476. jpeg: jpeg_decompress_struct;
  4477. jpeg_err: jpeg_error_mgr;
  4478. IntFormat: TglBitmapFormat;
  4479. pImage: pByte;
  4480. TempHeight, TempWidth: Integer;
  4481. pTemp: pByte;
  4482. Row: Integer;
  4483. FormatDesc: TFormatDescriptor;
  4484. begin
  4485. result := false;
  4486. if not init_libJPEG then
  4487. raise Exception.Create('LoadJPG - unable to initialize libJPEG.');
  4488. try
  4489. // reading first two bytes to test file and set cursor back to begin
  4490. StreamPos := aStream.Position;
  4491. aStream.Read({%H-}Temp[0], 2);
  4492. aStream.Position := StreamPos;
  4493. // if Bitmap then read file.
  4494. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  4495. FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);
  4496. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  4497. // error managment
  4498. jpeg.err := jpeg_std_error(@jpeg_err);
  4499. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  4500. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  4501. // decompression struct
  4502. jpeg_create_decompress(@jpeg);
  4503. // allocation space for streaming methods
  4504. jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));
  4505. // seeting up custom functions
  4506. with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin
  4507. pub.init_source := glBitmap_libJPEG_init_source;
  4508. pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;
  4509. pub.skip_input_data := glBitmap_libJPEG_skip_input_data;
  4510. pub.resync_to_restart := jpeg_resync_to_restart; // use default method
  4511. pub.term_source := glBitmap_libJPEG_term_source;
  4512. pub.bytes_in_buffer := 0; // forces fill_input_buffer on first read
  4513. pub.next_input_byte := nil; // until buffer loaded
  4514. SrcStream := aStream;
  4515. end;
  4516. // set global decoding state
  4517. jpeg.global_state := DSTATE_START;
  4518. // read header of jpeg
  4519. jpeg_read_header(@jpeg, false);
  4520. // setting output parameter
  4521. case jpeg.jpeg_color_space of
  4522. JCS_GRAYSCALE:
  4523. begin
  4524. jpeg.out_color_space := JCS_GRAYSCALE;
  4525. IntFormat := tfLuminance8ub1;
  4526. end;
  4527. else
  4528. jpeg.out_color_space := JCS_RGB;
  4529. IntFormat := tfRGB8ub3;
  4530. end;
  4531. // reading image
  4532. jpeg_start_decompress(@jpeg);
  4533. TempHeight := jpeg.output_height;
  4534. TempWidth := jpeg.output_width;
  4535. FormatDesc := TFormatDescriptor.Get(IntFormat);
  4536. // creating new image
  4537. GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));
  4538. try
  4539. pTemp := pImage;
  4540. for Row := 0 to TempHeight -1 do begin
  4541. jpeg_read_scanlines(@jpeg, @pTemp, 1);
  4542. Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));
  4543. end;
  4544. // finish decompression
  4545. jpeg_finish_decompress(@jpeg);
  4546. // destroy decompression
  4547. jpeg_destroy_decompress(@jpeg);
  4548. SetData(pImage, IntFormat, TempWidth, TempHeight);
  4549. result := true;
  4550. except
  4551. if Assigned(pImage) then
  4552. FreeMem(pImage);
  4553. raise;
  4554. end;
  4555. end;
  4556. finally
  4557. quit_libJPEG;
  4558. end;
  4559. end;
  4560. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  4561. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4562. function TglBitmapData.LoadJPEG(const aStream: TStream): Boolean;
  4563. var
  4564. bmp: TBitmap;
  4565. jpg: TJPEGImage;
  4566. StreamPos: Int64;
  4567. Temp: array[0..1]of Byte;
  4568. begin
  4569. result := false;
  4570. // reading first two bytes to test file and set cursor back to begin
  4571. StreamPos := aStream.Position;
  4572. aStream.Read(Temp[0], 2);
  4573. aStream.Position := StreamPos;
  4574. // if Bitmap then read file.
  4575. if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin
  4576. bmp := TBitmap.Create;
  4577. try
  4578. jpg := TJPEGImage.Create;
  4579. try
  4580. jpg.LoadFromStream(aStream);
  4581. bmp.Assign(jpg);
  4582. result := AssignFromBitmap(bmp);
  4583. finally
  4584. jpg.Free;
  4585. end;
  4586. finally
  4587. bmp.Free;
  4588. end;
  4589. end;
  4590. end;
  4591. {$IFEND}
  4592. {$ENDIF}
  4593. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  4594. {$IF DEFINED(GLB_LAZ_JPEG)}
  4595. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4596. procedure TglBitmapData.SaveJPEG(const aStream: TStream);
  4597. var
  4598. jpeg: TJPEGImage;
  4599. intf: TLazIntfImage;
  4600. raw: TRawImage;
  4601. begin
  4602. jpeg := TJPEGImage.Create;
  4603. intf := TLazIntfImage.Create(0, 0);
  4604. try
  4605. if not AssignToLazIntfImage(intf) then
  4606. raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');
  4607. intf.GetRawImage(raw);
  4608. jpeg.LoadFromRawImage(raw, false);
  4609. jpeg.SaveToStream(aStream);
  4610. finally
  4611. intf.Free;
  4612. jpeg.Free;
  4613. end;
  4614. end;
  4615. {$ELSEIF DEFINED(GLB_LIB_JPEG)}
  4616. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4617. procedure TglBitmapData.SaveJPEG(const aStream: TStream);
  4618. var
  4619. jpeg: jpeg_compress_struct;
  4620. jpeg_err: jpeg_error_mgr;
  4621. Row: Integer;
  4622. pTemp, pTemp2: pByte;
  4623. procedure CopyRow(pDest, pSource: pByte);
  4624. var
  4625. X: Integer;
  4626. begin
  4627. for X := 0 to Width - 1 do begin
  4628. pByteArray(pDest)^[0] := pByteArray(pSource)^[2];
  4629. pByteArray(pDest)^[1] := pByteArray(pSource)^[1];
  4630. pByteArray(pDest)^[2] := pByteArray(pSource)^[0];
  4631. Inc(pDest, 3);
  4632. Inc(pSource, 3);
  4633. end;
  4634. end;
  4635. begin
  4636. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  4637. raise EglBitmapUnsupportedFormat.Create(Format);
  4638. if not init_libJPEG then
  4639. raise Exception.Create('SaveJPG - unable to initialize libJPEG.');
  4640. try
  4641. FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);
  4642. FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);
  4643. // error managment
  4644. jpeg.err := jpeg_std_error(@jpeg_err);
  4645. jpeg_err.error_exit := glBitmap_libJPEG_error_exit;
  4646. jpeg_err.output_message := glBitmap_libJPEG_output_message;
  4647. // compression struct
  4648. jpeg_create_compress(@jpeg);
  4649. // allocation space for streaming methods
  4650. jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));
  4651. // seeting up custom functions
  4652. with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin
  4653. pub.init_destination := glBitmap_libJPEG_init_destination;
  4654. pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;
  4655. pub.term_destination := glBitmap_libJPEG_term_destination;
  4656. pub.next_output_byte := @DestBuffer[1];
  4657. pub.free_in_buffer := Length(DestBuffer);
  4658. DestStream := aStream;
  4659. end;
  4660. // very important state
  4661. jpeg.global_state := CSTATE_START;
  4662. jpeg.image_width := Width;
  4663. jpeg.image_height := Height;
  4664. case Format of
  4665. tfAlpha8ub1, tfLuminance8ub1: begin
  4666. jpeg.input_components := 1;
  4667. jpeg.in_color_space := JCS_GRAYSCALE;
  4668. end;
  4669. tfRGB8ub3, tfBGR8ub3: begin
  4670. jpeg.input_components := 3;
  4671. jpeg.in_color_space := JCS_RGB;
  4672. end;
  4673. end;
  4674. jpeg_set_defaults(@jpeg);
  4675. jpeg_set_quality(@jpeg, 95, true);
  4676. jpeg_start_compress(@jpeg, true);
  4677. pTemp := Data;
  4678. if Format = tfBGR8ub3 then
  4679. GetMem(pTemp2, fRowSize)
  4680. else
  4681. pTemp2 := pTemp;
  4682. try
  4683. for Row := 0 to jpeg.image_height -1 do begin
  4684. // prepare row
  4685. if Format = tfBGR8ub3 then
  4686. CopyRow(pTemp2, pTemp)
  4687. else
  4688. pTemp2 := pTemp;
  4689. // write row
  4690. jpeg_write_scanlines(@jpeg, @pTemp2, 1);
  4691. inc(pTemp, fRowSize);
  4692. end;
  4693. finally
  4694. // free memory
  4695. if Format = tfBGR8ub3 then
  4696. FreeMem(pTemp2);
  4697. end;
  4698. jpeg_finish_compress(@jpeg);
  4699. jpeg_destroy_compress(@jpeg);
  4700. finally
  4701. quit_libJPEG;
  4702. end;
  4703. end;
  4704. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}
  4705. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4706. procedure TglBitmapData.SaveJPEG(const aStream: TStream);
  4707. var
  4708. Bmp: TBitmap;
  4709. Jpg: TJPEGImage;
  4710. begin
  4711. if not (ftJPEG in FormatGetSupportedFiles(Format)) then
  4712. raise EglBitmapUnsupportedFormat.Create(Format);
  4713. Bmp := TBitmap.Create;
  4714. try
  4715. Jpg := TJPEGImage.Create;
  4716. try
  4717. AssignToBitmap(Bmp);
  4718. if (Format in [tfAlpha8ub1, tfLuminance8ub1]) then begin
  4719. Jpg.Grayscale := true;
  4720. Jpg.PixelFormat := jf8Bit;
  4721. end;
  4722. Jpg.Assign(Bmp);
  4723. Jpg.SaveToStream(aStream);
  4724. finally
  4725. FreeAndNil(Jpg);
  4726. end;
  4727. finally
  4728. FreeAndNil(Bmp);
  4729. end;
  4730. end;
  4731. {$IFEND}
  4732. {$ENDIF}
  4733. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4734. //RAW/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4735. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4736. type
  4737. RawHeader = packed record
  4738. Magic: String[5];
  4739. Version: Byte;
  4740. Width: Integer;
  4741. Height: Integer;
  4742. DataSize: Integer;
  4743. BitsPerPixel: Integer;
  4744. Precision: TglBitmapRec4ub;
  4745. Shift: TglBitmapRec4ub;
  4746. end;
  4747. function TglBitmapData.LoadRAW(const aStream: TStream): Boolean;
  4748. var
  4749. header: RawHeader;
  4750. StartPos: Int64;
  4751. fd: TFormatDescriptor;
  4752. buf: PByte;
  4753. begin
  4754. result := false;
  4755. StartPos := aStream.Position;
  4756. aStream.Read(header{%H-}, SizeOf(header));
  4757. if (header.Magic <> 'glBMP') then begin
  4758. aStream.Position := StartPos;
  4759. exit;
  4760. end;
  4761. fd := TFormatDescriptor.GetFromPrecShift(header.Precision, header.Shift, header.BitsPerPixel);
  4762. if (fd.Format = tfEmpty) then
  4763. raise EglBitmapUnsupportedFormat.Create('no supported format found');
  4764. buf := GetMemory(header.DataSize);
  4765. aStream.Read(buf^, header.DataSize);
  4766. SetData(buf, fd.Format, header.Width, header.Height);
  4767. result := true;
  4768. end;
  4769. procedure TglBitmapData.SaveRAW(const aStream: TStream);
  4770. var
  4771. header: RawHeader;
  4772. fd: TFormatDescriptor;
  4773. begin
  4774. fd := TFormatDescriptor.Get(Format);
  4775. header.Magic := 'glBMP';
  4776. header.Version := 1;
  4777. header.Width := Width;
  4778. header.Height := Height;
  4779. header.DataSize := fd.GetSize(fDimension);
  4780. header.BitsPerPixel := fd.BitsPerPixel;
  4781. header.Precision := fd.Precision;
  4782. header.Shift := fd.Shift;
  4783. aStream.Write(header, SizeOf(header));
  4784. aStream.Write(Data^, header.DataSize);
  4785. end;
  4786. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4787. //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4788. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4789. const
  4790. BMP_MAGIC = $4D42;
  4791. BMP_COMP_RGB = 0;
  4792. BMP_COMP_RLE8 = 1;
  4793. BMP_COMP_RLE4 = 2;
  4794. BMP_COMP_BITFIELDS = 3;
  4795. type
  4796. TBMPHeader = packed record
  4797. bfType: Word;
  4798. bfSize: Cardinal;
  4799. bfReserved1: Word;
  4800. bfReserved2: Word;
  4801. bfOffBits: Cardinal;
  4802. end;
  4803. TBMPInfo = packed record
  4804. biSize: Cardinal;
  4805. biWidth: Longint;
  4806. biHeight: Longint;
  4807. biPlanes: Word;
  4808. biBitCount: Word;
  4809. biCompression: Cardinal;
  4810. biSizeImage: Cardinal;
  4811. biXPelsPerMeter: Longint;
  4812. biYPelsPerMeter: Longint;
  4813. biClrUsed: Cardinal;
  4814. biClrImportant: Cardinal;
  4815. end;
  4816. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4817. function TglBitmapData.LoadBMP(const aStream: TStream): Boolean;
  4818. //////////////////////////////////////////////////////////////////////////////////////////////////
  4819. function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapRec4ul): TglBitmapFormat;
  4820. var
  4821. tmp, i: Cardinal;
  4822. begin
  4823. result := tfEmpty;
  4824. aStream.Read(aInfo{%H-}, SizeOf(aInfo));
  4825. FillChar(aMask{%H-}, SizeOf(aMask), 0);
  4826. //Read Compression
  4827. case aInfo.biCompression of
  4828. BMP_COMP_RLE4,
  4829. BMP_COMP_RLE8: begin
  4830. raise EglBitmap.Create('RLE compression is not supported');
  4831. end;
  4832. BMP_COMP_BITFIELDS: begin
  4833. if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin
  4834. for i := 0 to 2 do begin
  4835. aStream.Read(tmp{%H-}, SizeOf(tmp));
  4836. aMask.arr[i] := tmp;
  4837. end;
  4838. end else
  4839. raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');
  4840. end;
  4841. end;
  4842. //get suitable format
  4843. case aInfo.biBitCount of
  4844. 8: result := tfLuminance8ub1;
  4845. 16: result := tfX1RGB5us1;
  4846. 24: result := tfBGR8ub3;
  4847. 32: result := tfXRGB8ui1;
  4848. end;
  4849. end;
  4850. function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
  4851. var
  4852. i, c: Integer;
  4853. fd: TFormatDescriptor;
  4854. ColorTable: TbmpColorTable;
  4855. begin
  4856. result := nil;
  4857. if (aInfo.biBitCount >= 16) then
  4858. exit;
  4859. aFormat := tfLuminance8ub1;
  4860. c := aInfo.biClrUsed;
  4861. if (c = 0) then
  4862. c := 1 shl aInfo.biBitCount;
  4863. SetLength(ColorTable, c);
  4864. for i := 0 to c-1 do begin
  4865. aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
  4866. if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
  4867. aFormat := tfRGB8ub3;
  4868. end;
  4869. fd := TFormatDescriptor.Get(aFormat);
  4870. result := TbmpColorTableFormat.Create;
  4871. result.ColorTable := ColorTable;
  4872. result.SetCustomValues(aFormat, aInfo.biBitCount, fd.Precision, fd.Shift);
  4873. end;
  4874. //////////////////////////////////////////////////////////////////////////////////////////////////
  4875. function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapRec4ul; const aInfo: TBMPInfo): TbmpBitfieldFormat;
  4876. var
  4877. fd: TFormatDescriptor;
  4878. begin
  4879. result := nil;
  4880. if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin
  4881. // find suitable format ...
  4882. fd := TFormatDescriptor.GetFromMask(aMask);
  4883. if (fd.Format <> tfEmpty) then begin
  4884. aFormat := fd.Format;
  4885. exit;
  4886. end;
  4887. // or create custom bitfield format
  4888. result := TbmpBitfieldFormat.Create;
  4889. result.SetCustomValues(aInfo.biBitCount, aMask);
  4890. end;
  4891. end;
  4892. var
  4893. //simple types
  4894. StartPos: Int64;
  4895. ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;
  4896. PaddingBuff: Cardinal;
  4897. LineBuf, ImageData, TmpData: PByte;
  4898. SourceMD, DestMD: Pointer;
  4899. BmpFormat: TglBitmapFormat;
  4900. //records
  4901. Mask: TglBitmapRec4ul;
  4902. Header: TBMPHeader;
  4903. Info: TBMPInfo;
  4904. //classes
  4905. SpecialFormat: TFormatDescriptor;
  4906. FormatDesc: TFormatDescriptor;
  4907. //////////////////////////////////////////////////////////////////////////////////////////////////
  4908. procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);
  4909. var
  4910. i: Integer;
  4911. Pixel: TglBitmapPixelData;
  4912. begin
  4913. aStream.Read(aLineBuf^, rbLineSize);
  4914. SpecialFormat.PreparePixel(Pixel);
  4915. for i := 0 to Info.biWidth-1 do begin
  4916. SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);
  4917. glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);
  4918. FormatDesc.Map(Pixel, aData, DestMD);
  4919. end;
  4920. end;
  4921. begin
  4922. result := false;
  4923. BmpFormat := tfEmpty;
  4924. SpecialFormat := nil;
  4925. LineBuf := nil;
  4926. SourceMD := nil;
  4927. DestMD := nil;
  4928. // Header
  4929. StartPos := aStream.Position;
  4930. aStream.Read(Header{%H-}, SizeOf(Header));
  4931. if Header.bfType = BMP_MAGIC then begin
  4932. try try
  4933. BmpFormat := ReadInfo(Info, Mask);
  4934. SpecialFormat := ReadColorTable(BmpFormat, Info);
  4935. if not Assigned(SpecialFormat) then
  4936. SpecialFormat := CheckBitfields(BmpFormat, Mask, Info);
  4937. aStream.Position := StartPos + Header.bfOffBits;
  4938. if (BmpFormat <> tfEmpty) then begin
  4939. FormatDesc := TFormatDescriptor.Get(BmpFormat);
  4940. rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize
  4941. wbLineSize := Trunc(Info.biWidth * FormatDesc.BytesPerPixel);
  4942. Padding := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;
  4943. //get Memory
  4944. DestMD := FormatDesc.CreateMappingData;
  4945. ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));
  4946. GetMem(ImageData, ImageSize);
  4947. if Assigned(SpecialFormat) then begin
  4948. GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields
  4949. SourceMD := SpecialFormat.CreateMappingData;
  4950. end;
  4951. //read Data
  4952. try try
  4953. FillChar(ImageData^, ImageSize, $FF);
  4954. TmpData := ImageData;
  4955. if (Info.biHeight > 0) then
  4956. Inc(TmpData, wbLineSize * (Info.biHeight-1));
  4957. for i := 0 to Abs(Info.biHeight)-1 do begin
  4958. if Assigned(SpecialFormat) then
  4959. SpecialFormatReadLine(TmpData, LineBuf) //if is special format read and convert data
  4960. else
  4961. aStream.Read(TmpData^, wbLineSize); //else only read data
  4962. if (Info.biHeight > 0) then
  4963. dec(TmpData, wbLineSize)
  4964. else
  4965. inc(TmpData, wbLineSize);
  4966. aStream.Read(PaddingBuff{%H-}, Padding);
  4967. end;
  4968. SetData(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight));
  4969. result := true;
  4970. finally
  4971. if Assigned(LineBuf) then
  4972. FreeMem(LineBuf);
  4973. if Assigned(SourceMD) then
  4974. SpecialFormat.FreeMappingData(SourceMD);
  4975. FormatDesc.FreeMappingData(DestMD);
  4976. end;
  4977. except
  4978. if Assigned(ImageData) then
  4979. FreeMem(ImageData);
  4980. raise;
  4981. end;
  4982. end else
  4983. raise EglBitmap.Create('LoadBMP - No suitable format found');
  4984. except
  4985. aStream.Position := StartPos;
  4986. raise;
  4987. end;
  4988. finally
  4989. FreeAndNil(SpecialFormat);
  4990. end;
  4991. end
  4992. else aStream.Position := StartPos;
  4993. end;
  4994. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  4995. procedure TglBitmapData.SaveBMP(const aStream: TStream);
  4996. var
  4997. Header: TBMPHeader;
  4998. Info: TBMPInfo;
  4999. Converter: TFormatDescriptor;
  5000. FormatDesc: TFormatDescriptor;
  5001. SourceFD, DestFD: Pointer;
  5002. pData, srcData, dstData, ConvertBuffer: pByte;
  5003. Pixel: TglBitmapPixelData;
  5004. ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;
  5005. RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
  5006. PaddingBuff: Cardinal;
  5007. function GetLineWidth : Integer;
  5008. begin
  5009. result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;
  5010. end;
  5011. begin
  5012. if not (ftBMP in FormatGetSupportedFiles(Format)) then
  5013. raise EglBitmapUnsupportedFormat.Create(Format);
  5014. Converter := nil;
  5015. FormatDesc := TFormatDescriptor.Get(Format);
  5016. ImageSize := FormatDesc.GetSize(Dimension);
  5017. FillChar(Header{%H-}, SizeOf(Header), 0);
  5018. Header.bfType := BMP_MAGIC;
  5019. Header.bfSize := SizeOf(Header) + SizeOf(Info) + ImageSize;
  5020. Header.bfReserved1 := 0;
  5021. Header.bfReserved2 := 0;
  5022. Header.bfOffBits := SizeOf(Header) + SizeOf(Info);
  5023. FillChar(Info{%H-}, SizeOf(Info), 0);
  5024. Info.biSize := SizeOf(Info);
  5025. Info.biWidth := Width;
  5026. Info.biHeight := Height;
  5027. Info.biPlanes := 1;
  5028. Info.biCompression := BMP_COMP_RGB;
  5029. Info.biSizeImage := ImageSize;
  5030. try
  5031. case Format of
  5032. tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1:
  5033. begin
  5034. Info.biBitCount := 8;
  5035. Header.bfSize := Header.bfSize + 256 * SizeOf(Cardinal);
  5036. Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
  5037. Converter := TbmpColorTableFormat.Create;
  5038. with (Converter as TbmpColorTableFormat) do begin
  5039. SetCustomValues(fFormat, 8, FormatDesc.Precision, FormatDesc.Shift);
  5040. CreateColorTable;
  5041. end;
  5042. end;
  5043. tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,
  5044. tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,
  5045. tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1:
  5046. begin
  5047. Info.biBitCount := 16;
  5048. Info.biCompression := BMP_COMP_BITFIELDS;
  5049. end;
  5050. tfBGR8ub3, tfRGB8ub3:
  5051. begin
  5052. Info.biBitCount := 24;
  5053. if (Format = tfRGB8ub3) then
  5054. Converter := TfdBGR8ub3.Create; //use BGR8 Format Descriptor to Swap RGB Values
  5055. end;
  5056. tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,
  5057. tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1:
  5058. begin
  5059. Info.biBitCount := 32;
  5060. Info.biCompression := BMP_COMP_BITFIELDS;
  5061. end;
  5062. else
  5063. raise EglBitmapUnsupportedFormat.Create(Format);
  5064. end;
  5065. Info.biXPelsPerMeter := 2835;
  5066. Info.biYPelsPerMeter := 2835;
  5067. // prepare bitmasks
  5068. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  5069. Header.bfSize := Header.bfSize + 4 * SizeOf(Cardinal);
  5070. Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
  5071. RedMask := FormatDesc.Mask.r;
  5072. GreenMask := FormatDesc.Mask.g;
  5073. BlueMask := FormatDesc.Mask.b;
  5074. AlphaMask := FormatDesc.Mask.a;
  5075. end;
  5076. // headers
  5077. aStream.Write(Header, SizeOf(Header));
  5078. aStream.Write(Info, SizeOf(Info));
  5079. // colortable
  5080. if Assigned(Converter) and (Converter is TbmpColorTableFormat) then
  5081. with (Converter as TbmpColorTableFormat) do
  5082. aStream.Write(ColorTable[0].b,
  5083. SizeOf(TbmpColorTableEnty) * Length(ColorTable));
  5084. // bitmasks
  5085. if Info.biCompression = BMP_COMP_BITFIELDS then begin
  5086. aStream.Write(RedMask, SizeOf(Cardinal));
  5087. aStream.Write(GreenMask, SizeOf(Cardinal));
  5088. aStream.Write(BlueMask, SizeOf(Cardinal));
  5089. aStream.Write(AlphaMask, SizeOf(Cardinal));
  5090. end;
  5091. // image data
  5092. rbLineSize := Round(Info.biWidth * FormatDesc.BytesPerPixel);
  5093. wbLineSize := Round(Info.biWidth * Info.biBitCount / 8);
  5094. Padding := GetLineWidth - wbLineSize;
  5095. PaddingBuff := 0;
  5096. pData := Data;
  5097. inc(pData, (Height-1) * rbLineSize);
  5098. // prepare row buffer. But only for RGB because RGBA supports color masks
  5099. // so it's possible to change color within the image.
  5100. if Assigned(Converter) then begin
  5101. FormatDesc.PreparePixel(Pixel);
  5102. GetMem(ConvertBuffer, wbLineSize);
  5103. SourceFD := FormatDesc.CreateMappingData;
  5104. DestFD := Converter.CreateMappingData;
  5105. end else
  5106. ConvertBuffer := nil;
  5107. try
  5108. for LineIdx := 0 to Height - 1 do begin
  5109. // preparing row
  5110. if Assigned(Converter) then begin
  5111. srcData := pData;
  5112. dstData := ConvertBuffer;
  5113. for PixelIdx := 0 to Info.biWidth-1 do begin
  5114. FormatDesc.Unmap(srcData, Pixel, SourceFD);
  5115. glBitmapConvertPixel(Pixel, FormatDesc, Converter);
  5116. Converter.Map(Pixel, dstData, DestFD);
  5117. end;
  5118. aStream.Write(ConvertBuffer^, wbLineSize);
  5119. end else begin
  5120. aStream.Write(pData^, rbLineSize);
  5121. end;
  5122. dec(pData, rbLineSize);
  5123. if (Padding > 0) then
  5124. aStream.Write(PaddingBuff, Padding);
  5125. end;
  5126. finally
  5127. // destroy row buffer
  5128. if Assigned(ConvertBuffer) then begin
  5129. FormatDesc.FreeMappingData(SourceFD);
  5130. Converter.FreeMappingData(DestFD);
  5131. FreeMem(ConvertBuffer);
  5132. end;
  5133. end;
  5134. finally
  5135. if Assigned(Converter) then
  5136. Converter.Free;
  5137. end;
  5138. end;
  5139. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5140. //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5141. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5142. type
  5143. TTGAHeader = packed record
  5144. ImageID: Byte;
  5145. ColorMapType: Byte;
  5146. ImageType: Byte;
  5147. //ColorMapSpec: Array[0..4] of Byte;
  5148. ColorMapStart: Word;
  5149. ColorMapLength: Word;
  5150. ColorMapEntrySize: Byte;
  5151. OrigX: Word;
  5152. OrigY: Word;
  5153. Width: Word;
  5154. Height: Word;
  5155. Bpp: Byte;
  5156. ImageDesc: Byte;
  5157. end;
  5158. const
  5159. TGA_UNCOMPRESSED_RGB = 2;
  5160. TGA_UNCOMPRESSED_GRAY = 3;
  5161. TGA_COMPRESSED_RGB = 10;
  5162. TGA_COMPRESSED_GRAY = 11;
  5163. TGA_NONE_COLOR_TABLE = 0;
  5164. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5165. function TglBitmapData.LoadTGA(const aStream: TStream): Boolean;
  5166. var
  5167. Header: TTGAHeader;
  5168. ImageData: System.PByte;
  5169. StartPosition: Int64;
  5170. PixelSize, LineSize: Integer;
  5171. tgaFormat: TglBitmapFormat;
  5172. FormatDesc: TFormatDescriptor;
  5173. Counter: packed record
  5174. X, Y: packed record
  5175. low, high, dir: Integer;
  5176. end;
  5177. end;
  5178. const
  5179. CACHE_SIZE = $4000;
  5180. ////////////////////////////////////////////////////////////////////////////////////////
  5181. procedure ReadUncompressed;
  5182. var
  5183. i, j: Integer;
  5184. buf, tmp1, tmp2: System.PByte;
  5185. begin
  5186. buf := nil;
  5187. if (Counter.X.dir < 0) then
  5188. GetMem(buf, LineSize);
  5189. try
  5190. while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin
  5191. tmp1 := ImageData;
  5192. inc(tmp1, (Counter.Y.low * LineSize)); //pointer to LineStart
  5193. if (Counter.X.dir < 0) then begin //flip X
  5194. aStream.Read(buf^, LineSize);
  5195. tmp2 := buf;
  5196. inc(tmp2, LineSize - PixelSize); //pointer to last pixel in line
  5197. for i := 0 to Header.Width-1 do begin //for all pixels in line
  5198. for j := 0 to PixelSize-1 do begin //for all bytes in pixel
  5199. tmp1^ := tmp2^;
  5200. inc(tmp1);
  5201. inc(tmp2);
  5202. end;
  5203. dec(tmp2, 2*PixelSize); //move 2 backwards, because j-loop moved 1 forward
  5204. end;
  5205. end else
  5206. aStream.Read(tmp1^, LineSize);
  5207. inc(Counter.Y.low, Counter.Y.dir); //move to next line index
  5208. end;
  5209. finally
  5210. if Assigned(buf) then
  5211. FreeMem(buf);
  5212. end;
  5213. end;
  5214. ////////////////////////////////////////////////////////////////////////////////////////
  5215. procedure ReadCompressed;
  5216. /////////////////////////////////////////////////////////////////
  5217. var
  5218. TmpData: System.PByte;
  5219. LinePixelsRead: Integer;
  5220. procedure CheckLine;
  5221. begin
  5222. if (LinePixelsRead >= Header.Width) then begin
  5223. LinePixelsRead := 0;
  5224. inc(Counter.Y.low, Counter.Y.dir); //next line index
  5225. TmpData := ImageData;
  5226. inc(TmpData, Counter.Y.low * LineSize); //set line
  5227. if (Counter.X.dir < 0) then //if x flipped then
  5228. inc(TmpData, LineSize - PixelSize); //set last pixel
  5229. end;
  5230. end;
  5231. /////////////////////////////////////////////////////////////////
  5232. var
  5233. Cache: PByte;
  5234. CacheSize, CachePos: Integer;
  5235. procedure CachedRead(out Buffer; Count: Integer);
  5236. var
  5237. BytesRead: Integer;
  5238. begin
  5239. if (CachePos + Count > CacheSize) then begin
  5240. //if buffer overflow save non read bytes
  5241. BytesRead := 0;
  5242. if (CacheSize - CachePos > 0) then begin
  5243. BytesRead := CacheSize - CachePos;
  5244. Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);
  5245. inc(CachePos, BytesRead);
  5246. end;
  5247. //load cache from file
  5248. CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);
  5249. aStream.Read(Cache^, CacheSize);
  5250. CachePos := 0;
  5251. //read rest of requested bytes
  5252. if (Count - BytesRead > 0) then begin
  5253. Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);
  5254. inc(CachePos, Count - BytesRead);
  5255. end;
  5256. end else begin
  5257. //if no buffer overflow just read the data
  5258. Move(PByteArray(Cache)^[CachePos], Buffer, Count);
  5259. inc(CachePos, Count);
  5260. end;
  5261. end;
  5262. procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);
  5263. begin
  5264. case PixelSize of
  5265. 1: begin
  5266. aBuffer^ := aData^;
  5267. inc(aBuffer, Counter.X.dir);
  5268. end;
  5269. 2: begin
  5270. PWord(aBuffer)^ := PWord(aData)^;
  5271. inc(aBuffer, 2 * Counter.X.dir);
  5272. end;
  5273. 3: begin
  5274. PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];
  5275. PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];
  5276. PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];
  5277. inc(aBuffer, 3 * Counter.X.dir);
  5278. end;
  5279. 4: begin
  5280. PCardinal(aBuffer)^ := PCardinal(aData)^;
  5281. inc(aBuffer, 4 * Counter.X.dir);
  5282. end;
  5283. end;
  5284. end;
  5285. var
  5286. TotalPixelsToRead, TotalPixelsRead: Integer;
  5287. Temp: Byte;
  5288. buf: array [0..3] of Byte; //1 pixel is max 32bit long
  5289. PixelRepeat: Boolean;
  5290. PixelsToRead, PixelCount: Integer;
  5291. begin
  5292. CacheSize := 0;
  5293. CachePos := 0;
  5294. TotalPixelsToRead := Header.Width * Header.Height;
  5295. TotalPixelsRead := 0;
  5296. LinePixelsRead := 0;
  5297. GetMem(Cache, CACHE_SIZE);
  5298. try
  5299. TmpData := ImageData;
  5300. inc(TmpData, Counter.Y.low * LineSize); //set line
  5301. if (Counter.X.dir < 0) then //if x flipped then
  5302. inc(TmpData, LineSize - PixelSize); //set last pixel
  5303. repeat
  5304. //read CommandByte
  5305. CachedRead(Temp, 1);
  5306. PixelRepeat := (Temp and $80) > 0;
  5307. PixelsToRead := (Temp and $7F) + 1;
  5308. inc(TotalPixelsRead, PixelsToRead);
  5309. if PixelRepeat then
  5310. CachedRead(buf[0], PixelSize);
  5311. while (PixelsToRead > 0) do begin
  5312. CheckLine;
  5313. PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF
  5314. while (PixelCount > 0) do begin
  5315. if not PixelRepeat then
  5316. CachedRead(buf[0], PixelSize);
  5317. PixelToBuffer(@buf[0], TmpData);
  5318. inc(LinePixelsRead);
  5319. dec(PixelsToRead);
  5320. dec(PixelCount);
  5321. end;
  5322. end;
  5323. until (TotalPixelsRead >= TotalPixelsToRead);
  5324. finally
  5325. FreeMem(Cache);
  5326. end;
  5327. end;
  5328. function IsGrayFormat: Boolean;
  5329. begin
  5330. result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];
  5331. end;
  5332. begin
  5333. result := false;
  5334. // reading header to test file and set cursor back to begin
  5335. StartPosition := aStream.Position;
  5336. aStream.Read(Header{%H-}, SizeOf(Header));
  5337. // no colormapped files
  5338. if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [
  5339. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then
  5340. begin
  5341. try
  5342. if Header.ImageID <> 0 then // skip image ID
  5343. aStream.Position := aStream.Position + Header.ImageID;
  5344. tgaFormat := tfEmpty;
  5345. case Header.Bpp of
  5346. 8: if IsGrayFormat then case (Header.ImageDesc and $F) of
  5347. 0: tgaFormat := tfLuminance8ub1;
  5348. 8: tgaFormat := tfAlpha8ub1;
  5349. end;
  5350. 16: if IsGrayFormat then case (Header.ImageDesc and $F) of
  5351. 0: tgaFormat := tfLuminance16us1;
  5352. 8: tgaFormat := tfLuminance8Alpha8ub2;
  5353. end else case (Header.ImageDesc and $F) of
  5354. 0: tgaFormat := tfX1RGB5us1;
  5355. 1: tgaFormat := tfA1RGB5us1;
  5356. 4: tgaFormat := tfARGB4us1;
  5357. end;
  5358. 24: if not IsGrayFormat then case (Header.ImageDesc and $F) of
  5359. 0: tgaFormat := tfBGR8ub3;
  5360. end;
  5361. 32: if IsGrayFormat then case (Header.ImageDesc and $F) of
  5362. 0: tgaFormat := tfDepth32ui1;
  5363. end else case (Header.ImageDesc and $F) of
  5364. 0: tgaFormat := tfX2RGB10ui1;
  5365. 2: tgaFormat := tfA2RGB10ui1;
  5366. 8: tgaFormat := tfARGB8ui1;
  5367. end;
  5368. end;
  5369. if (tgaFormat = tfEmpty) then
  5370. raise EglBitmap.Create('LoadTga - unsupported format');
  5371. FormatDesc := TFormatDescriptor.Get(tgaFormat);
  5372. PixelSize := FormatDesc.GetSize(1, 1);
  5373. LineSize := FormatDesc.GetSize(Header.Width, 1);
  5374. GetMem(ImageData, LineSize * Header.Height);
  5375. try
  5376. //column direction
  5377. if ((Header.ImageDesc and (1 shl 4)) > 0) then begin
  5378. Counter.X.low := Header.Height-1;;
  5379. Counter.X.high := 0;
  5380. Counter.X.dir := -1;
  5381. end else begin
  5382. Counter.X.low := 0;
  5383. Counter.X.high := Header.Height-1;
  5384. Counter.X.dir := 1;
  5385. end;
  5386. // Row direction
  5387. if ((Header.ImageDesc and (1 shl 5)) > 0) then begin
  5388. Counter.Y.low := 0;
  5389. Counter.Y.high := Header.Height-1;
  5390. Counter.Y.dir := 1;
  5391. end else begin
  5392. Counter.Y.low := Header.Height-1;;
  5393. Counter.Y.high := 0;
  5394. Counter.Y.dir := -1;
  5395. end;
  5396. // Read Image
  5397. case Header.ImageType of
  5398. TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:
  5399. ReadUncompressed;
  5400. TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:
  5401. ReadCompressed;
  5402. end;
  5403. SetData(ImageData, tgaFormat, Header.Width, Header.Height);
  5404. result := true;
  5405. except
  5406. if Assigned(ImageData) then
  5407. FreeMem(ImageData);
  5408. raise;
  5409. end;
  5410. finally
  5411. aStream.Position := StartPosition;
  5412. end;
  5413. end
  5414. else aStream.Position := StartPosition;
  5415. end;
  5416. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5417. procedure TglBitmapData.SaveTGA(const aStream: TStream);
  5418. var
  5419. Header: TTGAHeader;
  5420. Size: Integer;
  5421. FormatDesc: TFormatDescriptor;
  5422. begin
  5423. if not (ftTGA in FormatGetSupportedFiles(Format)) then
  5424. raise EglBitmapUnsupportedFormat.Create(Format);
  5425. //prepare header
  5426. FormatDesc := TFormatDescriptor.Get(Format);
  5427. FillChar(Header{%H-}, SizeOf(Header), 0);
  5428. Header.ImageDesc := CountSetBits(FormatDesc.Range.a) and $F;
  5429. Header.Bpp := FormatDesc.BitsPerPixel;
  5430. Header.Width := Width;
  5431. Header.Height := Height;
  5432. Header.ImageDesc := Header.ImageDesc or $20; //flip y
  5433. if FormatDesc.IsGrayscale or (not FormatDesc.IsGrayscale and not FormatDesc.HasRed and FormatDesc.HasAlpha) then
  5434. Header.ImageType := TGA_UNCOMPRESSED_GRAY
  5435. else
  5436. Header.ImageType := TGA_UNCOMPRESSED_RGB;
  5437. aStream.Write(Header, SizeOf(Header));
  5438. // write Data
  5439. Size := FormatDesc.GetSize(Dimension);
  5440. aStream.Write(Data^, Size);
  5441. end;
  5442. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5443. //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5444. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5445. const
  5446. DDS_MAGIC: Cardinal = $20534444;
  5447. // DDS_header.dwFlags
  5448. DDSD_CAPS = $00000001;
  5449. DDSD_HEIGHT = $00000002;
  5450. DDSD_WIDTH = $00000004;
  5451. DDSD_PIXELFORMAT = $00001000;
  5452. // DDS_header.sPixelFormat.dwFlags
  5453. DDPF_ALPHAPIXELS = $00000001;
  5454. DDPF_ALPHA = $00000002;
  5455. DDPF_FOURCC = $00000004;
  5456. DDPF_RGB = $00000040;
  5457. DDPF_LUMINANCE = $00020000;
  5458. // DDS_header.sCaps.dwCaps1
  5459. DDSCAPS_TEXTURE = $00001000;
  5460. // DDS_header.sCaps.dwCaps2
  5461. DDSCAPS2_CUBEMAP = $00000200;
  5462. D3DFMT_DXT1 = $31545844;
  5463. D3DFMT_DXT3 = $33545844;
  5464. D3DFMT_DXT5 = $35545844;
  5465. type
  5466. TDDSPixelFormat = packed record
  5467. dwSize: Cardinal;
  5468. dwFlags: Cardinal;
  5469. dwFourCC: Cardinal;
  5470. dwRGBBitCount: Cardinal;
  5471. dwRBitMask: Cardinal;
  5472. dwGBitMask: Cardinal;
  5473. dwBBitMask: Cardinal;
  5474. dwABitMask: Cardinal;
  5475. end;
  5476. TDDSCaps = packed record
  5477. dwCaps1: Cardinal;
  5478. dwCaps2: Cardinal;
  5479. dwDDSX: Cardinal;
  5480. dwReserved: Cardinal;
  5481. end;
  5482. TDDSHeader = packed record
  5483. dwSize: Cardinal;
  5484. dwFlags: Cardinal;
  5485. dwHeight: Cardinal;
  5486. dwWidth: Cardinal;
  5487. dwPitchOrLinearSize: Cardinal;
  5488. dwDepth: Cardinal;
  5489. dwMipMapCount: Cardinal;
  5490. dwReserved: array[0..10] of Cardinal;
  5491. PixelFormat: TDDSPixelFormat;
  5492. Caps: TDDSCaps;
  5493. dwReserved2: Cardinal;
  5494. end;
  5495. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5496. function TglBitmapData.LoadDDS(const aStream: TStream): Boolean;
  5497. var
  5498. Header: TDDSHeader;
  5499. Converter: TbmpBitfieldFormat;
  5500. function GetDDSFormat: TglBitmapFormat;
  5501. var
  5502. fd: TFormatDescriptor;
  5503. i: Integer;
  5504. Mask: TglBitmapRec4ul;
  5505. Range: TglBitmapRec4ui;
  5506. match: Boolean;
  5507. begin
  5508. result := tfEmpty;
  5509. with Header.PixelFormat do begin
  5510. // Compresses
  5511. if ((dwFlags and DDPF_FOURCC) > 0) then begin
  5512. case Header.PixelFormat.dwFourCC of
  5513. D3DFMT_DXT1: result := tfS3tcDtx1RGBA;
  5514. D3DFMT_DXT3: result := tfS3tcDtx3RGBA;
  5515. D3DFMT_DXT5: result := tfS3tcDtx5RGBA;
  5516. end;
  5517. end else if ((dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE or DDPF_ALPHA)) > 0) then begin
  5518. // prepare masks
  5519. if ((dwFlags and DDPF_LUMINANCE) = 0) then begin
  5520. Mask.r := dwRBitMask;
  5521. Mask.g := dwGBitMask;
  5522. Mask.b := dwBBitMask;
  5523. end else begin
  5524. Mask.r := dwRBitMask;
  5525. Mask.g := dwRBitMask;
  5526. Mask.b := dwRBitMask;
  5527. end;
  5528. if (dwFlags and DDPF_ALPHAPIXELS > 0) then
  5529. Mask.a := dwABitMask
  5530. else
  5531. Mask.a := 0;;
  5532. //find matching format
  5533. fd := TFormatDescriptor.GetFromMask(Mask, dwRGBBitCount);
  5534. result := fd.Format;
  5535. if (result <> tfEmpty) then
  5536. exit;
  5537. //find format with same Range
  5538. for i := 0 to 3 do
  5539. Range.arr[i] := (2 shl CountSetBits(Mask.arr[i])) - 1;
  5540. for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin
  5541. fd := TFormatDescriptor.Get(result);
  5542. match := true;
  5543. for i := 0 to 3 do
  5544. if (fd.Range.arr[i] <> Range.arr[i]) then begin
  5545. match := false;
  5546. break;
  5547. end;
  5548. if match then
  5549. break;
  5550. end;
  5551. //no format with same range found -> use default
  5552. if (result = tfEmpty) then begin
  5553. if (dwABitMask > 0) then
  5554. result := tfRGBA8ui1
  5555. else
  5556. result := tfRGB8ub3;
  5557. end;
  5558. Converter := TbmpBitfieldFormat.Create;
  5559. Converter.SetCustomValues(dwRGBBitCount, glBitmapRec4ul(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask));
  5560. end;
  5561. end;
  5562. end;
  5563. var
  5564. StreamPos: Int64;
  5565. x, y, LineSize, RowSize, Magic: Cardinal;
  5566. NewImage, TmpData, RowData, SrcData: System.PByte;
  5567. SourceMD, DestMD: Pointer;
  5568. Pixel: TglBitmapPixelData;
  5569. ddsFormat: TglBitmapFormat;
  5570. FormatDesc: TFormatDescriptor;
  5571. begin
  5572. result := false;
  5573. Converter := nil;
  5574. StreamPos := aStream.Position;
  5575. // Magic
  5576. aStream.Read(Magic{%H-}, sizeof(Magic));
  5577. if (Magic <> DDS_MAGIC) then begin
  5578. aStream.Position := StreamPos;
  5579. exit;
  5580. end;
  5581. //Header
  5582. aStream.Read(Header{%H-}, sizeof(Header));
  5583. if (Header.dwSize <> SizeOf(Header)) or
  5584. ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>
  5585. (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then
  5586. begin
  5587. aStream.Position := StreamPos;
  5588. exit;
  5589. end;
  5590. if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then
  5591. raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');
  5592. ddsFormat := GetDDSFormat;
  5593. try
  5594. if (ddsFormat = tfEmpty) then
  5595. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  5596. FormatDesc := TFormatDescriptor.Get(ddsFormat);
  5597. LineSize := Trunc(Header.dwWidth * FormatDesc.BytesPerPixel);
  5598. GetMem(NewImage, Header.dwHeight * LineSize);
  5599. try
  5600. TmpData := NewImage;
  5601. //Converter needed
  5602. if Assigned(Converter) then begin
  5603. RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);
  5604. GetMem(RowData, RowSize);
  5605. SourceMD := Converter.CreateMappingData;
  5606. DestMD := FormatDesc.CreateMappingData;
  5607. try
  5608. for y := 0 to Header.dwHeight-1 do begin
  5609. TmpData := NewImage;
  5610. inc(TmpData, y * LineSize);
  5611. SrcData := RowData;
  5612. aStream.Read(SrcData^, RowSize);
  5613. for x := 0 to Header.dwWidth-1 do begin
  5614. Converter.Unmap(SrcData, Pixel, SourceMD);
  5615. glBitmapConvertPixel(Pixel, Converter, FormatDesc);
  5616. FormatDesc.Map(Pixel, TmpData, DestMD);
  5617. end;
  5618. end;
  5619. finally
  5620. Converter.FreeMappingData(SourceMD);
  5621. FormatDesc.FreeMappingData(DestMD);
  5622. FreeMem(RowData);
  5623. end;
  5624. end else
  5625. // Compressed
  5626. if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin
  5627. RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;
  5628. for Y := 0 to Header.dwHeight-1 do begin
  5629. aStream.Read(TmpData^, RowSize);
  5630. Inc(TmpData, LineSize);
  5631. end;
  5632. end else
  5633. // Uncompressed
  5634. if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin
  5635. RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;
  5636. for Y := 0 to Header.dwHeight-1 do begin
  5637. aStream.Read(TmpData^, RowSize);
  5638. Inc(TmpData, LineSize);
  5639. end;
  5640. end else
  5641. raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');
  5642. SetData(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight);
  5643. result := true;
  5644. except
  5645. if Assigned(NewImage) then
  5646. FreeMem(NewImage);
  5647. raise;
  5648. end;
  5649. finally
  5650. FreeAndNil(Converter);
  5651. end;
  5652. end;
  5653. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5654. procedure TglBitmapData.SaveDDS(const aStream: TStream);
  5655. var
  5656. Header: TDDSHeader;
  5657. FormatDesc: TFormatDescriptor;
  5658. begin
  5659. if not (ftDDS in FormatGetSupportedFiles(Format)) then
  5660. raise EglBitmapUnsupportedFormat.Create(Format);
  5661. FormatDesc := TFormatDescriptor.Get(Format);
  5662. // Generell
  5663. FillChar(Header{%H-}, SizeOf(Header), 0);
  5664. Header.dwSize := SizeOf(Header);
  5665. Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;
  5666. Header.dwWidth := Max(1, Width);
  5667. Header.dwHeight := Max(1, Height);
  5668. // Caps
  5669. Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;
  5670. // Pixelformat
  5671. Header.PixelFormat.dwSize := sizeof(Header);
  5672. if (FormatDesc.IsCompressed) then begin
  5673. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;
  5674. case Format of
  5675. tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;
  5676. tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;
  5677. tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;
  5678. end;
  5679. end else if not FormatDesc.HasColor and FormatDesc.HasAlpha then begin
  5680. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHA;
  5681. Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
  5682. Header.PixelFormat.dwABitMask := FormatDesc.Mask.a;
  5683. end else if FormatDesc.IsGrayscale then begin
  5684. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;
  5685. Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
  5686. Header.PixelFormat.dwRBitMask := FormatDesc.Mask.r;
  5687. Header.PixelFormat.dwABitMask := FormatDesc.Mask.a;
  5688. end else begin
  5689. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;
  5690. Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;
  5691. Header.PixelFormat.dwRBitMask := FormatDesc.Mask.r;
  5692. Header.PixelFormat.dwGBitMask := FormatDesc.Mask.g;
  5693. Header.PixelFormat.dwBBitMask := FormatDesc.Mask.b;
  5694. Header.PixelFormat.dwABitMask := FormatDesc.Mask.a;
  5695. end;
  5696. if (FormatDesc.HasAlpha) then
  5697. Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;
  5698. aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));
  5699. aStream.Write(Header, SizeOf(Header));
  5700. aStream.Write(Data^, FormatDesc.GetSize(Dimension));
  5701. end;
  5702. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5703. function TglBitmapData.FlipHorz: Boolean;
  5704. var
  5705. fd: TglBitmapFormatDescriptor;
  5706. Col, RowSize, PixelSize: Integer;
  5707. pTempDest, pDest, pSource: PByte;
  5708. begin
  5709. result := false;
  5710. fd := FormatDescriptor;
  5711. PixelSize := Ceil(fd.BytesPerPixel);
  5712. RowSize := fd.GetSize(Width, 1);
  5713. if Assigned(Data) and not fd.IsCompressed then begin
  5714. pSource := Data;
  5715. GetMem(pDest, RowSize);
  5716. try
  5717. pTempDest := pDest;
  5718. Inc(pTempDest, RowSize);
  5719. for Col := 0 to Width-1 do begin
  5720. dec(pTempDest, PixelSize); //dec before, because ptr is behind last byte of data
  5721. Move(pSource^, pTempDest^, PixelSize);
  5722. Inc(pSource, PixelSize);
  5723. end;
  5724. SetData(pDest, Format, Width);
  5725. result := true;
  5726. except
  5727. if Assigned(pDest) then
  5728. FreeMem(pDest);
  5729. raise;
  5730. end;
  5731. end;
  5732. end;
  5733. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5734. function TglBitmapData.FlipVert: Boolean;
  5735. var
  5736. fd: TglBitmapFormatDescriptor;
  5737. Row, RowSize, PixelSize: Integer;
  5738. TempDestData, DestData, SourceData: PByte;
  5739. begin
  5740. result := false;
  5741. fd := FormatDescriptor;
  5742. PixelSize := Ceil(fd.BytesPerPixel);
  5743. RowSize := fd.GetSize(Width, 1);
  5744. if Assigned(Data) then begin
  5745. SourceData := Data;
  5746. GetMem(DestData, Height * RowSize);
  5747. try
  5748. TempDestData := DestData;
  5749. Inc(TempDestData, Width * (Height -1) * PixelSize);
  5750. for Row := 0 to Height -1 do begin
  5751. Move(SourceData^, TempDestData^, RowSize);
  5752. Dec(TempDestData, RowSize);
  5753. Inc(SourceData, RowSize);
  5754. end;
  5755. SetData(DestData, Format, Width, Height);
  5756. result := true;
  5757. except
  5758. if Assigned(DestData) then
  5759. FreeMem(DestData);
  5760. raise;
  5761. end;
  5762. end;
  5763. end;
  5764. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5765. procedure TglBitmapData.LoadFromFile(const aFilename: String);
  5766. var
  5767. fs: TFileStream;
  5768. begin
  5769. if not FileExists(aFilename) then
  5770. raise EglBitmap.Create('file does not exist: ' + aFilename);
  5771. fs := TFileStream.Create(aFilename, fmOpenRead);
  5772. try
  5773. fs.Position := 0;
  5774. LoadFromStream(fs);
  5775. fFilename := aFilename;
  5776. finally
  5777. fs.Free;
  5778. end;
  5779. end;
  5780. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5781. procedure TglBitmapData.LoadFromStream(const aStream: TStream);
  5782. begin
  5783. {$IFDEF GLB_SUPPORT_PNG_READ}
  5784. if not LoadPNG(aStream) then
  5785. {$ENDIF}
  5786. {$IFDEF GLB_SUPPORT_JPEG_READ}
  5787. if not LoadJPEG(aStream) then
  5788. {$ENDIF}
  5789. if not LoadDDS(aStream) then
  5790. if not LoadTGA(aStream) then
  5791. if not LoadBMP(aStream) then
  5792. if not LoadRAW(aStream) then
  5793. raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');
  5794. end;
  5795. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5796. procedure TglBitmapData.LoadFromFunc(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat;
  5797. const aFunc: TglBitmapFunction; const aArgs: Pointer);
  5798. var
  5799. tmpData: PByte;
  5800. size: Integer;
  5801. begin
  5802. size := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  5803. GetMem(tmpData, size);
  5804. try
  5805. FillChar(tmpData^, size, #$FF);
  5806. SetData(tmpData, aFormat, aSize.X, aSize.Y);
  5807. except
  5808. if Assigned(tmpData) then
  5809. FreeMem(tmpData);
  5810. raise;
  5811. end;
  5812. Convert(Self, aFunc, false, aFormat, aArgs);
  5813. end;
  5814. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5815. procedure TglBitmapData.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
  5816. var
  5817. rs: TResourceStream;
  5818. begin
  5819. PrepareResType(aResource, aResType);
  5820. rs := TResourceStream.Create(aInstance, aResource, aResType);
  5821. try
  5822. LoadFromStream(rs);
  5823. finally
  5824. rs.Free;
  5825. end;
  5826. end;
  5827. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5828. procedure TglBitmapData.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  5829. var
  5830. rs: TResourceStream;
  5831. begin
  5832. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  5833. try
  5834. LoadFromStream(rs);
  5835. finally
  5836. rs.Free;
  5837. end;
  5838. end;
  5839. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5840. procedure TglBitmapData.SaveToFile(const aFilename: String; const aFileType: TglBitmapFileType);
  5841. var
  5842. fs: TFileStream;
  5843. begin
  5844. fs := TFileStream.Create(aFileName, fmCreate);
  5845. try
  5846. fs.Position := 0;
  5847. SaveToStream(fs, aFileType);
  5848. finally
  5849. fs.Free;
  5850. end;
  5851. end;
  5852. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5853. procedure TglBitmapData.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);
  5854. begin
  5855. case aFileType of
  5856. {$IFDEF GLB_SUPPORT_PNG_WRITE}
  5857. ftPNG: SavePNG(aStream);
  5858. {$ENDIF}
  5859. {$IFDEF GLB_SUPPORT_JPEG_WRITE}
  5860. ftJPEG: SaveJPEG(aStream);
  5861. {$ENDIF}
  5862. ftDDS: SaveDDS(aStream);
  5863. ftTGA: SaveTGA(aStream);
  5864. ftBMP: SaveBMP(aStream);
  5865. ftRAW: SaveRAW(aStream);
  5866. end;
  5867. end;
  5868. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5869. function TglBitmapData.Convert(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;
  5870. begin
  5871. result := Convert(Self, aFunc, aCreateTemp, Format, aArgs);
  5872. end;
  5873. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5874. function TglBitmapData.Convert(const aSource: TglBitmapData; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;
  5875. const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;
  5876. var
  5877. DestData, TmpData, SourceData: pByte;
  5878. TempHeight, TempWidth: Integer;
  5879. SourceFD, DestFD: TFormatDescriptor;
  5880. SourceMD, DestMD: Pointer;
  5881. FuncRec: TglBitmapFunctionRec;
  5882. begin
  5883. Assert(Assigned(Data));
  5884. Assert(Assigned(aSource));
  5885. Assert(Assigned(aSource.Data));
  5886. result := false;
  5887. if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin
  5888. SourceFD := TFormatDescriptor.Get(aSource.Format);
  5889. DestFD := TFormatDescriptor.Get(aFormat);
  5890. if (SourceFD.IsCompressed) then
  5891. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
  5892. if (DestFD.IsCompressed) then
  5893. raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);
  5894. // inkompatible Formats so CreateTemp
  5895. if (SourceFD.BitsPerPixel <> DestFD.BitsPerPixel) then
  5896. aCreateTemp := true;
  5897. // Values
  5898. TempHeight := Max(1, aSource.Height);
  5899. TempWidth := Max(1, aSource.Width);
  5900. FuncRec.Sender := Self;
  5901. FuncRec.Args := aArgs;
  5902. TmpData := nil;
  5903. if aCreateTemp then begin
  5904. GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
  5905. DestData := TmpData;
  5906. end else
  5907. DestData := Data;
  5908. try
  5909. SourceFD.PreparePixel(FuncRec.Source);
  5910. DestFD.PreparePixel (FuncRec.Dest);
  5911. SourceMD := SourceFD.CreateMappingData;
  5912. DestMD := DestFD.CreateMappingData;
  5913. FuncRec.Size := aSource.Dimension;
  5914. FuncRec.Position.Fields := FuncRec.Size.Fields;
  5915. try
  5916. SourceData := aSource.Data;
  5917. FuncRec.Position.Y := 0;
  5918. while FuncRec.Position.Y < TempHeight do begin
  5919. FuncRec.Position.X := 0;
  5920. while FuncRec.Position.X < TempWidth do begin
  5921. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  5922. aFunc(FuncRec);
  5923. DestFD.Map(FuncRec.Dest, DestData, DestMD);
  5924. inc(FuncRec.Position.X);
  5925. end;
  5926. inc(FuncRec.Position.Y);
  5927. end;
  5928. // Updating Image or InternalFormat
  5929. if aCreateTemp then
  5930. SetData(TmpData, aFormat, aSource.Width, aSource.Height)
  5931. else if (aFormat <> fFormat) then
  5932. Format := aFormat;
  5933. result := true;
  5934. finally
  5935. SourceFD.FreeMappingData(SourceMD);
  5936. DestFD.FreeMappingData(DestMD);
  5937. end;
  5938. except
  5939. if aCreateTemp and Assigned(TmpData) then
  5940. FreeMem(TmpData);
  5941. raise;
  5942. end;
  5943. end;
  5944. end;
  5945. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  5946. function TglBitmapData.ConvertTo(const aFormat: TglBitmapFormat): Boolean;
  5947. var
  5948. SourceFD, DestFD: TFormatDescriptor;
  5949. SourcePD, DestPD: TglBitmapPixelData;
  5950. ShiftData: TShiftData;
  5951. function DataIsIdentical: Boolean;
  5952. begin
  5953. result := SourceFD.MaskMatch(DestFD.Mask);
  5954. end;
  5955. function CanCopyDirect: Boolean;
  5956. begin
  5957. result :=
  5958. ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  5959. ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  5960. ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  5961. ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  5962. end;
  5963. function CanShift: Boolean;
  5964. begin
  5965. result :=
  5966. ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and
  5967. ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and
  5968. ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and
  5969. ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));
  5970. end;
  5971. function GetShift(aSource, aDest: Cardinal) : ShortInt;
  5972. begin
  5973. result := 0;
  5974. while (aSource > aDest) and (aSource > 0) do begin
  5975. inc(result);
  5976. aSource := aSource shr 1;
  5977. end;
  5978. end;
  5979. begin
  5980. if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin
  5981. SourceFD := TFormatDescriptor.Get(Format);
  5982. DestFD := TFormatDescriptor.Get(aFormat);
  5983. if DataIsIdentical then begin
  5984. result := true;
  5985. Format := aFormat;
  5986. exit;
  5987. end;
  5988. SourceFD.PreparePixel(SourcePD);
  5989. DestFD.PreparePixel (DestPD);
  5990. if CanCopyDirect then
  5991. result := Convert(Self, glBitmapConvertCopyFunc, false, aFormat)
  5992. else if CanShift then begin
  5993. ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);
  5994. ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);
  5995. ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);
  5996. ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);
  5997. result := Convert(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);
  5998. end else
  5999. result := Convert(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);
  6000. end else
  6001. result := true;
  6002. end;
  6003. {$IFDEF GLB_SDL}
  6004. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6005. function TglBitmapData.AssignToSurface(out aSurface: PSDL_Surface): Boolean;
  6006. var
  6007. Row, RowSize: Integer;
  6008. SourceData, TmpData: PByte;
  6009. TempDepth: Integer;
  6010. FormatDesc: TFormatDescriptor;
  6011. function GetRowPointer(Row: Integer): pByte;
  6012. begin
  6013. result := aSurface.pixels;
  6014. Inc(result, Row * RowSize);
  6015. end;
  6016. begin
  6017. result := false;
  6018. FormatDesc := TFormatDescriptor.Get(Format);
  6019. if FormatDesc.IsCompressed then
  6020. raise EglBitmapUnsupportedFormat.Create(Format);
  6021. if Assigned(Data) then begin
  6022. case Trunc(FormatDesc.PixelSize) of
  6023. 1: TempDepth := 8;
  6024. 2: TempDepth := 16;
  6025. 3: TempDepth := 24;
  6026. 4: TempDepth := 32;
  6027. else
  6028. raise EglBitmapUnsupportedFormat.Create(Format);
  6029. end;
  6030. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,
  6031. FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);
  6032. SourceData := Data;
  6033. RowSize := FormatDesc.GetSize(FileWidth, 1);
  6034. for Row := 0 to FileHeight-1 do begin
  6035. TmpData := GetRowPointer(Row);
  6036. if Assigned(TmpData) then begin
  6037. Move(SourceData^, TmpData^, RowSize);
  6038. inc(SourceData, RowSize);
  6039. end;
  6040. end;
  6041. result := true;
  6042. end;
  6043. end;
  6044. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6045. function TglBitmapData.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;
  6046. var
  6047. pSource, pData, pTempData: PByte;
  6048. Row, RowSize, TempWidth, TempHeight: Integer;
  6049. IntFormat: TglBitmapFormat;
  6050. fd: TFormatDescriptor;
  6051. Mask: TglBitmapMask;
  6052. function GetRowPointer(Row: Integer): pByte;
  6053. begin
  6054. result := aSurface^.pixels;
  6055. Inc(result, Row * RowSize);
  6056. end;
  6057. begin
  6058. result := false;
  6059. if (Assigned(aSurface)) then begin
  6060. with aSurface^.format^ do begin
  6061. Mask.r := RMask;
  6062. Mask.g := GMask;
  6063. Mask.b := BMask;
  6064. Mask.a := AMask;
  6065. IntFormat := TFormatDescriptor.GetFromMask(Mask).Format;
  6066. if (IntFormat = tfEmpty) then
  6067. raise EglBitmap.Create('AssignFromSurface - Invalid Pixelformat.');
  6068. end;
  6069. fd := TFormatDescriptor.Get(IntFormat);
  6070. TempWidth := aSurface^.w;
  6071. TempHeight := aSurface^.h;
  6072. RowSize := fd.GetSize(TempWidth, 1);
  6073. GetMem(pData, TempHeight * RowSize);
  6074. try
  6075. pTempData := pData;
  6076. for Row := 0 to TempHeight -1 do begin
  6077. pSource := GetRowPointer(Row);
  6078. if (Assigned(pSource)) then begin
  6079. Move(pSource^, pTempData^, RowSize);
  6080. Inc(pTempData, RowSize);
  6081. end;
  6082. end;
  6083. SetData(pData, IntFormat, TempWidth, TempHeight);
  6084. result := true;
  6085. except
  6086. if Assigned(pData) then
  6087. FreeMem(pData);
  6088. raise;
  6089. end;
  6090. end;
  6091. end;
  6092. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6093. function TglBitmapData.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;
  6094. var
  6095. Row, Col, AlphaInterleave: Integer;
  6096. pSource, pDest: PByte;
  6097. function GetRowPointer(Row: Integer): pByte;
  6098. begin
  6099. result := aSurface.pixels;
  6100. Inc(result, Row * Width);
  6101. end;
  6102. begin
  6103. result := false;
  6104. if Assigned(Data) then begin
  6105. if Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfBGRA8ub4, tfRGBA8ub4] then begin
  6106. aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);
  6107. AlphaInterleave := 0;
  6108. case Format of
  6109. tfLuminance8Alpha8ub2:
  6110. AlphaInterleave := 1;
  6111. tfBGRA8ub4, tfRGBA8ub4:
  6112. AlphaInterleave := 3;
  6113. end;
  6114. pSource := Data;
  6115. for Row := 0 to Height -1 do begin
  6116. pDest := GetRowPointer(Row);
  6117. if Assigned(pDest) then begin
  6118. for Col := 0 to Width -1 do begin
  6119. Inc(pSource, AlphaInterleave);
  6120. pDest^ := pSource^;
  6121. Inc(pDest);
  6122. Inc(pSource);
  6123. end;
  6124. end;
  6125. end;
  6126. result := true;
  6127. end;
  6128. end;
  6129. end;
  6130. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6131. function TglBitmapData.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
  6132. var
  6133. bmp: TglBitmap2D;
  6134. begin
  6135. bmp := TglBitmap2D.Create;
  6136. try
  6137. bmp.AssignFromSurface(aSurface);
  6138. result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);
  6139. finally
  6140. bmp.Free;
  6141. end;
  6142. end;
  6143. {$ENDIF}
  6144. {$IFDEF GLB_DELPHI}
  6145. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6146. function CreateGrayPalette: HPALETTE;
  6147. var
  6148. Idx: Integer;
  6149. Pal: PLogPalette;
  6150. begin
  6151. GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));
  6152. Pal.palVersion := $300;
  6153. Pal.palNumEntries := 256;
  6154. for Idx := 0 to Pal.palNumEntries - 1 do begin
  6155. Pal.palPalEntry[Idx].peRed := Idx;
  6156. Pal.palPalEntry[Idx].peGreen := Idx;
  6157. Pal.palPalEntry[Idx].peBlue := Idx;
  6158. Pal.palPalEntry[Idx].peFlags := 0;
  6159. end;
  6160. Result := CreatePalette(Pal^);
  6161. FreeMem(Pal);
  6162. end;
  6163. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6164. function TglBitmapData.AssignToBitmap(const aBitmap: TBitmap): Boolean;
  6165. var
  6166. Row, RowSize: Integer;
  6167. pSource, pData: PByte;
  6168. begin
  6169. result := false;
  6170. if Assigned(Data) then begin
  6171. if Assigned(aBitmap) then begin
  6172. aBitmap.Width := Width;
  6173. aBitmap.Height := Height;
  6174. case Format of
  6175. tfAlpha8ub1, tfLuminance8ub1: begin
  6176. aBitmap.PixelFormat := pf8bit;
  6177. aBitmap.Palette := CreateGrayPalette;
  6178. end;
  6179. tfRGB5A1us1:
  6180. aBitmap.PixelFormat := pf15bit;
  6181. tfR5G6B5us1:
  6182. aBitmap.PixelFormat := pf16bit;
  6183. tfRGB8ub3, tfBGR8ub3:
  6184. aBitmap.PixelFormat := pf24bit;
  6185. tfRGBA8ub4, tfBGRA8ub4:
  6186. aBitmap.PixelFormat := pf32bit;
  6187. else
  6188. raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');
  6189. end;
  6190. RowSize := FormatDescriptor.GetSize(Width, 1);
  6191. pSource := Data;
  6192. for Row := 0 to Height-1 do begin
  6193. pData := aBitmap.Scanline[Row];
  6194. Move(pSource^, pData^, RowSize);
  6195. Inc(pSource, RowSize);
  6196. if (Format in [tfRGB8ub3, tfRGBA8ub4]) then // swap RGB(A) to BGR(A)
  6197. SwapRGB(pData, Width, Format = tfRGBA8ub4);
  6198. end;
  6199. result := true;
  6200. end;
  6201. end;
  6202. end;
  6203. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6204. function TglBitmapData.AssignFromBitmap(const aBitmap: TBitmap): Boolean;
  6205. var
  6206. pSource, pData, pTempData: PByte;
  6207. Row, RowSize, TempWidth, TempHeight: Integer;
  6208. IntFormat: TglBitmapFormat;
  6209. begin
  6210. result := false;
  6211. if (Assigned(aBitmap)) then begin
  6212. case aBitmap.PixelFormat of
  6213. pf8bit:
  6214. IntFormat := tfLuminance8ub1;
  6215. pf15bit:
  6216. IntFormat := tfRGB5A1us1;
  6217. pf16bit:
  6218. IntFormat := tfR5G6B5us1;
  6219. pf24bit:
  6220. IntFormat := tfBGR8ub3;
  6221. pf32bit:
  6222. IntFormat := tfBGRA8ub4;
  6223. else
  6224. raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');
  6225. end;
  6226. TempWidth := aBitmap.Width;
  6227. TempHeight := aBitmap.Height;
  6228. RowSize := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);
  6229. GetMem(pData, TempHeight * RowSize);
  6230. try
  6231. pTempData := pData;
  6232. for Row := 0 to TempHeight -1 do begin
  6233. pSource := aBitmap.Scanline[Row];
  6234. if (Assigned(pSource)) then begin
  6235. Move(pSource^, pTempData^, RowSize);
  6236. Inc(pTempData, RowSize);
  6237. end;
  6238. end;
  6239. SetData(pData, IntFormat, TempWidth, TempHeight);
  6240. result := true;
  6241. except
  6242. if Assigned(pData) then
  6243. FreeMem(pData);
  6244. raise;
  6245. end;
  6246. end;
  6247. end;
  6248. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6249. function TglBitmapData.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
  6250. var
  6251. Row, Col, AlphaInterleave: Integer;
  6252. pSource, pDest: PByte;
  6253. begin
  6254. result := false;
  6255. if Assigned(Data) then begin
  6256. if (Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfRGBA8ub4, tfBGRA8ub4]) then begin
  6257. if Assigned(aBitmap) then begin
  6258. aBitmap.PixelFormat := pf8bit;
  6259. aBitmap.Palette := CreateGrayPalette;
  6260. aBitmap.Width := Width;
  6261. aBitmap.Height := Height;
  6262. case Format of
  6263. tfLuminance8Alpha8ub2:
  6264. AlphaInterleave := 1;
  6265. tfRGBA8ub4, tfBGRA8ub4:
  6266. AlphaInterleave := 3;
  6267. else
  6268. AlphaInterleave := 0;
  6269. end;
  6270. // Copy Data
  6271. pSource := Data;
  6272. for Row := 0 to Height -1 do begin
  6273. pDest := aBitmap.Scanline[Row];
  6274. if Assigned(pDest) then begin
  6275. for Col := 0 to Width -1 do begin
  6276. Inc(pSource, AlphaInterleave);
  6277. pDest^ := pSource^;
  6278. Inc(pDest);
  6279. Inc(pSource);
  6280. end;
  6281. end;
  6282. end;
  6283. result := true;
  6284. end;
  6285. end;
  6286. end;
  6287. end;
  6288. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6289. function TglBitmapData.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  6290. var
  6291. data: TglBitmapData;
  6292. begin
  6293. data := TglBitmapData.Create;
  6294. try
  6295. data.AssignFromBitmap(aBitmap);
  6296. result := AddAlphaFromDataObj(data, aFunc, aArgs);
  6297. finally
  6298. data.Free;
  6299. end;
  6300. end;
  6301. {$ENDIF}
  6302. {$IFDEF GLB_LAZARUS}
  6303. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6304. function TglBitmapData.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  6305. var
  6306. rid: TRawImageDescription;
  6307. FormatDesc: TFormatDescriptor;
  6308. begin
  6309. if not Assigned(Data) then
  6310. raise EglBitmap.Create('no pixel data assigned. load data before save');
  6311. result := false;
  6312. if not Assigned(aImage) or (Format = tfEmpty) then
  6313. exit;
  6314. FormatDesc := TFormatDescriptor.Get(Format);
  6315. if FormatDesc.IsCompressed then
  6316. exit;
  6317. FillChar(rid{%H-}, SizeOf(rid), 0);
  6318. if FormatDesc.IsGrayscale then
  6319. rid.Format := ricfGray
  6320. else
  6321. rid.Format := ricfRGBA;
  6322. rid.Width := Width;
  6323. rid.Height := Height;
  6324. rid.Depth := FormatDesc.BitsPerPixel;
  6325. rid.BitOrder := riboBitsInOrder;
  6326. rid.ByteOrder := riboLSBFirst;
  6327. rid.LineOrder := riloTopToBottom;
  6328. rid.LineEnd := rileTight;
  6329. rid.BitsPerPixel := FormatDesc.BitsPerPixel;
  6330. rid.RedPrec := CountSetBits(FormatDesc.Range.r);
  6331. rid.GreenPrec := CountSetBits(FormatDesc.Range.g);
  6332. rid.BluePrec := CountSetBits(FormatDesc.Range.b);
  6333. rid.AlphaPrec := CountSetBits(FormatDesc.Range.a);
  6334. rid.RedShift := FormatDesc.Shift.r;
  6335. rid.GreenShift := FormatDesc.Shift.g;
  6336. rid.BlueShift := FormatDesc.Shift.b;
  6337. rid.AlphaShift := FormatDesc.Shift.a;
  6338. rid.MaskBitsPerPixel := 0;
  6339. rid.PaletteColorCount := 0;
  6340. aImage.DataDescription := rid;
  6341. aImage.CreateData;
  6342. if not Assigned(aImage.PixelData) then
  6343. raise EglBitmap.Create('error while creating LazIntfImage');
  6344. Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));
  6345. result := true;
  6346. end;
  6347. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6348. function TglBitmapData.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
  6349. var
  6350. f: TglBitmapFormat;
  6351. FormatDesc: TFormatDescriptor;
  6352. ImageData: PByte;
  6353. ImageSize: Integer;
  6354. CanCopy: Boolean;
  6355. Mask: TglBitmapRec4ul;
  6356. procedure CopyConvert;
  6357. var
  6358. bfFormat: TbmpBitfieldFormat;
  6359. pSourceLine, pDestLine: PByte;
  6360. pSourceMD, pDestMD: Pointer;
  6361. Shift, Prec: TglBitmapRec4ub;
  6362. x, y: Integer;
  6363. pixel: TglBitmapPixelData;
  6364. begin
  6365. bfFormat := TbmpBitfieldFormat.Create;
  6366. with aImage.DataDescription do begin
  6367. Prec.r := RedPrec;
  6368. Prec.g := GreenPrec;
  6369. Prec.b := BluePrec;
  6370. Prec.a := AlphaPrec;
  6371. Shift.r := RedShift;
  6372. Shift.g := GreenShift;
  6373. Shift.b := BlueShift;
  6374. Shift.a := AlphaShift;
  6375. bfFormat.SetCustomValues(BitsPerPixel, Prec, Shift);
  6376. end;
  6377. pSourceMD := bfFormat.CreateMappingData;
  6378. pDestMD := FormatDesc.CreateMappingData;
  6379. try
  6380. for y := 0 to aImage.Height-1 do begin
  6381. pSourceLine := aImage.PixelData + y {%H-}* aImage.DataDescription.BytesPerLine;
  6382. pDestLine := ImageData + y * Round(FormatDesc.BytesPerPixel * aImage.Width);
  6383. for x := 0 to aImage.Width-1 do begin
  6384. bfFormat.Unmap(pSourceLine, pixel, pSourceMD);
  6385. FormatDesc.Map(pixel, pDestLine, pDestMD);
  6386. end;
  6387. end;
  6388. finally
  6389. FormatDesc.FreeMappingData(pDestMD);
  6390. bfFormat.FreeMappingData(pSourceMD);
  6391. bfFormat.Free;
  6392. end;
  6393. end;
  6394. begin
  6395. result := false;
  6396. if not Assigned(aImage) then
  6397. exit;
  6398. with aImage.DataDescription do begin
  6399. Mask.r := (QWord(1 shl RedPrec )-1) shl RedShift;
  6400. Mask.g := (QWord(1 shl GreenPrec)-1) shl GreenShift;
  6401. Mask.b := (QWord(1 shl BluePrec )-1) shl BlueShift;
  6402. Mask.a := (QWord(1 shl AlphaPrec)-1) shl AlphaShift;
  6403. end;
  6404. FormatDesc := TFormatDescriptor.GetFromMask(Mask);
  6405. f := FormatDesc.Format;
  6406. if (f = tfEmpty) then
  6407. exit;
  6408. CanCopy :=
  6409. (FormatDesc.BitsPerPixel = aImage.DataDescription.Depth) and
  6410. (aImage.DataDescription.BitsPerPixel = aImage.DataDescription.Depth);
  6411. ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
  6412. ImageData := GetMem(ImageSize);
  6413. try
  6414. if CanCopy then
  6415. Move(aImage.PixelData^, ImageData^, ImageSize)
  6416. else
  6417. CopyConvert;
  6418. SetData(ImageData, f, aImage.Width, aImage.Height);
  6419. except
  6420. if Assigned(ImageData) then
  6421. FreeMem(ImageData);
  6422. raise;
  6423. end;
  6424. result := true;
  6425. end;
  6426. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6427. function TglBitmapData.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
  6428. var
  6429. rid: TRawImageDescription;
  6430. FormatDesc: TFormatDescriptor;
  6431. Pixel: TglBitmapPixelData;
  6432. x, y: Integer;
  6433. srcMD: Pointer;
  6434. src, dst: PByte;
  6435. begin
  6436. result := false;
  6437. if not Assigned(aImage) or (Format = tfEmpty) then
  6438. exit;
  6439. FormatDesc := TFormatDescriptor.Get(Format);
  6440. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  6441. exit;
  6442. FillChar(rid{%H-}, SizeOf(rid), 0);
  6443. rid.Format := ricfGray;
  6444. rid.Width := Width;
  6445. rid.Height := Height;
  6446. rid.Depth := CountSetBits(FormatDesc.Range.a);
  6447. rid.BitOrder := riboBitsInOrder;
  6448. rid.ByteOrder := riboLSBFirst;
  6449. rid.LineOrder := riloTopToBottom;
  6450. rid.LineEnd := rileTight;
  6451. rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
  6452. rid.RedPrec := CountSetBits(FormatDesc.Range.a);
  6453. rid.GreenPrec := 0;
  6454. rid.BluePrec := 0;
  6455. rid.AlphaPrec := 0;
  6456. rid.RedShift := 0;
  6457. rid.GreenShift := 0;
  6458. rid.BlueShift := 0;
  6459. rid.AlphaShift := 0;
  6460. rid.MaskBitsPerPixel := 0;
  6461. rid.PaletteColorCount := 0;
  6462. aImage.DataDescription := rid;
  6463. aImage.CreateData;
  6464. srcMD := FormatDesc.CreateMappingData;
  6465. try
  6466. FormatDesc.PreparePixel(Pixel);
  6467. src := Data;
  6468. dst := aImage.PixelData;
  6469. for y := 0 to Height-1 do
  6470. for x := 0 to Width-1 do begin
  6471. FormatDesc.Unmap(src, Pixel, srcMD);
  6472. case rid.BitsPerPixel of
  6473. 8: begin
  6474. dst^ := Pixel.Data.a;
  6475. inc(dst);
  6476. end;
  6477. 16: begin
  6478. PWord(dst)^ := Pixel.Data.a;
  6479. inc(dst, 2);
  6480. end;
  6481. 24: begin
  6482. PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
  6483. PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
  6484. PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
  6485. inc(dst, 3);
  6486. end;
  6487. 32: begin
  6488. PCardinal(dst)^ := Pixel.Data.a;
  6489. inc(dst, 4);
  6490. end;
  6491. else
  6492. raise EglBitmapUnsupportedFormat.Create(Format);
  6493. end;
  6494. end;
  6495. finally
  6496. FormatDesc.FreeMappingData(srcMD);
  6497. end;
  6498. result := true;
  6499. end;
  6500. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6501. function TglBitmapData.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  6502. var
  6503. data: TglBitmapData;
  6504. begin
  6505. data := TglBitmapData.Create;
  6506. try
  6507. data.AssignFromLazIntfImage(aImage);
  6508. result := AddAlphaFromDataObj(data, aFunc, aArgs);
  6509. finally
  6510. data.Free;
  6511. end;
  6512. end;
  6513. {$ENDIF}
  6514. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6515. function TglBitmapData.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
  6516. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  6517. var
  6518. rs: TResourceStream;
  6519. begin
  6520. PrepareResType(aResource, aResType);
  6521. rs := TResourceStream.Create(aInstance, aResource, aResType);
  6522. try
  6523. result := AddAlphaFromStream(rs, aFunc, aArgs);
  6524. finally
  6525. rs.Free;
  6526. end;
  6527. end;
  6528. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6529. function TglBitmapData.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
  6530. const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  6531. var
  6532. rs: TResourceStream;
  6533. begin
  6534. rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
  6535. try
  6536. result := AddAlphaFromStream(rs, aFunc, aArgs);
  6537. finally
  6538. rs.Free;
  6539. end;
  6540. end;
  6541. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6542. function TglBitmapData.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  6543. begin
  6544. if TFormatDescriptor.Get(Format).IsCompressed then
  6545. raise EglBitmapUnsupportedFormat.Create(Format);
  6546. result := Convert(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);
  6547. end;
  6548. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6549. function TglBitmapData.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  6550. var
  6551. FS: TFileStream;
  6552. begin
  6553. FS := TFileStream.Create(aFileName, fmOpenRead);
  6554. try
  6555. result := AddAlphaFromStream(FS, aFunc, aArgs);
  6556. finally
  6557. FS.Free;
  6558. end;
  6559. end;
  6560. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6561. function TglBitmapData.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  6562. var
  6563. data: TglBitmapData;
  6564. begin
  6565. data := TglBitmapData.Create(aStream);
  6566. try
  6567. result := AddAlphaFromDataObj(data, aFunc, aArgs);
  6568. finally
  6569. data.Free;
  6570. end;
  6571. end;
  6572. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6573. function TglBitmapData.AddAlphaFromDataObj(const aDataObj: TglBitmapData; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
  6574. var
  6575. DestData, DestData2, SourceData: pByte;
  6576. TempHeight, TempWidth: Integer;
  6577. SourceFD, DestFD: TFormatDescriptor;
  6578. SourceMD, DestMD, DestMD2: Pointer;
  6579. FuncRec: TglBitmapFunctionRec;
  6580. begin
  6581. result := false;
  6582. Assert(Assigned(Data));
  6583. Assert(Assigned(aDataObj));
  6584. Assert(Assigned(aDataObj.Data));
  6585. if ((aDataObj.Width = Width) and (aDataObj.Height = Height)) then begin
  6586. result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);
  6587. SourceFD := TFormatDescriptor.Get(aDataObj.Format);
  6588. DestFD := TFormatDescriptor.Get(Format);
  6589. if not Assigned(aFunc) then begin
  6590. aFunc := glBitmapAlphaFunc;
  6591. FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);
  6592. end else
  6593. FuncRec.Args := aArgs;
  6594. // Values
  6595. TempWidth := aDataObj.Width;
  6596. TempHeight := aDataObj.Height;
  6597. if (TempWidth <= 0) or (TempHeight <= 0) then
  6598. exit;
  6599. FuncRec.Sender := Self;
  6600. FuncRec.Size := Dimension;
  6601. FuncRec.Position.Fields := FuncRec.Size.Fields;
  6602. DestData := Data;
  6603. DestData2 := Data;
  6604. SourceData := aDataObj.Data;
  6605. // Mapping
  6606. SourceFD.PreparePixel(FuncRec.Source);
  6607. DestFD.PreparePixel (FuncRec.Dest);
  6608. SourceMD := SourceFD.CreateMappingData;
  6609. DestMD := DestFD.CreateMappingData;
  6610. DestMD2 := DestFD.CreateMappingData;
  6611. try
  6612. FuncRec.Position.Y := 0;
  6613. while FuncRec.Position.Y < TempHeight do begin
  6614. FuncRec.Position.X := 0;
  6615. while FuncRec.Position.X < TempWidth do begin
  6616. SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);
  6617. DestFD.Unmap (DestData, FuncRec.Dest, DestMD);
  6618. aFunc(FuncRec);
  6619. DestFD.Map(FuncRec.Dest, DestData2, DestMD2);
  6620. inc(FuncRec.Position.X);
  6621. end;
  6622. inc(FuncRec.Position.Y);
  6623. end;
  6624. finally
  6625. SourceFD.FreeMappingData(SourceMD);
  6626. DestFD.FreeMappingData(DestMD);
  6627. DestFD.FreeMappingData(DestMD2);
  6628. end;
  6629. end;
  6630. end;
  6631. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6632. function TglBitmapData.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;
  6633. begin
  6634. result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);
  6635. end;
  6636. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6637. function TglBitmapData.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;
  6638. var
  6639. PixelData: TglBitmapPixelData;
  6640. begin
  6641. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  6642. result := AddAlphaFromColorKeyFloat(
  6643. aRed / PixelData.Range.r,
  6644. aGreen / PixelData.Range.g,
  6645. aBlue / PixelData.Range.b,
  6646. aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));
  6647. end;
  6648. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6649. function TglBitmapData.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;
  6650. var
  6651. values: array[0..2] of Single;
  6652. tmp: Cardinal;
  6653. i: Integer;
  6654. PixelData: TglBitmapPixelData;
  6655. begin
  6656. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  6657. with PixelData do begin
  6658. values[0] := aRed;
  6659. values[1] := aGreen;
  6660. values[2] := aBlue;
  6661. for i := 0 to 2 do begin
  6662. tmp := Trunc(Range.arr[i] * aDeviation);
  6663. Data.arr[i] := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));
  6664. Range.arr[i] := Max(0, Trunc(Range.arr[i] * values[i] - tmp));
  6665. end;
  6666. Data.a := 0;
  6667. Range.a := 0;
  6668. end;
  6669. result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);
  6670. end;
  6671. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6672. function TglBitmapData.AddAlphaFromValue(const aAlpha: Byte): Boolean;
  6673. begin
  6674. result := AddAlphaFromValueFloat(aAlpha / $FF);
  6675. end;
  6676. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6677. function TglBitmapData.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;
  6678. var
  6679. PixelData: TglBitmapPixelData;
  6680. begin
  6681. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  6682. result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);
  6683. end;
  6684. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6685. function TglBitmapData.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;
  6686. var
  6687. PixelData: TglBitmapPixelData;
  6688. begin
  6689. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  6690. with PixelData do
  6691. Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));
  6692. result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);
  6693. end;
  6694. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6695. function TglBitmapData.RemoveAlpha: Boolean;
  6696. var
  6697. FormatDesc: TFormatDescriptor;
  6698. begin
  6699. result := false;
  6700. FormatDesc := TFormatDescriptor.Get(Format);
  6701. if Assigned(Data) then begin
  6702. if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
  6703. raise EglBitmapUnsupportedFormat.Create(Format);
  6704. result := ConvertTo(FormatDesc.WithoutAlpha);
  6705. end;
  6706. end;
  6707. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6708. procedure TglBitmapData.FillWithColor(const aRed, aGreen, aBlue: Byte;
  6709. const aAlpha: Byte);
  6710. begin
  6711. FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);
  6712. end;
  6713. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6714. procedure TglBitmapData.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);
  6715. var
  6716. PixelData: TglBitmapPixelData;
  6717. begin
  6718. TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);
  6719. FillWithColorFloat(
  6720. aRed / PixelData.Range.r,
  6721. aGreen / PixelData.Range.g,
  6722. aBlue / PixelData.Range.b,
  6723. aAlpha / PixelData.Range.a);
  6724. end;
  6725. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6726. procedure TglBitmapData.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);
  6727. var
  6728. PixelData: TglBitmapPixelData;
  6729. begin
  6730. TFormatDescriptor.Get(Format).PreparePixel(PixelData);
  6731. with PixelData do begin
  6732. Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));
  6733. Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));
  6734. Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));
  6735. Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));
  6736. end;
  6737. Convert(glBitmapFillWithColorFunc, false, @PixelData);
  6738. end;
  6739. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6740. procedure TglBitmapData.SetData(const aData: PByte; const aFormat: TglBitmapFormat; const aWidth: Integer; const aHeight: Integer);
  6741. begin
  6742. if (Data <> aData) then begin
  6743. if (Assigned(Data)) then
  6744. FreeMem(Data);
  6745. fData := aData;
  6746. end;
  6747. if Assigned(fData) then begin
  6748. FillChar(fDimension, SizeOf(fDimension), 0);
  6749. if aWidth <> -1 then begin
  6750. fDimension.Fields := fDimension.Fields + [ffX];
  6751. fDimension.X := aWidth;
  6752. end;
  6753. if aHeight <> -1 then begin
  6754. fDimension.Fields := fDimension.Fields + [ffY];
  6755. fDimension.Y := aHeight;
  6756. end;
  6757. fFormat := aFormat;
  6758. end else
  6759. fFormat := tfEmpty;
  6760. UpdateScanlines;
  6761. end;
  6762. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6763. function TglBitmapData.Clone: TglBitmapData;
  6764. var
  6765. Temp: TglBitmapData;
  6766. TempPtr: PByte;
  6767. Size: Integer;
  6768. begin
  6769. result := nil;
  6770. Temp := (ClassType.Create as TglBitmapData);
  6771. try
  6772. // copy texture data if assigned
  6773. if Assigned(Data) then begin
  6774. Size := TFormatDescriptor.Get(Format).GetSize(fDimension);
  6775. GetMem(TempPtr, Size);
  6776. try
  6777. Move(Data^, TempPtr^, Size);
  6778. Temp.SetData(TempPtr, Format, Width, Height);
  6779. except
  6780. if Assigned(TempPtr) then
  6781. FreeMem(TempPtr);
  6782. raise;
  6783. end;
  6784. end else begin
  6785. TempPtr := nil;
  6786. Temp.SetData(TempPtr, Format, Width, Height);
  6787. end;
  6788. // copy properties
  6789. Temp.fFormat := Format;
  6790. result := Temp;
  6791. except
  6792. FreeAndNil(Temp);
  6793. raise;
  6794. end;
  6795. end;
  6796. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6797. procedure TglBitmapData.Invert(const aRed, aGreen, aBlue, aAlpha: Boolean);
  6798. var
  6799. mask: PtrInt;
  6800. begin
  6801. mask :=
  6802. (Byte(aRed) and 1) or
  6803. ((Byte(aGreen) and 1) shl 1) or
  6804. ((Byte(aBlue) and 1) shl 2) or
  6805. ((Byte(aAlpha) and 1) shl 3);
  6806. if (mask > 0) then
  6807. Convert(glBitmapInvertFunc, false, {%H-}Pointer(mask));
  6808. end;
  6809. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6810. type
  6811. TMatrixItem = record
  6812. X, Y: Integer;
  6813. W: Single;
  6814. end;
  6815. PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;
  6816. TglBitmapToNormalMapRec = Record
  6817. Scale: Single;
  6818. Heights: array of Single;
  6819. MatrixU : array of TMatrixItem;
  6820. MatrixV : array of TMatrixItem;
  6821. end;
  6822. const
  6823. ONE_OVER_255 = 1 / 255;
  6824. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6825. procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);
  6826. var
  6827. Val: Single;
  6828. begin
  6829. with FuncRec do begin
  6830. Val :=
  6831. Source.Data.r * LUMINANCE_WEIGHT_R +
  6832. Source.Data.g * LUMINANCE_WEIGHT_G +
  6833. Source.Data.b * LUMINANCE_WEIGHT_B;
  6834. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;
  6835. end;
  6836. end;
  6837. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6838. procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);
  6839. begin
  6840. with FuncRec do
  6841. PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;
  6842. end;
  6843. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6844. procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);
  6845. type
  6846. TVec = Array[0..2] of Single;
  6847. var
  6848. Idx: Integer;
  6849. du, dv: Double;
  6850. Len: Single;
  6851. Vec: TVec;
  6852. function GetHeight(X, Y: Integer): Single;
  6853. begin
  6854. with FuncRec do begin
  6855. X := Max(0, Min(Size.X -1, X));
  6856. Y := Max(0, Min(Size.Y -1, Y));
  6857. result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];
  6858. end;
  6859. end;
  6860. begin
  6861. with FuncRec do begin
  6862. with PglBitmapToNormalMapRec(Args)^ do begin
  6863. du := 0;
  6864. for Idx := Low(MatrixU) to High(MatrixU) do
  6865. du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;
  6866. dv := 0;
  6867. for Idx := Low(MatrixU) to High(MatrixU) do
  6868. dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;
  6869. Vec[0] := -du * Scale;
  6870. Vec[1] := -dv * Scale;
  6871. Vec[2] := 1;
  6872. end;
  6873. // Normalize
  6874. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  6875. if Len <> 0 then begin
  6876. Vec[0] := Vec[0] * Len;
  6877. Vec[1] := Vec[1] * Len;
  6878. Vec[2] := Vec[2] * Len;
  6879. end;
  6880. // Farbe zuweisem
  6881. Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);
  6882. Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);
  6883. Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);
  6884. end;
  6885. end;
  6886. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  6887. procedure TglBitmapData.GenerateNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);
  6888. var
  6889. Rec: TglBitmapToNormalMapRec;
  6890. procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);
  6891. begin
  6892. if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin
  6893. Matrix[Index].X := X;
  6894. Matrix[Index].Y := Y;
  6895. Matrix[Index].W := W;
  6896. end;
  6897. end;
  6898. begin
  6899. if TFormatDescriptor.Get(Format).IsCompressed then
  6900. raise EglBitmapUnsupportedFormat.Create(Format);
  6901. if aScale > 100 then
  6902. Rec.Scale := 100
  6903. else if aScale < -100 then
  6904. Rec.Scale := -100
  6905. else
  6906. Rec.Scale := aScale;
  6907. SetLength(Rec.Heights, Width * Height);
  6908. try
  6909. case aFunc of
  6910. nm4Samples: begin
  6911. SetLength(Rec.MatrixU, 2);
  6912. SetEntry(Rec.MatrixU, 0, -1, 0, -0.5);
  6913. SetEntry(Rec.MatrixU, 1, 1, 0, 0.5);
  6914. SetLength(Rec.MatrixV, 2);
  6915. SetEntry(Rec.MatrixV, 0, 0, 1, 0.5);
  6916. SetEntry(Rec.MatrixV, 1, 0, -1, -0.5);
  6917. end;
  6918. nmSobel: begin
  6919. SetLength(Rec.MatrixU, 6);
  6920. SetEntry(Rec.MatrixU, 0, -1, 1, -1.0);
  6921. SetEntry(Rec.MatrixU, 1, -1, 0, -2.0);
  6922. SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);
  6923. SetEntry(Rec.MatrixU, 3, 1, 1, 1.0);
  6924. SetEntry(Rec.MatrixU, 4, 1, 0, 2.0);
  6925. SetEntry(Rec.MatrixU, 5, 1, -1, 1.0);
  6926. SetLength(Rec.MatrixV, 6);
  6927. SetEntry(Rec.MatrixV, 0, -1, 1, 1.0);
  6928. SetEntry(Rec.MatrixV, 1, 0, 1, 2.0);
  6929. SetEntry(Rec.MatrixV, 2, 1, 1, 1.0);
  6930. SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);
  6931. SetEntry(Rec.MatrixV, 4, 0, -1, -2.0);
  6932. SetEntry(Rec.MatrixV, 5, 1, -1, -1.0);
  6933. end;
  6934. nm3x3: begin
  6935. SetLength(Rec.MatrixU, 6);
  6936. SetEntry(Rec.MatrixU, 0, -1, 1, -1/6);
  6937. SetEntry(Rec.MatrixU, 1, -1, 0, -1/6);
  6938. SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);
  6939. SetEntry(Rec.MatrixU, 3, 1, 1, 1/6);
  6940. SetEntry(Rec.MatrixU, 4, 1, 0, 1/6);
  6941. SetEntry(Rec.MatrixU, 5, 1, -1, 1/6);
  6942. SetLength(Rec.MatrixV, 6);
  6943. SetEntry(Rec.MatrixV, 0, -1, 1, 1/6);
  6944. SetEntry(Rec.MatrixV, 1, 0, 1, 1/6);
  6945. SetEntry(Rec.MatrixV, 2, 1, 1, 1/6);
  6946. SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);
  6947. SetEntry(Rec.MatrixV, 4, 0, -1, -1/6);
  6948. SetEntry(Rec.MatrixV, 5, 1, -1, -1/6);
  6949. end;
  6950. nm5x5: begin
  6951. SetLength(Rec.MatrixU, 20);
  6952. SetEntry(Rec.MatrixU, 0, -2, 2, -1 / 16);
  6953. SetEntry(Rec.MatrixU, 1, -1, 2, -1 / 10);
  6954. SetEntry(Rec.MatrixU, 2, 1, 2, 1 / 10);
  6955. SetEntry(Rec.MatrixU, 3, 2, 2, 1 / 16);
  6956. SetEntry(Rec.MatrixU, 4, -2, 1, -1 / 10);
  6957. SetEntry(Rec.MatrixU, 5, -1, 1, -1 / 8);
  6958. SetEntry(Rec.MatrixU, 6, 1, 1, 1 / 8);
  6959. SetEntry(Rec.MatrixU, 7, 2, 1, 1 / 10);
  6960. SetEntry(Rec.MatrixU, 8, -2, 0, -1 / 2.8);
  6961. SetEntry(Rec.MatrixU, 9, -1, 0, -0.5);
  6962. SetEntry(Rec.MatrixU, 10, 1, 0, 0.5);
  6963. SetEntry(Rec.MatrixU, 11, 2, 0, 1 / 2.8);
  6964. SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);
  6965. SetEntry(Rec.MatrixU, 13, -1, -1, -1 / 8);
  6966. SetEntry(Rec.MatrixU, 14, 1, -1, 1 / 8);
  6967. SetEntry(Rec.MatrixU, 15, 2, -1, 1 / 10);
  6968. SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);
  6969. SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);
  6970. SetEntry(Rec.MatrixU, 18, 1, -2, 1 / 10);
  6971. SetEntry(Rec.MatrixU, 19, 2, -2, 1 / 16);
  6972. SetLength(Rec.MatrixV, 20);
  6973. SetEntry(Rec.MatrixV, 0, -2, 2, 1 / 16);
  6974. SetEntry(Rec.MatrixV, 1, -1, 2, 1 / 10);
  6975. SetEntry(Rec.MatrixV, 2, 0, 2, 0.25);
  6976. SetEntry(Rec.MatrixV, 3, 1, 2, 1 / 10);
  6977. SetEntry(Rec.MatrixV, 4, 2, 2, 1 / 16);
  6978. SetEntry(Rec.MatrixV, 5, -2, 1, 1 / 10);
  6979. SetEntry(Rec.MatrixV, 6, -1, 1, 1 / 8);
  6980. SetEntry(Rec.MatrixV, 7, 0, 1, 0.5);
  6981. SetEntry(Rec.MatrixV, 8, 1, 1, 1 / 8);
  6982. SetEntry(Rec.MatrixV, 9, 2, 1, 1 / 16);
  6983. SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);
  6984. SetEntry(Rec.MatrixV, 11, -1, -1, -1 / 8);
  6985. SetEntry(Rec.MatrixV, 12, 0, -1, -0.5);
  6986. SetEntry(Rec.MatrixV, 13, 1, -1, -1 / 8);
  6987. SetEntry(Rec.MatrixV, 14, 2, -1, -1 / 10);
  6988. SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);
  6989. SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);
  6990. SetEntry(Rec.MatrixV, 17, 0, -2, -0.25);
  6991. SetEntry(Rec.MatrixV, 18, 1, -2, -1 / 10);
  6992. SetEntry(Rec.MatrixV, 19, 2, -2, -1 / 16);
  6993. end;
  6994. end;
  6995. // Daten Sammeln
  6996. if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then
  6997. Convert(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)
  6998. else
  6999. Convert(glBitmapToNormalMapPrepareFunc, false, @Rec);
  7000. Convert(glBitmapToNormalMapFunc, false, @Rec);
  7001. finally
  7002. SetLength(Rec.Heights, 0);
  7003. end;
  7004. end;
  7005. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7006. constructor TglBitmapData.Create;
  7007. begin
  7008. inherited Create;
  7009. fFormat := glBitmapDefaultFormat;
  7010. end;
  7011. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7012. constructor TglBitmapData.Create(const aFileName: String);
  7013. begin
  7014. Create;
  7015. LoadFromFile(aFileName);
  7016. end;
  7017. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7018. constructor TglBitmapData.Create(const aStream: TStream);
  7019. begin
  7020. Create;
  7021. LoadFromStream(aStream);
  7022. end;
  7023. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7024. constructor TglBitmapData.Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; aData: PByte);
  7025. var
  7026. ImageSize: Integer;
  7027. begin
  7028. Create;
  7029. if not Assigned(aData) then begin
  7030. ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);
  7031. GetMem(aData, ImageSize);
  7032. try
  7033. FillChar(aData^, ImageSize, #$FF);
  7034. SetData(aData, aFormat, aSize.X, aSize.Y);
  7035. except
  7036. if Assigned(aData) then
  7037. FreeMem(aData);
  7038. raise;
  7039. end;
  7040. end else begin
  7041. SetData(aData, aFormat, aSize.X, aSize.Y);
  7042. end;
  7043. end;
  7044. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7045. constructor TglBitmapData.Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer);
  7046. begin
  7047. Create;
  7048. LoadFromFunc(aSize, aFormat, aFunc, aArgs);
  7049. end;
  7050. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7051. constructor TglBitmapData.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
  7052. begin
  7053. Create;
  7054. LoadFromResource(aInstance, aResource, aResType);
  7055. end;
  7056. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7057. constructor TglBitmapData.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
  7058. begin
  7059. Create;
  7060. LoadFromResourceID(aInstance, aResourceID, aResType);
  7061. end;
  7062. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7063. destructor TglBitmapData.Destroy;
  7064. begin
  7065. SetData(nil, tfEmpty);
  7066. inherited Destroy;
  7067. end;
  7068. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7069. //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7070. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7071. function TglBitmap.GetWidth: Integer;
  7072. begin
  7073. if (ffX in fDimension.Fields) then
  7074. result := fDimension.X
  7075. else
  7076. result := -1;
  7077. end;
  7078. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7079. function TglBitmap.GetHeight: Integer;
  7080. begin
  7081. if (ffY in fDimension.Fields) then
  7082. result := fDimension.Y
  7083. else
  7084. result := -1;
  7085. end;
  7086. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7087. procedure TglBitmap.SetCustomData(const aValue: Pointer);
  7088. begin
  7089. if fCustomData = aValue then
  7090. exit;
  7091. fCustomData := aValue;
  7092. end;
  7093. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7094. procedure TglBitmap.SetCustomName(const aValue: String);
  7095. begin
  7096. if fCustomName = aValue then
  7097. exit;
  7098. fCustomName := aValue;
  7099. end;
  7100. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7101. procedure TglBitmap.SetCustomNameW(const aValue: WideString);
  7102. begin
  7103. if fCustomNameW = aValue then
  7104. exit;
  7105. fCustomNameW := aValue;
  7106. end;
  7107. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7108. procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);
  7109. begin
  7110. if fDeleteTextureOnFree = aValue then
  7111. exit;
  7112. fDeleteTextureOnFree := aValue;
  7113. end;
  7114. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7115. procedure TglBitmap.SetID(const aValue: Cardinal);
  7116. begin
  7117. if fID = aValue then
  7118. exit;
  7119. fID := aValue;
  7120. end;
  7121. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7122. procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);
  7123. begin
  7124. if fMipMap = aValue then
  7125. exit;
  7126. fMipMap := aValue;
  7127. end;
  7128. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7129. procedure TglBitmap.SetTarget(const aValue: Cardinal);
  7130. begin
  7131. if fTarget = aValue then
  7132. exit;
  7133. fTarget := aValue;
  7134. end;
  7135. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7136. procedure TglBitmap.SetAnisotropic(const aValue: Integer);
  7137. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)}
  7138. var
  7139. MaxAnisotropic: Integer;
  7140. {$IFEND}
  7141. begin
  7142. fAnisotropic := aValue;
  7143. if (ID > 0) then begin
  7144. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)}
  7145. if GL_EXT_texture_filter_anisotropic then begin
  7146. if fAnisotropic > 0 then begin
  7147. Bind({$IFNDEF OPENGL_ES}false{$ENDIF});
  7148. glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);
  7149. if aValue > MaxAnisotropic then
  7150. fAnisotropic := MaxAnisotropic;
  7151. glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);
  7152. end;
  7153. end else begin
  7154. fAnisotropic := 0;
  7155. end;
  7156. {$ELSE}
  7157. fAnisotropic := 0;
  7158. {$IFEND}
  7159. end;
  7160. end;
  7161. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7162. procedure TglBitmap.Init;
  7163. begin
  7164. fID := 0;
  7165. fTarget := 0;
  7166. {$IFNDEF OPENGL_ES}
  7167. fIsResident := false;
  7168. {$ENDIF}
  7169. fMipMap := glBitmapDefaultMipmap;
  7170. fDeleteTextureOnFree := glBitmapGetDefaultDeleteTextureOnFree;
  7171. glBitmapGetDefaultFilter (fFilterMin, fFilterMag);
  7172. glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);
  7173. {$IFNDEF OPENGL_ES}
  7174. glBitmapGetDefaultSwizzle (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  7175. {$ENDIF}
  7176. end;
  7177. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7178. procedure TglBitmap.Finish;
  7179. begin
  7180. if (fID > 0) and fDeleteTextureOnFree then
  7181. glDeleteTextures(1, @fID);
  7182. end;
  7183. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7184. procedure TglBitmap.CreateID;
  7185. begin
  7186. if (ID <> 0) then
  7187. glDeleteTextures(1, @fID);
  7188. glGenTextures(1, @fID);
  7189. Bind({$IFNDEF OPENGL_ES}false{$ENDIF});
  7190. end;
  7191. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7192. procedure TglBitmap.SetupParameters({$IFNDEF OPENGL_ES}out aBuildWithGlu: Boolean{$ENDIF});
  7193. begin
  7194. // Set Up Parameters
  7195. SetWrap(fWrapS, fWrapT, fWrapR);
  7196. SetFilter(fFilterMin, fFilterMag);
  7197. SetAnisotropic(fAnisotropic);
  7198. {$IFNDEF OPENGL_ES}
  7199. SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);
  7200. if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  7201. SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);
  7202. {$ENDIF}
  7203. {$IFNDEF OPENGL_ES}
  7204. // Mip Maps Generation Mode
  7205. aBuildWithGlu := false;
  7206. if (MipMap = mmMipmap) then begin
  7207. if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then
  7208. glTexParameteri(Target, GL_GENERATE_MIPMAP, GLint(GL_TRUE))
  7209. else
  7210. aBuildWithGlu := true;
  7211. end else if (MipMap = mmMipmapGlu) then
  7212. aBuildWithGlu := true;
  7213. {$ELSE}
  7214. if (MipMap = mmMipmap) then
  7215. glGenerateMipmap(Target);
  7216. {$ENDIF}
  7217. end;
  7218. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7219. //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7220. {$IFNDEF OPENGL_ES}
  7221. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7222. procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);
  7223. begin
  7224. fBorderColor[0] := aRed;
  7225. fBorderColor[1] := aGreen;
  7226. fBorderColor[2] := aBlue;
  7227. fBorderColor[3] := aAlpha;
  7228. if (ID > 0) then begin
  7229. Bind(false);
  7230. glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);
  7231. end;
  7232. end;
  7233. {$ENDIF}
  7234. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7235. procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);
  7236. begin
  7237. //check MIN filter
  7238. case aMin of
  7239. GL_NEAREST:
  7240. fFilterMin := GL_NEAREST;
  7241. GL_LINEAR:
  7242. fFilterMin := GL_LINEAR;
  7243. GL_NEAREST_MIPMAP_NEAREST:
  7244. fFilterMin := GL_NEAREST_MIPMAP_NEAREST;
  7245. GL_LINEAR_MIPMAP_NEAREST:
  7246. fFilterMin := GL_LINEAR_MIPMAP_NEAREST;
  7247. GL_NEAREST_MIPMAP_LINEAR:
  7248. fFilterMin := GL_NEAREST_MIPMAP_LINEAR;
  7249. GL_LINEAR_MIPMAP_LINEAR:
  7250. fFilterMin := GL_LINEAR_MIPMAP_LINEAR;
  7251. else
  7252. raise EglBitmap.Create('SetFilter - Unknow MIN filter.');
  7253. end;
  7254. //check MAG filter
  7255. case aMag of
  7256. GL_NEAREST:
  7257. fFilterMag := GL_NEAREST;
  7258. GL_LINEAR:
  7259. fFilterMag := GL_LINEAR;
  7260. else
  7261. raise EglBitmap.Create('SetFilter - Unknow MAG filter.');
  7262. end;
  7263. //apply filter
  7264. if (ID > 0) then begin
  7265. Bind({$IFNDEF OPENGL_ES}false{$ENDIF});
  7266. glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);
  7267. if (MipMap = mmNone) {$IFNDEF OPENGL_ES}or (Target = GL_TEXTURE_RECTANGLE){$ENDIF} then begin
  7268. case fFilterMin of
  7269. GL_NEAREST, GL_LINEAR:
  7270. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  7271. GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:
  7272. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
  7273. GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:
  7274. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
  7275. end;
  7276. end else
  7277. glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);
  7278. end;
  7279. end;
  7280. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7281. procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);
  7282. procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);
  7283. begin
  7284. case aValue of
  7285. {$IFNDEF OPENGL_ES}
  7286. GL_CLAMP:
  7287. aTarget := GL_CLAMP;
  7288. {$ENDIF}
  7289. GL_REPEAT:
  7290. aTarget := GL_REPEAT;
  7291. GL_CLAMP_TO_EDGE: begin
  7292. {$IFNDEF OPENGL_ES}
  7293. if not GL_VERSION_1_2 and not GL_EXT_texture_edge_clamp then
  7294. aTarget := GL_CLAMP
  7295. else
  7296. {$ENDIF}
  7297. aTarget := GL_CLAMP_TO_EDGE;
  7298. end;
  7299. {$IFNDEF OPENGL_ES}
  7300. GL_CLAMP_TO_BORDER: begin
  7301. if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then
  7302. aTarget := GL_CLAMP_TO_BORDER
  7303. else
  7304. aTarget := GL_CLAMP;
  7305. end;
  7306. {$ENDIF}
  7307. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  7308. GL_MIRRORED_REPEAT: begin
  7309. {$IFNDEF OPENGL_ES}
  7310. if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then
  7311. {$ELSE}
  7312. if GL_VERSION_2_0 then
  7313. {$ENDIF}
  7314. aTarget := GL_MIRRORED_REPEAT
  7315. else
  7316. raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');
  7317. end;
  7318. {$IFEND}
  7319. else
  7320. raise EglBitmap.Create('SetWrap - Unknow Texturewrap');
  7321. end;
  7322. end;
  7323. begin
  7324. CheckAndSetWrap(S, fWrapS);
  7325. CheckAndSetWrap(T, fWrapT);
  7326. CheckAndSetWrap(R, fWrapR);
  7327. if (ID > 0) then begin
  7328. Bind({$IFNDEF OPENGL_ES}false{$ENDIF});
  7329. glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);
  7330. glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);
  7331. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  7332. {$IFDEF OPENGL_ES} if GL_VERSION_3_0 then{$ENDIF}
  7333. glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);
  7334. {$IFEND}
  7335. end;
  7336. end;
  7337. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  7338. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7339. procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);
  7340. procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);
  7341. begin
  7342. if (aValue = GL_ZERO) or (aValue = GL_ONE) or (aValue = GL_ALPHA) or
  7343. (aValue = GL_RED) or (aValue = GL_GREEN) or (aValue = GL_BLUE) then
  7344. fSwizzle[aIndex] := aValue
  7345. else
  7346. raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');
  7347. end;
  7348. begin
  7349. {$IFNDEF OPENGL_ES}
  7350. if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then
  7351. raise EglBitmapNotSupported.Create('texture swizzle is not supported');
  7352. {$ELSE}
  7353. if not GL_VERSION_3_0 then
  7354. raise EglBitmapNotSupported.Create('texture swizzle is not supported');
  7355. {$ENDIF}
  7356. CheckAndSetValue(r, 0);
  7357. CheckAndSetValue(g, 1);
  7358. CheckAndSetValue(b, 2);
  7359. CheckAndSetValue(a, 3);
  7360. if (ID > 0) then begin
  7361. Bind(false);
  7362. {$IFNDEF OPENGL_ES}
  7363. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, PGLint(@fSwizzle[0]));
  7364. {$ELSE}
  7365. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_R, PGLint(@fSwizzle[0]));
  7366. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_G, PGLint(@fSwizzle[1]));
  7367. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_B, PGLint(@fSwizzle[2]));
  7368. glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_A, PGLint(@fSwizzle[3]));
  7369. {$ENDIF}
  7370. end;
  7371. end;
  7372. {$IFEND}
  7373. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7374. procedure TglBitmap.Bind({$IFNDEF OPENGL_ES}const aEnableTextureUnit: Boolean{$ENDIF});
  7375. begin
  7376. {$IFNDEF OPENGL_ES}
  7377. if aEnableTextureUnit then
  7378. glEnable(Target);
  7379. {$ENDIF}
  7380. if (ID > 0) then
  7381. glBindTexture(Target, ID);
  7382. end;
  7383. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7384. procedure TglBitmap.Unbind({$IFNDEF OPENGL_ES}const aDisableTextureUnit: Boolean{$ENDIF});
  7385. begin
  7386. {$IFNDEF OPENGL_ES}
  7387. if aDisableTextureUnit then
  7388. glDisable(Target);
  7389. {$ENDIF}
  7390. glBindTexture(Target, 0);
  7391. end;
  7392. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7393. procedure TglBitmap.UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean);
  7394. var
  7395. w, h: Integer;
  7396. begin
  7397. w := aDataObj.Width;
  7398. h := aDataObj.Height;
  7399. fDimension.Fields := [];
  7400. if (w > 0) then
  7401. fDimension.Fields := fDimension.Fields + [ffX];
  7402. if (h > 0) then
  7403. fDimension.Fields := fDimension.Fields + [ffY];
  7404. fDimension.X := w;
  7405. fDimension.Y := h;
  7406. end;
  7407. {$IFNDEF OPENGL_ES}
  7408. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7409. function TglBitmap.DownloadData(const aDataObj: TglBitmapData): Boolean;
  7410. var
  7411. Temp: PByte;
  7412. TempWidth, TempHeight: Integer;
  7413. TempIntFormat: GLint;
  7414. IntFormat: TglBitmapFormat;
  7415. FormatDesc: TFormatDescriptor;
  7416. begin
  7417. result := false;
  7418. Bind;
  7419. // Request Data
  7420. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH, @TempWidth);
  7421. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT, @TempHeight);
  7422. glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);
  7423. FormatDesc := (TglBitmapFormatDescriptor.GetByFormat(TempIntFormat) as TFormatDescriptor);
  7424. IntFormat := FormatDesc.Format;
  7425. // Getting data from OpenGL
  7426. FormatDesc := TFormatDescriptor.Get(IntFormat);
  7427. GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));
  7428. try
  7429. glPixelStorei(GL_PACK_ALIGNMENT, 1);
  7430. if FormatDesc.IsCompressed then begin
  7431. if not Assigned(glGetCompressedTexImage) then
  7432. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7433. glGetCompressedTexImage(Target, 0, Temp)
  7434. end else
  7435. glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  7436. aDataObj.SetData(Temp, IntFormat, TempWidth, TempHeight);
  7437. result := true;
  7438. except
  7439. if Assigned(Temp) then
  7440. FreeMem(Temp);
  7441. raise;
  7442. end;
  7443. end;
  7444. {$ENDIF}
  7445. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7446. constructor TglBitmap.Create;
  7447. begin
  7448. if (ClassType = TglBitmap) then
  7449. raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');
  7450. inherited Create;
  7451. Init;
  7452. end;
  7453. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7454. constructor TglBitmap.Create(const aData: TglBitmapData);
  7455. begin
  7456. Create;
  7457. UploadData(aData);
  7458. end;
  7459. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7460. destructor TglBitmap.Destroy;
  7461. begin
  7462. Finish;
  7463. inherited Destroy;
  7464. end;
  7465. {$IFNDEF OPENGL_ES}
  7466. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7467. //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7468. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7469. procedure TglBitmap1D.Init;
  7470. begin
  7471. inherited;
  7472. Target := GL_TEXTURE_1D;
  7473. end;
  7474. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7475. procedure TglBitmap1D.UploadDataIntern(const aDataObj: TglBitmapData; const aBuildWithGlu: Boolean);
  7476. var
  7477. fd: TglBitmapFormatDescriptor;
  7478. begin
  7479. // Upload data
  7480. fd := aDataObj.FormatDescriptor;
  7481. if (fd.glFormat = 0) or (fd.glInternalFormat = 0) or (fd.glDataFormat = 0) then
  7482. raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data');
  7483. if fd.IsCompressed then begin
  7484. if not Assigned(glCompressedTexImage1D) then
  7485. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7486. glCompressedTexImage1D(Target, 0, fd.glInternalFormat, aDataObj.Width, 0, fd.GetSize(aDataObj.Width, 1), aDataObj.Data)
  7487. end else if aBuildWithGlu then
  7488. gluBuild1DMipmaps(Target, fd.glInternalFormat, aDataObj.Width, fd.glFormat, fd.glDataFormat, aDataObj.Data)
  7489. else
  7490. glTexImage1D(Target, 0, fd.glInternalFormat, aDataObj.Width, 0, fd.glFormat, fd.glDataFormat, aDataObj.Data);
  7491. end;
  7492. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7493. procedure TglBitmap1D.UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean);
  7494. var
  7495. BuildWithGlu, TexRec: Boolean;
  7496. TexSize: Integer;
  7497. begin
  7498. if not Assigned(aDataObj) then
  7499. exit;
  7500. // Check Texture Size
  7501. if (aCheckSize) then begin
  7502. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  7503. if (aDataObj.Width > TexSize) then
  7504. raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  7505. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and
  7506. (Target = GL_TEXTURE_RECTANGLE);
  7507. if not (IsPowerOfTwo(aDataObj.Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  7508. raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7509. end;
  7510. inherited UploadData(aDataObj, aCheckSize);
  7511. if (fID = 0) then
  7512. CreateID;
  7513. SetupParameters(BuildWithGlu);
  7514. UploadDataIntern(aDataObj, BuildWithGlu);
  7515. glAreTexturesResident(1, @fID, @fIsResident);
  7516. end;
  7517. {$ENDIF}
  7518. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7519. //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7520. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7521. procedure TglBitmap2D.Init;
  7522. begin
  7523. inherited;
  7524. Target := GL_TEXTURE_2D;
  7525. end;
  7526. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7527. procedure TglBitmap2D.UploadDataIntern(const aDataObj: TglBitmapData; const aTarget: GLenum{$IFNDEF OPENGL_ES}; const aBuildWithGlu: Boolean{$ENDIF});
  7528. var
  7529. fd: TglBitmapFormatDescriptor;
  7530. begin
  7531. fd := aDataObj.FormatDescriptor;
  7532. if (fd.glFormat = 0) or (fd.glInternalFormat = 0) or (fd.glDataFormat = 0) then
  7533. raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data');
  7534. glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
  7535. if fd.IsCompressed then begin
  7536. if not Assigned(glCompressedTexImage2D) then
  7537. raise EglBitmap.Create('compressed formats not supported by video adapter');
  7538. glCompressedTexImage2D(aTarget, 0, fd.glInternalFormat, aDataObj.Width, aDataObj.Height, 0, fd.GetSize(fDimension), aDataObj.Data)
  7539. {$IFNDEF OPENGL_ES}
  7540. end else if aBuildWithGlu then begin
  7541. gluBuild2DMipmaps(aTarget, fd.ChannelCount, aDataObj.Width, aDataObj.Height, fd.glFormat, fd.glDataFormat, aDataObj.Data)
  7542. {$ENDIF}
  7543. end else begin
  7544. glTexImage2D(aTarget, 0, fd.glInternalFormat, aDataObj.Width, aDataObj.Height, 0, fd.glFormat, fd.glDataFormat, aDataObj.Data);
  7545. end;
  7546. end;
  7547. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7548. procedure TglBitmap2D.UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean);
  7549. var
  7550. {$IFNDEF OPENGL_ES}
  7551. BuildWithGlu, TexRec: Boolean;
  7552. {$ENDIF}
  7553. PotTex: Boolean;
  7554. TexSize: Integer;
  7555. begin
  7556. if not Assigned(aDataObj) then
  7557. exit;
  7558. // Check Texture Size
  7559. if (aCheckSize) then begin
  7560. glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);
  7561. if ((aDataObj.Width > TexSize) or (aDataObj.Height > TexSize)) then
  7562. raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');
  7563. PotTex := IsPowerOfTwo(aDataObj.Width) and IsPowerOfTwo(aDataObj.Height);
  7564. {$IF NOT DEFINED(OPENGL_ES)}
  7565. TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);
  7566. if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then
  7567. raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7568. {$ELSEIF DEFINED(OPENGL_ES_EXT)}
  7569. if not PotTex and not GL_OES_texture_npot then
  7570. raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7571. {$ELSE}
  7572. if not PotTex then
  7573. raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');
  7574. {$IFEND}
  7575. end;
  7576. inherited UploadData(aDataObj, aCheckSize);
  7577. if (fID = 0) then
  7578. CreateID;
  7579. SetupParameters({$IFNDEF OPENGL_ES}BuildWithGlu{$ENDIF});
  7580. UploadDataIntern(aDataObj, Target{$IFNDEF OPENGL_ES}, BuildWithGlu{$ENDIF});
  7581. {$IFNDEF OPENGL_ES}
  7582. glAreTexturesResident(1, @fID, @fIsResident);
  7583. {$ENDIF}
  7584. end;
  7585. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7586. class procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat; const aDataObj: TglBitmapData);
  7587. var
  7588. Temp: pByte;
  7589. Size, w, h: Integer;
  7590. FormatDesc: TFormatDescriptor;
  7591. begin
  7592. FormatDesc := TFormatDescriptor.Get(aFormat);
  7593. if FormatDesc.IsCompressed then
  7594. raise EglBitmapUnsupportedFormat.Create(aFormat);
  7595. w := aRight - aLeft;
  7596. h := aBottom - aTop;
  7597. Size := FormatDesc.GetSize(w, h);
  7598. GetMem(Temp, Size);
  7599. try
  7600. glPixelStorei(GL_PACK_ALIGNMENT, 1);
  7601. glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);
  7602. aDataObj.SetData(Temp, aFormat, w, h);
  7603. aDataObj.FlipVert;
  7604. except
  7605. if Assigned(Temp) then
  7606. FreeMem(Temp);
  7607. raise;
  7608. end;
  7609. end;
  7610. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  7611. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7612. //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7613. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7614. procedure TglBitmapCubeMap.Init;
  7615. begin
  7616. inherited;
  7617. {$IFNDEF OPENGL_ES}
  7618. if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then
  7619. raise EglBitmap.Create('TglBitmapCubeMap.Init - CubeMaps are unsupported.');
  7620. {$ELSE}
  7621. if not (GL_VERSION_2_0) then
  7622. raise EglBitmap.Create('TglBitmapCubeMap.Init - CubeMaps are unsupported.');
  7623. {$ENDIF}
  7624. SetWrap;
  7625. Target := GL_TEXTURE_CUBE_MAP;
  7626. {$IFNDEF OPENGL_ES}
  7627. fGenMode := GL_REFLECTION_MAP;
  7628. {$ENDIF}
  7629. end;
  7630. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7631. procedure TglBitmapCubeMap.UploadData(const aDataObj: TglBitmapData; const aCheckSize: Boolean);
  7632. begin
  7633. Assert(false, 'TglBitmapCubeMap.UploadData - Don''t call UploadData directly, use UploadCubeMap instead');
  7634. end;
  7635. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7636. procedure TglBitmapCubeMap.UploadCubeMap(const aDataObj: TglBitmapData; const aCubeTarget: Cardinal; const aCheckSize: Boolean);
  7637. var
  7638. {$IFNDEF OPENGL_ES}
  7639. BuildWithGlu: Boolean;
  7640. {$ENDIF}
  7641. TexSize: Integer;
  7642. begin
  7643. if (aCheckSize) then begin
  7644. glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);
  7645. if (aDataObj.Width > TexSize) or (aDataObj.Height > TexSize) then
  7646. raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenerateCubeMap - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');
  7647. {$IF NOT DEFINED(OPENGL_ES)}
  7648. if not ((IsPowerOfTwo(aDataObj.Width) and IsPowerOfTwo(aDataObj.Height)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then
  7649. raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
  7650. {$ELSEIF DEFINED(OPENGL_ES_EXT)}
  7651. if not (IsPowerOfTwo(aDataObj.Width) and IsPowerOfTwo(aDataObj.Height)) and not GL_OES_texture_npot then
  7652. raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
  7653. {$ELSE}
  7654. if not (IsPowerOfTwo(aDataObj.Width) and IsPowerOfTwo(aDataObj.Height)) then
  7655. raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');
  7656. {$IFEND}
  7657. end;
  7658. inherited UploadData(aDataObj, aCheckSize);
  7659. if (fID = 0) then
  7660. CreateID;
  7661. SetupParameters({$IFNDEF OPENGL_ES}BuildWithGlu{$ENDIF});
  7662. UploadDataIntern(aDataObj, aCubeTarget{$IFNDEF OPENGL_ES}, BuildWithGlu{$ENDIF});
  7663. end;
  7664. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7665. procedure TglBitmapCubeMap.Bind({$IFNDEF OPENGL_ES}const aEnableTexCoordsGen: Boolean; const aEnableTextureUnit: Boolean{$ENDIF});
  7666. begin
  7667. inherited Bind({$IFNDEF OPENGL_ES}aEnableTextureUnit{$ENDIF});
  7668. {$IFNDEF OPENGL_ES}
  7669. if aEnableTexCoordsGen then begin
  7670. glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);
  7671. glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);
  7672. glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);
  7673. glEnable(GL_TEXTURE_GEN_S);
  7674. glEnable(GL_TEXTURE_GEN_T);
  7675. glEnable(GL_TEXTURE_GEN_R);
  7676. end;
  7677. {$ENDIF}
  7678. end;
  7679. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7680. procedure TglBitmapCubeMap.Unbind({$IFNDEF OPENGL_ES}const aDisableTexCoordsGen: Boolean; const aDisableTextureUnit: Boolean{$ENDIF});
  7681. begin
  7682. inherited Unbind({$IFNDEF OPENGL_ES}aDisableTextureUnit{$ENDIF});
  7683. {$IFNDEF OPENGL_ES}
  7684. if aDisableTexCoordsGen then begin
  7685. glDisable(GL_TEXTURE_GEN_S);
  7686. glDisable(GL_TEXTURE_GEN_T);
  7687. glDisable(GL_TEXTURE_GEN_R);
  7688. end;
  7689. {$ENDIF}
  7690. end;
  7691. {$IFEND}
  7692. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}
  7693. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7694. //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7695. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7696. type
  7697. TVec = Array[0..2] of Single;
  7698. TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7699. PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;
  7700. TglBitmapNormalMapRec = record
  7701. HalfSize : Integer;
  7702. Func: TglBitmapNormalMapGetVectorFunc;
  7703. end;
  7704. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7705. procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7706. begin
  7707. aVec[0] := aHalfSize;
  7708. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7709. aVec[2] := - (aPosition.X + 0.5 - aHalfSize);
  7710. end;
  7711. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7712. procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7713. begin
  7714. aVec[0] := - aHalfSize;
  7715. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7716. aVec[2] := aPosition.X + 0.5 - aHalfSize;
  7717. end;
  7718. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7719. procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7720. begin
  7721. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7722. aVec[1] := aHalfSize;
  7723. aVec[2] := aPosition.Y + 0.5 - aHalfSize;
  7724. end;
  7725. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7726. procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7727. begin
  7728. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7729. aVec[1] := - aHalfSize;
  7730. aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);
  7731. end;
  7732. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7733. procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7734. begin
  7735. aVec[0] := aPosition.X + 0.5 - aHalfSize;
  7736. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7737. aVec[2] := aHalfSize;
  7738. end;
  7739. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7740. procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);
  7741. begin
  7742. aVec[0] := - (aPosition.X + 0.5 - aHalfSize);
  7743. aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);
  7744. aVec[2] := - aHalfSize;
  7745. end;
  7746. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7747. procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);
  7748. var
  7749. i: Integer;
  7750. Vec: TVec;
  7751. Len: Single;
  7752. begin
  7753. with FuncRec do begin
  7754. with PglBitmapNormalMapRec(Args)^ do begin
  7755. Func(Vec, Position, HalfSize);
  7756. // Normalize
  7757. Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));
  7758. if Len <> 0 then begin
  7759. Vec[0] := Vec[0] * Len;
  7760. Vec[1] := Vec[1] * Len;
  7761. Vec[2] := Vec[2] * Len;
  7762. end;
  7763. // Scale Vector and AddVectro
  7764. Vec[0] := Vec[0] * 0.5 + 0.5;
  7765. Vec[1] := Vec[1] * 0.5 + 0.5;
  7766. Vec[2] := Vec[2] * 0.5 + 0.5;
  7767. end;
  7768. // Set Color
  7769. for i := 0 to 2 do
  7770. Dest.Data.arr[i] := Round(Vec[i] * 255);
  7771. end;
  7772. end;
  7773. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7774. procedure TglBitmapNormalMap.Init;
  7775. begin
  7776. inherited;
  7777. {$IFNDEF OPENGL_ES}
  7778. fGenMode := GL_NORMAL_MAP;
  7779. {$ENDIF}
  7780. end;
  7781. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  7782. procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aCheckSize: Boolean);
  7783. var
  7784. Rec: TglBitmapNormalMapRec;
  7785. SizeRec: TglBitmapSize;
  7786. DataObj: TglBitmapData;
  7787. begin
  7788. Rec.HalfSize := aSize div 2;
  7789. SizeRec.Fields := [ffX, ffY];
  7790. SizeRec.X := aSize;
  7791. SizeRec.Y := aSize;
  7792. DataObj := TglBitmapData.Create;
  7793. try
  7794. // Positive X
  7795. Rec.Func := glBitmapNormalMapPosX;
  7796. DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
  7797. UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_POSITIVE_X, aCheckSize);
  7798. // Negative X
  7799. Rec.Func := glBitmapNormalMapNegX;
  7800. DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
  7801. UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aCheckSize);
  7802. // Positive Y
  7803. Rec.Func := glBitmapNormalMapPosY;
  7804. DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
  7805. UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aCheckSize);
  7806. // Negative Y
  7807. Rec.Func := glBitmapNormalMapNegY;
  7808. DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
  7809. UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aCheckSize);
  7810. // Positive Z
  7811. Rec.Func := glBitmapNormalMapPosZ;
  7812. DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
  7813. UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aCheckSize);
  7814. // Negative Z
  7815. Rec.Func := glBitmapNormalMapNegZ;
  7816. DataObj.LoadFromFunc(SizeRec, tfBGR8ub3, glBitmapNormalMapFunc, @Rec);
  7817. UploadCubeMap(DataObj, GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aCheckSize);
  7818. finally
  7819. FreeAndNil(DataObj);
  7820. end;
  7821. end;
  7822. {$IFEND}
  7823. initialization
  7824. glBitmapSetDefaultFormat (tfEmpty);
  7825. glBitmapSetDefaultMipmap (mmMipmap);
  7826. glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);
  7827. glBitmapSetDefaultWrap (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
  7828. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}
  7829. glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);
  7830. {$IFEND}
  7831. glBitmapSetDefaultFreeDataAfterGenTexture(true);
  7832. glBitmapSetDefaultDeleteTextureOnFree (true);
  7833. TFormatDescriptor.Init;
  7834. finalization
  7835. TFormatDescriptor.Finalize;
  7836. end.