opengl
/
glBitmap
1
0
Fork 0
Código Incidencias 0 Pull Requests 0 Lanzamientos 0 Wiki Actividad
No puede seleccionar más de 25 temas Los temas deben comenzar con una letra o número, pueden incluir guiones ('-') y pueden tener hasta 35 caracteres de largo.
23 Commits
2 Ramas
1.7 MiB
 
 
Árbol: e406e4032c
Ramas Etiquetas
${ item.name }
Crear rama ${ searchTerm }
desde 'e406e4032c'
${ noResults }
glBitmap/glBitmap.pas

8358 líneas
289 KiB
Original Blame Histórico 

  1. {***********************************************************

  2. glBitmap by Steffen Xonna aka Lossy eX (2003-2008)

  3. http://www.opengl24.de/index.php?cat=header&file=glbitmap

  4. 

  5. modified by Delphi OpenGL Community (http://delphigl.com/) (2013)

  6. 

  7. ------------------------------------------------------------

  8. The contents of this file are used with permission, subject to

  9. the Mozilla Public License Version 1.1 (the "License"); you may

  10. not use this file except in compliance with the License. You may

  11. obtain a copy of the License at

  12. http://www.mozilla.org/MPL/MPL-1.1.html

  13. ------------------------------------------------------------

  14. Version 3.0.0 unstable

  15. ------------------------------------------------------------

  16. History

  17. 20-11-2013

  18. - refactoring of the complete library

  19. 21-03-2010

  20. - The define GLB_DELPHI dosn't check versions anymore. If you say you are using delphi

  21.   then it's your problem if that isn't true. This prevents the unit for incompatibility

  22.   with newer versions of Delphi.

  23. - Problems with D2009+ resolved (Thanks noeska and all i forgot)

  24. - GetPixel isn't set if you are loading textures inside the constructor (Thanks Wilson)

  25. 10-08-2008

  26. - AddAlphaFromglBitmap used the custom pointer instead the imagedatapointer (Thanks Wilson)

  27. - Additional Datapointer for functioninterface now has the name CustomData  

  28. 24-07-2008

  29. - AssigneAlphaToBitmap overwrites his own palette (Thanks Wilson)

  30. - If you load an texture from an file the property Filename will be set to the name of the file

  31. - Three new properties to attach custom data to the Texture objects

  32.   - CustomName  (free for use string)

  33.   - CustomNameW (free for use widestring)

  34.   - CustomDataPointer (free for use pointer to attach other objects or complex structures)

  35. 27-05-2008

  36. - RLE TGAs loaded much faster

  37. 26-05-2008

  38. - fixed some problem with reading RLE TGAs.

  39. 21-05-2008

  40. - function clone now only copys data if it's assigned and now it also copies the ID

  41. - it seems that lazarus dont like comments in comments.

  42. 01-05-2008

  43. - It's possible to set the id of the texture

  44. - define GLB_NO_NATIVE_GL deactivated by default

  45. 27-04-2008

  46. - Now supports the following libraries

  47.   - SDL and SDL_image

  48.   - libPNG

  49.   - libJPEG

  50. - Linux compatibillity via free pascal compatibility (delphi sources optional)

  51. - BMPs now loaded manuel

  52. - Large restructuring

  53. - Property DataPtr now has the name Data

  54. - Functions are more flexible between RGB(A) and BGR(A). RGB can be saved as Bitmap and will be saved as BGR

  55. - Unused Depth removed

  56. - Function FreeData to freeing image data added 

  57. 24-10-2007

  58. - ImageID flag of TGAs was ignored. (Thanks Zwoetzen)

  59. 15-11-2006

  60. - Function SetBorderColor implemented (only used by opengl if wrap is set to GL_CLAMP_TO_BORDER)

  61. - Function AddAlphaFromValue implemented to use an fixed Value as Alphachannel

  62. - Function ReadOpenGLExtension is now only intern

  63. 29-06-2006

  64. - pngimage now disabled by default like all other versions.

  65. 26-06-2006

  66. - Setting up an anisotropic filter of 0 isnt allowed by nvidia (Thanks Ogridi)

  67. 22-06-2006

  68. - Fixed some Problem with Delphi 5

  69. - Now uses the newest version of pngimage. Makes saving pngs much easier.

  70. 22-03-2006

  71. - Property IsCompressed and Size removed. Not really supported by Spec (Thanks Ogridi)

  72. 09-03-2006

  73. - Internal Format ifDepth8 added

  74. - function GrabScreen now supports all uncompressed formats

  75. 31-01-2006

  76. - AddAlphaFromglBitmap implemented

  77. 29-12-2005

  78. - LoadFromResource and LoadFromResourceId now needs an Instance and an ResourceType (for ID)

  79. 28-12-2005

  80. - Width, Height and Depth internal changed to TglBitmapPixelPosition.

  81.   property Width, Height, Depth are still existing and new property Dimension are avail

  82. 11-12-2005

  83. - Added native OpenGL Support. Breaking the dglOpenGL "barrier".

  84. 19-10-2005

  85. - Added function GrabScreen to class TglBitmap2D

  86. 18-10-2005

  87. - Added support to Save images

  88. - Added function Clone to Clone Instance

  89. 11-10-2005

  90. - Functions now works with Cardinals for each channel. Up to 32 Bits per channel.

  91.   Usefull for Future

  92. - Several speed optimizations

  93. 09-10-2005

  94. - Internal structure change. Loading of TGA, PNG and DDS improved.

  95.   Data, format and size will now set directly with SetDataPtr.

  96. - AddFunc now works with all Types of Images and Formats

  97. - Some Funtions moved to Baseclass TglBitmap

  98. 06-10-2005

  99. - Added Support to decompress DXT3 and DXT5 compressed Images.

  100. - Added Mapping to convert data from one format into an other.

  101. 05-10-2005

  102. - Added method ConvertTo in Class TglBitmap2D. Method allows to convert every

  103.   supported Input format (supported by GetPixel) into any uncompresed Format

  104. - Added Support to decompress DXT1 compressed Images.

  105. - SwapColors replaced by ConvertTo

  106. 04-10-2005

  107. - Added Support for compressed DDSs

  108. - Added new internal formats (DXT1, DXT3, DXT5)

  109. 29-09-2005

  110. - Parameter Components renamed to InternalFormat

  111. 23-09-2005

  112. - Some AllocMem replaced with GetMem (little speed change)

  113. - better exception handling. Better protection from memory leaks.

  114. 22-09-2005

  115. - Added support for Direct Draw Surfaces (.DDS) (uncompressed images only)

  116. - Added new internal formats (RGB8, RGBA8, RGBA4, RGB5A1, RGB10A2, R5G6B5)

  117. 07-09-2005

  118. - Added support for Grayscale textures

  119. - Added internal formats (Alpha, Luminance, LuminanceAlpha, BGR8, BGRA8)

  120. 10-07-2005

  121. - Added support for GL_VERSION_2_0

  122. - Added support for GL_EXT_texture_filter_anisotropic

  123. 04-07-2005

  124. - Function FillWithColor fills the Image with one Color

  125. - Function LoadNormalMap added

  126. 30-06-2005

  127. - ToNormalMap allows to Create an NormalMap from the Alphachannel

  128. - ToNormalMap now supports Sobel (nmSobel) function.

  129. 29-06-2005

  130. - support for RLE Compressed RGB TGAs added

  131. 28-06-2005

  132. - Class TglBitmapNormalMap added to support Normalmap generation

  133. - Added function ToNormalMap in class TglBitmap2D to genereate normal maps from textures.

  134.   3 Filters are supported. (4 Samples, 3x3 and 5x5)

  135. 16-06-2005

  136. - Method LoadCubeMapClass removed

  137. - LoadCubeMap returnvalue is now the Texture paramter. Such as LoadTextures

  138. - virtual abstract method GenTexture in class TglBitmap now is protected

  139. 12-06-2005

  140. - now support DescriptionFlag in LoadTga. Allows vertical flipped images to be loaded as normal

  141. 10-06-2005

  142. - little enhancement for IsPowerOfTwo

  143. - TglBitmap1D.GenTexture now tests NPOT Textures

  144. 06-06-2005

  145. - some little name changes. All properties or function with Texture in name are

  146.   now without texture in name. We have allways texture so we dosn't name it.

  147. 03-06-2005

  148. - GenTexture now tests if texture is NPOT and NPOT-Texture are supported or

  149.   TextureTarget is GL_TEXTURE_RECTANGLE. Else it raised an exception.

  150. 02-06-2005

  151. - added support for GL_ARB_texture_rectangle, GL_EXT_texture_rectangle and GL_NV_texture_rectangle

  152. 25-04-2005

  153. - Function Unbind added

  154. - call of SetFilter or SetTextureWrap if TextureID exists results in setting properties to opengl texture.

  155. 21-04-2005

  156. - class TglBitmapCubeMap added (allows to Create Cubemaps)

  157. 29-03-2005

  158. - Added Support for PNG Images. (http://pngdelphi.sourceforge.net/)

  159.   To Enable png's use the define pngimage

  160. 22-03-2005

  161. - New Functioninterface added

  162. - Function GetPixel added

  163. 27-11-2004

  164. - Property BuildMipMaps renamed to MipMap

  165. 21-11-2004

  166. - property Name removed.

  167. - BuildMipMaps is now a set of 3 values. None, GluBuildMipmaps and SGIS_generate_mipmap

  168. 22-05-2004

  169. - property name added. Only used in glForms!

  170. 26-11-2003

  171. - property FreeDataAfterGenTexture is now available as default (default = true)

  172. - BuildMipmaps now implemented in TglBitmap1D (i've forgotten it)

  173. - function MoveMemory replaced with function Move (little speed change)

  174. - several calculations stored in variables (little speed change)

  175. 29-09-2003

  176. - property BuildMipsMaps added (default = true)

  177.   if BuildMipMaps isn't set GenTextures uses glTexImage[12]D else it use gluBuild[12]dMipmaps

  178. - property FreeDataAfterGenTexture added (default = true)

  179.   if FreeDataAfterGenTexture is set the texturedata were deleted after the texture was generated.

  180. - parameter DisableOtherTextureUnits of Bind removed

  181. - parameter FreeDataAfterGeneration of GenTextures removed

  182. 12-09-2003

  183. - TglBitmap dosn't delete data if class was destroyed (fixed)

  184. 09-09-2003

  185. - Bind now enables TextureUnits (by params)

  186. - GenTextures can leave data (by param)

  187. - LoadTextures now optimal

  188. 03-09-2003

  189. - Performance optimization in AddFunc

  190. - procedure Bind moved to subclasses

  191. - Added new Class TglBitmap1D to support real OpenGL 1D Textures

  192. 19-08-2003

  193. - Texturefilter and texturewrap now also as defaults

  194.   Minfilter = GL_LINEAR_MIPMAP_LINEAR

  195.   Magfilter = GL_LINEAR

  196.   Wrap(str) = GL_CLAMP_TO_EDGE

  197. - Added new format tfCompressed to create a compressed texture.

  198. - propertys IsCompressed, TextureSize and IsResident added

  199.   IsCompressed and TextureSize only contains data from level 0

  200. 18-08-2003

  201. - Added function AddFunc to add PerPixelEffects to Image

  202. - LoadFromFunc now based on AddFunc

  203. - Invert now based on AddFunc

  204. - SwapColors now based on AddFunc

  205. 16-08-2003

  206. - Added function FlipHorz

  207. 15-08-2003

  208. - Added function LaodFromFunc to create images with function

  209. - Added function FlipVert

  210. - Added internal format RGB(A) if GL_EXT_bgra or OpenGL 1.2 isn't supported

  211. 29-07-2003

  212. - Added Alphafunctions to calculate alpha per function

  213. - Added Alpha from ColorKey using alphafunctions

  214. 28-07-2003

  215. - First full functionally Version of glBitmap

  216. - Support for 24Bit and 32Bit TGA Pictures added

  217. 25-07-2003

  218. - begin of programming

  219. ***********************************************************}

  220. unit glBitmap;

  221. 

  222. // Please uncomment the defines below to configure the glBitmap to your preferences.

  223. // If you have configured the unit you can uncomment the warning above.

  224. {$MESSAGE warn 'Hey. I''m the glBitmap.pas and i need to be configured. My master tell me your preferences! ;)'}

  225. 

  226. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  227. // Preferences ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  228. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  229. // activate to enable build-in OpenGL support with statically linked methods

  230. // use dglOpenGL.pas if not enabled

  231. {.$DEFINE GLB_NATIVE_OGL_STATIC}

  232. 

  233. // activate to enable build-in OpenGL support with dynamically linked methods

  234. // use dglOpenGL.pas if not enabled

  235. {.$DEFINE GLB_NATIVE_OGL_DYNAMIC}

  236. 

  237. 

  238. // activate to enable the support for SDL_surfaces

  239. {.$DEFINE GLB_SDL}

  240. 

  241. // activate  to enable the support for TBitmap from Delphi (not lazarus)

  242. {.$DEFINE GLB_DELPHI}

  243. 

  244. // activate to enable the support for TLazIntfImage from Lazarus

  245. {$DEFINE GLB_LAZARUS}

  246. 

  247. 

  248. 

  249. // activate to enable the support of SDL_image to load files. (READ ONLY)

  250. // If you enable SDL_image all other libraries will be ignored!

  251. {.$DEFINE GLB_SDL_IMAGE}

  252. 

  253. 

  254. 

  255. // activate to enable png support with the unit pngimage -> http://pngdelphi.sourceforge.net/

  256. // if you enable pngimage the libPNG will be ignored

  257. {.$DEFINE GLB_PNGIMAGE}

  258. 

  259. // activate to use the libPNG -> http://www.libpng.org/

  260. // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libpng

  261. {.$DEFINE GLB_LIB_PNG}

  262. 

  263. 

  264. 

  265. // if you enable delphi jpegs the libJPEG will be ignored

  266. {.$DEFINE GLB_DELPHI_JPEG}

  267. 

  268. // activate to use the libJPEG -> http://www.ijg.org/

  269. // You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libjpeg

  270. {.$DEFINE GLB_LIB_JPEG}

  271. 

  272. 

  273. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  274. // PRIVATE: do not change anything! //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  275. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  276. // Delphi Versions

  277. {$IFDEF fpc}

  278.   {$MODE Delphi}

  279. 

  280.   {$IFDEF CPUI386}

  281.     {$DEFINE CPU386}

  282.     {$ASMMODE INTEL}

  283.   {$ENDIF}

  284. 

  285.   {$IFNDEF WINDOWS}

  286.     {$linklib c}

  287.   {$ENDIF}

  288. {$ENDIF}

  289. 

  290. // Operation System

  291. {$IF DEFINED(WIN32) or DEFINED(WIN64) or DEFINED(WINDOWS)}

  292.   {$DEFINE GLB_WIN}

  293. {$ELSEIF DEFINED(LINUX)}

  294.   {$DEFINE GLB_LINUX}

  295. {$IFEND}

  296. 

  297. // native OpenGL Support

  298. {$IF DEFINED(GLB_NATIVE_OGL_STATIC) OR DEFINED(GLB_NATIVE_OGL_DYNAMIC)}

  299.   {$DEFINE GLB_NATIVE_OGL}

  300. {$IFEND}

  301. 

  302. // checking define combinations

  303. //SDL Image

  304. {$IFDEF GLB_SDL_IMAGE}

  305.   {$IFNDEF GLB_SDL}

  306.     {$MESSAGE warn 'SDL_image won''t work without SDL. SDL will be activated.'}

  307.     {$DEFINE GLB_SDL}

  308.   {$ENDIF}

  309.   {$IFDEF GLB_PNGIMAGE}

  310.     {$MESSAGE warn 'The unit pngimage will be ignored because you are using SDL_image.'}

  311.     {$undef GLB_PNGIMAGE}

  312.   {$ENDIF}

  313.   {$IFDEF GLB_DELPHI_JPEG}

  314.     {$MESSAGE warn 'The unit JPEG will be ignored because you are using SDL_image.'}

  315.     {$undef GLB_DELPHI_JPEG}

  316.   {$ENDIF}

  317.   {$IFDEF GLB_LIB_PNG}

  318.     {$MESSAGE warn 'The library libPNG will be ignored because you are using SDL_image.'}

  319.     {$undef GLB_LIB_PNG}

  320.   {$ENDIF}

  321.   {$IFDEF GLB_LIB_JPEG}

  322.     {$MESSAGE warn 'The library libJPEG will be ignored because you are using SDL_image.'}

  323.     {$undef GLB_LIB_JPEG}

  324.   {$ENDIF}

  325. 

  326.   {$DEFINE GLB_SUPPORT_PNG_READ}

  327.   {$DEFINE GLB_SUPPORT_JPEG_READ}

  328. {$ENDIF}

  329. 

  330. // PNG Image

  331. {$IFDEF GLB_PNGIMAGE}

  332.   {$IFDEF GLB_LIB_PNG}

  333.     {$MESSAGE warn 'The library libPNG will be ignored if you are using pngimage.'}

  334.     {$undef GLB_LIB_PNG}

  335.   {$ENDIF}

  336. 

  337.   {$DEFINE GLB_SUPPORT_PNG_READ}

  338.   {$DEFINE GLB_SUPPORT_PNG_WRITE}

  339. {$ENDIF}

  340. 

  341. // libPNG

  342. {$IFDEF GLB_LIB_PNG}

  343.   {$DEFINE GLB_SUPPORT_PNG_READ}

  344.   {$DEFINE GLB_SUPPORT_PNG_WRITE}

  345. {$ENDIF}

  346. 

  347. // JPEG Image

  348. {$IFDEF GLB_DELPHI_JPEG}

  349.   {$IFDEF GLB_LIB_JPEG}

  350.     {$MESSAGE warn 'The library libJPEG will be ignored if you are using the unit JPEG.'}

  351.     {$undef GLB_LIB_JPEG}

  352.   {$ENDIF}

  353. 

  354.   {$DEFINE GLB_SUPPORT_JPEG_READ}

  355.   {$DEFINE GLB_SUPPORT_JPEG_WRITE}

  356. {$ENDIF}

  357. 

  358. // libJPEG

  359. {$IFDEF GLB_LIB_JPEG}

  360.   {$DEFINE GLB_SUPPORT_JPEG_READ}

  361.   {$DEFINE GLB_SUPPORT_JPEG_WRITE}

  362. {$ENDIF}

  363. 

  364. // native OpenGL

  365. {$IF DEFINED(GLB_NATIVE_OGL_STATIC) AND DEFINED(GLB_NATIVE_OGL_DYNAMIC)}

  366.   {$MESSAGE warn 'GLB_NATIVE_OGL_STATIC will be ignored because you enabled GLB_NATIVE_OGL_DYNAMIC'}

  367. {$IFEND}

  368. 

  369. // general options

  370. {$EXTENDEDSYNTAX ON}

  371. {$LONGSTRINGS ON}

  372. {$ALIGN ON}

  373. {$IFNDEF FPC}

  374.   {$OPTIMIZATION ON}

  375. {$ENDIF}

  376. 

  377. interface

  378. 

  379. uses

  380.   {$IFNDEF GLB_NATIVE_OGL}      dglOpenGL,                {$ENDIF}

  381.   {$IF DEFINED(GLB_WIN) AND

  382.        DEFINED(GLB_NATIVE_OGL)} windows,                  {$IFEND}

  383. 

  384.   {$IFDEF GLB_SDL}              SDL,                      {$ENDIF}

  385.   {$IFDEF GLB_LAZARUS}          IntfGraphics, GraphType,  {$ENDIF}

  386.   {$IFDEF GLB_DELPHI}           Dialogs, Graphics,        {$ENDIF}

  387. 

  388.   {$IFDEF GLB_SDL_IMAGE}        SDL_image,                {$ENDIF}

  389.   {$IFDEF GLB_PNGIMAGE}         pngimage,                 {$ENDIF}

  390.   {$IFDEF GLB_LIB_PNG}          libPNG,                   {$ENDIF}

  391.   {$IFDEF GLB_DELPHI_JPEG}      JPEG,                     {$ENDIF}

  392.   {$IFDEF GLB_LIB_JPEG}         libJPEG,                  {$ENDIF}

  393. 

  394.   Classes, SysUtils;

  395. 

  396. {$IFDEF GLB_NATIVE_OGL}

  397. const

  398.   GL_TRUE   = 1;

  399.   GL_FALSE  = 0;

  400. 

  401.   GL_ZERO = 0;

  402.   GL_ONE  = 1;

  403. 

  404.   GL_VERSION    = $1F02;

  405.   GL_EXTENSIONS = $1F03;

  406. 

  407.   GL_TEXTURE_1D         = $0DE0;

  408.   GL_TEXTURE_2D         = $0DE1;

  409.   GL_TEXTURE_RECTANGLE  = $84F5;

  410. 

  411.   GL_NORMAL_MAP                   = $8511;

  412.   GL_TEXTURE_CUBE_MAP             = $8513;

  413.   GL_REFLECTION_MAP               = $8512;

  414.   GL_TEXTURE_CUBE_MAP_POSITIVE_X  = $8515;

  415.   GL_TEXTURE_CUBE_MAP_NEGATIVE_X  = $8516;

  416.   GL_TEXTURE_CUBE_MAP_POSITIVE_Y  = $8517;

  417.   GL_TEXTURE_CUBE_MAP_NEGATIVE_Y  = $8518;

  418.   GL_TEXTURE_CUBE_MAP_POSITIVE_Z  = $8519;

  419.   GL_TEXTURE_CUBE_MAP_NEGATIVE_Z  = $851A;

  420. 

  421.   GL_TEXTURE_WIDTH            = $1000;

  422.   GL_TEXTURE_HEIGHT           = $1001;

  423.   GL_TEXTURE_INTERNAL_FORMAT  = $1003;

  424.   GL_TEXTURE_SWIZZLE_RGBA     = $8E46;

  425. 

  426.   GL_S = $2000;

  427.   GL_T = $2001;

  428.   GL_R = $2002;

  429.   GL_Q = $2003;

  430. 

  431.   GL_TEXTURE_GEN_S = $0C60;

  432.   GL_TEXTURE_GEN_T = $0C61;

  433.   GL_TEXTURE_GEN_R = $0C62;

  434.   GL_TEXTURE_GEN_Q = $0C63;

  435. 

  436.   GL_RED    = $1903;

  437.   GL_GREEN  = $1904;

  438.   GL_BLUE   = $1905;

  439. 

  440.   GL_ALPHA    = $1906;

  441.   GL_ALPHA4   = $803B;

  442.   GL_ALPHA8   = $803C;

  443.   GL_ALPHA12  = $803D;

  444.   GL_ALPHA16  = $803E;

  445. 

  446.   GL_LUMINANCE    = $1909;

  447.   GL_LUMINANCE4   = $803F;

  448.   GL_LUMINANCE8   = $8040;

  449.   GL_LUMINANCE12  = $8041;

  450.   GL_LUMINANCE16  = $8042;

  451. 

  452.   GL_LUMINANCE_ALPHA      = $190A;

  453.   GL_LUMINANCE4_ALPHA4    = $8043;

  454.   GL_LUMINANCE6_ALPHA2    = $8044;

  455.   GL_LUMINANCE8_ALPHA8    = $8045;

  456.   GL_LUMINANCE12_ALPHA4   = $8046;

  457.   GL_LUMINANCE12_ALPHA12  = $8047;

  458.   GL_LUMINANCE16_ALPHA16  = $8048;

  459. 

  460.   GL_RGB      = $1907;

  461.   GL_BGR      = $80E0;

  462.   GL_R3_G3_B2 = $2A10;

  463.   GL_RGB4     = $804F;

  464.   GL_RGB5     = $8050;

  465.   GL_RGB565   = $8D62;

  466.   GL_RGB8     = $8051;

  467.   GL_RGB10    = $8052;

  468.   GL_RGB12    = $8053;

  469.   GL_RGB16    = $8054;

  470. 

  471.   GL_RGBA     = $1908;

  472.   GL_BGRA     = $80E1;

  473.   GL_RGBA2    = $8055;

  474.   GL_RGBA4    = $8056;

  475.   GL_RGB5_A1  = $8057;

  476.   GL_RGBA8    = $8058;

  477.   GL_RGB10_A2 = $8059;

  478.   GL_RGBA12   = $805A;

  479.   GL_RGBA16   = $805B;

  480. 

  481.   GL_DEPTH_COMPONENT    = $1902;

  482.   GL_DEPTH_COMPONENT16  = $81A5;

  483.   GL_DEPTH_COMPONENT24  = $81A6;

  484.   GL_DEPTH_COMPONENT32  = $81A7;

  485. 

  486.   GL_COMPRESSED_RGB                 = $84ED;

  487.   GL_COMPRESSED_RGBA                = $84EE;

  488.   GL_COMPRESSED_RGB_S3TC_DXT1_EXT   = $83F0;

  489.   GL_COMPRESSED_RGBA_S3TC_DXT1_EXT  = $83F1;

  490.   GL_COMPRESSED_RGBA_S3TC_DXT3_EXT  = $83F2;

  491.   GL_COMPRESSED_RGBA_S3TC_DXT5_EXT  = $83F3;

  492. 

  493.   GL_UNSIGNED_BYTE            = $1401;

  494.   GL_UNSIGNED_BYTE_3_3_2      = $8032;

  495.   GL_UNSIGNED_BYTE_2_3_3_REV  = $8362;

  496. 

  497.   GL_UNSIGNED_SHORT             = $1403;

  498.   GL_UNSIGNED_SHORT_5_6_5       = $8363;

  499.   GL_UNSIGNED_SHORT_4_4_4_4     = $8033;

  500.   GL_UNSIGNED_SHORT_5_5_5_1     = $8034;

  501.   GL_UNSIGNED_SHORT_5_6_5_REV   = $8364;

  502.   GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;

  503.   GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;

  504. 

  505.   GL_UNSIGNED_INT                 = $1405;

  506.   GL_UNSIGNED_INT_8_8_8_8         = $8035;

  507.   GL_UNSIGNED_INT_10_10_10_2      = $8036;

  508.   GL_UNSIGNED_INT_8_8_8_8_REV     = $8367;

  509.   GL_UNSIGNED_INT_2_10_10_10_REV  = $8368;

  510. 

  511.   { Texture Filter }

  512.   GL_TEXTURE_MAG_FILTER     = $2800;

  513.   GL_TEXTURE_MIN_FILTER     = $2801;

  514.   GL_NEAREST                = $2600;

  515.   GL_NEAREST_MIPMAP_NEAREST = $2700;

  516.   GL_NEAREST_MIPMAP_LINEAR  = $2702;

  517.   GL_LINEAR                 = $2601;

  518.   GL_LINEAR_MIPMAP_NEAREST  = $2701;

  519.   GL_LINEAR_MIPMAP_LINEAR   = $2703;

  520. 

  521.   { Texture Wrap }

  522.   GL_TEXTURE_WRAP_S   = $2802;

  523.   GL_TEXTURE_WRAP_T   = $2803;

  524.   GL_TEXTURE_WRAP_R   = $8072;

  525.   GL_CLAMP            = $2900;

  526.   GL_REPEAT           = $2901;

  527.   GL_CLAMP_TO_EDGE    = $812F;

  528.   GL_CLAMP_TO_BORDER  = $812D;

  529.   GL_MIRRORED_REPEAT  = $8370;

  530. 

  531.   { Other }

  532.   GL_GENERATE_MIPMAP      = $8191;

  533.   GL_TEXTURE_BORDER_COLOR = $1004;

  534.   GL_MAX_TEXTURE_SIZE     = $0D33;

  535.   GL_PACK_ALIGNMENT       = $0D05;

  536.   GL_UNPACK_ALIGNMENT     = $0CF5;

  537. 

  538.   GL_TEXTURE_MAX_ANISOTROPY_EXT     = $84FE;

  539.   GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;

  540.   GL_MAX_CUBE_MAP_TEXTURE_SIZE      = $851C;

  541.   GL_TEXTURE_GEN_MODE               = $2500;

  542. 

  543. {$IF DEFINED(GLB_WIN)}

  544.   libglu    = 'glu32.dll';

  545.   libopengl = 'opengl32.dll';

  546. {$ELSEIF DEFINED(GLB_LINUX)}

  547.   libglu    = 'libGLU.so.1';

  548.   libopengl = 'libGL.so.1';

  549. {$IFEND}

  550. 

  551. type

  552.   GLboolean = BYTEBOOL;

  553.   GLint     = Integer;

  554.   GLsizei   = Integer;

  555.   GLuint    = Cardinal;

  556.   GLfloat   = Single;

  557.   GLenum    = Cardinal;

  558. 

  559.   PGLvoid    = Pointer;

  560.   PGLboolean = ^GLboolean;

  561.   PGLint     = ^GLint;

  562.   PGLuint    = ^GLuint;

  563.   PGLfloat   = ^GLfloat;

  564. 

  565.   TglCompressedTexImage1D  = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}

  566.   TglCompressedTexImage2D  = procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; height: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}

  567.   TglGetCompressedTexImage = procedure(target: GLenum; level: GLint; img: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}

  568. 

  569. {$IF DEFINED(GLB_WIN)}

  570.   TwglGetProcAddress = function (ProcName: PAnsiChar): Pointer; stdcall;

  571. {$ELSEIF DEFINED(GLB_LINUX)}

  572.   TglXGetProcAddress = function(ProcName: PAnsiChar): Pointer; cdecl;

  573.   TglXGetProcAddressARB = function(const name: PAnsiChar): pointer; cdecl;

  574. {$IFEND}

  575. 

  576. {$IF DEFINED(GLB_NATIVE_OGL_DYNAMIC)}

  577.   TglEnable  = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}

  578.   TglDisable = procedure(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}

  579. 

  580.   TglGetString   = function(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}

  581.   TglGetIntegerv = procedure(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}

  582. 

  583.   TglTexParameteri          = procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}

  584.   TglTexParameteriv         = procedure(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}

  585.   TglTexParameterfv         = procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}

  586.   TglGetTexParameteriv      = procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}

  587.   TglGetTexParameterfv      = procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}

  588.   TglGetTexLevelParameteriv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}

  589.   TglGetTexLevelParameterfv = procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}

  590. 

  591.   TglTexGeni        = procedure(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}

  592.   TglGenTextures    = procedure(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}

  593.   TglBindTexture    = procedure(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}

  594.   TglDeleteTextures = procedure(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}

  595. 

  596.   TglAreTexturesResident = function(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}

  597.   TglReadPixels          = procedure(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}

  598.   TglPixelStorei         = procedure(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}

  599. 

  600.   TglTexImage1D  = procedure(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}

  601.   TglTexImage2D  = procedure(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; height: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}

  602.   TglGetTexImage = procedure(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}

  603. 

  604.   TgluBuild1DMipmaps = function(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}

  605.   TgluBuild2DMipmaps = function(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF}

  606. 

  607. {$ELSEIF DEFINED(GLB_NATIVE_OGL_STATIC)}

  608.   procedure glEnable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;

  609.   procedure glDisable(cap: GLenum); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;

  610. 

  611.   function glGetString(name: GLenum): PAnsiChar; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;

  612.   procedure glGetIntegerv(pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;

  613. 

  614.   procedure glTexParameteri(target: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;

  615.   procedure glTexParameteriv(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;

  616.   procedure glTexParameterfv(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;

  617.   procedure glGetTexParameteriv(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;

  618.   procedure glGetTexParameterfv(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;

  619.   procedure glGetTexLevelParameteriv(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;

  620.   procedure glGetTexLevelParameterfv(target: GLenum; level: GLint; pname: GLenum; params: PGLfloat); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;

  621. 

  622.   procedure glTexGeni(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;

  623.   procedure glGenTextures(n: GLsizei; textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;

  624.   procedure glBindTexture(target: GLenum; texture: GLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;

  625.   procedure glDeleteTextures(n: GLsizei; const textures: PGLuint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;

  626. 

  627.   function  glAreTexturesResident(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF DGL_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;

  628.   procedure glReadPixels(x: GLint; y: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;

  629.   procedure glPixelStorei(pname: GLenum; param: GLint); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;

  630. 

  631.   procedure glTexImage1D(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;

  632.   procedure glTexImage2D(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; height: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;

  633.   procedure glGetTexImage(target: GLenum; level: GLint; format: GLenum; _type: GLenum; pixels: PGLvoid); {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libopengl;

  634. 

  635.   function gluBuild1DMipmaps(target: GLEnum; components, width: GLint; format, atype: GLEnum; const data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;

  636.   function gluBuild2DMipmaps(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; const Data: Pointer): GLint; {$IFDEF GLB_WIN}stdcall; {$ELSE}cdecl; {$ENDIF} external libglu;

  637. {$IFEND}

  638. 

  639. var

  640.   GL_VERSION_1_2,

  641.   GL_VERSION_1_3,

  642.   GL_VERSION_1_4,

  643.   GL_VERSION_2_0,

  644.   GL_VERSION_3_3,

  645. 

  646.   GL_SGIS_generate_mipmap,

  647. 

  648.   GL_ARB_texture_border_clamp,

  649.   GL_ARB_texture_mirrored_repeat,

  650.   GL_ARB_texture_rectangle,

  651.   GL_ARB_texture_non_power_of_two,

  652.   GL_ARB_texture_swizzle,

  653.   GL_ARB_texture_cube_map,

  654. 

  655.   GL_IBM_texture_mirrored_repeat,

  656. 

  657.   GL_NV_texture_rectangle,

  658. 

  659.   GL_EXT_texture_edge_clamp,

  660.   GL_EXT_texture_rectangle,

  661.   GL_EXT_texture_swizzle,

  662.   GL_EXT_texture_cube_map,

  663.   GL_EXT_texture_filter_anisotropic: Boolean;

  664. 

  665.   glCompressedTexImage1D: TglCompressedTexImage1D;

  666.   glCompressedTexImage2D: TglCompressedTexImage2D;

  667.   glGetCompressedTexImage: TglGetCompressedTexImage;

  668. 

  669. {$IF DEFINED(GLB_WIN)}

  670.   wglGetProcAddress: TwglGetProcAddress;

  671. {$ELSEIF DEFINED(GLB_LINUX)}

  672.   glXGetProcAddress: TglXGetProcAddress;

  673.   glXGetProcAddressARB: TglXGetProcAddress;

  674. {$IFEND}

  675. 

  676. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}

  677.   glEnable: TglEnable;

  678.   glDisable: TglDisable;

  679. 

  680.   glGetString: TglGetString;

  681.   glGetIntegerv: TglGetIntegerv;

  682. 

  683.   glTexParameteri: TglTexParameteri;

  684.   glTexParameteriv: TglTexParameteriv;

  685.   glTexParameterfv: TglTexParameterfv;

  686.   glGetTexParameteriv: TglGetTexParameteriv;

  687.   glGetTexParameterfv: TglGetTexParameterfv;

  688.   glGetTexLevelParameteriv: TglGetTexLevelParameteriv;

  689.   glGetTexLevelParameterfv: TglGetTexLevelParameterfv;

  690. 

  691.   glTexGeni: TglTexGeni;

  692.   glGenTextures: TglGenTextures;

  693.   glBindTexture: TglBindTexture;

  694.   glDeleteTextures: TglDeleteTextures;

  695. 

  696.   glAreTexturesResident: TglAreTexturesResident;

  697.   glReadPixels: TglReadPixels;

  698.   glPixelStorei: TglPixelStorei;

  699. 

  700.   glTexImage1D: TglTexImage1D;

  701.   glTexImage2D: TglTexImage2D;

  702.   glGetTexImage: TglGetTexImage;

  703. 

  704.   gluBuild1DMipmaps: TgluBuild1DMipmaps;

  705.   gluBuild2DMipmaps: TgluBuild2DMipmaps;

  706. {$ENDIF}

  707. {$ENDIF}

  708. 

  709. type

  710. ////////////////////////////////////////////////////////////////////////////////////////////////////

  711.   TglBitmapFormat = (

  712.     tfEmpty = 0, //must be smallest value!

  713. 

  714.     tfAlpha4,

  715.     tfAlpha8,

  716.     tfAlpha12,

  717.     tfAlpha16,

  718. 

  719.     tfLuminance4,

  720.     tfLuminance8,

  721.     tfLuminance12,

  722.     tfLuminance16,

  723. 

  724.     tfLuminance4Alpha4,

  725.     tfLuminance6Alpha2,

  726.     tfLuminance8Alpha8,

  727.     tfLuminance12Alpha4,

  728.     tfLuminance12Alpha12,

  729.     tfLuminance16Alpha16,

  730. 

  731.     tfR3G3B2,

  732.     tfRGB4,

  733.     tfR5G6B5,

  734.     tfRGB5,

  735.     tfRGB8,

  736.     tfRGB10,

  737.     tfRGB12,

  738.     tfRGB16,

  739. 

  740.     tfRGBA2,

  741.     tfRGBA4,

  742.     tfRGB5A1,

  743.     tfRGBA8,

  744.     tfRGB10A2,

  745.     tfRGBA12,

  746.     tfRGBA16,

  747. 

  748.     tfBGR4,

  749.     tfB5G6R5,

  750.     tfBGR5,

  751.     tfBGR8,

  752.     tfBGR10,

  753.     tfBGR12,

  754.     tfBGR16,

  755. 

  756.     tfBGRA2,

  757.     tfBGRA4,

  758.     tfBGR5A1,

  759.     tfBGRA8,

  760.     tfBGR10A2,

  761.     tfBGRA12,

  762.     tfBGRA16,

  763. 

  764.     tfDepth16,

  765.     tfDepth24,

  766.     tfDepth32,

  767. 

  768.     tfS3tcDtx1RGBA,

  769.     tfS3tcDtx3RGBA,

  770.     tfS3tcDtx5RGBA

  771.   );

  772. 

  773.   TglBitmapFileType = (

  774.      {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG,  {$ENDIF}

  775.      {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}

  776.      ftDDS,

  777.      ftTGA,

  778.      ftBMP);

  779.    TglBitmapFileTypes = set of TglBitmapFileType;

  780. 

  781.    TglBitmapMipMap = (

  782.      mmNone,

  783.      mmMipmap,

  784.      mmMipmapGlu);

  785. 

  786.    TglBitmapNormalMapFunc = (

  787.      nm4Samples,

  788.      nmSobel,

  789.      nm3x3,

  790.      nm5x5);

  791. 

  792.  ////////////////////////////////////////////////////////////////////////////////////////////////////

  793.    EglBitmap                  = class(Exception);

  794.    EglBitmapNotSupported      = class(Exception);

  795.    EglBitmapSizeToLarge       = class(EglBitmap);

  796.    EglBitmapNonPowerOfTwo     = class(EglBitmap);

  797.    EglBitmapUnsupportedFormat = class(EglBitmap)

  798.      constructor Create(const aFormat: TglBitmapFormat); overload;

  799.      constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;

  800.    end;

  801. 

  802. ////////////////////////////////////////////////////////////////////////////////////////////////////

  803.   TglBitmapColorRec = packed record

  804.   case Integer of

  805.     0: (r, g, b, a: Cardinal);

  806.     1: (arr: array[0..3] of Cardinal);

  807.   end;

  808. 

  809.   TglBitmapPixelData = packed record

  810.     Data, Range: TglBitmapColorRec;

  811.     Format: TglBitmapFormat;

  812.   end;

  813.   PglBitmapPixelData = ^TglBitmapPixelData;

  814. 

  815. ////////////////////////////////////////////////////////////////////////////////////////////////////

  816.   TglBitmapPixelPositionFields = set of (ffX, ffY);

  817.   TglBitmapPixelPosition = record

  818.     Fields : TglBitmapPixelPositionFields;

  819.     X : Word;

  820.     Y : Word;

  821.   end;

  822. 

  823.   TglBitmapFormatDescriptor = class(TObject)

  824.   protected

  825.     function GetIsCompressed: Boolean; virtual; abstract;

  826.     function GetHasAlpha:     Boolean; virtual; abstract;

  827. 

  828.     function GetglDataFormat:     GLenum;  virtual; abstract;

  829.     function GetglFormat:         GLenum;  virtual; abstract;

  830.     function GetglInternalFormat: GLenum;  virtual; abstract;

  831.   public

  832.     property IsCompressed: Boolean read GetIsCompressed;

  833.     property HasAlpha:     Boolean read GetHasAlpha;

  834. 

  835.     property glFormat:         GLenum  read GetglFormat;

  836.     property glInternalFormat: GLenum  read GetglInternalFormat;

  837.     property glDataFormat:     GLenum  read GetglDataFormat;

  838.   end;

  839. 

  840. ////////////////////////////////////////////////////////////////////////////////////////////////////

  841.   TglBitmap = class;

  842.   TglBitmapFunctionRec = record

  843.     Sender:   TglBitmap;

  844.     Size:     TglBitmapPixelPosition;

  845.     Position: TglBitmapPixelPosition;

  846.     Source:   TglBitmapPixelData;

  847.     Dest:     TglBitmapPixelData;

  848.     Args:     Pointer;

  849.   end;

  850.   TglBitmapFunction = procedure(var FuncRec: TglBitmapFunctionRec);

  851. 

  852. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  853.   TglBitmap = class

  854.   private

  855.     function GetFormatDesc: TglBitmapFormatDescriptor;

  856.   protected

  857.     fID: GLuint;

  858.     fTarget: GLuint;

  859.     fAnisotropic: Integer;

  860.     fDeleteTextureOnFree: Boolean;

  861.     fFreeDataAfterGenTexture: Boolean;

  862.     fData: PByte;

  863.     fIsResident: Boolean;

  864.     fBorderColor: array[0..3] of Single;

  865. 

  866.     fDimension: TglBitmapPixelPosition;

  867.     fMipMap: TglBitmapMipMap;

  868.     fFormat: TglBitmapFormat;

  869. 

  870.     // Mapping

  871.     fPixelSize: Integer;

  872.     fRowSize: Integer;

  873. 

  874.     // Filtering

  875.     fFilterMin: GLenum;

  876.     fFilterMag: GLenum;

  877. 

  878.     // TexturWarp

  879.     fWrapS: GLenum;

  880.     fWrapT: GLenum;

  881.     fWrapR: GLenum;

  882. 

  883.     //Swizzle

  884.     fSwizzle: array[0..3] of GLenum;

  885. 

  886.     // CustomData

  887.     fFilename: String;

  888.     fCustomName: String;

  889.     fCustomNameW: WideString;

  890.     fCustomData: Pointer;

  891. 

  892.     //Getter

  893.     function GetWidth:  Integer; virtual;

  894.     function GetHeight: Integer; virtual;

  895. 

  896.     function GetFileWidth:  Integer; virtual;

  897.     function GetFileHeight: Integer; virtual;

  898. 

  899.     //Setter

  900.     procedure SetCustomData(const aValue: Pointer);

  901.     procedure SetCustomName(const aValue: String);

  902.     procedure SetCustomNameW(const aValue: WideString);

  903.     procedure SetDeleteTextureOnFree(const aValue: Boolean);

  904.     procedure SetFormat(const aValue: TglBitmapFormat);

  905.     procedure SetFreeDataAfterGenTexture(const aValue: Boolean);

  906.     procedure SetID(const aValue: Cardinal);

  907.     procedure SetMipMap(const aValue: TglBitmapMipMap);

  908.     procedure SetTarget(const aValue: Cardinal);

  909.     procedure SetAnisotropic(const aValue: Integer);

  910. 

  911.     procedure CreateID;

  912.     procedure SetupParameters(out aBuildWithGlu: Boolean);

  913.     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;

  914.       const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;  //be careful, aData could be freed by this method

  915.     procedure GenTexture(const aTestTextureSize: Boolean = true); virtual; abstract;

  916. 

  917.     function FlipHorz: Boolean; virtual;

  918.     function FlipVert: Boolean; virtual;

  919. 

  920.     property Width:  Integer read GetWidth;

  921.     property Height: Integer read GetHeight;

  922. 

  923.     property FileWidth:  Integer read GetFileWidth;

  924.     property FileHeight: Integer read GetFileHeight;

  925.   public

  926.     //Properties

  927.     property ID:           Cardinal        read fID          write SetID;

  928.     property Target:       Cardinal        read fTarget      write SetTarget;

  929.     property Format:       TglBitmapFormat read fFormat      write SetFormat;

  930.     property MipMap:       TglBitmapMipMap read fMipMap      write SetMipMap;

  931.     property Anisotropic:  Integer         read fAnisotropic write SetAnisotropic;

  932. 

  933.     property FormatDesc:   TglBitmapFormatDescriptor read GetFormatDesc;

  934. 

  935.     property Filename:    String     read fFilename;

  936.     property CustomName:  String     read fCustomName  write SetCustomName;

  937.     property CustomNameW: WideString read fCustomNameW write SetCustomNameW;

  938.     property CustomData:  Pointer    read fCustomData  write SetCustomData;

  939. 

  940.     property DeleteTextureOnFree:     Boolean read fDeleteTextureOnFree     write SetDeleteTextureOnFree;

  941.     property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;

  942. 

  943.     property Dimension:  TglBitmapPixelPosition  read fDimension;

  944.     property Data:       PByte                   read fData;

  945.     property IsResident: Boolean                 read fIsResident;

  946. 

  947.     procedure AfterConstruction; override;

  948.     procedure BeforeDestruction; override;

  949. 

  950.     procedure PrepareResType(var aResource: String; var aResType: PChar);

  951. 

  952.     //Load

  953.     procedure LoadFromFile(const aFilename: String);

  954.     procedure LoadFromStream(const aStream: TStream); virtual;

  955.     procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;

  956.       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);

  957.     procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);

  958.     procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);

  959. 

  960.     //Save

  961.     procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);

  962.     procedure SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType); virtual;

  963. 

  964.     //Convert

  965.     function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer = nil): Boolean; overload;

  966.     function AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;

  967.       const aFormat: TglBitmapFormat; const aArgs: Pointer = nil): Boolean; overload;

  968.   public

  969.     //Alpha & Co

  970.     {$IFDEF GLB_SDL}

  971.     function AssignToSurface(out aSurface: PSDL_Surface): Boolean;

  972.     function AssignFromSurface(const aSurface: PSDL_Surface): Boolean;

  973.     function AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;

  974.     function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil;

  975.       const aArgs: Pointer = nil): Boolean;

  976.     {$ENDIF}

  977. 

  978.     {$IFDEF GLB_DELPHI}

  979.     function AssignToBitmap(const aBitmap: TBitmap): Boolean;

  980.     function AssignFromBitmap(const aBitmap: TBitmap): Boolean;

  981.     function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;

  982.     function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;

  983.       const aArgs: Pointer = nil): Boolean;

  984.     {$ENDIF}

  985. 

  986.     {$IFDEF GLB_LAZARUS}

  987.     function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;

  988.     function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;

  989.     function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;

  990.     function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil;

  991.       const aArgs: Pointer = nil): Boolean;

  992.     {$ENDIF}

  993. 

  994.     function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil;

  995.       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;

  996.     function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;

  997.       const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;

  998. 

  999.     function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;

  1000.     function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;

  1001.     function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;

  1002.     function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;

  1003. 

  1004.     function AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte = 0): Boolean;

  1005.     function AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal = 0): Boolean;

  1006.     function AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single = 0): Boolean;

  1007. 

  1008.     function AddAlphaFromValue(const aAlpha: Byte): Boolean;

  1009.     function AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;

  1010.     function AddAlphaFromValueFloat(const aAlpha: Single): Boolean;

  1011. 

  1012.     function RemoveAlpha: Boolean; virtual;

  1013.   public

  1014.     //Common

  1015.     function Clone: TglBitmap;

  1016.     function ConvertTo(const aFormat: TglBitmapFormat): Boolean; virtual;

  1017.     procedure Invert(const aUseRGB: Boolean = true; const aUseAlpha: Boolean = false);

  1018.     procedure SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);

  1019.     procedure FreeData;

  1020. 

  1021.     //ColorFill

  1022.     procedure FillWithColor(const aRed, aGreen, aBlue: Byte; const aAlpha: Byte = 255);

  1023.     procedure FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal = $FFFFFFFF);

  1024.     procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha : Single = 1);

  1025. 

  1026.     //TexParameters

  1027.     procedure SetFilter(const aMin, aMag: GLenum);

  1028.     procedure SetWrap(

  1029.       const S: GLenum = GL_CLAMP_TO_EDGE;

  1030.       const T: GLenum = GL_CLAMP_TO_EDGE;

  1031.       const R: GLenum = GL_CLAMP_TO_EDGE);

  1032.     procedure SetSwizzle(const r, g, b, a: GLenum);

  1033. 

  1034.     procedure Bind(const aEnableTextureUnit: Boolean = true); virtual;

  1035.     procedure Unbind(const aDisableTextureUnit: Boolean = true); virtual;

  1036. 

  1037.     //Constructors

  1038.     constructor Create; overload;

  1039.     constructor Create(const aFileName: String); overload;

  1040.     constructor Create(const aStream: TStream); overload;

  1041.     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat); overload;

  1042.     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;

  1043.     constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;

  1044.     constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;

  1045.   private

  1046.     {$IFDEF GLB_SUPPORT_PNG_READ}  function  LoadPNG(const aStream: TStream): Boolean; virtual; {$ENDIF}

  1047.     {$ifdef GLB_SUPPORT_PNG_WRITE} procedure SavePNG(const aStream: TStream); virtual; {$ENDIF}

  1048. 

  1049.     {$IFDEF GLB_SUPPORT_JPEG_READ}  function  LoadJPEG(const aStream: TStream): Boolean; virtual; {$ENDIF}

  1050.     {$IFDEF GLB_SUPPORT_JPEG_WRITE} procedure SaveJPEG(const aStream: TStream); virtual; {$ENDIF}

  1051. 

  1052.     function LoadBMP(const aStream: TStream): Boolean; virtual;

  1053.     procedure SaveBMP(const aStream: TStream); virtual;

  1054. 

  1055.     function LoadTGA(const aStream: TStream): Boolean; virtual;

  1056.     procedure SaveTGA(const aStream: TStream); virtual;

  1057. 

  1058.     function LoadDDS(const aStream: TStream): Boolean; virtual;

  1059.     procedure SaveDDS(const aStream: TStream); virtual;

  1060.   end;

  1061. 

  1062. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1063.   TglBitmap1D = class(TglBitmap)

  1064.   protected

  1065.     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;

  1066.       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;

  1067.     procedure UploadData(const aBuildWithGlu: Boolean);

  1068.   public

  1069.     property Width;

  1070.     procedure AfterConstruction; override;

  1071.     function FlipHorz: Boolean; override;

  1072.     procedure GenTexture(const aTestTextureSize: Boolean = true); override;

  1073.   end;

  1074. 

  1075. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1076.   TglBitmap2D = class(TglBitmap)

  1077.   protected

  1078.     fLines: array of PByte;

  1079.     function GetScanline(const aIndex: Integer): Pointer;

  1080.     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;

  1081.       const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;

  1082.     procedure UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);

  1083.   public

  1084.     property Width;

  1085.     property Height;

  1086.     property Scanline[const aIndex: Integer]: Pointer read GetScanline;

  1087. 

  1088.     procedure AfterConstruction; override;

  1089. 

  1090.     procedure GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);

  1091.     procedure GetDataFromTexture;

  1092.     procedure GenTexture(const aTestTextureSize: Boolean = true); override;

  1093. 

  1094.     function FlipHorz: Boolean; override;

  1095.     function FlipVert: Boolean; override;

  1096. 

  1097.     procedure ToNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;

  1098.       const aScale: Single = 2; const aUseAlpha: Boolean = false);

  1099.   end;

  1100. 

  1101. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1102.   TglBitmapCubeMap = class(TglBitmap2D)

  1103.   protected

  1104.     fGenMode: Integer;

  1105.     procedure GenTexture(const aTestTextureSize: Boolean = true); reintroduce;

  1106.   public

  1107.     procedure AfterConstruction; override;

  1108.     procedure GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean = true);

  1109.     procedure Bind(const aEnableTexCoordsGen: Boolean = true; const aEnableTextureUnit: Boolean = true); reintroduce; virtual;

  1110.     procedure Unbind(const aDisableTexCoordsGen: Boolean = true; const aDisableTextureUnit: Boolean = true); reintroduce; virtual;

  1111.   end;

  1112. 

  1113. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1114.   TglBitmapNormalMap = class(TglBitmapCubeMap)

  1115.   public

  1116.     procedure AfterConstruction; override;

  1117.     procedure GenerateNormalMap(const aSize: Integer = 32; const aTestTextureSize: Boolean = true);

  1118.   end;

  1119. 

  1120. const

  1121.   NULL_SIZE: TglBitmapPixelPosition = (Fields: []; X: 0; Y: 0);

  1122. 

  1123. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);

  1124. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);

  1125. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);

  1126. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);

  1127. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);

  1128. procedure glBitmapSetDefaultWrap(

  1129.   const S: Cardinal = GL_CLAMP_TO_EDGE;

  1130.   const T: Cardinal = GL_CLAMP_TO_EDGE;

  1131.   const R: Cardinal = GL_CLAMP_TO_EDGE);

  1132. 

  1133. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;

  1134. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;

  1135. function glBitmapGetDefaultMipmap: TglBitmapMipMap;

  1136. function glBitmapGetDefaultFormat: TglBitmapFormat;

  1137. procedure glBitmapGetDefaultFilter(var aMin, aMag: Cardinal);

  1138. procedure glBitmapGetDefaultTextureWrap(var S, T, R: Cardinal);

  1139. 

  1140. function glBitmapPosition(X: Integer = -1; Y: Integer = -1): TglBitmapPixelPosition;

  1141. function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;

  1142. function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;

  1143. 

  1144. var

  1145.   glBitmapDefaultDeleteTextureOnFree: Boolean;

  1146.   glBitmapDefaultFreeDataAfterGenTextures: Boolean;

  1147.   glBitmapDefaultFormat: TglBitmapFormat;

  1148.   glBitmapDefaultMipmap: TglBitmapMipMap;

  1149.   glBitmapDefaultFilterMin: Cardinal;

  1150.   glBitmapDefaultFilterMag: Cardinal;

  1151.   glBitmapDefaultWrapS: Cardinal;

  1152.   glBitmapDefaultWrapT: Cardinal;

  1153.   glBitmapDefaultWrapR: Cardinal;

  1154.   glDefaultSwizzle: array[0..3] of GLenum;

  1155. 

  1156. {$IFDEF GLB_DELPHI}

  1157. function CreateGrayPalette: HPALETTE;

  1158. {$ENDIF}

  1159. 

  1160. implementation

  1161. 

  1162. uses

  1163.   Math, syncobjs, typinfo;

  1164. 

  1165. type

  1166. {$IFNDEF fpc}

  1167.   QWord   = System.UInt64;

  1168.   PQWord  = ^QWord;

  1169. 

  1170.   PtrInt  = Longint;

  1171.   PtrUInt = DWord;

  1172. {$ENDIF}

  1173. 

  1174. ////////////////////////////////////////////////////////////////////////////////////////////////////

  1175.   TShiftRec = packed record

  1176.   case Integer of

  1177.     0: (r, g, b, a: Byte);

  1178.     1: (arr: array[0..3] of Byte);

  1179.   end;

  1180. 

  1181.   TFormatDescriptor = class(TglBitmapFormatDescriptor)

  1182.   private

  1183.     function GetRedMask: QWord;

  1184.     function GetGreenMask: QWord;

  1185.     function GetBlueMask: QWord;

  1186.     function GetAlphaMask: QWord;

  1187.   protected

  1188.     fFormat: TglBitmapFormat;

  1189.     fWithAlpha: TglBitmapFormat;

  1190.     fWithoutAlpha: TglBitmapFormat;

  1191.     fRGBInverted: TglBitmapFormat;

  1192.     fUncompressed: TglBitmapFormat;

  1193.     fPixelSize: Single;

  1194.     fIsCompressed: Boolean;

  1195. 

  1196.     fRange: TglBitmapColorRec;

  1197.     fShift: TShiftRec;

  1198. 

  1199.     fglFormat:         GLenum;

  1200.     fglInternalFormat: GLenum;

  1201.     fglDataFormat:     GLenum;

  1202. 

  1203.     function GetIsCompressed: Boolean; override;

  1204.     function GetHasAlpha: Boolean; override;

  1205. 

  1206.     function GetglFormat: GLenum; override;

  1207.     function GetglInternalFormat: GLenum; override;

  1208.     function GetglDataFormat: GLenum; override;

  1209. 

  1210.     function GetComponents: Integer; virtual;

  1211.   public

  1212.     property Format:       TglBitmapFormat read fFormat;

  1213.     property WithAlpha:    TglBitmapFormat read fWithAlpha;

  1214.     property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;

  1215.     property RGBInverted:  TglBitmapFormat read fRGBInverted;

  1216.     property Components:   Integer         read GetComponents;

  1217.     property PixelSize:    Single          read fPixelSize;

  1218. 

  1219.     property Range: TglBitmapColorRec read fRange;

  1220.     property Shift: TShiftRec         read fShift;

  1221. 

  1222.     property RedMask:   QWord read GetRedMask;

  1223.     property GreenMask: QWord read GetGreenMask;

  1224.     property BlueMask:  QWord read GetBlueMask;

  1225.     property AlphaMask: QWord read GetAlphaMask;

  1226. 

  1227.     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); virtual; abstract;

  1228.     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); virtual; abstract;

  1229. 

  1230.     function GetSize(const aSize: TglBitmapPixelPosition): Integer; overload; virtual;

  1231.     function GetSize(const aWidth, aHeight: Integer): Integer; overload; virtual; 

  1232. 

  1233.     function CreateMappingData: Pointer; virtual;

  1234.     procedure FreeMappingData(var aMappingData: Pointer); virtual;

  1235. 

  1236.     function IsEmpty:  Boolean; virtual;

  1237.     function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean; virtual;

  1238. 

  1239.     procedure PreparePixel(out aPixel: TglBitmapPixelData); virtual;

  1240. 

  1241.     constructor Create; virtual;

  1242.   public

  1243.     class procedure Init;

  1244.     class function Get(const aFormat: TglBitmapFormat): TFormatDescriptor;

  1245.     class function GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;

  1246.     class procedure Clear;

  1247.     class procedure Finalize;

  1248.   end;

  1249.   TFormatDescriptorClass = class of TFormatDescriptor;

  1250. 

  1251.   TfdEmpty = class(TFormatDescriptor);

  1252. 

  1253. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1254.   TfdAlpha_UB1 = class(TFormatDescriptor) //1* unsigned byte

  1255.     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;

  1256.     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;

  1257.     constructor Create; override;

  1258.   end;

  1259. 

  1260.   TfdLuminance_UB1 = class(TFormatDescriptor) //1* unsigned byte

  1261.     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;

  1262.     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;

  1263.     constructor Create; override;

  1264.   end;

  1265. 

  1266.   TfdUniversal_UB1 = class(TFormatDescriptor) //1* unsigned byte

  1267.     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;

  1268.     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;

  1269.     constructor Create; override;

  1270.   end;

  1271. 

  1272.   TfdLuminanceAlpha_UB2 = class(TfdLuminance_UB1) //2* unsigned byte

  1273.     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;

  1274.     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;

  1275.     constructor Create; override;

  1276.   end;

  1277. 

  1278.   TfdRGB_UB3 = class(TFormatDescriptor) //3* unsigned byte

  1279.     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;

  1280.     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;

  1281.     constructor Create; override;

  1282.   end;

  1283. 

  1284.   TfdBGR_UB3 = class(TFormatDescriptor) //3* unsigned byte (inverse)

  1285.     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;

  1286.     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;

  1287.     constructor Create; override;

  1288.   end;

  1289. 

  1290.   TfdRGBA_UB4 = class(TfdRGB_UB3) //4* unsigned byte

  1291.     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;

  1292.     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;

  1293.     constructor Create; override;

  1294.   end;

  1295. 

  1296.   TfdBGRA_UB4 = class(TfdBGR_UB3) //4* unsigned byte  (inverse)

  1297.     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;

  1298.     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;

  1299.     constructor Create; override;

  1300.   end;

  1301. 

  1302. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1303.   TfdAlpha_US1 = class(TFormatDescriptor) //1* unsigned short

  1304.     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;

  1305.     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;

  1306.     constructor Create; override;

  1307.   end;

  1308. 

  1309.   TfdLuminance_US1 = class(TFormatDescriptor) //1* unsigned short

  1310.     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;

  1311.     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;

  1312.     constructor Create; override;

  1313.   end;

  1314. 

  1315.   TfdUniversal_US1 = class(TFormatDescriptor) //1* unsigned short

  1316.     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;

  1317.     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;

  1318.     constructor Create; override;

  1319.   end;

  1320. 

  1321.   TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short

  1322.     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;

  1323.     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;

  1324.     constructor Create; override;

  1325.   end;

  1326. 

  1327.   TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short

  1328.     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;

  1329.     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;

  1330.     constructor Create; override;

  1331.   end;

  1332. 

  1333.   TfdRGB_US3 = class(TFormatDescriptor) //3* unsigned short

  1334.     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;

  1335.     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;

  1336.     constructor Create; override;

  1337.   end;

  1338. 

  1339.   TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)

  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.     constructor Create; override;

  1343.   end;

  1344. 

  1345.   TfdRGBA_US4 = class(TfdRGB_US3) //4* unsigned short

  1346.     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;

  1347.     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;

  1348.     constructor Create; override;

  1349.   end;

  1350. 

  1351.   TfdBGRA_US4 = class(TfdBGR_US3) //4* unsigned short (inverse)

  1352.     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;

  1353.     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;

  1354.     constructor Create; override;

  1355.   end;

  1356. 

  1357. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1358.   TfdUniversal_UI1 = class(TFormatDescriptor) //1* unsigned int

  1359.     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;

  1360.     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;

  1361.     constructor Create; override;

  1362.   end;

  1363. 

  1364.   TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int

  1365.     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;

  1366.     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;

  1367.     constructor Create; override;

  1368.   end;

  1369. 

  1370. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1371.   TfdAlpha4 = class(TfdAlpha_UB1)

  1372.     constructor Create; override;

  1373.   end;

  1374. 

  1375.   TfdAlpha8 = class(TfdAlpha_UB1)

  1376.     constructor Create; override;

  1377.   end;

  1378. 

  1379.   TfdAlpha12 = class(TfdAlpha_US1)

  1380.     constructor Create; override;

  1381.   end;

  1382. 

  1383.   TfdAlpha16 = class(TfdAlpha_US1)

  1384.     constructor Create; override;

  1385.   end;

  1386. 

  1387.   TfdLuminance4 = class(TfdLuminance_UB1)

  1388.     constructor Create; override;

  1389.   end;

  1390. 

  1391.   TfdLuminance8 = class(TfdLuminance_UB1)

  1392.     constructor Create; override;

  1393.   end;

  1394. 

  1395.   TfdLuminance12 = class(TfdLuminance_US1)

  1396.     constructor Create; override;

  1397.   end;

  1398. 

  1399.   TfdLuminance16 = class(TfdLuminance_US1)

  1400.     constructor Create; override;

  1401.   end;

  1402. 

  1403.   TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)

  1404.     constructor Create; override;

  1405.   end;

  1406. 

  1407.   TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)

  1408.     constructor Create; override;

  1409.   end;

  1410. 

  1411.   TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)

  1412.     constructor Create; override;

  1413.   end;

  1414. 

  1415.   TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)

  1416.     constructor Create; override;

  1417.   end;

  1418. 

  1419.   TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)

  1420.     constructor Create; override;

  1421.   end;

  1422. 

  1423.   TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)

  1424.     constructor Create; override;

  1425.   end;

  1426. 

  1427.   TfdR3G3B2 = class(TfdUniversal_UB1)

  1428.     constructor Create; override;

  1429.   end;

  1430. 

  1431.   TfdRGB4 = class(TfdUniversal_US1)

  1432.     constructor Create; override;

  1433.   end;

  1434. 

  1435.   TfdR5G6B5 = class(TfdUniversal_US1)

  1436.     constructor Create; override;

  1437.   end;

  1438. 

  1439.   TfdRGB5 = class(TfdUniversal_US1)

  1440.     constructor Create; override;

  1441.   end;

  1442. 

  1443.   TfdRGB8 = class(TfdRGB_UB3)

  1444.     constructor Create; override;

  1445.   end;

  1446. 

  1447.   TfdRGB10 = class(TfdUniversal_UI1)

  1448.     constructor Create; override;

  1449.   end;

  1450. 

  1451.   TfdRGB12 = class(TfdRGB_US3)

  1452.     constructor Create; override;

  1453.   end;

  1454. 

  1455.   TfdRGB16 = class(TfdRGB_US3)

  1456.     constructor Create; override;

  1457.   end;

  1458. 

  1459.   TfdRGBA2 = class(TfdRGBA_UB4)

  1460.     constructor Create; override;

  1461.   end;

  1462. 

  1463.   TfdRGBA4 = class(TfdUniversal_US1)

  1464.     constructor Create; override;

  1465.   end;

  1466. 

  1467.   TfdRGB5A1 = class(TfdUniversal_US1)

  1468.     constructor Create; override;

  1469.   end;

  1470. 

  1471.   TfdRGBA8 = class(TfdRGBA_UB4)

  1472.     constructor Create; override;

  1473.   end;

  1474. 

  1475.   TfdRGB10A2 = class(TfdUniversal_UI1)

  1476.     constructor Create; override;

  1477.   end;

  1478. 

  1479.   TfdRGBA12 = class(TfdRGBA_US4)

  1480.     constructor Create; override;

  1481.   end;

  1482. 

  1483.   TfdRGBA16 = class(TfdRGBA_US4)

  1484.     constructor Create; override;

  1485.   end;

  1486. 

  1487.   TfdBGR4 = class(TfdUniversal_US1)

  1488.     constructor Create; override;

  1489.   end;

  1490. 

  1491.   TfdB5G6R5 = class(TfdUniversal_US1)

  1492.     constructor Create; override;

  1493.   end;

  1494. 

  1495.   TfdBGR5 = class(TfdUniversal_US1)

  1496.     constructor Create; override;

  1497.   end;

  1498. 

  1499.   TfdBGR8 = class(TfdBGR_UB3)

  1500.     constructor Create; override;

  1501.   end;

  1502. 

  1503.   TfdBGR10 = class(TfdUniversal_UI1)

  1504.     constructor Create; override;

  1505.   end;

  1506. 

  1507.   TfdBGR12 = class(TfdBGR_US3)

  1508.     constructor Create; override;

  1509.   end;

  1510. 

  1511.   TfdBGR16 = class(TfdBGR_US3)

  1512.     constructor Create; override;

  1513.   end;

  1514. 

  1515.   TfdBGRA2 = class(TfdBGRA_UB4)

  1516.     constructor Create; override;

  1517.   end;

  1518. 

  1519.   TfdBGRA4 = class(TfdUniversal_US1)

  1520.     constructor Create; override;

  1521.   end;

  1522. 

  1523.   TfdBGR5A1 = class(TfdUniversal_US1)

  1524.     constructor Create; override;

  1525.   end;

  1526. 

  1527.   TfdBGRA8 = class(TfdBGRA_UB4)

  1528.     constructor Create; override;

  1529.   end;

  1530. 

  1531.   TfdBGR10A2 = class(TfdUniversal_UI1)

  1532.     constructor Create; override;

  1533.   end;

  1534. 

  1535.   TfdBGRA12 = class(TfdBGRA_US4)

  1536.     constructor Create; override;

  1537.   end;

  1538. 

  1539.   TfdBGRA16 = class(TfdBGRA_US4)

  1540.     constructor Create; override;

  1541.   end;

  1542. 

  1543.   TfdDepth16 = class(TfdDepth_US1)

  1544.     constructor Create; override;

  1545.   end;

  1546. 

  1547.   TfdDepth24 = class(TfdDepth_UI1)

  1548.     constructor Create; override;

  1549.   end;

  1550. 

  1551.   TfdDepth32 = class(TfdDepth_UI1)

  1552.     constructor Create; override;

  1553.   end;

  1554. 

  1555.   TfdS3tcDtx1RGBA = class(TFormatDescriptor)

  1556.     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;

  1557.     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;

  1558.     constructor Create; override;

  1559.   end;

  1560. 

  1561.   TfdS3tcDtx3RGBA = class(TFormatDescriptor)

  1562.     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;

  1563.     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;

  1564.     constructor Create; override;

  1565.   end;

  1566. 

  1567.   TfdS3tcDtx5RGBA = class(TFormatDescriptor)

  1568.     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;

  1569.     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;

  1570.     constructor Create; override;

  1571.   end;

  1572. 

  1573. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1574.   TbmpBitfieldFormat = class(TFormatDescriptor)

  1575.   private

  1576.     procedure SetRedMask  (const aValue: QWord);

  1577.     procedure SetGreenMask(const aValue: QWord);

  1578.     procedure SetBlueMask (const aValue: QWord);

  1579.     procedure SetAlphaMask(const aValue: QWord);

  1580. 

  1581.     procedure Update(aMask: QWord; out aRange: Cardinal; out aShift: Byte);

  1582.   public

  1583.     property RedMask:   QWord read GetRedMask   write SetRedMask;

  1584.     property GreenMask: QWord read GetGreenMask write SetGreenMask;

  1585.     property BlueMask:  QWord read GetBlueMask  write SetBlueMask;

  1586.     property AlphaMask: QWord read GetAlphaMask write SetAlphaMask;

  1587. 

  1588.     property PixelSize: Single read fPixelSize write fPixelSize;

  1589. 

  1590.     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;

  1591.     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;

  1592.   end;

  1593. 

  1594. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1595.   TbmpColorTableEnty = packed record

  1596.     b, g, r, a: Byte;

  1597.   end;

  1598.   TbmpColorTable = array of TbmpColorTableEnty;

  1599.   TbmpColorTableFormat = class(TFormatDescriptor)

  1600.   private

  1601.     fColorTable: TbmpColorTable;

  1602.   public

  1603.     property PixelSize:  Single            read fPixelSize  write fPixelSize;

  1604.     property ColorTable: TbmpColorTable    read fColorTable write fColorTable;

  1605.     property Range:      TglBitmapColorRec read fRange      write fRange;

  1606.     property Shift:      TShiftRec         read fShift      write fShift;

  1607.     property Format:     TglBitmapFormat   read fFormat     write fFormat;

  1608. 

  1609.     procedure CreateColorTable;

  1610. 

  1611.     procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;

  1612.     procedure Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer); override;

  1613.     destructor Destroy; override;

  1614.   end;

  1615. 

  1616. const

  1617.   LUMINANCE_WEIGHT_R = 0.30;

  1618.   LUMINANCE_WEIGHT_G = 0.59;

  1619.   LUMINANCE_WEIGHT_B = 0.11;

  1620. 

  1621.   ALPHA_WEIGHT_R = 0.30;

  1622.   ALPHA_WEIGHT_G = 0.59;

  1623.   ALPHA_WEIGHT_B = 0.11;

  1624. 

  1625.   DEPTH_WEIGHT_R = 0.333333333;

  1626.   DEPTH_WEIGHT_G = 0.333333333;

  1627.   DEPTH_WEIGHT_B = 0.333333333;

  1628. 

  1629.   UNSUPPORTED_FORMAT = 'the given format isn''t supported by this function.';

  1630. 

  1631.   FORMAT_DESCRIPTOR_CLASSES: array[TglBitmapFormat] of TFormatDescriptorClass = (

  1632.     TfdEmpty,

  1633. 

  1634.     TfdAlpha4,

  1635.     TfdAlpha8,

  1636.     TfdAlpha12,

  1637.     TfdAlpha16,

  1638. 

  1639.     TfdLuminance4,

  1640.     TfdLuminance8,

  1641.     TfdLuminance12,

  1642.     TfdLuminance16,

  1643. 

  1644.     TfdLuminance4Alpha4,

  1645.     TfdLuminance6Alpha2,

  1646.     TfdLuminance8Alpha8,

  1647.     TfdLuminance12Alpha4,

  1648.     TfdLuminance12Alpha12,

  1649.     TfdLuminance16Alpha16,

  1650. 

  1651.     TfdR3G3B2,

  1652.     TfdRGB4,

  1653.     TfdR5G6B5,

  1654.     TfdRGB5,

  1655.     TfdRGB8,

  1656.     TfdRGB10,

  1657.     TfdRGB12,

  1658.     TfdRGB16,

  1659. 

  1660.     TfdRGBA2,

  1661.     TfdRGBA4,

  1662.     TfdRGB5A1,

  1663.     TfdRGBA8,

  1664.     TfdRGB10A2,

  1665.     TfdRGBA12,

  1666.     TfdRGBA16,

  1667. 

  1668.     TfdBGR4,

  1669.     TfdB5G6R5,

  1670.     TfdBGR5,

  1671.     TfdBGR8,

  1672.     TfdBGR10,

  1673.     TfdBGR12,

  1674.     TfdBGR16,

  1675. 

  1676.     TfdBGRA2,

  1677.     TfdBGRA4,

  1678.     TfdBGR5A1,

  1679.     TfdBGRA8,

  1680.     TfdBGR10A2,

  1681.     TfdBGRA12,

  1682.     TfdBGRA16,

  1683. 

  1684.     TfdDepth16,

  1685.     TfdDepth24,

  1686.     TfdDepth32,

  1687. 

  1688.     TfdS3tcDtx1RGBA,

  1689.     TfdS3tcDtx3RGBA,

  1690.     TfdS3tcDtx5RGBA

  1691.   );

  1692. 

  1693. var

  1694.   FormatDescriptorCS: TCriticalSection;

  1695.   FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;

  1696. 

  1697. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1698. constructor EglBitmapUnsupportedFormat.Create(const aFormat: TglBitmapFormat);

  1699. begin

  1700.   inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));

  1701. end;

  1702. 

  1703. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1704. constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);

  1705. begin

  1706.   inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));

  1707. end;

  1708. 

  1709. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1710. function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;

  1711. begin

  1712.   result.Fields := [];

  1713. 

  1714.   if X >= 0 then

  1715.     result.Fields := result.Fields + [ffX];

  1716.   if Y >= 0 then

  1717.     result.Fields := result.Fields + [ffY];

  1718. 

  1719.   result.X := Max(0, X);

  1720.   result.Y := Max(0, Y);

  1721. end;

  1722. 

  1723. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1724. function glBitmapColorRec(const r, g, b, a: Cardinal): TglBitmapColorRec;

  1725. begin

  1726.   result.r := r;

  1727.   result.g := g;

  1728.   result.b := b;

  1729.   result.a := a;

  1730. end;

  1731. 

  1732. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1733. function glBitmapColorRecCmp(const r1, r2: TglBitmapColorRec): Boolean;

  1734. var

  1735.   i: Integer;

  1736. begin

  1737.   result := false;

  1738.   for i := 0 to high(r1.arr) do

  1739.     if (r1.arr[i] <> r2.arr[i]) then

  1740.       exit;

  1741.   result := true;

  1742. end;

  1743. 

  1744. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1745. function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;

  1746. begin

  1747.   result.r := r;

  1748.   result.g := g;

  1749.   result.b := b;

  1750.   result.a := a;

  1751. end;

  1752. 

  1753. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1754. function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;

  1755. begin

  1756.   result := [];

  1757. 

  1758.   if (aFormat in [

  1759.         //4 bbp

  1760.         tfLuminance4,

  1761. 

  1762.         //8bpp

  1763.         tfR3G3B2, tfLuminance8,

  1764. 

  1765.         //16bpp

  1766.         tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,

  1767.         tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,

  1768. 

  1769.         //24bpp

  1770.         tfBGR8, tfRGB8,

  1771. 

  1772.         //32bpp

  1773.         tfRGB10, tfRGB10A2, tfRGBA8,

  1774.         tfBGR10, tfBGR10A2, tfBGRA8]) then

  1775.     result := result + [ftBMP];

  1776. 

  1777.   if (aFormat in [

  1778.         //8 bpp

  1779.         tfLuminance8, tfAlpha8,

  1780. 

  1781.         //16 bpp

  1782.         tfLuminance16, tfLuminance8Alpha8,

  1783.         tfRGB5, tfRGB5A1, tfRGBA4,

  1784.         tfBGR5, tfBGR5A1, tfBGRA4,

  1785. 

  1786.         //24 bpp

  1787.         tfRGB8, tfBGR8,

  1788. 

  1789.         //32 bpp

  1790.         tfRGB10A2, tfRGBA8, tfBGR10A2, tfBGRA8]) then

  1791.     result := result + [ftTGA];

  1792. 

  1793.   if (aFormat in [

  1794.         //8 bpp

  1795.         tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,

  1796.         tfR3G3B2, tfRGBA2, tfBGRA2,

  1797. 

  1798.         //16 bpp

  1799.         tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,

  1800.         tfRGB4, tfR5G6B5, tfRGB5, tfRGBA4, tfRGB5A1,

  1801.         tfBGR4, tfB5G6R5, tfBGR5, tfBGRA4, tfBGR5A1,

  1802. 

  1803.         //24 bpp

  1804.         tfRGB8, tfBGR8,

  1805. 

  1806.         //32 bbp

  1807.         tfLuminance16Alpha16,

  1808.         tfRGBA8, tfRGB10A2,

  1809.         tfBGRA8, tfBGR10A2,

  1810. 

  1811.         //compressed

  1812.         tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then

  1813.     result := result + [ftDDS];

  1814. 

  1815.   {$IFDEF GLB_SUPPORT_PNG_WRITE}

  1816.   if aFormat in [

  1817.       tfAlpha8, tfLuminance8, tfLuminance8Alpha8,

  1818.       tfRGB8, tfRGBA8,

  1819.       tfBGR8, tfBGRA8] then

  1820.     result := result + [ftPNG];

  1821.   {$ENDIF}

  1822. 

  1823.   {$IFDEF GLB_SUPPORT_JPEG_WRITE}

  1824.   if aFormat in [tfAlpha8, tfLuminance8, tfRGB8, tfBGR8] then

  1825.     result := result + [ftJPEG];

  1826.   {$ENDIF}

  1827. end;

  1828. 

  1829. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1830. function IsPowerOfTwo(aNumber: Integer): Boolean;

  1831. begin

  1832.   while (aNumber and 1) = 0 do

  1833.     aNumber := aNumber shr 1;

  1834.   result := aNumber = 1;

  1835. end;

  1836. 

  1837. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1838. function GetTopMostBit(aBitSet: QWord): Integer;

  1839. begin

  1840.   result := 0;

  1841.   while aBitSet > 0 do begin

  1842.     inc(result);

  1843.     aBitSet := aBitSet shr 1;

  1844.   end;

  1845. end;

  1846. 

  1847. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1848. function CountSetBits(aBitSet: QWord): Integer;

  1849. begin

  1850.   result := 0;

  1851.   while aBitSet > 0 do begin

  1852.     if (aBitSet and 1) = 1 then

  1853.       inc(result);

  1854.     aBitSet := aBitSet shr 1;

  1855.   end;

  1856. end;

  1857. 

  1858. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1859. function LuminanceWeight(const aPixel: TglBitmapPixelData): Cardinal;

  1860. begin

  1861.   result := Trunc(

  1862.     LUMINANCE_WEIGHT_R * aPixel.Data.r +

  1863.     LUMINANCE_WEIGHT_G * aPixel.Data.g +

  1864.     LUMINANCE_WEIGHT_B * aPixel.Data.b);

  1865. end;

  1866. 

  1867. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1868. function DepthWeight(const aPixel: TglBitmapPixelData): Cardinal;

  1869. begin

  1870.   result := Trunc(

  1871.     DEPTH_WEIGHT_R * aPixel.Data.r +

  1872.     DEPTH_WEIGHT_G * aPixel.Data.g +

  1873.     DEPTH_WEIGHT_B * aPixel.Data.b);

  1874. end;

  1875. 

  1876. {$IFDEF GLB_NATIVE_OGL}

  1877. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1878. //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1879. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1880. var

  1881.   GL_LibHandle: Pointer = nil;

  1882. 

  1883. function glbGetProcAddress(aProcName: PChar; aLibHandle: Pointer = nil): Pointer;

  1884. begin

  1885.   if not Assigned(aLibHandle) then

  1886.     aLibHandle := GL_LibHandle;

  1887. 

  1888. {$IF DEFINED(GLB_WIN)}

  1889.   result := GetProcAddress({%H-}HMODULE(aLibHandle), aProcName);

  1890.   if Assigned(result) then

  1891.     exit;

  1892. 

  1893.   if Assigned(wglGetProcAddress) then

  1894.     result := wglGetProcAddress(aProcName);

  1895. {$ELSEIF DEFINED(GLB_LINUX)}

  1896.   if Assigned(glXGetProcAddress) then begin

  1897.     result := glXGetProcAddress(aProcName);

  1898.     if Assigned(result) then

  1899.       exit;

  1900.   end;

  1901. 

  1902.   if Assigned(glXGetProcAddressARB) then begin

  1903.     result := glXGetProcAddressARB(aProcName);

  1904.     if Assigned(result) then

  1905.       exit;

  1906.   end;

  1907. 

  1908.   result := dlsym(aLibHandle, aProcName);

  1909. {$IFEND}

  1910.   if not Assigned(result) then

  1911.     raise EglBitmap.Create('unable to load procedure form library: ' + aProcName);

  1912. end;

  1913. 

  1914. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}

  1915. var

  1916.   GLU_LibHandle: Pointer = nil;

  1917.   OpenGLInitialized: Boolean;

  1918.   InitOpenGLCS: TCriticalSection;

  1919. 

  1920. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1921. procedure glbInitOpenGL;

  1922. 

  1923.   ////////////////////////////////////////////////////////////////////////////////

  1924.   function glbLoadLibrary(const aName: PChar): Pointer;

  1925.   begin

  1926.     {$IF DEFINED(GLB_WIN)}

  1927.     result := {%H-}Pointer(LoadLibrary(aName));

  1928.     {$ELSEIF DEFINED(GLB_LINUX)}

  1929.     result := dlopen(Name, RTLD_LAZY);

  1930.     {$ELSE}

  1931.     result := nil;

  1932.     {$IFEND}

  1933.   end;

  1934. 

  1935.   ////////////////////////////////////////////////////////////////////////////////

  1936.   function glbFreeLibrary(const aLibHandle: Pointer): Boolean;

  1937.   begin

  1938.     result := false;

  1939.     if not Assigned(aLibHandle) then

  1940.       exit;

  1941. 

  1942.     {$IF DEFINED(GLB_WIN)}

  1943.     Result := FreeLibrary({%H-}HINST(aLibHandle));

  1944.     {$ELSEIF DEFINED(GLB_LINUX)}

  1945.     Result := dlclose(aLibHandle) = 0;

  1946.     {$IFEND}

  1947.   end;

  1948. 

  1949. begin

  1950.   if Assigned(GL_LibHandle) then

  1951.     glbFreeLibrary(GL_LibHandle);

  1952. 

  1953.   if Assigned(GLU_LibHandle) then

  1954.     glbFreeLibrary(GLU_LibHandle);

  1955. 

  1956.   GL_LibHandle := glbLoadLibrary(libopengl);

  1957.   if not Assigned(GL_LibHandle) then

  1958.     raise EglBitmap.Create('unable to load library: ' + libopengl);

  1959. 

  1960.   GLU_LibHandle := glbLoadLibrary(libglu);

  1961.   if not Assigned(GLU_LibHandle) then

  1962.     raise EglBitmap.Create('unable to load library: ' + libglu);

  1963. 

  1964.   try

  1965.   {$IF DEFINED(GLB_WIN)}

  1966.     wglGetProcAddress    := glbGetProcAddress('wglGetProcAddress');

  1967.   {$ELSEIF DEFINED(GLB_LINUX)}

  1968.     glXGetProcAddress    := glbGetProcAddress('glXGetProcAddress');

  1969.     glXGetProcAddressARB := glbGetProcAddress('glXGetProcAddressARB');

  1970.   {$IFEND}

  1971. 

  1972.     glEnable := glbGetProcAddress('glEnable');

  1973.     glDisable := glbGetProcAddress('glDisable');

  1974.     glGetString := glbGetProcAddress('glGetString');

  1975.     glGetIntegerv := glbGetProcAddress('glGetIntegerv');

  1976.     glTexParameteri := glbGetProcAddress('glTexParameteri');

  1977.     glTexParameteriv := glbGetProcAddress('glTexParameteriv');

  1978.     glTexParameterfv := glbGetProcAddress('glTexParameterfv');

  1979.     glGetTexParameteriv := glbGetProcAddress('glGetTexParameteriv');

  1980.     glGetTexParameterfv := glbGetProcAddress('glGetTexParameterfv');

  1981.     glGetTexLevelParameteriv := glbGetProcAddress('glGetTexLevelParameteriv');

  1982.     glGetTexLevelParameterfv := glbGetProcAddress('glGetTexLevelParameterfv');

  1983.     glTexGeni := glbGetProcAddress('glTexGeni');

  1984.     glGenTextures := glbGetProcAddress('glGenTextures');

  1985.     glBindTexture := glbGetProcAddress('glBindTexture');

  1986.     glDeleteTextures := glbGetProcAddress('glDeleteTextures');

  1987.     glAreTexturesResident := glbGetProcAddress('glAreTexturesResident');

  1988.     glReadPixels := glbGetProcAddress('glReadPixels');

  1989.     glPixelStorei := glbGetProcAddress('glPixelStorei');

  1990.     glTexImage1D := glbGetProcAddress('glTexImage1D');

  1991.     glTexImage2D := glbGetProcAddress('glTexImage2D');

  1992.     glGetTexImage := glbGetProcAddress('glGetTexImage');

  1993. 

  1994.     gluBuild1DMipmaps := glbGetProcAddress('gluBuild1DMipmaps', GLU_LibHandle);

  1995.     gluBuild2DMipmaps := glbGetProcAddress('gluBuild2DMipmaps', GLU_LibHandle);

  1996.   finally

  1997.     glbFreeLibrary(GL_LibHandle);

  1998.     glbFreeLibrary(GLU_LibHandle);

  1999.   end;

  2000. end;

  2001. {$ENDIF}

  2002. 

  2003. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2004. procedure glbReadOpenGLExtensions;

  2005. var

  2006.   Buffer: AnsiString;

  2007.   MajorVersion, MinorVersion: Integer;

  2008. 

  2009.   ///////////////////////////////////////////////////////////////////////////////////////////

  2010.   procedure TrimVersionString(aBuffer: AnsiString; out aMajor, aMinor: Integer);

  2011.   var

  2012.     Separator: Integer;

  2013.   begin

  2014.     aMinor := 0;

  2015.     aMajor := 0;

  2016. 

  2017.     Separator := Pos(AnsiString('.'), aBuffer);

  2018.     if (Separator > 1) and (Separator < Length(aBuffer)) and

  2019.        (aBuffer[Separator - 1] in ['0'..'9']) and

  2020.        (aBuffer[Separator + 1] in ['0'..'9']) then begin

  2021. 

  2022.       Dec(Separator);

  2023.       while (Separator > 0) and (aBuffer[Separator] in ['0'..'9']) do

  2024.         Dec(Separator);

  2025. 

  2026.       Delete(aBuffer, 1, Separator);

  2027.       Separator := Pos(AnsiString('.'), aBuffer) + 1;

  2028. 

  2029.       while (Separator <= Length(aBuffer)) and (AnsiChar(aBuffer[Separator]) in ['0'..'9']) do

  2030.         Inc(Separator);

  2031. 

  2032.       Delete(aBuffer, Separator, 255);

  2033.       Separator := Pos(AnsiString('.'), aBuffer);

  2034. 

  2035.       aMajor := StrToInt(Copy(String(aBuffer), 1, Separator - 1));

  2036.       aMinor := StrToInt(Copy(String(aBuffer), Separator + 1, 1));

  2037.     end;

  2038.   end;

  2039. 

  2040.   ///////////////////////////////////////////////////////////////////////////////////////////

  2041.   function CheckExtension(const Extension: AnsiString): Boolean;

  2042.   var

  2043.     ExtPos: Integer;

  2044.   begin

  2045.     ExtPos := Pos(Extension, Buffer);

  2046.     result := ExtPos > 0;

  2047.     if result then

  2048.       result := ((ExtPos + Length(Extension) - 1) = Length(Buffer)) or not (Buffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']);

  2049.   end;

  2050. 

  2051.   ///////////////////////////////////////////////////////////////////////////////////////////

  2052.   function CheckVersion(const aMajor, aMinor: Integer): Boolean;

  2053.   begin

  2054.     result := (MajorVersion > aMajor) or ((MajorVersion = aMajor) and (MinorVersion >= aMinor));

  2055.   end;

  2056. 

  2057. begin

  2058. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}

  2059.   InitOpenGLCS.Enter;

  2060.   try

  2061.     if not OpenGLInitialized then begin

  2062.       glbInitOpenGL;

  2063.       OpenGLInitialized := true;

  2064.     end;

  2065.   finally

  2066.     InitOpenGLCS.Leave;

  2067.   end;

  2068. {$ENDIF}

  2069. 

  2070.   // Version

  2071.   Buffer := glGetString(GL_VERSION);

  2072.   TrimVersionString(Buffer, MajorVersion, MinorVersion);

  2073. 

  2074.   GL_VERSION_1_2 := CheckVersion(1, 2);

  2075.   GL_VERSION_1_3 := CheckVersion(1, 3);

  2076.   GL_VERSION_1_4 := CheckVersion(1, 4);

  2077.   GL_VERSION_2_0 := CheckVersion(2, 0);

  2078.   GL_VERSION_3_3 := CheckVersion(3, 3);

  2079. 

  2080.   // Extensions

  2081.   Buffer := glGetString(GL_EXTENSIONS);

  2082.   GL_ARB_texture_border_clamp       := CheckExtension('GL_ARB_texture_border_clamp');

  2083.   GL_ARB_texture_non_power_of_two   := CheckExtension('GL_ARB_texture_non_power_of_two');

  2084.   GL_ARB_texture_swizzle            := CheckExtension('GL_ARB_texture_swizzle');

  2085.   GL_ARB_texture_cube_map           := CheckExtension('GL_ARB_texture_cube_map');

  2086.   GL_ARB_texture_rectangle          := CheckExtension('GL_ARB_texture_rectangle');

  2087.   GL_ARB_texture_mirrored_repeat    := CheckExtension('GL_ARB_texture_mirrored_repeat');

  2088.   GL_EXT_texture_edge_clamp         := CheckExtension('GL_EXT_texture_edge_clamp');

  2089.   GL_EXT_texture_filter_anisotropic := CheckExtension('GL_EXT_texture_filter_anisotropic');

  2090.   GL_EXT_texture_rectangle          := CheckExtension('GL_EXT_texture_rectangle');

  2091.   GL_EXT_texture_swizzle            := CheckExtension('GL_EXT_texture_swizzle');

  2092.   GL_EXT_texture_cube_map           := CheckExtension('GL_EXT_texture_cube_map');

  2093.   GL_NV_texture_rectangle           := CheckExtension('GL_NV_texture_rectangle');

  2094.   GL_IBM_texture_mirrored_repeat    := CheckExtension('GL_IBM_texture_mirrored_repeat');

  2095.   GL_SGIS_generate_mipmap           := CheckExtension('GL_SGIS_generate_mipmap');

  2096. 

  2097.   if GL_VERSION_1_3 then begin

  2098.     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1D');

  2099.     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2D');

  2100.     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImage');

  2101.   end else begin

  2102.     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1DARB');

  2103.     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2DARB');

  2104.     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB');

  2105.   end;

  2106. end;

  2107. {$ENDIF}

  2108. 

  2109. {$IFDEF GLB_SDL_IMAGE}

  2110. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2111. // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2112. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2113. function glBitmapRWseek(context: PSDL_RWops; offset: Integer; whence: Integer): Integer; cdecl;

  2114. begin

  2115.   result := TStream(context^.unknown.data1).Seek(offset, whence);

  2116. end;

  2117. 

  2118. function glBitmapRWread(context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer): Integer; cdecl;

  2119. begin

  2120.   result := TStream(context^.unknown.data1).Read(Ptr^, size * maxnum);

  2121. end;

  2122. 

  2123. function glBitmapRWwrite(context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer): Integer; cdecl;

  2124. begin

  2125.   result := TStream(context^.unknown.data1).Write(Ptr^, size * num);

  2126. end;

  2127. 

  2128. function glBitmapRWclose(context: PSDL_RWops): Integer; cdecl;

  2129. begin

  2130.   result := 0;

  2131. end;

  2132. 

  2133. function glBitmapCreateRWops(Stream: TStream): PSDL_RWops;

  2134. begin

  2135.   result := SDL_AllocRW;

  2136. 

  2137.   if result = nil then

  2138.     raise EglBitmapException.Create('glBitmapCreateRWops - SDL_AllocRW failed.');

  2139. 

  2140.   result^.seek := glBitmapRWseek;

  2141.   result^.read := glBitmapRWread;

  2142.   result^.write := glBitmapRWwrite;

  2143.   result^.close := glBitmapRWclose;

  2144.   result^.unknown.data1 := Stream;

  2145. end;

  2146. {$ENDIF}

  2147. 

  2148. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2149. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);

  2150. begin

  2151.   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;

  2152. end;

  2153. 

  2154. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2155. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);

  2156. begin

  2157.   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;

  2158. end;

  2159. 

  2160. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2161. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);

  2162. begin

  2163.   glBitmapDefaultMipmap := aValue;

  2164. end;

  2165. 

  2166. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2167. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);

  2168. begin

  2169.   glBitmapDefaultFormat := aFormat;

  2170. end;

  2171. 

  2172. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2173. procedure glBitmapSetDefaultFilter(const aMin, aMag: Integer);

  2174. begin

  2175.   glBitmapDefaultFilterMin := aMin;

  2176.   glBitmapDefaultFilterMag := aMag;

  2177. end;

  2178. 

  2179. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2180. procedure glBitmapSetDefaultWrap(const S: Cardinal = GL_CLAMP_TO_EDGE; const T: Cardinal = GL_CLAMP_TO_EDGE; const R: Cardinal = GL_CLAMP_TO_EDGE);

  2181. begin

  2182.   glBitmapDefaultWrapS := S;

  2183.   glBitmapDefaultWrapT := T;

  2184.   glBitmapDefaultWrapR := R;

  2185. end;

  2186. 

  2187. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2188. procedure glBitmapSetDefaultSwizzle(const r: GLenum = GL_RED; g: GLenum = GL_GREEN; b: GLenum = GL_BLUE; a: GLenum = GL_ALPHA);

  2189. begin

  2190.   glDefaultSwizzle[0] := r;

  2191.   glDefaultSwizzle[1] := g;

  2192.   glDefaultSwizzle[2] := b;

  2193.   glDefaultSwizzle[3] := a;

  2194. end;

  2195. 

  2196. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2197. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;

  2198. begin

  2199.   result := glBitmapDefaultDeleteTextureOnFree;

  2200. end;

  2201. 

  2202. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2203. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;

  2204. begin

  2205.   result := glBitmapDefaultFreeDataAfterGenTextures;

  2206. end;

  2207. 

  2208. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2209. function glBitmapGetDefaultMipmap: TglBitmapMipMap;

  2210. begin

  2211.   result := glBitmapDefaultMipmap;

  2212. end;

  2213. 

  2214. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2215. function glBitmapGetDefaultFormat: TglBitmapFormat;

  2216. begin

  2217.   result := glBitmapDefaultFormat;

  2218. end;

  2219. 

  2220. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2221. procedure glBitmapGetDefaultFilter(var aMin, aMag: GLenum);

  2222. begin

  2223.   aMin := glBitmapDefaultFilterMin;

  2224.   aMag := glBitmapDefaultFilterMag;

  2225. end;

  2226. 

  2227. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2228. procedure glBitmapGetDefaultTextureWrap(var S, T, R: GLenum);

  2229. begin

  2230.   S := glBitmapDefaultWrapS;

  2231.   T := glBitmapDefaultWrapT;

  2232.   R := glBitmapDefaultWrapR;

  2233. end;

  2234. 

  2235. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2236. procedure glBitmapGetDefaultSwizzle(var r, g, b, a: GLenum);

  2237. begin

  2238.   r := glDefaultSwizzle[0];

  2239.   g := glDefaultSwizzle[1];

  2240.   b := glDefaultSwizzle[2];

  2241.   a := glDefaultSwizzle[3];

  2242. end;

  2243. 

  2244. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2245. //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2246. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2247. function TFormatDescriptor.GetRedMask: QWord;

  2248. begin

  2249.   result := fRange.r shl fShift.r;

  2250. end;

  2251. 

  2252. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2253. function TFormatDescriptor.GetGreenMask: QWord;

  2254. begin

  2255.   result := fRange.g shl fShift.g;

  2256. end;

  2257. 

  2258. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2259. function TFormatDescriptor.GetBlueMask: QWord;

  2260. begin

  2261.   result := fRange.b shl fShift.b;

  2262. end;

  2263. 

  2264. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2265. function TFormatDescriptor.GetAlphaMask: QWord;

  2266. begin

  2267.   result := fRange.a shl fShift.a;

  2268. end;

  2269. 

  2270. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2271. function TFormatDescriptor.GetIsCompressed: Boolean;

  2272. begin

  2273.   result := fIsCompressed;

  2274. end;

  2275. 

  2276. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2277. function TFormatDescriptor.GetHasAlpha: Boolean;

  2278. begin

  2279.   result := (fRange.a > 0);

  2280. end;

  2281. 

  2282. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2283. function TFormatDescriptor.GetglFormat: GLenum;

  2284. begin

  2285.   result := fglFormat;

  2286. end;

  2287. 

  2288. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2289. function TFormatDescriptor.GetglInternalFormat: GLenum;

  2290. begin

  2291.   result := fglInternalFormat;

  2292. end;

  2293. 

  2294. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2295. function TFormatDescriptor.GetglDataFormat: GLenum;

  2296. begin

  2297.   result := fglDataFormat;

  2298. end;

  2299. 

  2300. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2301. function TFormatDescriptor.GetComponents: Integer;

  2302. var

  2303.   i: Integer;

  2304. begin

  2305.   result := 0;

  2306.   for i := 0 to 3 do

  2307.     if (fRange.arr[i] > 0) then

  2308.       inc(result);

  2309. end;

  2310. 

  2311. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2312. function TFormatDescriptor.GetSize(const aSize: TglBitmapPixelPosition): Integer;

  2313. var

  2314.   w, h: Integer;

  2315. begin

  2316.   if (ffX in aSize.Fields) or (ffY in aSize.Fields) then begin

  2317.     w := Max(1, aSize.X);

  2318.     h := Max(1, aSize.Y);

  2319.     result := GetSize(w, h);

  2320.   end else

  2321.     result := 0;

  2322. end;

  2323. 

  2324. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2325. function TFormatDescriptor.GetSize(const aWidth, aHeight: Integer): Integer;

  2326. begin

  2327.   result := 0;

  2328.   if (aWidth <= 0) or (aHeight <= 0) then

  2329.     exit;

  2330.   result := Ceil(aWidth * aHeight * fPixelSize);

  2331. end;

  2332. 

  2333. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2334. function TFormatDescriptor.CreateMappingData: Pointer;

  2335. begin

  2336.   result := nil;

  2337. end;

  2338. 

  2339. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2340. procedure TFormatDescriptor.FreeMappingData(var aMappingData: Pointer);

  2341. begin

  2342.   //DUMMY

  2343. end;

  2344. 

  2345. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2346. function TFormatDescriptor.IsEmpty: Boolean;

  2347. begin

  2348.   result := (fFormat = tfEmpty);

  2349. end;

  2350. 

  2351. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2352. function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean;

  2353. begin

  2354.   result := false;

  2355.   if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then

  2356.     raise EglBitmap.Create('FormatCheckFormat - All Masks are 0');

  2357.   if (aRedMask   <> RedMask) then

  2358.     exit;

  2359.   if (aGreenMask <> GreenMask) then

  2360.     exit;

  2361.   if (aBlueMask  <> BlueMask) then

  2362.     exit;

  2363.   if (aAlphaMask <> AlphaMask) then

  2364.     exit;

  2365.   result := true;

  2366. end;

  2367. 

  2368. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2369. procedure TFormatDescriptor.PreparePixel(out aPixel: TglBitmapPixelData);

  2370. begin

  2371.   FillChar(aPixel{%H-}, SizeOf(aPixel), 0);

  2372.   aPixel.Data   := fRange;

  2373.   aPixel.Range  := fRange;

  2374.   aPixel.Format := fFormat;

  2375. end;

  2376. 

  2377. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2378. constructor TFormatDescriptor.Create;

  2379. begin

  2380.   inherited Create;

  2381. 

  2382.   fFormat       := tfEmpty;

  2383.   fWithAlpha    := tfEmpty;

  2384.   fWithoutAlpha := tfEmpty;

  2385.   fRGBInverted  := tfEmpty;

  2386.   fUncompressed := tfEmpty;

  2387.   fPixelSize    := 0.0;

  2388.   fIsCompressed := false;

  2389. 

  2390.   fglFormat         := 0;

  2391.   fglInternalFormat := 0;

  2392.   fglDataFormat     := 0;

  2393. 

  2394.   FillChar(fRange, 0, SizeOf(fRange));

  2395.   FillChar(fShift, 0, SizeOf(fShift));

  2396. end;

  2397. 

  2398. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2399. //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2400. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2401. procedure TfdAlpha_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);

  2402. begin

  2403.   aData^ := aPixel.Data.a;

  2404.   inc(aData);

  2405. end;

  2406. 

  2407. procedure TfdAlpha_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);

  2408. begin

  2409.   aPixel.Data.r := 0;

  2410.   aPixel.Data.g := 0;

  2411.   aPixel.Data.b := 0;

  2412.   aPixel.Data.a := aData^;

  2413.   inc(aData);

  2414. end;

  2415. 

  2416. constructor TfdAlpha_UB1.Create;

  2417. begin

  2418.   inherited Create;

  2419.   fPixelSize        := 1.0;

  2420.   fRange.a          := $FF;

  2421.   fglFormat         := GL_ALPHA;

  2422.   fglDataFormat     := GL_UNSIGNED_BYTE;

  2423. end;

  2424. 

  2425. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2426. //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2427. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2428. procedure TfdLuminance_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);

  2429. begin

  2430.   aData^ := LuminanceWeight(aPixel);

  2431.   inc(aData);

  2432. end;

  2433. 

  2434. procedure TfdLuminance_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);

  2435. begin

  2436.   aPixel.Data.r := aData^;

  2437.   aPixel.Data.g := aData^;

  2438.   aPixel.Data.b := aData^;

  2439.   aPixel.Data.a := 0;

  2440.   inc(aData);

  2441. end;

  2442. 

  2443. constructor TfdLuminance_UB1.Create;

  2444. begin

  2445.   inherited Create;

  2446.   fPixelSize        := 1.0;

  2447.   fRange.r          := $FF;

  2448.   fRange.g          := $FF;

  2449.   fRange.b          := $FF;

  2450.   fglFormat         := GL_LUMINANCE;

  2451.   fglDataFormat     := GL_UNSIGNED_BYTE;

  2452. end;

  2453. 

  2454. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2455. //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2456. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2457. procedure TfdUniversal_UB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);

  2458. var

  2459.   i: Integer;

  2460. begin

  2461.   aData^ := 0;

  2462.   for i := 0 to 3 do

  2463.     if (fRange.arr[i] > 0) then

  2464.       aData^ := aData^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);

  2465.   inc(aData);

  2466. end;

  2467. 

  2468. procedure TfdUniversal_UB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);

  2469. var

  2470.   i: Integer;

  2471. begin

  2472.   for i := 0 to 3 do

  2473.     aPixel.Data.arr[i] := (aData^ shr fShift.arr[i]) and fRange.arr[i];

  2474.   inc(aData);

  2475. end;

  2476. 

  2477. constructor TfdUniversal_UB1.Create;

  2478. begin

  2479.   inherited Create;

  2480.   fPixelSize := 1.0;

  2481. end;

  2482. 

  2483. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2484. //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2485. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2486. procedure TfdLuminanceAlpha_UB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);

  2487. begin

  2488.   inherited Map(aPixel, aData, aMapData);

  2489.   aData^ := aPixel.Data.a;

  2490.   inc(aData);

  2491. end;

  2492. 

  2493. procedure TfdLuminanceAlpha_UB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);

  2494. begin

  2495.   inherited Unmap(aData, aPixel, aMapData);

  2496.   aPixel.Data.a := aData^;

  2497.   inc(aData);

  2498. end;

  2499. 

  2500. constructor TfdLuminanceAlpha_UB2.Create;

  2501. begin

  2502.   inherited Create;

  2503.   fPixelSize        := 2.0;

  2504.   fRange.a          := $FF;

  2505.   fShift.a          :=   8;

  2506.   fglFormat         := GL_LUMINANCE_ALPHA;

  2507.   fglDataFormat     := GL_UNSIGNED_BYTE;

  2508. end;

  2509. 

  2510. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2511. //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2512. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2513. procedure TfdRGB_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);

  2514. begin

  2515.   aData^ := aPixel.Data.r;

  2516.   inc(aData);

  2517.   aData^ := aPixel.Data.g;

  2518.   inc(aData);

  2519.   aData^ := aPixel.Data.b;

  2520.   inc(aData);

  2521. end;

  2522. 

  2523. procedure TfdRGB_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);

  2524. begin

  2525.   aPixel.Data.r := aData^;

  2526.   inc(aData);

  2527.   aPixel.Data.g := aData^;

  2528.   inc(aData);

  2529.   aPixel.Data.b := aData^;

  2530.   inc(aData);

  2531.   aPixel.Data.a := 0;

  2532. end;

  2533. 

  2534. constructor TfdRGB_UB3.Create;

  2535. begin

  2536.   inherited Create;

  2537.   fPixelSize        := 3.0;

  2538.   fRange.r          := $FF;

  2539.   fRange.g          := $FF;

  2540.   fRange.b          := $FF;

  2541.   fShift.r          :=   0;

  2542.   fShift.g          :=   8;

  2543.   fShift.b          :=  16;

  2544.   fglFormat         := GL_RGB;

  2545.   fglDataFormat     := GL_UNSIGNED_BYTE;

  2546. end;

  2547. 

  2548. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2549. //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2550. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2551. procedure TfdBGR_UB3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);

  2552. begin

  2553.   aData^ := aPixel.Data.b;

  2554.   inc(aData);

  2555.   aData^ := aPixel.Data.g;

  2556.   inc(aData);

  2557.   aData^ := aPixel.Data.r;

  2558.   inc(aData);

  2559. end;

  2560. 

  2561. procedure TfdBGR_UB3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);

  2562. begin

  2563.   aPixel.Data.b := aData^;

  2564.   inc(aData);

  2565.   aPixel.Data.g := aData^;

  2566.   inc(aData);

  2567.   aPixel.Data.r := aData^;

  2568.   inc(aData);

  2569.   aPixel.Data.a := 0;

  2570. end;

  2571. 

  2572. constructor TfdBGR_UB3.Create;

  2573. begin

  2574.   fPixelSize        := 3.0;

  2575.   fRange.r          := $FF;

  2576.   fRange.g          := $FF;

  2577.   fRange.b          := $FF;

  2578.   fShift.r          :=  16;

  2579.   fShift.g          :=   8;

  2580.   fShift.b          :=   0;

  2581.   fglFormat         := GL_BGR;

  2582.   fglDataFormat     := GL_UNSIGNED_BYTE;

  2583. end;

  2584. 

  2585. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2586. //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2587. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2588. procedure TfdRGBA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);

  2589. begin

  2590.   inherited Map(aPixel, aData, aMapData);

  2591.   aData^ := aPixel.Data.a;

  2592.   inc(aData);

  2593. end;

  2594. 

  2595. procedure TfdRGBA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);

  2596. begin

  2597.   inherited Unmap(aData, aPixel, aMapData);

  2598.   aPixel.Data.a := aData^;

  2599.   inc(aData);

  2600. end;

  2601. 

  2602. constructor TfdRGBA_UB4.Create;

  2603. begin

  2604.   inherited Create;

  2605.   fPixelSize        := 4.0;

  2606.   fRange.a          := $FF;

  2607.   fShift.a          :=  24;

  2608.   fglFormat         := GL_RGBA;

  2609.   fglDataFormat     := GL_UNSIGNED_BYTE;

  2610. end;

  2611. 

  2612. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2613. //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2614. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2615. procedure TfdBGRA_UB4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);

  2616. begin

  2617.   inherited Map(aPixel, aData, aMapData);

  2618.   aData^ := aPixel.Data.a;

  2619.   inc(aData);

  2620. end;

  2621. 

  2622. procedure TfdBGRA_UB4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);

  2623. begin

  2624.   inherited Unmap(aData, aPixel, aMapData);

  2625.   aPixel.Data.a := aData^;

  2626.   inc(aData);

  2627. end;

  2628. 

  2629. constructor TfdBGRA_UB4.Create;

  2630. begin

  2631.   inherited Create;

  2632.   fPixelSize        := 4.0;

  2633.   fRange.a          := $FF;

  2634.   fShift.a          :=  24;

  2635.   fglFormat         := GL_BGRA;

  2636.   fglDataFormat     := GL_UNSIGNED_BYTE;

  2637. end;

  2638. 

  2639. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2640. //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2641. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2642. procedure TfdAlpha_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);

  2643. begin

  2644.   PWord(aData)^ := aPixel.Data.a;

  2645.   inc(aData, 2);

  2646. end;

  2647. 

  2648. procedure TfdAlpha_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);

  2649. begin

  2650.   aPixel.Data.r := 0;

  2651.   aPixel.Data.g := 0;

  2652.   aPixel.Data.b := 0;

  2653.   aPixel.Data.a := PWord(aData)^;

  2654.   inc(aData, 2);

  2655. end;

  2656. 

  2657. constructor TfdAlpha_US1.Create;

  2658. begin

  2659.   inherited Create;

  2660.   fPixelSize        := 2.0;

  2661.   fRange.a          := $FFFF;

  2662.   fglFormat         := GL_ALPHA;

  2663.   fglDataFormat     := GL_UNSIGNED_SHORT;

  2664. end;

  2665. 

  2666. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2667. //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2668. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2669. procedure TfdLuminance_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);

  2670. begin

  2671.   PWord(aData)^ := LuminanceWeight(aPixel);

  2672.   inc(aData, 2);

  2673. end;

  2674. 

  2675. procedure TfdLuminance_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);

  2676. begin

  2677.   aPixel.Data.r := PWord(aData)^;

  2678.   aPixel.Data.g := PWord(aData)^;

  2679.   aPixel.Data.b := PWord(aData)^;

  2680.   aPixel.Data.a := 0;

  2681.   inc(aData, 2);

  2682. end;

  2683. 

  2684. constructor TfdLuminance_US1.Create;

  2685. begin

  2686.   inherited Create;

  2687.   fPixelSize        := 2.0;

  2688.   fRange.r          := $FFFF;

  2689.   fRange.g          := $FFFF;

  2690.   fRange.b          := $FFFF;

  2691.   fglFormat         := GL_LUMINANCE;

  2692.   fglDataFormat     := GL_UNSIGNED_SHORT;

  2693. end;

  2694. 

  2695. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2696. //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2697. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2698. procedure TfdUniversal_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);

  2699. var

  2700.   i: Integer;

  2701. begin

  2702.   PWord(aData)^ := 0;

  2703.   for i := 0 to 3 do

  2704.     if (fRange.arr[i] > 0) then

  2705.       PWord(aData)^ := PWord(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);

  2706.   inc(aData, 2);

  2707. end;

  2708. 

  2709. procedure TfdUniversal_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);

  2710. var

  2711.   i: Integer;

  2712. begin

  2713.   for i := 0 to 3 do

  2714.     aPixel.Data.arr[i] := (PWord(aData)^ shr fShift.arr[i]) and fRange.arr[i];

  2715.   inc(aData, 2);

  2716. end;

  2717. 

  2718. constructor TfdUniversal_US1.Create;

  2719. begin

  2720.   inherited Create;

  2721.   fPixelSize := 2.0;

  2722. end;

  2723. 

  2724. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2725. //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2726. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2727. procedure TfdDepth_US1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);

  2728. begin

  2729.   PWord(aData)^ := DepthWeight(aPixel);

  2730.   inc(aData, 2);

  2731. end;

  2732. 

  2733. procedure TfdDepth_US1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);

  2734. begin

  2735.   aPixel.Data.r := PWord(aData)^;

  2736.   aPixel.Data.g := PWord(aData)^;

  2737.   aPixel.Data.b := PWord(aData)^;

  2738.   aPixel.Data.a := 0;

  2739.   inc(aData, 2);

  2740. end;

  2741. 

  2742. constructor TfdDepth_US1.Create;

  2743. begin

  2744.   inherited Create;

  2745.   fPixelSize        := 2.0;

  2746.   fRange.r          := $FFFF;

  2747.   fRange.g          := $FFFF;

  2748.   fRange.b          := $FFFF;

  2749.   fglFormat         := GL_DEPTH_COMPONENT;

  2750.   fglDataFormat     := GL_UNSIGNED_SHORT;

  2751. end;

  2752. 

  2753. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2754. //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2755. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2756. procedure TfdLuminanceAlpha_US2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);

  2757. begin

  2758.   inherited Map(aPixel, aData, aMapData);

  2759.   PWord(aData)^ := aPixel.Data.a;

  2760.   inc(aData, 2);

  2761. end;

  2762. 

  2763. procedure TfdLuminanceAlpha_US2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);

  2764. begin

  2765.   inherited Unmap(aData, aPixel, aMapData);

  2766.   aPixel.Data.a := PWord(aData)^;

  2767.   inc(aData, 2);

  2768. end;

  2769. 

  2770. constructor TfdLuminanceAlpha_US2.Create;

  2771. begin

  2772.   inherited Create;

  2773.   fPixelSize        :=   4.0;

  2774.   fRange.a          := $FFFF;

  2775.   fShift.a          :=    16;

  2776.   fglFormat         := GL_LUMINANCE_ALPHA;

  2777.   fglDataFormat     := GL_UNSIGNED_SHORT;

  2778. end;

  2779. 

  2780. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2781. //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2782. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2783. procedure TfdRGB_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);

  2784. begin

  2785.   PWord(aData)^ := aPixel.Data.r;

  2786.   inc(aData, 2);

  2787.   PWord(aData)^ := aPixel.Data.g;

  2788.   inc(aData, 2);

  2789.   PWord(aData)^ := aPixel.Data.b;

  2790.   inc(aData, 2);

  2791. end;

  2792. 

  2793. procedure TfdRGB_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);

  2794. begin

  2795.   aPixel.Data.r := PWord(aData)^;

  2796.   inc(aData, 2);

  2797.   aPixel.Data.g := PWord(aData)^;

  2798.   inc(aData, 2);

  2799.   aPixel.Data.b := PWord(aData)^;

  2800.   inc(aData, 2);

  2801.   aPixel.Data.a := 0;

  2802. end;

  2803. 

  2804. constructor TfdRGB_US3.Create;

  2805. begin

  2806.   inherited Create;

  2807.   fPixelSize        :=   6.0;

  2808.   fRange.r          := $FFFF;

  2809.   fRange.g          := $FFFF;

  2810.   fRange.b          := $FFFF;

  2811.   fShift.r          :=     0;

  2812.   fShift.g          :=    16;

  2813.   fShift.b          :=    32;

  2814.   fglFormat         := GL_RGB;

  2815.   fglDataFormat     := GL_UNSIGNED_SHORT;

  2816. end;

  2817. 

  2818. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2819. //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2820. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2821. procedure TfdBGR_US3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);

  2822. begin

  2823.   PWord(aData)^ := aPixel.Data.b;

  2824.   inc(aData, 2);

  2825.   PWord(aData)^ := aPixel.Data.g;

  2826.   inc(aData, 2);

  2827.   PWord(aData)^ := aPixel.Data.r;

  2828.   inc(aData, 2);

  2829. end;

  2830. 

  2831. procedure TfdBGR_US3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);

  2832. begin

  2833.   aPixel.Data.b := PWord(aData)^;

  2834.   inc(aData, 2);

  2835.   aPixel.Data.g := PWord(aData)^;

  2836.   inc(aData, 2);

  2837.   aPixel.Data.r := PWord(aData)^;

  2838.   inc(aData, 2);

  2839.   aPixel.Data.a := 0;

  2840. end;

  2841. 

  2842. constructor TfdBGR_US3.Create;

  2843. begin

  2844.   inherited Create;

  2845.   fPixelSize        :=   6.0;

  2846.   fRange.r          := $FFFF;

  2847.   fRange.g          := $FFFF;

  2848.   fRange.b          := $FFFF;

  2849.   fShift.r          :=    32;

  2850.   fShift.g          :=    16;

  2851.   fShift.b          :=     0;

  2852.   fglFormat         := GL_BGR;

  2853.   fglDataFormat     := GL_UNSIGNED_SHORT;

  2854. end;

  2855. 

  2856. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2857. //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2858. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2859. procedure TfdRGBA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);

  2860. begin

  2861.   inherited Map(aPixel, aData, aMapData);

  2862.   PWord(aData)^ := aPixel.Data.a;

  2863.   inc(aData, 2);

  2864. end;

  2865. 

  2866. procedure TfdRGBA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);

  2867. begin

  2868.   inherited Unmap(aData, aPixel, aMapData);

  2869.   aPixel.Data.a := PWord(aData)^;

  2870.   inc(aData, 2);

  2871. end;

  2872. 

  2873. constructor TfdRGBA_US4.Create;

  2874. begin

  2875.   inherited Create;

  2876.   fPixelSize        :=   8.0;

  2877.   fRange.a          := $FFFF;

  2878.   fShift.a          :=    48;

  2879.   fglFormat         := GL_RGBA;

  2880.   fglDataFormat     := GL_UNSIGNED_SHORT;

  2881. end;

  2882. 

  2883. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2884. //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2885. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2886. procedure TfdBGRA_US4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);

  2887. begin

  2888.   inherited Map(aPixel, aData, aMapData);

  2889.   PWord(aData)^ := aPixel.Data.a;

  2890.   inc(aData, 2);

  2891. end;

  2892. 

  2893. procedure TfdBGRA_US4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);

  2894. begin

  2895.   inherited Unmap(aData, aPixel, aMapData);

  2896.   aPixel.Data.a := PWord(aData)^;

  2897.   inc(aData, 2);

  2898. end;

  2899. 

  2900. constructor TfdBGRA_US4.Create;

  2901. begin

  2902.   inherited Create;

  2903.   fPixelSize        :=   8.0;

  2904.   fRange.a          := $FFFF;

  2905.   fShift.a          :=    48;

  2906.   fglFormat         := GL_BGRA;

  2907.   fglDataFormat     := GL_UNSIGNED_SHORT;

  2908. end;

  2909. 

  2910. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2911. //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2912. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2913. procedure TfdUniversal_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);

  2914. var

  2915.   i: Integer;

  2916. begin

  2917.   PCardinal(aData)^ := 0;

  2918.   for i := 0 to 3 do

  2919.     if (fRange.arr[i] > 0) then

  2920.       PCardinal(aData)^ := PCardinal(aData)^ or ((aPixel.Data.arr[i] and fRange.arr[i]) shl fShift.arr[i]);

  2921.   inc(aData, 4);

  2922. end;

  2923. 

  2924. procedure TfdUniversal_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);

  2925. var

  2926.   i: Integer;

  2927. begin

  2928.   for i := 0 to 3 do

  2929.     aPixel.Data.arr[i] := (PCardinal(aData)^ shr fShift.arr[i]) and fRange.arr[i];

  2930.   inc(aData, 2);

  2931. end;

  2932. 

  2933. constructor TfdUniversal_UI1.Create;

  2934. begin

  2935.   inherited Create;

  2936.   fPixelSize := 4.0;

  2937. end;

  2938. 

  2939. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2940. //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2941. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2942. procedure TfdDepth_UI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);

  2943. begin

  2944.   PCardinal(aData)^ := DepthWeight(aPixel);

  2945.   inc(aData, 4);

  2946. end;

  2947. 

  2948. procedure TfdDepth_UI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);

  2949. begin

  2950.   aPixel.Data.r := PCardinal(aData)^;

  2951.   aPixel.Data.g := PCardinal(aData)^;

  2952.   aPixel.Data.b := PCardinal(aData)^;

  2953.   aPixel.Data.a := 0;

  2954.   inc(aData, 4);

  2955. end;

  2956. 

  2957. constructor TfdDepth_UI1.Create;

  2958. begin

  2959.   inherited Create;

  2960.   fPixelSize        := 4.0;

  2961.   fRange.r          := $FFFFFFFF;

  2962.   fRange.g          := $FFFFFFFF;

  2963.   fRange.b          := $FFFFFFFF;

  2964.   fglFormat         := GL_DEPTH_COMPONENT;

  2965.   fglDataFormat     := GL_UNSIGNED_INT;

  2966. end;

  2967. 

  2968. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2969. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2970. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2971. constructor TfdAlpha4.Create;

  2972. begin

  2973.   inherited Create;

  2974.   fFormat           := tfAlpha4;

  2975.   fWithAlpha        := tfAlpha4;

  2976.   fglInternalFormat := GL_ALPHA4;

  2977. end;

  2978. 

  2979. constructor TfdAlpha8.Create;

  2980. begin

  2981.   inherited Create;

  2982.   fFormat           := tfAlpha8;

  2983.   fWithAlpha        := tfAlpha8;

  2984.   fglInternalFormat := GL_ALPHA8;

  2985. end;

  2986. 

  2987. constructor TfdAlpha12.Create;

  2988. begin

  2989.   inherited Create;

  2990.   fFormat           := tfAlpha12;

  2991.   fWithAlpha        := tfAlpha12;

  2992.   fglInternalFormat := GL_ALPHA12;

  2993. end;

  2994. 

  2995. constructor TfdAlpha16.Create;

  2996. begin

  2997.   inherited Create;

  2998.   fFormat           := tfAlpha16;

  2999.   fWithAlpha        := tfAlpha16;

  3000.   fglInternalFormat := GL_ALPHA16;

  3001. end;

  3002. 

  3003. constructor TfdLuminance4.Create;

  3004. begin

  3005.   inherited Create;

  3006.   fFormat           := tfLuminance4;

  3007.   fWithAlpha        := tfLuminance4Alpha4;

  3008.   fWithoutAlpha     := tfLuminance4;

  3009.   fglInternalFormat := GL_LUMINANCE4;

  3010. end;

  3011. 

  3012. constructor TfdLuminance8.Create;

  3013. begin

  3014.   inherited Create;

  3015.   fFormat           := tfLuminance8;

  3016.   fWithAlpha        := tfLuminance8Alpha8;

  3017.   fWithoutAlpha     := tfLuminance8;

  3018.   fglInternalFormat := GL_LUMINANCE8;

  3019. end;

  3020. 

  3021. constructor TfdLuminance12.Create;

  3022. begin

  3023.   inherited Create;

  3024.   fFormat           := tfLuminance12;

  3025.   fWithAlpha        := tfLuminance12Alpha12;

  3026.   fWithoutAlpha     := tfLuminance12;

  3027.   fglInternalFormat := GL_LUMINANCE12;

  3028. end;

  3029. 

  3030. constructor TfdLuminance16.Create;

  3031. begin

  3032.   inherited Create;

  3033.   fFormat           := tfLuminance16;

  3034.   fWithAlpha        := tfLuminance16Alpha16;

  3035.   fWithoutAlpha     := tfLuminance16;

  3036.   fglInternalFormat := GL_LUMINANCE16;

  3037. end;

  3038. 

  3039. constructor TfdLuminance4Alpha4.Create;

  3040. begin

  3041.   inherited Create;

  3042.   fFormat           := tfLuminance4Alpha4;

  3043.   fWithAlpha        := tfLuminance4Alpha4;

  3044.   fWithoutAlpha     := tfLuminance4;

  3045.   fglInternalFormat := GL_LUMINANCE4_ALPHA4;

  3046. end;

  3047. 

  3048. constructor TfdLuminance6Alpha2.Create;

  3049. begin

  3050.   inherited Create;

  3051.   fFormat           := tfLuminance6Alpha2;

  3052.   fWithAlpha        := tfLuminance6Alpha2;

  3053.   fWithoutAlpha     := tfLuminance8;

  3054.   fglInternalFormat := GL_LUMINANCE6_ALPHA2;

  3055. end;

  3056. 

  3057. constructor TfdLuminance8Alpha8.Create;

  3058. begin

  3059.   inherited Create;

  3060.   fFormat           := tfLuminance8Alpha8;

  3061.   fWithAlpha        := tfLuminance8Alpha8;

  3062.   fWithoutAlpha     := tfLuminance8;

  3063.   fglInternalFormat := GL_LUMINANCE8_ALPHA8;

  3064. end;

  3065. 

  3066. constructor TfdLuminance12Alpha4.Create;

  3067. begin

  3068.   inherited Create;

  3069.   fFormat           := tfLuminance12Alpha4;

  3070.   fWithAlpha        := tfLuminance12Alpha4;

  3071.   fWithoutAlpha     := tfLuminance12;

  3072.   fglInternalFormat := GL_LUMINANCE12_ALPHA4;

  3073. end;

  3074. 

  3075. constructor TfdLuminance12Alpha12.Create;

  3076. begin

  3077.   inherited Create;

  3078.   fFormat           := tfLuminance12Alpha12;

  3079.   fWithAlpha        := tfLuminance12Alpha12;

  3080.   fWithoutAlpha     := tfLuminance12;

  3081.   fglInternalFormat := GL_LUMINANCE12_ALPHA12;

  3082. end;

  3083. 

  3084. constructor TfdLuminance16Alpha16.Create;

  3085. begin

  3086.   inherited Create;

  3087.   fFormat           := tfLuminance16Alpha16;

  3088.   fWithAlpha        := tfLuminance16Alpha16;

  3089.   fWithoutAlpha     := tfLuminance16;

  3090.   fglInternalFormat := GL_LUMINANCE16_ALPHA16;

  3091. end;

  3092. 

  3093. constructor TfdR3G3B2.Create;

  3094. begin

  3095.   inherited Create;

  3096.   fFormat           := tfR3G3B2;

  3097.   fWithAlpha        := tfRGBA2;

  3098.   fWithoutAlpha     := tfR3G3B2;

  3099.   fRange.r          := $7;

  3100.   fRange.g          := $7;

  3101.   fRange.b          := $3;

  3102.   fShift.r          :=  0;

  3103.   fShift.g          :=  3;

  3104.   fShift.b          :=  6;

  3105.   fglFormat         := GL_RGB;

  3106.   fglInternalFormat := GL_R3_G3_B2;

  3107.   fglDataFormat     := GL_UNSIGNED_BYTE_2_3_3_REV;

  3108. end;

  3109. 

  3110. constructor TfdRGB4.Create;

  3111. begin

  3112.   inherited Create;

  3113.   fFormat           := tfRGB4;

  3114.   fWithAlpha        := tfRGBA4;

  3115.   fWithoutAlpha     := tfRGB4;

  3116.   fRGBInverted      := tfBGR4;

  3117.   fRange.r          := $F;

  3118.   fRange.g          := $F;

  3119.   fRange.b          := $F;

  3120.   fShift.r          :=  0;

  3121.   fShift.g          :=  4;

  3122.   fShift.b          :=  8;

  3123.   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA

  3124.   fglInternalFormat := GL_RGB4;

  3125.   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;

  3126. end;

  3127. 

  3128. constructor TfdR5G6B5.Create;

  3129. begin

  3130.   inherited Create;

  3131.   fFormat           := tfR5G6B5;

  3132.   fWithAlpha        := tfRGBA4;

  3133.   fWithoutAlpha     := tfR5G6B5;

  3134.   fRGBInverted      := tfB5G6R5;

  3135.   fRange.r          := $1F;

  3136.   fRange.g          := $3F;

  3137.   fRange.b          := $1F;

  3138.   fShift.r          :=   0;

  3139.   fShift.g          :=   5;

  3140.   fShift.b          :=  11;

  3141.   fglFormat         := GL_RGB;

  3142.   fglInternalFormat := GL_RGB565;

  3143.   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5_REV;

  3144. end;

  3145. 

  3146. constructor TfdRGB5.Create;

  3147. begin

  3148.   inherited Create;

  3149.   fFormat           := tfRGB5;

  3150.   fWithAlpha        := tfRGB5A1;

  3151.   fWithoutAlpha     := tfRGB5;

  3152.   fRGBInverted      := tfBGR5;

  3153.   fRange.r          := $1F;

  3154.   fRange.g          := $1F;

  3155.   fRange.b          := $1F;

  3156.   fShift.r          :=   0;

  3157.   fShift.g          :=   5;

  3158.   fShift.b          :=  10;

  3159.   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA

  3160.   fglInternalFormat := GL_RGB5;

  3161.   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;

  3162. end;

  3163. 

  3164. constructor TfdRGB8.Create;

  3165. begin

  3166.   inherited Create;

  3167.   fFormat           := tfRGB8;

  3168.   fWithAlpha        := tfRGBA8;

  3169.   fWithoutAlpha     := tfRGB8;

  3170.   fRGBInverted      := tfBGR8;

  3171.   fglInternalFormat := GL_RGB8;

  3172. end;

  3173. 

  3174. constructor TfdRGB10.Create;

  3175. begin

  3176.   inherited Create;

  3177.   fFormat           := tfRGB10;

  3178.   fWithAlpha        := tfRGB10A2;

  3179.   fWithoutAlpha     := tfRGB10;

  3180.   fRGBInverted      := tfBGR10;

  3181.   fRange.r          := $3FF;

  3182.   fRange.g          := $3FF;

  3183.   fRange.b          := $3FF;

  3184.   fShift.r          :=    0;

  3185.   fShift.g          :=   10;

  3186.   fShift.b          :=   20;

  3187.   fglFormat         := GL_RGBA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA

  3188.   fglInternalFormat := GL_RGB10;

  3189.   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;

  3190. end;

  3191. 

  3192. constructor TfdRGB12.Create;

  3193. begin

  3194.   inherited Create;

  3195.   fFormat           := tfRGB12;

  3196.   fWithAlpha        := tfRGBA12;

  3197.   fWithoutAlpha     := tfRGB12;

  3198.   fRGBInverted      := tfBGR12;

  3199.   fglInternalFormat := GL_RGB12;

  3200. end;

  3201. 

  3202. constructor TfdRGB16.Create;

  3203. begin

  3204.   inherited Create;

  3205.   fFormat           := tfRGB16;

  3206.   fWithAlpha        := tfRGBA16;

  3207.   fWithoutAlpha     := tfRGB16;

  3208.   fRGBInverted      := tfBGR16;

  3209.   fglInternalFormat := GL_RGB16;

  3210. end;

  3211. 

  3212. constructor TfdRGBA2.Create;

  3213. begin

  3214.   inherited Create;

  3215.   fFormat           := tfRGBA2;

  3216.   fWithAlpha        := tfRGBA2;

  3217.   fWithoutAlpha     := tfR3G3B2;

  3218.   fRGBInverted      := tfBGRA2;

  3219.   fglInternalFormat := GL_RGBA2;

  3220. end;

  3221. 

  3222. constructor TfdRGBA4.Create;

  3223. begin

  3224.   inherited Create;

  3225.   fFormat           := tfRGBA4;

  3226.   fWithAlpha        := tfRGBA4;

  3227.   fWithoutAlpha     := tfRGB4;

  3228.   fRGBInverted      := tfBGRA4;

  3229.   fRange.r          := $F;

  3230.   fRange.g          := $F;

  3231.   fRange.b          := $F;

  3232.   fRange.a          := $F;

  3233.   fShift.r          :=  0;

  3234.   fShift.g          :=  4;

  3235.   fShift.b          :=  8;

  3236.   fShift.a          := 12;

  3237.   fglFormat         := GL_RGBA;

  3238.   fglInternalFormat := GL_RGBA4;

  3239.   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;

  3240. end;

  3241. 

  3242. constructor TfdRGB5A1.Create;

  3243. begin

  3244.   inherited Create;

  3245.   fFormat           := tfRGB5A1;

  3246.   fWithAlpha        := tfRGB5A1;

  3247.   fWithoutAlpha     := tfRGB5;

  3248.   fRGBInverted      := tfBGR5A1;

  3249.   fRange.r          := $1F;

  3250.   fRange.g          := $1F;

  3251.   fRange.b          := $1F;

  3252.   fRange.a          := $01;

  3253.   fShift.r          :=   0;

  3254.   fShift.g          :=   5;

  3255.   fShift.b          :=  10;

  3256.   fShift.a          :=  15;

  3257.   fglFormat         := GL_RGBA;

  3258.   fglInternalFormat := GL_RGB5_A1;

  3259.   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;

  3260. end;

  3261. 

  3262. constructor TfdRGBA8.Create;

  3263. begin

  3264.   inherited Create;

  3265.   fFormat           := tfRGBA8;

  3266.   fWithAlpha        := tfRGBA8;

  3267.   fWithoutAlpha     := tfRGB8;

  3268.   fRGBInverted      := tfBGRA8;

  3269.   fglInternalFormat := GL_RGBA8;

  3270. end;

  3271. 

  3272. constructor TfdRGB10A2.Create;

  3273. begin

  3274.   inherited Create;

  3275.   fFormat           := tfRGB10A2;

  3276.   fWithAlpha        := tfRGB10A2;

  3277.   fWithoutAlpha     := tfRGB10;

  3278.   fRGBInverted      := tfBGR10A2;

  3279.   fRange.r          := $3FF;

  3280.   fRange.g          := $3FF;

  3281.   fRange.b          := $3FF;

  3282.   fRange.a          := $003;

  3283.   fShift.r          :=    0;

  3284.   fShift.g          :=   10;

  3285.   fShift.b          :=   20;

  3286.   fShift.a          :=   30;

  3287.   fglFormat         := GL_RGBA;

  3288.   fglInternalFormat := GL_RGB10_A2;

  3289.   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;

  3290. end;

  3291. 

  3292. constructor TfdRGBA12.Create;

  3293. begin

  3294.   inherited Create;

  3295.   fFormat           := tfRGBA12;

  3296.   fWithAlpha        := tfRGBA12;

  3297.   fWithoutAlpha     := tfRGB12;

  3298.   fRGBInverted      := tfBGRA12;

  3299.   fglInternalFormat := GL_RGBA12;

  3300. end;

  3301. 

  3302. constructor TfdRGBA16.Create;

  3303. begin

  3304.   inherited Create;

  3305.   fFormat           := tfRGBA16;

  3306.   fWithAlpha        := tfRGBA16;

  3307.   fWithoutAlpha     := tfRGB16;

  3308.   fRGBInverted      := tfBGRA16;

  3309.   fglInternalFormat := GL_RGBA16;

  3310. end;

  3311. 

  3312. constructor TfdBGR4.Create;

  3313. begin

  3314.   inherited Create;

  3315.   fPixelSize        := 2.0;

  3316.   fFormat           := tfBGR4;

  3317.   fWithAlpha        := tfBGRA4;

  3318.   fWithoutAlpha     := tfBGR4;

  3319.   fRGBInverted      := tfRGB4;

  3320.   fRange.r          := $F;

  3321.   fRange.g          := $F;

  3322.   fRange.b          := $F;

  3323.   fRange.a          := $0;

  3324.   fShift.r          :=  8;

  3325.   fShift.g          :=  4;

  3326.   fShift.b          :=  0;

  3327.   fShift.a          :=  0;

  3328.   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA

  3329.   fglInternalFormat := GL_RGB4;

  3330.   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;

  3331. end;

  3332. 

  3333. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3334. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3335. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3336. constructor TfdB5G6R5.Create;

  3337. begin

  3338.   inherited Create;

  3339.   fFormat           := tfB5G6R5;

  3340.   fWithAlpha        := tfBGRA4;

  3341.   fWithoutAlpha     := tfB5G6R5;

  3342.   fRGBInverted      := tfR5G6B5;

  3343.   fRange.r          := $1F;

  3344.   fRange.g          := $3F;

  3345.   fRange.b          := $1F;

  3346.   fShift.r          :=  11;

  3347.   fShift.g          :=   5;

  3348.   fShift.b          :=   0;

  3349.   fglFormat         := GL_RGB;  //B5G6R5 is only possible as R5G6B5 -> use reverted dataformat

  3350.   fglInternalFormat := GL_RGB8;

  3351.   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5;

  3352. end;

  3353. 

  3354. constructor TfdBGR5.Create;

  3355. begin

  3356.   inherited Create;

  3357.   fPixelSize        := 2.0;

  3358.   fFormat           := tfBGR5;

  3359.   fWithAlpha        := tfBGR5A1;

  3360.   fWithoutAlpha     := tfBGR5;

  3361.   fRGBInverted      := tfRGB5;

  3362.   fRange.r          := $1F;

  3363.   fRange.g          := $1F;

  3364.   fRange.b          := $1F;

  3365.   fRange.a          := $00;

  3366.   fShift.r          :=  10;

  3367.   fShift.g          :=   5;

  3368.   fShift.b          :=   0;

  3369.   fShift.a          :=   0;

  3370.   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA

  3371.   fglInternalFormat := GL_RGB5;

  3372.   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;

  3373. end;

  3374. 

  3375. constructor TfdBGR8.Create;

  3376. begin

  3377.   inherited Create;

  3378.   fFormat           := tfBGR8;

  3379.   fWithAlpha        := tfBGRA8;

  3380.   fWithoutAlpha     := tfBGR8;

  3381.   fRGBInverted      := tfRGB8;

  3382.   fglInternalFormat := GL_RGB8;

  3383. end;

  3384. 

  3385. constructor TfdBGR10.Create;

  3386. begin

  3387.   inherited Create;

  3388.   fFormat           := tfBGR10;

  3389.   fWithAlpha        := tfBGR10A2;

  3390.   fWithoutAlpha     := tfBGR10;

  3391.   fRGBInverted      := tfRGB10;

  3392.   fRange.r          := $3FF;

  3393.   fRange.g          := $3FF;

  3394.   fRange.b          := $3FF;

  3395.   fRange.a          := $000;

  3396.   fShift.r          :=   20;

  3397.   fShift.g          :=   10;

  3398.   fShift.b          :=    0;

  3399.   fShift.a          :=    0;

  3400.   fglFormat         := GL_BGRA; //GL_INVALID_OPERATION if not GL_BGRA or GL_RGBA

  3401.   fglInternalFormat := GL_RGB10;

  3402.   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;

  3403. end;

  3404. 

  3405. constructor TfdBGR12.Create;

  3406. begin

  3407.   inherited Create;

  3408.   fFormat           := tfBGR12;

  3409.   fWithAlpha        := tfBGRA12;

  3410.   fWithoutAlpha     := tfBGR12;

  3411.   fRGBInverted      := tfRGB12;

  3412.   fglInternalFormat := GL_RGB12;

  3413. end;

  3414. 

  3415. constructor TfdBGR16.Create;

  3416. begin

  3417.   inherited Create;

  3418.   fFormat           := tfBGR16;

  3419.   fWithAlpha        := tfBGRA16;

  3420.   fWithoutAlpha     := tfBGR16;

  3421.   fRGBInverted      := tfRGB16;

  3422.   fglInternalFormat := GL_RGB16;

  3423. end;

  3424. 

  3425. constructor TfdBGRA2.Create;

  3426. begin

  3427.   inherited Create;

  3428.   fFormat           := tfBGRA2;

  3429.   fWithAlpha        := tfBGRA4;

  3430.   fWithoutAlpha     := tfBGR4;

  3431.   fRGBInverted      := tfRGBA2;

  3432.   fglInternalFormat := GL_RGBA2;

  3433. end;

  3434. 

  3435. constructor TfdBGRA4.Create;

  3436. begin

  3437.   inherited Create;

  3438.   fFormat           := tfBGRA4;

  3439.   fWithAlpha        := tfBGRA4;

  3440.   fWithoutAlpha     := tfBGR4;

  3441.   fRGBInverted      := tfRGBA4;

  3442.   fRange.r          := $F;

  3443.   fRange.g          := $F;

  3444.   fRange.b          := $F;

  3445.   fRange.a          := $F;

  3446.   fShift.r          :=  8;

  3447.   fShift.g          :=  4;

  3448.   fShift.b          :=  0;

  3449.   fShift.a          := 12;

  3450.   fglFormat         := GL_BGRA;

  3451.   fglInternalFormat := GL_RGBA4;

  3452.   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;

  3453. end;

  3454. 

  3455. constructor TfdBGR5A1.Create;

  3456. begin

  3457.   inherited Create;

  3458.   fFormat           := tfBGR5A1;

  3459.   fWithAlpha        := tfBGR5A1;

  3460.   fWithoutAlpha     := tfBGR5;

  3461.   fRGBInverted      := tfRGB5A1;

  3462.   fRange.r          := $1F;

  3463.   fRange.g          := $1F;

  3464.   fRange.b          := $1F;

  3465.   fRange.a          := $01;

  3466.   fShift.r          :=  10;

  3467.   fShift.g          :=   5;

  3468.   fShift.b          :=   0;

  3469.   fShift.a          :=  15;

  3470.   fglFormat         := GL_BGRA;

  3471.   fglInternalFormat := GL_RGB5_A1;

  3472.   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;

  3473. end;

  3474. 

  3475. constructor TfdBGRA8.Create;

  3476. begin

  3477.   inherited Create;

  3478.   fFormat           := tfBGRA8;

  3479.   fWithAlpha        := tfBGRA8;

  3480.   fWithoutAlpha     := tfBGR8;

  3481.   fRGBInverted      := tfRGBA8;

  3482.   fglInternalFormat := GL_RGBA8;

  3483. end;

  3484. 

  3485. constructor TfdBGR10A2.Create;

  3486. begin

  3487.   inherited Create;

  3488.   fFormat           := tfBGR10A2;

  3489.   fWithAlpha        := tfBGR10A2;

  3490.   fWithoutAlpha     := tfBGR10;

  3491.   fRGBInverted      := tfRGB10A2;

  3492.   fRange.r          := $3FF;

  3493.   fRange.g          := $3FF;

  3494.   fRange.b          := $3FF;

  3495.   fRange.a          := $003;

  3496.   fShift.r          :=   20;

  3497.   fShift.g          :=   10;

  3498.   fShift.b          :=    0;

  3499.   fShift.a          :=   30;

  3500.   fglFormat         := GL_BGRA;

  3501.   fglInternalFormat := GL_RGB10_A2;

  3502.   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;

  3503. end;

  3504. 

  3505. constructor TfdBGRA12.Create;

  3506. begin

  3507.   inherited Create;

  3508.   fFormat           := tfBGRA12;

  3509.   fWithAlpha        := tfBGRA12;

  3510.   fWithoutAlpha     := tfBGR12;

  3511.   fRGBInverted      := tfRGBA12;

  3512.   fglInternalFormat := GL_RGBA12;

  3513. end;

  3514. 

  3515. constructor TfdBGRA16.Create;

  3516. begin

  3517.   inherited Create;

  3518.   fFormat           := tfBGRA16;

  3519.   fWithAlpha        := tfBGRA16;

  3520.   fWithoutAlpha     := tfBGR16;

  3521.   fRGBInverted      := tfRGBA16;

  3522.   fglInternalFormat := GL_RGBA16;

  3523. end;

  3524. 

  3525. constructor TfdDepth16.Create;

  3526. begin

  3527.   inherited Create;

  3528.   fFormat           := tfDepth16;

  3529.   fWithAlpha        := tfEmpty;

  3530.   fWithoutAlpha     := tfDepth16;

  3531.   fglInternalFormat := GL_DEPTH_COMPONENT16;

  3532. end;

  3533. 

  3534. constructor TfdDepth24.Create;

  3535. begin

  3536.   inherited Create;

  3537.   fFormat           := tfDepth24;

  3538.   fWithAlpha        := tfEmpty;

  3539.   fWithoutAlpha     := tfDepth24;

  3540.   fglInternalFormat := GL_DEPTH_COMPONENT24;

  3541. end;

  3542. 

  3543. constructor TfdDepth32.Create;

  3544. begin

  3545.   inherited Create;

  3546.   fFormat           := tfDepth32;

  3547.   fWithAlpha        := tfEmpty;

  3548.   fWithoutAlpha     := tfDepth32;

  3549.   fglInternalFormat := GL_DEPTH_COMPONENT32;

  3550. end;

  3551. 

  3552. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3553. //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3554. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3555. procedure TfdS3tcDtx1RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);

  3556. begin

  3557.   raise EglBitmap.Create('mapping for compressed formats is not supported');

  3558. end;

  3559. 

  3560. procedure TfdS3tcDtx1RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);

  3561. begin

  3562.   raise EglBitmap.Create('mapping for compressed formats is not supported');

  3563. end;

  3564. 

  3565. constructor TfdS3tcDtx1RGBA.Create;

  3566. begin

  3567.   inherited Create;

  3568.   fFormat           := tfS3tcDtx1RGBA;

  3569.   fWithAlpha        := tfS3tcDtx1RGBA;

  3570.   fUncompressed     := tfRGB5A1;

  3571.   fPixelSize        := 0.5;

  3572.   fIsCompressed     := true;

  3573.   fglFormat         := GL_COMPRESSED_RGBA;

  3574.   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;

  3575.   fglDataFormat     := GL_UNSIGNED_BYTE;

  3576. end;

  3577. 

  3578. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3579. //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3580. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3581. procedure TfdS3tcDtx3RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);

  3582. begin

  3583.   raise EglBitmap.Create('mapping for compressed formats is not supported');

  3584. end;

  3585. 

  3586. procedure TfdS3tcDtx3RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);

  3587. begin

  3588.   raise EglBitmap.Create('mapping for compressed formats is not supported');

  3589. end;

  3590. 

  3591. constructor TfdS3tcDtx3RGBA.Create;

  3592. begin

  3593.   inherited Create;

  3594.   fFormat           := tfS3tcDtx3RGBA;

  3595.   fWithAlpha        := tfS3tcDtx3RGBA;

  3596.   fUncompressed     := tfRGBA8;

  3597.   fPixelSize        := 1.0;

  3598.   fIsCompressed     := true;

  3599.   fglFormat         := GL_COMPRESSED_RGBA;

  3600.   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;

  3601.   fglDataFormat     := GL_UNSIGNED_BYTE;

  3602. end;

  3603. 

  3604. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3605. //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3606. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3607. procedure TfdS3tcDtx5RGBA.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);

  3608. begin

  3609.   raise EglBitmap.Create('mapping for compressed formats is not supported');

  3610. end;

  3611. 

  3612. procedure TfdS3tcDtx5RGBA.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);

  3613. begin

  3614.   raise EglBitmap.Create('mapping for compressed formats is not supported');

  3615. end;

  3616. 

  3617. constructor TfdS3tcDtx5RGBA.Create;

  3618. begin

  3619.   inherited Create;

  3620.   fFormat           := tfS3tcDtx3RGBA;

  3621.   fWithAlpha        := tfS3tcDtx3RGBA;

  3622.   fUncompressed     := tfRGBA8;

  3623.   fPixelSize        := 1.0;

  3624.   fIsCompressed     := true;

  3625.   fglFormat         := GL_COMPRESSED_RGBA;

  3626.   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;

  3627.   fglDataFormat     := GL_UNSIGNED_BYTE;

  3628. end;

  3629. 

  3630. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3631. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3632. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3633. class procedure TFormatDescriptor.Init;

  3634. begin

  3635.   if not Assigned(FormatDescriptorCS) then

  3636.     FormatDescriptorCS := TCriticalSection.Create;

  3637. end;

  3638. 

  3639. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3640. class function TFormatDescriptor.Get(const aFormat: TglBitmapFormat): TFormatDescriptor;

  3641. begin

  3642.   FormatDescriptorCS.Enter;

  3643.   try

  3644.     result := FormatDescriptors[aFormat];

  3645.     if not Assigned(result) then begin

  3646.       result := FORMAT_DESCRIPTOR_CLASSES[aFormat].Create;

  3647.       FormatDescriptors[aFormat] := result;

  3648.     end;

  3649.   finally

  3650.     FormatDescriptorCS.Leave;

  3651.   end;

  3652. end;

  3653. 

  3654. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3655. class function TFormatDescriptor.GetWithAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;

  3656. begin

  3657.   result := Get(Get(aFormat).WithAlpha);

  3658. end;

  3659. 

  3660. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3661. class procedure TFormatDescriptor.Clear;

  3662. var

  3663.   f: TglBitmapFormat;

  3664. begin

  3665.   FormatDescriptorCS.Enter;

  3666.   try

  3667.     for f := low(FormatDescriptors) to high(FormatDescriptors) do

  3668.       FreeAndNil(FormatDescriptors[f]);

  3669.   finally

  3670.     FormatDescriptorCS.Leave;

  3671.   end;

  3672. end;

  3673. 

  3674. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3675. class procedure TFormatDescriptor.Finalize;

  3676. begin

  3677.   Clear;

  3678.   FreeAndNil(FormatDescriptorCS);

  3679. end;

  3680. 

  3681. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3682. //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3683. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3684. procedure TbmpBitfieldFormat.SetRedMask(const aValue: QWord);

  3685. begin

  3686.   Update(aValue, fRange.r, fShift.r);

  3687. end;

  3688. 

  3689. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3690. procedure TbmpBitfieldFormat.SetGreenMask(const aValue: QWord);

  3691. begin

  3692.   Update(aValue, fRange.g, fShift.g);

  3693. end;

  3694. 

  3695. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3696. procedure TbmpBitfieldFormat.SetBlueMask(const aValue: QWord);

  3697. begin

  3698.   Update(aValue, fRange.b, fShift.b);

  3699. end;

  3700. 

  3701. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3702. procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: QWord);

  3703. begin

  3704.   Update(aValue, fRange.a, fShift.a);

  3705. end;

  3706. 

  3707. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3708. procedure TbmpBitfieldFormat.Update(aMask: QWord; out aRange: Cardinal; out

  3709.   aShift: Byte);

  3710. begin

  3711.   aShift := 0;

  3712.   aRange := 0;

  3713.   if (aMask = 0) then

  3714.     exit;

  3715.   while (aMask > 0) and ((aMask and 1) = 0) do begin

  3716.     inc(aShift);

  3717.     aMask := aMask shr 1;

  3718.   end;

  3719.   aRange := 1;

  3720.   while (aMask > 0) do begin

  3721.     aRange := aRange shl 1;

  3722.     aMask  := aMask  shr 1;

  3723.   end;

  3724.   dec(aRange);

  3725. 

  3726.   fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);

  3727. end;

  3728. 

  3729. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3730. procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);

  3731. var

  3732.   data: QWord;

  3733.   s: Integer;

  3734. begin

  3735.   data :=

  3736.     ((aPixel.Data.r and fRange.r) shl fShift.r) or

  3737.     ((aPixel.Data.g and fRange.g) shl fShift.g) or

  3738.     ((aPixel.Data.b and fRange.b) shl fShift.b) or

  3739.     ((aPixel.Data.a and fRange.a) shl fShift.a);

  3740.   s := Round(fPixelSize);

  3741.   case s of

  3742.     1:           aData^  := data;

  3743.     2:     PWord(aData)^ := data;

  3744.     4: PCardinal(aData)^ := data;

  3745.     8:    PQWord(aData)^ := data;

  3746.   else

  3747.     raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);

  3748.   end;

  3749.   inc(aData, s);

  3750. end;

  3751. 

  3752. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3753. procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);

  3754. var

  3755.   data: QWord;

  3756.   s, i: Integer;

  3757. begin

  3758.   s := Round(fPixelSize);

  3759.   case s of

  3760.     1: data :=           aData^;

  3761.     2: data :=     PWord(aData)^;

  3762.     4: data := PCardinal(aData)^;

  3763.     8: data :=    PQWord(aData)^;

  3764.   else

  3765.     raise EglBitmap.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);

  3766.   end;

  3767.   for i := 0 to 3 do

  3768.     aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];

  3769.   inc(aData, s);

  3770. end;

  3771. 

  3772. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3773. //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3774. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3775. procedure TbmpColorTableFormat.CreateColorTable;

  3776. var

  3777.   i: Integer;

  3778. begin

  3779.   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then

  3780.     raise EglBitmap.Create(UNSUPPORTED_FORMAT);

  3781. 

  3782.   if (Format = tfLuminance4) then

  3783.     SetLength(fColorTable, 16)

  3784.   else

  3785.     SetLength(fColorTable, 256);

  3786. 

  3787.   case Format of

  3788.     tfLuminance4: begin

  3789.       for i := 0 to High(fColorTable) do begin

  3790.         fColorTable[i].r := 16 * i;

  3791.         fColorTable[i].g := 16 * i;

  3792.         fColorTable[i].b := 16 * i;

  3793.         fColorTable[i].a := 0;

  3794.       end;

  3795.     end;

  3796. 

  3797.     tfLuminance8: begin

  3798.       for i := 0 to High(fColorTable) do begin

  3799.         fColorTable[i].r := i;

  3800.         fColorTable[i].g := i;

  3801.         fColorTable[i].b := i;

  3802.         fColorTable[i].a := 0;

  3803.       end;

  3804.     end;

  3805. 

  3806.     tfR3G3B2: begin

  3807.       for i := 0 to High(fColorTable) do begin

  3808.         fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);

  3809.         fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);

  3810.         fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);

  3811.         fColorTable[i].a := 0;

  3812.       end;

  3813.     end;

  3814.   end;

  3815. end;

  3816. 

  3817. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3818. procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);

  3819. var

  3820.   d: Byte;

  3821. begin

  3822.   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then

  3823.     raise EglBitmap.Create(UNSUPPORTED_FORMAT);

  3824. 

  3825.   case Format of

  3826.     tfLuminance4: begin

  3827.       if (aMapData = nil) then

  3828.         aData^ := 0;

  3829.       d := LuminanceWeight(aPixel) and Range.r;

  3830.       aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData)));

  3831.       inc(PByte(aMapData), 4);

  3832.       if ({%H-}PtrUInt(aMapData) >= 8) then begin

  3833.         inc(aData);

  3834.         aMapData := nil;

  3835.       end;

  3836.     end;

  3837. 

  3838.     tfLuminance8: begin

  3839.       aData^ := LuminanceWeight(aPixel) and Range.r;

  3840.       inc(aData);

  3841.     end;

  3842. 

  3843.     tfR3G3B2: begin

  3844.       aData^ := Round(

  3845.         ((aPixel.Data.r and Range.r) shl Shift.r) or

  3846.         ((aPixel.Data.g and Range.g) shl Shift.g) or

  3847.         ((aPixel.Data.b and Range.b) shl Shift.b));

  3848.       inc(aData);

  3849.     end;

  3850.   end;

  3851. end;

  3852. 

  3853. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3854. procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);

  3855. var

  3856.   idx: QWord;

  3857.   s: Integer;

  3858.   bits: Byte;

  3859.   f: Single;

  3860. begin

  3861.   s    := Trunc(fPixelSize);

  3862.   f    := fPixelSize - s;

  3863.   bits := Round(8 * f);

  3864.   case s of

  3865.     0: idx :=          (aData^ shr (8 - bits - {%H-}PtrInt(aMapData))) and ((1 shl bits) - 1);

  3866.     1: idx :=           aData^;

  3867.     2: idx :=     PWord(aData)^;

  3868.     4: idx := PCardinal(aData)^;

  3869.     8: idx :=    PQWord(aData)^;

  3870.   else

  3871.     raise EglBitmap.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);

  3872.   end;

  3873.   if (idx >= Length(fColorTable)) then

  3874.     raise EglBitmap.CreateFmt('invalid color index: %d', [idx]);

  3875.   with fColorTable[idx] do begin

  3876.     aPixel.Data.r := r;

  3877.     aPixel.Data.g := g;

  3878.     aPixel.Data.b := b;

  3879.     aPixel.Data.a := a;

  3880.   end;

  3881.   inc(PByte(aMapData), bits);

  3882.   if ({%H-}PtrUInt(aMapData) >= 8) then begin

  3883.     inc(aData, 1);

  3884.     dec(PByte(aMapData), 8);

  3885.   end;

  3886.   inc(aData, s);

  3887. end;

  3888. 

  3889. destructor TbmpColorTableFormat.Destroy;

  3890. begin

  3891.   SetLength(fColorTable, 0);

  3892.   inherited Destroy;

  3893. end;

  3894. 

  3895. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3896. //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3897. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3898. procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);

  3899. var

  3900.   i: Integer;

  3901. begin

  3902.   for i := 0 to 3 do begin

  3903.     if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin

  3904.       if (aSourceFD.Range.arr[i] > 0) then

  3905.         aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])

  3906.       else

  3907.         aPixel.Data.arr[i] := aDestFD.Range.arr[i];

  3908.     end;

  3909.   end;

  3910. end;

  3911. 

  3912. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3913. procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);

  3914. begin

  3915.   with aFuncRec do begin

  3916.     if (Source.Range.r   > 0) then

  3917.       Dest.Data.r := Source.Data.r;

  3918.     if (Source.Range.g > 0) then

  3919.       Dest.Data.g := Source.Data.g;

  3920.     if (Source.Range.b  > 0) then

  3921.       Dest.Data.b := Source.Data.b;

  3922.     if (Source.Range.a > 0) then

  3923.       Dest.Data.a := Source.Data.a;

  3924.   end;

  3925. end;

  3926. 

  3927. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3928. procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);

  3929. var

  3930.   i: Integer;

  3931. begin

  3932.   with aFuncRec do begin

  3933.     for i := 0 to 3 do

  3934.       if (Source.Range.arr[i] > 0) then

  3935.         Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);

  3936.   end;

  3937. end;

  3938. 

  3939. type

  3940.   TShiftData = packed record

  3941.     case Integer of

  3942.       0: (r, g, b, a: SmallInt);

  3943.       1: (arr: array[0..3] of SmallInt);

  3944.   end;

  3945.   PShiftData = ^TShiftData;

  3946. 

  3947. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3948. procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);

  3949. var

  3950.   i: Integer;

  3951. begin

  3952.   with aFuncRec do

  3953.     for i := 0 to 3 do

  3954.       if (Source.Range.arr[i] > 0) then

  3955.         Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];

  3956. end;

  3957. 

  3958. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3959. procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);

  3960. begin

  3961.   with aFuncRec do begin

  3962.     Dest.Data := Source.Data;

  3963.     if ({%H-}PtrUInt(Args) and $1 > 0) then begin

  3964.       Dest.Data.r := Dest.Data.r xor Dest.Range.r;

  3965.       Dest.Data.g := Dest.Data.g xor Dest.Range.g;

  3966.       Dest.Data.b := Dest.Data.b xor Dest.Range.b;

  3967.     end;

  3968.     if ({%H-}PtrUInt(Args) and $2 > 0) then begin

  3969.       Dest.Data.a := Dest.Data.a xor Dest.Range.a;

  3970.     end;

  3971.   end;

  3972. end;

  3973. 

  3974. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3975. procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);

  3976. var

  3977.   i: Integer;

  3978. begin

  3979.   with aFuncRec do begin

  3980.     for i := 0 to 3 do

  3981.       Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];

  3982.   end;

  3983. end;

  3984. 

  3985. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3986. procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);

  3987. var

  3988.   Temp: Single;

  3989. begin

  3990.   with FuncRec do begin

  3991.     if (FuncRec.Args = nil) then begin //source has no alpha

  3992.       Temp :=

  3993.         Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +

  3994.         Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +

  3995.         Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;

  3996.       Dest.Data.a := Round(Dest.Range.a * Temp);

  3997.     end else

  3998.       Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);

  3999.   end;

  4000. end;

  4001. 

  4002. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4003. procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);

  4004. type

  4005.   PglBitmapPixelData = ^TglBitmapPixelData;

  4006. begin

  4007.   with FuncRec do begin

  4008.     Dest.Data.r := Source.Data.r;

  4009.     Dest.Data.g := Source.Data.g;

  4010.     Dest.Data.b := Source.Data.b;

  4011. 

  4012.     with PglBitmapPixelData(Args)^ do

  4013.       if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and

  4014.           (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and

  4015.           (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then

  4016.         Dest.Data.a := 0

  4017.       else

  4018.         Dest.Data.a := Dest.Range.a;

  4019.   end;

  4020. end;

  4021. 

  4022. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4023. procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);

  4024. begin

  4025.   with FuncRec do begin

  4026.     Dest.Data.r := Source.Data.r;

  4027.     Dest.Data.g := Source.Data.g;

  4028.     Dest.Data.b := Source.Data.b;

  4029.     Dest.Data.a := PCardinal(Args)^;

  4030.   end;

  4031. end;

  4032. 

  4033. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4034. procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);

  4035. type

  4036.   PRGBPix = ^TRGBPix;

  4037.   TRGBPix = array [0..2] of byte;

  4038. var

  4039.   Temp: Byte;

  4040. begin

  4041.   while aWidth > 0 do begin

  4042.     Temp := PRGBPix(aData)^[0];

  4043.     PRGBPix(aData)^[0] := PRGBPix(aData)^[2];

  4044.     PRGBPix(aData)^[2] := Temp;

  4045. 

  4046.     if aHasAlpha then

  4047.       Inc(aData, 4)

  4048.     else

  4049.       Inc(aData, 3);

  4050.     dec(aWidth);

  4051.   end;

  4052. end;

  4053. 

  4054. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4055. //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4056. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4057. function TglBitmap.GetFormatDesc: TglBitmapFormatDescriptor;

  4058. begin

  4059.   result := TFormatDescriptor.Get(Format);

  4060. end;

  4061. 

  4062. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4063. function TglBitmap.GetWidth: Integer;

  4064. begin

  4065.   if (ffX in fDimension.Fields) then

  4066.     result := fDimension.X

  4067.   else

  4068.     result := -1;

  4069. end;

  4070. 

  4071. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4072. function TglBitmap.GetHeight: Integer;

  4073. begin

  4074.   if (ffY in fDimension.Fields) then

  4075.     result := fDimension.Y

  4076.   else

  4077.     result := -1;

  4078. end;

  4079. 

  4080. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4081. function TglBitmap.GetFileWidth: Integer;

  4082. begin

  4083.   result := Max(1, Width);

  4084. end;

  4085. 

  4086. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4087. function TglBitmap.GetFileHeight: Integer;

  4088. begin

  4089.   result := Max(1, Height);

  4090. end;

  4091. 

  4092. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4093. procedure TglBitmap.SetCustomData(const aValue: Pointer);

  4094. begin

  4095.   if fCustomData = aValue then

  4096.     exit;

  4097.   fCustomData := aValue;

  4098. end;

  4099. 

  4100. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4101. procedure TglBitmap.SetCustomName(const aValue: String);

  4102. begin

  4103.   if fCustomName = aValue then

  4104.     exit;

  4105.   fCustomName := aValue;

  4106. end;

  4107. 

  4108. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4109. procedure TglBitmap.SetCustomNameW(const aValue: WideString);

  4110. begin

  4111.   if fCustomNameW = aValue then

  4112.     exit;

  4113.   fCustomNameW := aValue;

  4114. end;

  4115. 

  4116. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4117. procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);

  4118. begin

  4119.   if fDeleteTextureOnFree = aValue then

  4120.     exit;

  4121.   fDeleteTextureOnFree := aValue;

  4122. end;

  4123. 

  4124. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4125. procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);

  4126. begin

  4127.   if fFormat = aValue then

  4128.     exit;

  4129.   if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then

  4130.     raise EglBitmapUnsupportedFormat.Create(Format);

  4131.   SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method

  4132. end;

  4133. 

  4134. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4135. procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);

  4136. begin

  4137.   if fFreeDataAfterGenTexture = aValue then

  4138.     exit;

  4139.   fFreeDataAfterGenTexture := aValue;

  4140. end;

  4141. 

  4142. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4143. procedure TglBitmap.SetID(const aValue: Cardinal);

  4144. begin

  4145.   if fID = aValue then

  4146.     exit;

  4147.   fID := aValue;

  4148. end;

  4149. 

  4150. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4151. procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);

  4152. begin

  4153.   if fMipMap = aValue then

  4154.     exit;

  4155.   fMipMap := aValue;

  4156. end;

  4157. 

  4158. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4159. procedure TglBitmap.SetTarget(const aValue: Cardinal);

  4160. begin

  4161.   if fTarget = aValue then

  4162.     exit;

  4163.   fTarget := aValue;

  4164. end;

  4165. 

  4166. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4167. procedure TglBitmap.SetAnisotropic(const aValue: Integer);

  4168. var

  4169.   MaxAnisotropic: Integer;

  4170. begin

  4171.   fAnisotropic := aValue;

  4172.   if (ID > 0) then begin

  4173.     if GL_EXT_texture_filter_anisotropic then begin

  4174.       if fAnisotropic > 0 then begin

  4175.         Bind(false);

  4176.         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);

  4177.         if aValue > MaxAnisotropic then

  4178.           fAnisotropic := MaxAnisotropic;

  4179.         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);

  4180.       end;

  4181.     end else begin

  4182.       fAnisotropic := 0;

  4183.     end;

  4184.   end;

  4185. end;

  4186. 

  4187. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4188. procedure TglBitmap.CreateID;

  4189. begin

  4190.   if (ID <> 0) then

  4191.     glDeleteTextures(1, @fID);

  4192.   glGenTextures(1, @fID);

  4193.   Bind(false);

  4194. end;

  4195. 

  4196. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4197. procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);

  4198. begin

  4199.   // Set Up Parameters

  4200.   SetWrap(fWrapS, fWrapT, fWrapR);

  4201.   SetFilter(fFilterMin, fFilterMag);

  4202.   SetAnisotropic(fAnisotropic);

  4203.   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);

  4204. 

  4205.   if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then

  4206.     SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);

  4207. 

  4208.   // Mip Maps Generation Mode

  4209.   aBuildWithGlu := false;

  4210.   if (MipMap = mmMipmap) then begin

  4211.     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then

  4212.       glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)

  4213.     else

  4214.       aBuildWithGlu := true;

  4215.   end else if (MipMap = mmMipmapGlu) then

  4216.     aBuildWithGlu := true;

  4217. end;

  4218. 

  4219. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4220. procedure TglBitmap.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;

  4221.   const aWidth: Integer; const aHeight: Integer);

  4222. var

  4223.   s: Single;

  4224. begin

  4225.   if (Data <> aData) then begin

  4226.     if (Assigned(Data)) then

  4227.       FreeMem(Data);

  4228.     fData := aData;

  4229.   end;

  4230. 

  4231.   FillChar(fDimension, SizeOf(fDimension), 0);

  4232.   if not Assigned(fData) then begin

  4233.     fFormat    := tfEmpty;

  4234.     fPixelSize := 0;

  4235.     fRowSize   := 0;

  4236.   end else begin

  4237.     if aWidth <> -1 then begin

  4238.       fDimension.Fields := fDimension.Fields + [ffX];

  4239.       fDimension.X := aWidth;

  4240.     end;

  4241. 

  4242.     if aHeight <> -1 then begin

  4243.       fDimension.Fields := fDimension.Fields + [ffY];

  4244.       fDimension.Y := aHeight;

  4245.     end;

  4246. 

  4247.     s := TFormatDescriptor.Get(aFormat).PixelSize;

  4248.     fFormat    := aFormat;

  4249.     fPixelSize := Ceil(s);

  4250.     fRowSize   := Ceil(s * aWidth);

  4251.   end;

  4252. end;

  4253. 

  4254. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4255. function TglBitmap.FlipHorz: Boolean;

  4256. begin

  4257.   result := false;

  4258. end;

  4259. 

  4260. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4261. function TglBitmap.FlipVert: Boolean;

  4262. begin

  4263.   result := false;

  4264. end;

  4265. 

  4266. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4267. //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4268. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4269. procedure TglBitmap.AfterConstruction;

  4270. begin

  4271.   inherited AfterConstruction;

  4272. 

  4273.   fID         := 0;

  4274.   fTarget     := 0;

  4275.   fIsResident := false;

  4276. 

  4277.   fFormat                  := glBitmapGetDefaultFormat;

  4278.   fMipMap                  := glBitmapDefaultMipmap;

  4279.   fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;

  4280.   fDeleteTextureOnFree     := glBitmapGetDefaultDeleteTextureOnFree;

  4281. 

  4282.   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);

  4283.   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);

  4284.   glBitmapGetDefaultSwizzle    (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);

  4285. end;

  4286. 

  4287. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4288. procedure TglBitmap.BeforeDestruction;

  4289. var

  4290.   NewData: PByte;

  4291. begin

  4292.   NewData := nil;

  4293.   SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method

  4294.   if (fID > 0) and fDeleteTextureOnFree then

  4295.     glDeleteTextures(1, @fID);

  4296.   inherited BeforeDestruction;

  4297. end;

  4298. 

  4299. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4300. procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);

  4301. var

  4302.   TempPos: Integer;

  4303. begin

  4304.   if not Assigned(aResType) then begin

  4305.     TempPos   := Pos('.', aResource);

  4306.     aResType  := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));

  4307.     aResource := UpperCase(Copy(aResource, 0, TempPos -1));

  4308.   end;

  4309. end;

  4310. 

  4311. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4312. procedure TglBitmap.LoadFromFile(const aFilename: String);

  4313. var

  4314.   fs: TFileStream;

  4315. begin

  4316.   if not FileExists(aFilename) then

  4317.     raise EglBitmap.Create('file does not exist: ' + aFilename);

  4318.   fFilename := aFilename;

  4319.   fs := TFileStream.Create(fFilename, fmOpenRead);

  4320.   try

  4321.     fs.Position := 0;

  4322.     LoadFromStream(fs);

  4323.   finally

  4324.     fs.Free;

  4325.   end;

  4326. end;

  4327. 

  4328. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4329. procedure TglBitmap.LoadFromStream(const aStream: TStream);

  4330. begin

  4331.   {$IFDEF GLB_SUPPORT_PNG_READ}

  4332.   if not LoadPNG(aStream) then

  4333.   {$ENDIF}

  4334.   {$IFDEF GLB_SUPPORT_JPEG_READ}

  4335.   if not LoadJPEG(aStream) then

  4336.   {$ENDIF}

  4337.   if not LoadDDS(aStream) then

  4338.   if not LoadTGA(aStream) then

  4339.   if not LoadBMP(aStream) then

  4340.     raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');

  4341. end;

  4342. 

  4343. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4344. procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;

  4345.   const aFormat: TglBitmapFormat; const aArgs: Pointer);

  4346. var

  4347.   tmpData: PByte;

  4348.   size: Integer;

  4349. begin

  4350.   size := TFormatDescriptor.Get(aFormat).GetSize(aSize);

  4351.   GetMem(tmpData, size);

  4352.   try

  4353.     FillChar(tmpData^, size, #$FF);

  4354.     SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method

  4355.   except

  4356.     if Assigned(tmpData) then

  4357.       FreeMem(tmpData);

  4358.     raise;

  4359.   end;

  4360.   AddFunc(Self, aFunc, false, Format, aArgs);

  4361. end;

  4362. 

  4363. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4364. procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);

  4365. var

  4366.   rs: TResourceStream;

  4367. begin

  4368.   PrepareResType(aResource, aResType);

  4369.   rs := TResourceStream.Create(aInstance, aResource, aResType);

  4370.   try

  4371.     LoadFromStream(rs);

  4372.   finally

  4373.     rs.Free;

  4374.   end;

  4375. end;

  4376. 

  4377. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4378. procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);

  4379. var

  4380.   rs: TResourceStream;

  4381. begin

  4382.   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);

  4383.   try

  4384.     LoadFromStream(rs);

  4385.   finally

  4386.     rs.Free;

  4387.   end;

  4388. end;

  4389. 

  4390. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4391. procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);

  4392. var

  4393.   fs: TFileStream;

  4394. begin

  4395.   fs := TFileStream.Create(aFileName, fmCreate);

  4396.   try

  4397.     fs.Position := 0;

  4398.     SaveToStream(fs, aFileType);

  4399.   finally

  4400.     fs.Free;

  4401.   end;

  4402. end;

  4403. 

  4404. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4405. procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);

  4406. begin

  4407.   case aFileType of

  4408.     {$IFDEF GLB_SUPPORT_PNG_WRITE}

  4409.     ftPNG:  SavePNG(aStream);

  4410.     {$ENDIF}

  4411.     {$IFDEF GLB_SUPPORT_JPEG_WRITE}

  4412.     ftJPEG: SaveJPEG(aStream);

  4413.     {$ENDIF}

  4414.     ftDDS:  SaveDDS(aStream);

  4415.     ftTGA:  SaveTGA(aStream);

  4416.     ftBMP:  SaveBMP(aStream);

  4417.   end;

  4418. end;

  4419. 

  4420. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4421. function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;

  4422. begin

  4423.   result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);

  4424. end;

  4425. 

  4426. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4427. function TglBitmap.AddFunc(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;

  4428.   const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;

  4429. var

  4430.   DestData, TmpData, SourceData: pByte;

  4431.   TempHeight, TempWidth: Integer;

  4432.   SourceFD, DestFD: TFormatDescriptor;

  4433.   SourceMD, DestMD: Pointer;

  4434. 

  4435.   FuncRec: TglBitmapFunctionRec;

  4436. begin

  4437.   Assert(Assigned(Data));

  4438.   Assert(Assigned(aSource));

  4439.   Assert(Assigned(aSource.Data));

  4440. 

  4441.   result := false;

  4442.   if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin

  4443.     SourceFD := TFormatDescriptor.Get(aSource.Format);

  4444.     DestFD   := TFormatDescriptor.Get(aFormat);

  4445. 

  4446.     if (SourceFD.IsCompressed) then

  4447.       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);

  4448.     if (DestFD.IsCompressed) then

  4449.       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);

  4450. 

  4451.     // inkompatible Formats so CreateTemp

  4452.     if (SourceFD.PixelSize <> DestFD.PixelSize) then

  4453.       aCreateTemp := true;

  4454. 

  4455.     // Values

  4456.     TempHeight := Max(1, aSource.Height);

  4457.     TempWidth  := Max(1, aSource.Width);

  4458. 

  4459.     FuncRec.Sender := Self;

  4460.     FuncRec.Args   := aArgs;

  4461. 

  4462.     TmpData := nil;

  4463.     if aCreateTemp then begin

  4464.       GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));

  4465.       DestData := TmpData;

  4466.     end else

  4467.       DestData := Data;

  4468. 

  4469.     try

  4470.       SourceFD.PreparePixel(FuncRec.Source);

  4471.       DestFD.PreparePixel  (FuncRec.Dest);

  4472. 

  4473.       SourceMD := SourceFD.CreateMappingData;

  4474.       DestMD   := DestFD.CreateMappingData;

  4475. 

  4476.       FuncRec.Size            := aSource.Dimension;

  4477.       FuncRec.Position.Fields := FuncRec.Size.Fields;

  4478. 

  4479.       try

  4480.         SourceData := aSource.Data;

  4481.         FuncRec.Position.Y := 0;

  4482.         while FuncRec.Position.Y < TempHeight do begin

  4483.           FuncRec.Position.X := 0;

  4484.           while FuncRec.Position.X < TempWidth do begin

  4485.             SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);

  4486.             aFunc(FuncRec);

  4487.             DestFD.Map(FuncRec.Dest, DestData, DestMD);

  4488.             inc(FuncRec.Position.X);

  4489.           end;

  4490.           inc(FuncRec.Position.Y);

  4491.         end;

  4492. 

  4493.         // Updating Image or InternalFormat

  4494.         if aCreateTemp then

  4495.           SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method

  4496.         else if (aFormat <> fFormat) then

  4497.           Format := aFormat;

  4498. 

  4499.         result := true;

  4500.       finally

  4501.         SourceFD.FreeMappingData(SourceMD);

  4502.         DestFD.FreeMappingData(DestMD);

  4503.       end;

  4504.     except

  4505.       if aCreateTemp and Assigned(TmpData) then

  4506.         FreeMem(TmpData);

  4507.       raise;

  4508.     end;

  4509.   end;

  4510. end;

  4511. 

  4512. {$IFDEF GLB_SDL}

  4513. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4514. function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;

  4515. var

  4516.   Row, RowSize: Integer;

  4517.   SourceData, TmpData: PByte;

  4518.   TempDepth: Integer;

  4519.   FormatDesc: TFormatDescriptor;

  4520. 

  4521.   function GetRowPointer(Row: Integer): pByte;

  4522.   begin

  4523.     result := aSurface.pixels;

  4524.     Inc(result, Row * RowSize);

  4525.   end;

  4526. 

  4527. begin

  4528.   result := false;

  4529. 

  4530.   FormatDesc := TFormatDescriptor.Get(Format);

  4531.   if FormatDesc.IsCompressed then

  4532.     raise EglBitmapUnsupportedFormat.Create(Format);

  4533. 

  4534.   if Assigned(Data) then begin

  4535.     case Trunc(FormatDesc.PixelSize) of

  4536.       1: TempDepth :=  8;

  4537.       2: TempDepth := 16;

  4538.       3: TempDepth := 24;

  4539.       4: TempDepth := 32;

  4540.     else

  4541.       raise EglBitmapUnsupportedFormat.Create(Format);

  4542.     end;

  4543. 

  4544.     aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,

  4545.       FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);

  4546.     SourceData := Data;

  4547.     RowSize    := FormatDesc.GetSize(FileWidth, 1);

  4548. 

  4549.     for Row := 0 to FileHeight-1 do begin

  4550.       TmpData := GetRowPointer(Row);

  4551.       if Assigned(TmpData) then begin

  4552.         Move(SourceData^, TmpData^, RowSize);

  4553.         inc(SourceData, RowSize);

  4554.       end;

  4555.     end;

  4556.     result := true;

  4557.   end;

  4558. end;

  4559. 

  4560. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4561. function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;

  4562. var

  4563.   pSource, pData, pTempData: PByte;

  4564.   Row, RowSize, TempWidth, TempHeight: Integer;

  4565.   IntFormat: TglBitmapFormat;

  4566.   FormatDesc: TFormatDescriptor;

  4567. 

  4568.   function GetRowPointer(Row: Integer): pByte;

  4569.   begin

  4570.     result := aSurface^.pixels;

  4571.     Inc(result, Row * RowSize);

  4572.   end;

  4573. 

  4574. begin

  4575.   result := false;

  4576.   if (Assigned(aSurface)) then begin

  4577.     with aSurface^.format^ do begin

  4578.       for IntFormat := High(TglBitmapFormat) to Low(TglBitmapFormat) do begin

  4579.         FormatDesc := TFormatDescriptor.Get(IntFormat);

  4580.         if (FormatDesc.MaskMatch(RMask, GMask, BMask, AMask)) then

  4581.           break;

  4582.       end;

  4583.       if (IntFormat = tfEmpty) then

  4584.         raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');

  4585.     end;

  4586. 

  4587.     TempWidth  := aSurface^.w;

  4588.     TempHeight := aSurface^.h;

  4589.     RowSize := FormatDesc.GetSize(TempWidth, 1);

  4590.     GetMem(pData, TempHeight * RowSize);

  4591.     try

  4592.       pTempData := pData;

  4593.       for Row := 0 to TempHeight -1 do begin

  4594.         pSource := GetRowPointer(Row);

  4595.         if (Assigned(pSource)) then begin

  4596.           Move(pSource^, pTempData^, RowSize);

  4597.           Inc(pTempData, RowSize);

  4598.         end;

  4599.       end;

  4600.       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method

  4601.       result := true;

  4602.     except

  4603.       if Assigned(pData) then

  4604.         FreeMem(pData);

  4605.       raise;

  4606.     end;

  4607.   end;

  4608. end;

  4609. 

  4610. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4611. function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;

  4612. var

  4613.   Row, Col, AlphaInterleave: Integer;

  4614.   pSource, pDest: PByte;

  4615. 

  4616.   function GetRowPointer(Row: Integer): pByte;

  4617.   begin

  4618.     result := aSurface.pixels;

  4619.     Inc(result, Row * Width);

  4620.   end;

  4621. 

  4622. begin

  4623.   result := false;

  4624.   if Assigned(Data) then begin

  4625.     if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin

  4626.       aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);

  4627. 

  4628.       AlphaInterleave := 0;

  4629.       case Format of

  4630.         tfLuminance8Alpha8:

  4631.           AlphaInterleave := 1;

  4632.         tfBGRA8, tfRGBA8:

  4633.           AlphaInterleave := 3;

  4634.       end;

  4635. 

  4636.       pSource := Data;

  4637.       for Row := 0 to Height -1 do begin

  4638.         pDest := GetRowPointer(Row);

  4639.         if Assigned(pDest) then begin

  4640.           for Col := 0 to Width -1 do begin

  4641.             Inc(pSource, AlphaInterleave);

  4642.             pDest^ := pSource^;

  4643.             Inc(pDest);

  4644.             Inc(pSource);

  4645.           end;

  4646.         end;

  4647.       end;

  4648.       result := true;

  4649.     end;

  4650.   end;

  4651. end;

  4652. 

  4653. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4654. function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;

  4655. var

  4656.   bmp: TglBitmap2D;

  4657. begin

  4658.   bmp := TglBitmap2D.Create;

  4659.   try

  4660.     bmp.AssignFromSurface(aSurface);

  4661.     result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);

  4662.   finally

  4663.     bmp.Free;

  4664.   end;

  4665. end;

  4666. {$ENDIF}

  4667. 

  4668. {$IFDEF GLB_DELPHI}

  4669. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4670. function CreateGrayPalette: HPALETTE;

  4671. var

  4672.   Idx: Integer;

  4673.   Pal: PLogPalette;

  4674. begin

  4675.   GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));

  4676. 

  4677.   Pal.palVersion := $300;

  4678.   Pal.palNumEntries := 256;

  4679. 

  4680.   for Idx := 0 to Pal.palNumEntries - 1 do begin

  4681.     Pal.palPalEntry[Idx].peRed   := Idx;

  4682.     Pal.palPalEntry[Idx].peGreen := Idx;

  4683.     Pal.palPalEntry[Idx].peBlue  := Idx;

  4684.     Pal.palPalEntry[Idx].peFlags := 0;

  4685.   end;

  4686.   Result := CreatePalette(Pal^);

  4687.   FreeMem(Pal);

  4688. end;

  4689. 

  4690. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4691. function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;

  4692. var

  4693.   Row: Integer;

  4694.   pSource, pData: PByte;

  4695. begin

  4696.   result := false;

  4697.   if Assigned(Data) then begin

  4698.     if Assigned(aBitmap) then begin

  4699.       aBitmap.Width  := Width;

  4700.       aBitmap.Height := Height;

  4701. 

  4702.       case Format of

  4703.         tfAlpha8, tfLuminance8: begin

  4704.           aBitmap.PixelFormat := pf8bit;

  4705.           aBitmap.Palette     := CreateGrayPalette;

  4706.         end;

  4707.         tfRGB5A1:

  4708.           aBitmap.PixelFormat := pf15bit;

  4709.         tfR5G6B5:

  4710.           aBitmap.PixelFormat := pf16bit;

  4711.         tfRGB8, tfBGR8:

  4712.           aBitmap.PixelFormat := pf24bit;

  4713.         tfRGBA8, tfBGRA8:

  4714.           aBitmap.PixelFormat := pf32bit;

  4715.       else

  4716.         raise EglBitmapException.Create('AssignToBitmap - Invalid Pixelformat.');

  4717.       end;

  4718. 

  4719.       pSource := Data;

  4720.       for Row := 0 to FileHeight -1 do begin

  4721.         pData := aBitmap.Scanline[Row];

  4722.         Move(pSource^, pData^, fRowSize);

  4723.         Inc(pSource, fRowSize);

  4724.         if (Format in [tfRGB8, tfRGBA8]) then        // swap RGB(A) to BGR(A)

  4725.           SwapRGB(pData, FileWidth, Format = tfRGBA8);

  4726.       end;

  4727.       result := true;

  4728.     end;

  4729.   end;

  4730. end;

  4731. 

  4732. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4733. function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;

  4734. var

  4735.   pSource, pData, pTempData: PByte;

  4736.   Row, RowSize, TempWidth, TempHeight: Integer;

  4737.   IntFormat: TglBitmapFormat;

  4738. begin

  4739.   result := false;

  4740. 

  4741.   if (Assigned(aBitmap)) then begin

  4742.     case aBitmap.PixelFormat of

  4743.       pf8bit:

  4744.         IntFormat := tfLuminance8;

  4745.       pf15bit:

  4746.         IntFormat := tfRGB5A1;

  4747.       pf16bit:

  4748.         IntFormat := tfR5G6B5;

  4749.       pf24bit:

  4750.         IntFormat := tfBGR8;

  4751.       pf32bit:

  4752.         IntFormat := tfBGRA8;

  4753.     else

  4754.       raise EglBitmapException.Create('AssignFromBitmap - Invalid Pixelformat.');

  4755.     end;

  4756. 

  4757.     TempWidth  := aBitmap.Width;

  4758.     TempHeight := aBitmap.Height;

  4759.     RowSize    := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);

  4760.     GetMem(pData, TempHeight * RowSize);

  4761.     try

  4762.       pTempData := pData;

  4763.       for Row := 0 to TempHeight -1 do begin

  4764.         pSource := aBitmap.Scanline[Row];

  4765.         if (Assigned(pSource)) then begin

  4766.           Move(pSource^, pTempData^, RowSize);

  4767.           Inc(pTempData, RowSize);

  4768.         end;

  4769.       end;

  4770.       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method

  4771.       result := true;

  4772.     except

  4773.       if Assigned(pData) then

  4774.         FreeMem(pData);

  4775.       raise;

  4776.     end;

  4777.   end;

  4778. end;

  4779. 

  4780. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4781. function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;

  4782. var

  4783.   Row, Col, AlphaInterleave: Integer;

  4784.   pSource, pDest: PByte;

  4785. begin

  4786.   result := false;

  4787. 

  4788.   if Assigned(Data) then begin

  4789.     if (Format in [tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8]) then begin

  4790.       if Assigned(aBitmap) then begin

  4791.         aBitmap.PixelFormat := pf8bit;

  4792.         aBitmap.Palette     := CreateGrayPalette;

  4793.         aBitmap.Width       := Width;

  4794.         aBitmap.Height      := Height;

  4795. 

  4796.         case Format of

  4797.           tfLuminance8Alpha8:

  4798.             AlphaInterleave := 1;

  4799.           tfRGBA8, tfBGRA8:

  4800.             AlphaInterleave := 3;

  4801.           else

  4802.             AlphaInterleave := 0;

  4803.         end;

  4804. 

  4805.         // Copy Data

  4806.         pSource := Data;

  4807. 

  4808.         for Row := 0 to Height -1 do begin

  4809.           pDest := aBitmap.Scanline[Row];

  4810.           if Assigned(pDest) then begin

  4811.             for Col := 0 to Width -1 do begin

  4812.               Inc(pSource, AlphaInterleave);

  4813.               pDest^ := pSource^;

  4814.               Inc(pDest);

  4815.               Inc(pSource);

  4816.             end;

  4817.           end;

  4818.         end;   

  4819.         result := true;

  4820.       end;

  4821.     end;

  4822.   end;

  4823. end;

  4824. 

  4825. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4826. function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;

  4827. var

  4828.   tex: TglBitmap2D;

  4829. begin

  4830.   tex := TglBitmap2D.Create;

  4831.   try

  4832.     tex.AssignFromBitmap(ABitmap);

  4833.     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);

  4834.   finally

  4835.     tex.Free;

  4836.   end;

  4837. end;

  4838. {$ENDIF}

  4839. 

  4840. {$IFDEF GLB_LAZARUS}

  4841. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4842. function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;

  4843. var

  4844.   rid: TRawImageDescription;

  4845.   FormatDesc: TFormatDescriptor;

  4846. begin

  4847.   result := false;

  4848.   if not Assigned(aImage) or (Format = tfEmpty) then

  4849.     exit;

  4850.   FormatDesc := TFormatDescriptor.Get(Format);

  4851.   if FormatDesc.IsCompressed then

  4852.     exit;

  4853. 

  4854.   FillChar(rid{%H-}, SizeOf(rid), 0);

  4855.   if (Format in [

  4856.        tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,

  4857.        tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,

  4858.        tfLuminance4Alpha4, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16]) then

  4859.     rid.Format := ricfGray

  4860.   else

  4861.     rid.Format := ricfRGBA;

  4862. 

  4863.   rid.Width        := Width;

  4864.   rid.Height       := Height;

  4865.   rid.Depth        := CountSetBits(FormatDesc.Range.r or FormatDesc.Range.g or FormatDesc.Range.b or FormatDesc.Range.a);

  4866.   rid.BitOrder     := riboBitsInOrder;

  4867.   rid.ByteOrder    := riboLSBFirst;

  4868.   rid.LineOrder    := riloTopToBottom;

  4869.   rid.LineEnd      := rileTight;

  4870.   rid.BitsPerPixel := Round(8 * FormatDesc.PixelSize);

  4871.   rid.RedPrec      := CountSetBits(FormatDesc.Range.r);

  4872.   rid.GreenPrec    := CountSetBits(FormatDesc.Range.g);

  4873.   rid.BluePrec     := CountSetBits(FormatDesc.Range.b);

  4874.   rid.AlphaPrec    := CountSetBits(FormatDesc.Range.a);

  4875.   rid.RedShift     := FormatDesc.Shift.r;

  4876.   rid.GreenShift   := FormatDesc.Shift.g;

  4877.   rid.BlueShift    := FormatDesc.Shift.b;

  4878.   rid.AlphaShift   := FormatDesc.Shift.a;

  4879. 

  4880.   rid.MaskBitsPerPixel  := 0;

  4881.   rid.PaletteColorCount := 0;

  4882. 

  4883.   aImage.DataDescription := rid;

  4884.   aImage.CreateData;

  4885. 

  4886.   Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));

  4887. 

  4888.   result := true;

  4889. end;

  4890. 

  4891. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4892. function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;

  4893. var

  4894.   f: TglBitmapFormat;

  4895.   FormatDesc: TFormatDescriptor;

  4896.   ImageData: PByte;

  4897.   ImageSize: Integer;

  4898. begin

  4899.   result := false;

  4900.   if not Assigned(aImage) then

  4901.     exit;

  4902.   for f := High(f) downto Low(f) do begin

  4903.     FormatDesc := TFormatDescriptor.Get(f);

  4904.     with aImage.DataDescription do

  4905.       if FormatDesc.MaskMatch(

  4906.         (QWord(1 shl RedPrec  )-1) shl RedShift,

  4907.         (QWord(1 shl GreenPrec)-1) shl GreenShift,

  4908.         (QWord(1 shl BluePrec )-1) shl BlueShift,

  4909.         (QWord(1 shl AlphaPrec)-1) shl AlphaShift) then

  4910.         break;

  4911.   end;

  4912. 

  4913.   if (f = tfEmpty) then

  4914.     exit;

  4915. 

  4916.   ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);

  4917.   ImageData := GetMem(ImageSize);

  4918.   try

  4919.     Move(aImage.PixelData^, ImageData^, (aImage.Width * aImage.Height * aImage.DataDescription.BitsPerPixel) shr 3);

  4920.     SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method

  4921.   except

  4922.     if Assigned(ImageData) then

  4923.       FreeMem(ImageData);

  4924.     raise;

  4925.   end;

  4926. 

  4927.   result := true;

  4928. end;

  4929. 

  4930. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4931. function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;

  4932. var

  4933.   rid: TRawImageDescription;

  4934.   FormatDesc: TFormatDescriptor;

  4935.   Pixel: TglBitmapPixelData;

  4936.   x, y: Integer;

  4937.   srcMD: Pointer;

  4938.   src, dst: PByte;

  4939. begin

  4940.   result := false;

  4941.   if not Assigned(aImage) or (Format = tfEmpty) then

  4942.     exit;

  4943.   FormatDesc := TFormatDescriptor.Get(Format);

  4944.   if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then

  4945.     exit;

  4946. 

  4947.   FillChar(rid{%H-}, SizeOf(rid), 0);

  4948.   rid.Format       := ricfGray;

  4949.   rid.Width        := Width;

  4950.   rid.Height       := Height;

  4951.   rid.Depth        := CountSetBits(FormatDesc.Range.a);

  4952.   rid.BitOrder     := riboBitsInOrder;

  4953.   rid.ByteOrder    := riboLSBFirst;

  4954.   rid.LineOrder    := riloTopToBottom;

  4955.   rid.LineEnd      := rileTight;

  4956.   rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);

  4957.   rid.RedPrec      := CountSetBits(FormatDesc.Range.a);

  4958.   rid.GreenPrec    := 0;

  4959.   rid.BluePrec     := 0;

  4960.   rid.AlphaPrec    := 0;

  4961.   rid.RedShift     := 0;

  4962.   rid.GreenShift   := 0;

  4963.   rid.BlueShift    := 0;

  4964.   rid.AlphaShift   := 0;

  4965. 

  4966.   rid.MaskBitsPerPixel  := 0;

  4967.   rid.PaletteColorCount := 0;

  4968. 

  4969.   aImage.DataDescription := rid;

  4970.   aImage.CreateData;

  4971. 

  4972.   srcMD := FormatDesc.CreateMappingData;

  4973.   try

  4974.     FormatDesc.PreparePixel(Pixel);

  4975.     src := Data;

  4976.     dst := aImage.PixelData;

  4977.     for y := 0 to Height-1 do

  4978.       for x := 0 to Width-1 do begin

  4979.         FormatDesc.Unmap(src, Pixel, srcMD);

  4980.         case rid.BitsPerPixel of

  4981.            8: begin

  4982.             dst^ := Pixel.Data.a;

  4983.             inc(dst);

  4984.           end;

  4985.           16: begin

  4986.             PWord(dst)^ := Pixel.Data.a;

  4987.             inc(dst, 2);

  4988.           end;

  4989.           24: begin

  4990.             PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];

  4991.             PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];

  4992.             PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];

  4993.             inc(dst, 3);

  4994.           end;

  4995.           32: begin

  4996.             PCardinal(dst)^ := Pixel.Data.a;

  4997.             inc(dst, 4);

  4998.           end;

  4999.         else

  5000.           raise EglBitmapUnsupportedFormat.Create(Format);

  5001.         end;

  5002.       end;

  5003.   finally

  5004.     FormatDesc.FreeMappingData(srcMD);

  5005.   end;

  5006.   result := true;

  5007. end;

  5008. 

  5009. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5010. function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;

  5011. var

  5012.   tex: TglBitmap2D;

  5013. begin

  5014.   tex := TglBitmap2D.Create;

  5015.   try

  5016.     tex.AssignFromLazIntfImage(aImage);

  5017.     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);

  5018.   finally

  5019.     tex.Free;

  5020.   end;

  5021. end;

  5022. {$ENDIF}

  5023. 

  5024. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5025. function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;

  5026.   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;

  5027. var

  5028.   rs: TResourceStream;

  5029. begin

  5030.   PrepareResType(aResource, aResType);

  5031.   rs := TResourceStream.Create(aInstance, aResource, aResType);

  5032.   try

  5033.     result := AddAlphaFromStream(rs, aFunc, aArgs);

  5034.   finally

  5035.     rs.Free;

  5036.   end;

  5037. end;

  5038. 

  5039. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5040. function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;

  5041.   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;

  5042. var

  5043.   rs: TResourceStream;

  5044. begin

  5045.   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);

  5046.   try

  5047.     result := AddAlphaFromStream(rs, aFunc, aArgs);

  5048.   finally

  5049.     rs.Free;

  5050.   end;

  5051. end;

  5052. 

  5053. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5054. function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;

  5055. begin

  5056.   if TFormatDescriptor.Get(Format).IsCompressed then

  5057.     raise EglBitmapUnsupportedFormat.Create(Format);

  5058.   result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);

  5059. end;

  5060. 

  5061. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5062. function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;

  5063. var

  5064.   FS: TFileStream;

  5065. begin

  5066.   FS := TFileStream.Create(aFileName, fmOpenRead);

  5067.   try

  5068.     result := AddAlphaFromStream(FS, aFunc, aArgs);

  5069.   finally

  5070.     FS.Free;

  5071.   end;

  5072. end;

  5073. 

  5074. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5075. function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;

  5076. var

  5077.   tex: TglBitmap2D;

  5078. begin

  5079.   tex := TglBitmap2D.Create(aStream);

  5080.   try

  5081.     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);

  5082.   finally

  5083.     tex.Free;

  5084.   end;

  5085. end;

  5086. 

  5087. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5088. function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;

  5089. var

  5090.   DestData, DestData2, SourceData: pByte;

  5091.   TempHeight, TempWidth: Integer;

  5092.   SourceFD, DestFD: TFormatDescriptor;

  5093.   SourceMD, DestMD, DestMD2: Pointer;

  5094. 

  5095.   FuncRec: TglBitmapFunctionRec;

  5096. begin

  5097.   result := false;

  5098. 

  5099.   Assert(Assigned(Data));

  5100.   Assert(Assigned(aBitmap));

  5101.   Assert(Assigned(aBitmap.Data));

  5102. 

  5103.   if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin

  5104.     result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);

  5105. 

  5106.     SourceFD := TFormatDescriptor.Get(aBitmap.Format);

  5107.     DestFD   := TFormatDescriptor.Get(Format);

  5108. 

  5109.     if not Assigned(aFunc) then begin

  5110.       aFunc        := glBitmapAlphaFunc;

  5111.       FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);

  5112.     end else

  5113.       FuncRec.Args := aArgs;

  5114. 

  5115.     // Values

  5116.     TempHeight := aBitmap.FileHeight;

  5117.     TempWidth  := aBitmap.FileWidth;

  5118. 

  5119.     FuncRec.Sender          := Self;

  5120.     FuncRec.Size            := Dimension;

  5121.     FuncRec.Position.Fields := FuncRec.Size.Fields;

  5122. 

  5123.     DestData   := Data;

  5124.     DestData2  := Data;

  5125.     SourceData := aBitmap.Data;

  5126. 

  5127.     // Mapping

  5128.     SourceFD.PreparePixel(FuncRec.Source);

  5129.     DestFD.PreparePixel  (FuncRec.Dest);

  5130. 

  5131.     SourceMD := SourceFD.CreateMappingData;

  5132.     DestMD   := DestFD.CreateMappingData;

  5133.     DestMD2  := DestFD.CreateMappingData;

  5134.     try

  5135.       FuncRec.Position.Y := 0;

  5136.       while FuncRec.Position.Y < TempHeight do begin

  5137.         FuncRec.Position.X := 0;

  5138.         while FuncRec.Position.X < TempWidth do begin

  5139.           SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);

  5140.           DestFD.Unmap  (DestData,   FuncRec.Dest,   DestMD);

  5141.           aFunc(FuncRec);

  5142.           DestFD.Map(FuncRec.Dest, DestData2, DestMD2);

  5143.           inc(FuncRec.Position.X);

  5144.         end;

  5145.         inc(FuncRec.Position.Y);

  5146.       end;

  5147.     finally

  5148.       SourceFD.FreeMappingData(SourceMD);

  5149.       DestFD.FreeMappingData(DestMD);

  5150.       DestFD.FreeMappingData(DestMD2);

  5151.     end;

  5152.   end;

  5153. end;

  5154. 

  5155. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5156. function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;

  5157. begin

  5158.   result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);

  5159. end;

  5160. 

  5161. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5162. function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;

  5163. var

  5164.   PixelData: TglBitmapPixelData;

  5165. begin

  5166.   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);

  5167.   result := AddAlphaFromColorKeyFloat(

  5168.     aRed   / PixelData.Range.r,

  5169.     aGreen / PixelData.Range.g,

  5170.     aBlue  / PixelData.Range.b,

  5171.     aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));

  5172. end;

  5173. 

  5174. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5175. function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;

  5176. var

  5177.   values: array[0..2] of Single;

  5178.   tmp: Cardinal;

  5179.   i: Integer;

  5180.   PixelData: TglBitmapPixelData;

  5181. begin

  5182.   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);

  5183.   with PixelData do begin

  5184.     values[0] := aRed;

  5185.     values[1] := aGreen;

  5186.     values[2] := aBlue;

  5187. 

  5188.     for i := 0 to 2 do begin

  5189.       tmp          := Trunc(Range.arr[i] * aDeviation);

  5190.       Data.arr[i]  := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));

  5191.       Range.arr[i] := Max(0,            Trunc(Range.arr[i] * values[i] - tmp));

  5192.     end;

  5193.     Data.a  := 0;

  5194.     Range.a := 0;

  5195.   end;

  5196.   result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);

  5197. end;

  5198. 

  5199. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5200. function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;

  5201. begin

  5202.   result := AddAlphaFromValueFloat(aAlpha / $FF);

  5203. end;

  5204. 

  5205. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5206. function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;

  5207. var

  5208.   PixelData: TglBitmapPixelData;

  5209. begin

  5210.   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);

  5211.   result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);

  5212. end;

  5213. 

  5214. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5215. function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;

  5216. var

  5217.   PixelData: TglBitmapPixelData;

  5218. begin

  5219.   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);

  5220.   with PixelData do

  5221.     Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));

  5222.   result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);

  5223. end;

  5224. 

  5225. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5226. function TglBitmap.RemoveAlpha: Boolean;

  5227. var

  5228.   FormatDesc: TFormatDescriptor;

  5229. begin

  5230.   result := false;

  5231.   FormatDesc := TFormatDescriptor.Get(Format);

  5232.   if Assigned(Data) then begin

  5233.     if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then

  5234.       raise EglBitmapUnsupportedFormat.Create(Format);

  5235.     result := ConvertTo(FormatDesc.WithoutAlpha);

  5236.   end;

  5237. end;

  5238. 

  5239. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5240. function TglBitmap.Clone: TglBitmap;

  5241. var

  5242.   Temp: TglBitmap;

  5243.   TempPtr: PByte;

  5244.   Size: Integer;

  5245. begin

  5246.   result := nil;

  5247.   Temp := (ClassType.Create as TglBitmap);

  5248.   try

  5249.     // copy texture data if assigned

  5250.     if Assigned(Data) then begin

  5251.       Size := TFormatDescriptor.Get(Format).GetSize(fDimension);

  5252.       GetMem(TempPtr, Size);

  5253.       try

  5254.         Move(Data^, TempPtr^, Size);

  5255.         Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method

  5256.       except

  5257.         if Assigned(TempPtr) then

  5258.           FreeMem(TempPtr);

  5259.         raise;

  5260.       end;

  5261.     end else begin

  5262.       TempPtr := nil;

  5263.       Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method

  5264.     end;

  5265. 

  5266. 	// copy properties

  5267.     Temp.fID                      := ID;

  5268.     Temp.fTarget                  := Target;

  5269.     Temp.fFormat                  := Format;

  5270.     Temp.fMipMap                  := MipMap;

  5271.     Temp.fAnisotropic             := Anisotropic;

  5272.     Temp.fBorderColor             := fBorderColor;

  5273.     Temp.fDeleteTextureOnFree     := DeleteTextureOnFree;

  5274.     Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;

  5275.     Temp.fFilterMin               := fFilterMin;

  5276.     Temp.fFilterMag               := fFilterMag;

  5277.     Temp.fWrapS                   := fWrapS;

  5278.     Temp.fWrapT                   := fWrapT;

  5279.     Temp.fWrapR                   := fWrapR;

  5280.     Temp.fFilename                := fFilename;

  5281.     Temp.fCustomName              := fCustomName;

  5282.     Temp.fCustomNameW             := fCustomNameW;

  5283.     Temp.fCustomData              := fCustomData;

  5284. 

  5285.     result := Temp;

  5286.   except

  5287.     FreeAndNil(Temp);

  5288.     raise;

  5289.   end;

  5290. end;

  5291. 

  5292. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5293. function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;

  5294. var

  5295.   SourceFD, DestFD: TFormatDescriptor;

  5296.   SourcePD, DestPD: TglBitmapPixelData;

  5297.   ShiftData: TShiftData;

  5298. 

  5299.   function CanCopyDirect: Boolean;

  5300.   begin

  5301.     result :=

  5302.       ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and

  5303.       ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and

  5304.       ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and

  5305.       ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));

  5306.   end;

  5307. 

  5308.   function CanShift: Boolean;

  5309.   begin

  5310.     result :=

  5311.       ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and

  5312.       ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and

  5313.       ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and

  5314.       ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));

  5315.   end;

  5316. 

  5317.   function GetShift(aSource, aDest: Cardinal) : ShortInt;

  5318.   begin

  5319.     result := 0;

  5320.     while (aSource > aDest) and (aSource > 0) do begin

  5321.       inc(result);

  5322.       aSource := aSource shr 1;

  5323.     end;

  5324.   end;

  5325. 

  5326. begin

  5327.   if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin

  5328.     SourceFD := TFormatDescriptor.Get(Format);

  5329.     DestFD   := TFormatDescriptor.Get(aFormat);

  5330. 

  5331.     SourceFD.PreparePixel(SourcePD);

  5332.     DestFD.PreparePixel  (DestPD);

  5333. 

  5334.     if CanCopyDirect then

  5335.       result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)

  5336.     else if CanShift then begin

  5337.       ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);

  5338.       ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);

  5339.       ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);

  5340.       ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);

  5341.       result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);

  5342.     end else

  5343.       result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);

  5344.   end else

  5345.     result := true;

  5346. end;

  5347. 

  5348. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5349. procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);

  5350. begin

  5351.   if aUseRGB or aUseAlpha then

  5352.     AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(

  5353.       ((PtrInt(aUseAlpha) and 1) shl 1) or

  5354.        (PtrInt(aUseRGB)   and 1)      ));

  5355. end;

  5356. 

  5357. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5358. procedure TglBitmap.SetBorderColor(const aRed, aGreen, aBlue, aAlpha: Single);

  5359. begin

  5360.   fBorderColor[0] := aRed;

  5361.   fBorderColor[1] := aGreen;

  5362.   fBorderColor[2] := aBlue;

  5363.   fBorderColor[3] := aAlpha;

  5364.   if (ID > 0) then begin

  5365.     Bind(false);

  5366.     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);

  5367.   end;

  5368. end;

  5369. 

  5370. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5371. procedure TglBitmap.FreeData;

  5372. var

  5373.   TempPtr: PByte;

  5374. begin

  5375.   TempPtr := nil;

  5376.   SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method

  5377. end;

  5378. 

  5379. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5380. procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;

  5381.   const aAlpha: Byte);

  5382. begin

  5383.   FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);

  5384. end;

  5385. 

  5386. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5387. procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);

  5388. var

  5389.   PixelData: TglBitmapPixelData;

  5390. begin

  5391.   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);

  5392.   FillWithColorFloat(

  5393.     aRed   / PixelData.Range.r,

  5394.     aGreen / PixelData.Range.g,

  5395.     aBlue  / PixelData.Range.b,

  5396.     aAlpha / PixelData.Range.a);

  5397. end;

  5398. 

  5399. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5400. procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);

  5401. var

  5402.   PixelData: TglBitmapPixelData;

  5403. begin

  5404.   TFormatDescriptor.Get(Format).PreparePixel(PixelData);

  5405.   with PixelData do begin

  5406.     Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));

  5407.     Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));

  5408.     Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));

  5409.     Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));

  5410.   end;

  5411.   AddFunc(glBitmapFillWithColorFunc, false, @PixelData);

  5412. end;

  5413. 

  5414. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5415. procedure TglBitmap.SetFilter(const aMin, aMag: GLenum);

  5416. begin

  5417.   //check MIN filter

  5418.   case aMin of

  5419.     GL_NEAREST:

  5420.       fFilterMin := GL_NEAREST;

  5421.     GL_LINEAR:

  5422.       fFilterMin := GL_LINEAR;

  5423.     GL_NEAREST_MIPMAP_NEAREST:

  5424.       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;

  5425.     GL_LINEAR_MIPMAP_NEAREST:

  5426.       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;

  5427.     GL_NEAREST_MIPMAP_LINEAR:

  5428.       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;

  5429.     GL_LINEAR_MIPMAP_LINEAR:

  5430.       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;

  5431.     else

  5432.       raise EglBitmap.Create('SetFilter - Unknow MIN filter.');

  5433.   end;

  5434. 

  5435.   //check MAG filter

  5436.   case aMag of

  5437.     GL_NEAREST:

  5438.       fFilterMag := GL_NEAREST;

  5439.     GL_LINEAR:

  5440.       fFilterMag := GL_LINEAR;

  5441.     else

  5442.       raise EglBitmap.Create('SetFilter - Unknow MAG filter.');

  5443.   end;

  5444. 

  5445.   //apply filter

  5446.   if (ID > 0) then begin

  5447.     Bind(false);

  5448.     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);

  5449. 

  5450.     if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin

  5451.       case fFilterMin of

  5452.         GL_NEAREST, GL_LINEAR:

  5453.           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);

  5454.         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:

  5455.           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);

  5456.         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:

  5457.           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);

  5458.       end;

  5459.     end else

  5460.       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);

  5461.   end;

  5462. end;

  5463. 

  5464. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5465. procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);

  5466. 

  5467.   procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);

  5468.   begin

  5469.     case aValue of

  5470.       GL_CLAMP:

  5471.         aTarget := GL_CLAMP;

  5472. 

  5473.       GL_REPEAT:

  5474.         aTarget := GL_REPEAT;

  5475. 

  5476.       GL_CLAMP_TO_EDGE: begin

  5477.         if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then

  5478.           aTarget := GL_CLAMP_TO_EDGE

  5479.         else

  5480.           aTarget := GL_CLAMP;

  5481.       end;

  5482. 

  5483.       GL_CLAMP_TO_BORDER: begin

  5484.         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then

  5485.           aTarget := GL_CLAMP_TO_BORDER

  5486.         else

  5487.           aTarget := GL_CLAMP;

  5488.       end;

  5489. 

  5490.       GL_MIRRORED_REPEAT: begin

  5491.         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then

  5492.           aTarget := GL_MIRRORED_REPEAT

  5493.         else

  5494.           raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');

  5495.       end;

  5496.     else

  5497.       raise EglBitmap.Create('SetWrap - Unknow Texturewrap');

  5498.     end;

  5499.   end;

  5500. 

  5501. begin

  5502.   CheckAndSetWrap(S, fWrapS);

  5503.   CheckAndSetWrap(T, fWrapT);

  5504.   CheckAndSetWrap(R, fWrapR);

  5505. 

  5506.   if (ID > 0) then begin

  5507.     Bind(false);

  5508.     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);

  5509.     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);

  5510.     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);

  5511.   end;

  5512. end;

  5513. 

  5514. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5515. procedure TglBitmap.SetSwizzle(const r, g, b, a: GLenum);

  5516. 

  5517.   procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);

  5518.   begin

  5519.     if (aValue = GL_ZERO) or (aValue =   GL_ONE) or (aValue = GL_ALPHA) or

  5520.        (aValue =  GL_RED) or (aValue = GL_GREEN) or (aValue =  GL_BLUE) then

  5521.       fSwizzle[aIndex] := aValue

  5522.     else

  5523.       raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');

  5524.   end;

  5525. 

  5526. begin

  5527.   if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then

  5528.     raise EglBitmapNotSupported.Create('texture swizzle is not supported');

  5529.   CheckAndSetValue(r, 0);

  5530.   CheckAndSetValue(g, 1);

  5531.   CheckAndSetValue(b, 2);

  5532.   CheckAndSetValue(a, 3);

  5533. 

  5534.   if (ID > 0) then begin

  5535.     Bind(false);

  5536.     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, @fSwizzle[0]);

  5537.   end;

  5538. end;

  5539. 

  5540. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5541. procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);

  5542. begin

  5543.   if aEnableTextureUnit then

  5544.     glEnable(Target);

  5545.   if (ID > 0) then

  5546.     glBindTexture(Target, ID);

  5547. end;

  5548. 

  5549. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5550. procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);

  5551. begin

  5552.   if aDisableTextureUnit then

  5553.     glDisable(Target);

  5554.   glBindTexture(Target, 0);

  5555. end;

  5556. 

  5557. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5558. constructor TglBitmap.Create;

  5559. begin

  5560.   if (ClassType = TglBitmap) then

  5561.     raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');

  5562. {$IFDEF GLB_NATIVE_OGL}

  5563.   glbReadOpenGLExtensions;

  5564. {$ENDIF}

  5565.   inherited Create;

  5566. end;

  5567. 

  5568. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5569. constructor TglBitmap.Create(const aFileName: String);

  5570. begin

  5571.   Create;

  5572.   LoadFromFile(aFileName);

  5573. end;

  5574. 

  5575. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5576. constructor TglBitmap.Create(const aStream: TStream);

  5577. begin

  5578.   Create;

  5579.   LoadFromStream(aStream);

  5580. end;

  5581. 

  5582. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5583. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat);

  5584. var

  5585.   Image: PByte;

  5586.   ImageSize: Integer;

  5587. begin

  5588.   Create;

  5589.   ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);

  5590.   GetMem(Image, ImageSize);

  5591.   try

  5592.     FillChar(Image^, ImageSize, #$FF);

  5593.     SetDataPointer(Image, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method

  5594.   except

  5595.     if Assigned(Image) then

  5596.       FreeMem(Image);

  5597.     raise;

  5598.   end;

  5599. end;

  5600. 

  5601. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5602. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat;

  5603.   const aFunc: TglBitmapFunction; const aArgs: Pointer);

  5604. begin

  5605.   Create;

  5606.   LoadFromFunc(aSize, aFunc, aFormat, aArgs);

  5607. end;

  5608. 

  5609. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5610. constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);

  5611. begin

  5612.   Create;

  5613.   LoadFromResource(aInstance, aResource, aResType);

  5614. end;

  5615. 

  5616. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5617. constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);

  5618. begin

  5619.   Create;

  5620.   LoadFromResourceID(aInstance, aResourceID, aResType);

  5621. end;

  5622. 

  5623. {$IFDEF GLB_SUPPORT_PNG_READ}

  5624. {$IF DEFINED(GLB_SDL_IMAGE)}

  5625. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5626. //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5627. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5628. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;

  5629. var

  5630.   Surface: PSDL_Surface;

  5631.   RWops: PSDL_RWops;

  5632. begin

  5633.   result := false;

  5634.   RWops := glBitmapCreateRWops(aStream);

  5635.   try

  5636.     if IMG_isPNG(RWops) > 0 then begin

  5637.       Surface := IMG_LoadPNG_RW(RWops);

  5638.       try

  5639.         AssignFromSurface(Surface);

  5640.         result := true;

  5641.       finally

  5642.         SDL_FreeSurface(Surface);

  5643.       end;

  5644.     end;

  5645.   finally

  5646.     SDL_FreeRW(RWops);

  5647.   end;

  5648. end;

  5649. 

  5650. {$ELSEIF DEFINED(GLB_LIB_PNG)}

  5651. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5652. procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;

  5653. begin

  5654.   TStream(png_get_io_ptr(png)).Read(buffer^, size);

  5655. end;

  5656. 

  5657. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5658. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;

  5659. var

  5660.   StreamPos: Int64;

  5661.   signature: array [0..7] of byte;

  5662.   png: png_structp;

  5663.   png_info: png_infop;

  5664. 

  5665.   TempHeight, TempWidth: Integer;

  5666.   Format: TglBitmapFormat;

  5667. 

  5668.   png_data: pByte;

  5669.   png_rows: array of pByte;

  5670.   Row, LineSize: Integer;

  5671. begin

  5672.   result := false;

  5673. 

  5674.   if not init_libPNG then

  5675.     raise Exception.Create('LoadPNG - unable to initialize libPNG.');

  5676. 

  5677.   try

  5678.     // signature

  5679.     StreamPos := aStream.Position;

  5680.     aStream.Read(signature{%H-}, 8);

  5681.     aStream.Position := StreamPos;

  5682. 

  5683.     if png_check_sig(@signature, 8) <> 0 then begin

  5684.       // png read struct

  5685.       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);

  5686.       if png = nil then

  5687.         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');

  5688. 

  5689.       // png info

  5690.       png_info := png_create_info_struct(png);

  5691.       if png_info = nil then begin

  5692.         png_destroy_read_struct(@png, nil, nil);

  5693.         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');

  5694.       end;

  5695. 

  5696.       // set read callback

  5697.       png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);

  5698. 

  5699.       // read informations

  5700.       png_read_info(png, png_info);

  5701. 

  5702.       // size 

  5703.       TempHeight := png_get_image_height(png, png_info);

  5704.       TempWidth := png_get_image_width(png, png_info);

  5705. 

  5706.       // format

  5707.       case png_get_color_type(png, png_info) of

  5708.         PNG_COLOR_TYPE_GRAY:

  5709.           Format := tfLuminance8;

  5710.         PNG_COLOR_TYPE_GRAY_ALPHA:

  5711.           Format := tfLuminance8Alpha8;

  5712.         PNG_COLOR_TYPE_RGB:

  5713.           Format := tfRGB8;

  5714.         PNG_COLOR_TYPE_RGB_ALPHA:

  5715.           Format := tfRGBA8;

  5716.         else

  5717.           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');

  5718.       end;

  5719. 

  5720.       // cut upper 8 bit from 16 bit formats

  5721.       if png_get_bit_depth(png, png_info) > 8 then

  5722.         png_set_strip_16(png);

  5723. 

  5724.       // expand bitdepth smaller than 8

  5725.       if png_get_bit_depth(png, png_info) < 8 then

  5726.         png_set_expand(png);

  5727. 

  5728.       // allocating mem for scanlines

  5729.       LineSize := png_get_rowbytes(png, png_info);

  5730.       GetMem(png_data, TempHeight * LineSize);

  5731.       try

  5732.         SetLength(png_rows, TempHeight);

  5733.         for Row := Low(png_rows) to High(png_rows) do begin

  5734.           png_rows[Row] := png_data;

  5735.           Inc(png_rows[Row], Row * LineSize);

  5736.         end;

  5737. 

  5738.         // read complete image into scanlines

  5739.         png_read_image(png, @png_rows[0]);

  5740. 

  5741.         // read end

  5742.         png_read_end(png, png_info);

  5743. 

  5744.         // destroy read struct

  5745.         png_destroy_read_struct(@png, @png_info, nil);

  5746. 

  5747.         SetLength(png_rows, 0);

  5748. 

  5749.         // set new data

  5750.         SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method

  5751. 

  5752.         result := true;

  5753.       except

  5754.         if Assigned(png_data) then

  5755.           FreeMem(png_data);

  5756.         raise;

  5757.       end;

  5758.     end;

  5759.   finally

  5760.     quit_libPNG;

  5761.   end;

  5762. end;

  5763. 

  5764. {$ELSEIF DEFINED(GLB_PNGIMAGE)}

  5765. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5766. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;

  5767. var

  5768.   StreamPos: Int64;

  5769.   Png: TPNGObject;

  5770.   Header: String[8];

  5771.   Row, Col, PixSize, LineSize: Integer;

  5772.   NewImage, pSource, pDest, pAlpha: pByte;

  5773.   PngFormat: TglBitmapFormat;

  5774.   FormatDesc: TFormatDescriptor;

  5775. 

  5776. const

  5777.   PngHeader: String[8] = #137#80#78#71#13#10#26#10;

  5778. 

  5779. begin

  5780.   result := false;

  5781. 

  5782.   StreamPos := aStream.Position;

  5783.   aStream.Read(Header[0], SizeOf(Header));

  5784.   aStream.Position := StreamPos;

  5785. 

  5786.   {Test if the header matches}

  5787.   if Header = PngHeader then begin

  5788.     Png := TPNGObject.Create;

  5789.     try

  5790.       Png.LoadFromStream(aStream);

  5791. 

  5792.       case Png.Header.ColorType of

  5793.         COLOR_GRAYSCALE:

  5794.           PngFormat := tfLuminance8;

  5795.         COLOR_GRAYSCALEALPHA:

  5796.           PngFormat := tfLuminance8Alpha8;

  5797.         COLOR_RGB:

  5798.           PngFormat := tfBGR8;

  5799.         COLOR_RGBALPHA:

  5800.           PngFormat := tfBGRA8;

  5801.         else

  5802.           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');

  5803.       end;

  5804. 

  5805.       FormatDesc := TFormatDescriptor.Get(PngFormat);

  5806.       PixSize    := Round(FormatDesc.PixelSize);

  5807.       LineSize   := FormatDesc.GetSize(Png.Header.Width, 1);

  5808. 

  5809.       GetMem(NewImage, LineSize * Integer(Png.Header.Height));

  5810.       try

  5811.         pDest := NewImage;

  5812. 

  5813.         case Png.Header.ColorType of

  5814.           COLOR_RGB, COLOR_GRAYSCALE:

  5815.             begin

  5816.               for Row := 0 to Png.Height -1 do begin

  5817.                 Move (Png.Scanline[Row]^, pDest^, LineSize);

  5818.                 Inc(pDest, LineSize);

  5819.               end;

  5820.             end;

  5821.           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:

  5822.             begin

  5823.               PixSize := PixSize -1;

  5824. 

  5825.               for Row := 0 to Png.Height -1 do begin

  5826.                 pSource := Png.Scanline[Row];

  5827.                 pAlpha := pByte(Png.AlphaScanline[Row]);

  5828. 

  5829.                 for Col := 0 to Png.Width -1 do begin

  5830.                   Move (pSource^, pDest^, PixSize);

  5831.                   Inc(pSource, PixSize);

  5832.                   Inc(pDest, PixSize);

  5833. 

  5834.                   pDest^ := pAlpha^;

  5835.                   inc(pAlpha);

  5836.                   Inc(pDest);

  5837.                 end;

  5838.               end;

  5839.             end;

  5840.           else

  5841.             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');

  5842.         end;

  5843. 

  5844.         SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method

  5845. 

  5846.         result := true;

  5847.       except

  5848.         if Assigned(NewImage) then

  5849.           FreeMem(NewImage);

  5850.         raise;

  5851.       end;

  5852.     finally

  5853.       Png.Free;

  5854.     end;

  5855.   end;

  5856. end;

  5857. {$IFEND}

  5858. {$ENDIF}

  5859. 

  5860. {$IFDEF GLB_SUPPORT_PNG_WRITE}

  5861. {$IFDEF GLB_LIB_PNG}

  5862. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5863. procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;

  5864. begin

  5865.   TStream(png_get_io_ptr(png)).Write(buffer^, size);

  5866. end;

  5867. {$ENDIF}

  5868. 

  5869. {$IF DEFINED(GLB_LIB_PNG)}

  5870. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5871. procedure TglBitmap.SavePNG(const aStream: TStream);

  5872. var

  5873.   png: png_structp;

  5874.   png_info: png_infop;

  5875.   png_rows: array of pByte;

  5876.   LineSize: Integer;

  5877.   ColorType: Integer;

  5878.   Row: Integer;

  5879.   FormatDesc: TFormatDescriptor;

  5880. begin

  5881.   if not (ftPNG in FormatGetSupportedFiles(Format)) then

  5882.     raise EglBitmapUnsupportedFormat.Create(Format);

  5883. 

  5884.   if not init_libPNG then

  5885.     raise Exception.Create('unable to initialize libPNG.');

  5886. 

  5887.   try

  5888.     case Format of

  5889.       tfAlpha8, tfLuminance8:

  5890.         ColorType := PNG_COLOR_TYPE_GRAY;

  5891.       tfLuminance8Alpha8:

  5892.         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;

  5893.       tfBGR8, tfRGB8:

  5894.         ColorType := PNG_COLOR_TYPE_RGB;

  5895.       tfBGRA8, tfRGBA8:

  5896.         ColorType := PNG_COLOR_TYPE_RGBA;

  5897.       else

  5898.         raise EglBitmapUnsupportedFormat.Create(Format);

  5899.     end;

  5900. 

  5901.     FormatDesc := TFormatDescriptor.Get(Format);

  5902.     LineSize := FormatDesc.GetSize(Width, 1);

  5903. 

  5904.     // creating array for scanline

  5905.     SetLength(png_rows, Height);

  5906.     try

  5907.       for Row := 0 to Height - 1 do begin

  5908.         png_rows[Row] := Data;

  5909.         Inc(png_rows[Row], Row * LineSize)

  5910.       end;

  5911. 

  5912.       // write struct

  5913.       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);

  5914.       if png = nil then

  5915.         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');

  5916. 

  5917.       // create png info

  5918.       png_info := png_create_info_struct(png);

  5919.       if png_info = nil then begin

  5920.         png_destroy_write_struct(@png, nil);

  5921.         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');

  5922.       end;

  5923. 

  5924.       // set read callback

  5925.       png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);

  5926. 

  5927.       // set compression

  5928.       png_set_compression_level(png, 6);

  5929. 

  5930.       if Format in [tfBGR8, tfBGRA8] then

  5931.         png_set_bgr(png);

  5932. 

  5933.       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);

  5934.       png_write_info(png, png_info);

  5935.       png_write_image(png, @png_rows[0]);

  5936.       png_write_end(png, png_info);

  5937.       png_destroy_write_struct(@png, @png_info);

  5938.     finally

  5939.       SetLength(png_rows, 0);

  5940.     end;

  5941.   finally

  5942.     quit_libPNG;

  5943.   end;

  5944. end;

  5945. 

  5946. {$ELSEIF DEFINED(GLB_PNGIMAGE)}

  5947. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5948. procedure TglBitmap.SavePNG(const aStream: TStream);

  5949. var

  5950.   Png: TPNGObject;

  5951. 

  5952.   pSource, pDest: pByte;

  5953.   X, Y, PixSize: Integer;

  5954.   ColorType: Cardinal;

  5955.   Alpha: Boolean;

  5956. 

  5957.   pTemp: pByte;

  5958.   Temp: Byte;

  5959. begin

  5960.   if not (ftPNG in FormatGetSupportedFiles (Format)) then

  5961.     raise EglBitmapUnsupportedFormat.Create(Format);

  5962. 

  5963.   case Format of

  5964.     tfAlpha8, tfLuminance8: begin

  5965.       ColorType := COLOR_GRAYSCALE;

  5966.       PixSize   := 1;

  5967.       Alpha     := false;

  5968.     end;

  5969.     tfLuminance8Alpha8: begin

  5970.       ColorType := COLOR_GRAYSCALEALPHA;

  5971.       PixSize   := 1;

  5972.       Alpha     := true;

  5973.     end;

  5974.     tfBGR8, tfRGB8: begin

  5975.       ColorType := COLOR_RGB;

  5976.       PixSize   := 3;

  5977.       Alpha     := false;

  5978.     end;

  5979.     tfBGRA8, tfRGBA8: begin

  5980.       ColorType := COLOR_RGBALPHA;

  5981.       PixSize   := 3;

  5982.       Alpha     := true

  5983.     end;

  5984.   else

  5985.     raise EglBitmapUnsupportedFormat.Create(Format);

  5986.   end;

  5987. 

  5988.   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);

  5989.   try

  5990.     // Copy ImageData

  5991.     pSource := Data;

  5992.     for Y := 0 to Height -1 do begin

  5993.       pDest := png.ScanLine[Y];

  5994.       for X := 0 to Width -1 do begin

  5995.         Move(pSource^, pDest^, PixSize);

  5996.         Inc(pDest, PixSize);

  5997.         Inc(pSource, PixSize);

  5998.         if Alpha then begin

  5999.           png.AlphaScanline[Y]^[X] := pSource^;

  6000.           Inc(pSource);

  6001.         end;

  6002.       end;

  6003. 

  6004.       // convert RGB line to BGR

  6005.       if Format in [tfRGB8, tfRGBA8] then begin

  6006.         pTemp := png.ScanLine[Y];

  6007.         for X := 0 to Width -1 do begin

  6008.           Temp := pByteArray(pTemp)^[0];

  6009.           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];

  6010.           pByteArray(pTemp)^[2] := Temp;

  6011.           Inc(pTemp, 3);

  6012.         end;

  6013.       end;

  6014.     end;

  6015. 

  6016.     // Save to Stream

  6017.     Png.CompressionLevel := 6;

  6018.     Png.SaveToStream(aStream);

  6019.   finally

  6020.     FreeAndNil(Png);

  6021.   end;

  6022. end;

  6023. {$IFEND}

  6024. {$ENDIF}

  6025. 

  6026. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6027. //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6028. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6029. {$IFDEF GLB_LIB_JPEG}

  6030. type

  6031.   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;

  6032.   glBitmap_libJPEG_source_mgr = record

  6033.     pub: jpeg_source_mgr;

  6034. 

  6035.     SrcStream: TStream;

  6036.     SrcBuffer: array [1..4096] of byte;

  6037.   end;

  6038. 

  6039.   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;

  6040.   glBitmap_libJPEG_dest_mgr = record

  6041.     pub: jpeg_destination_mgr;

  6042. 

  6043.     DestStream: TStream;

  6044.     DestBuffer: array [1..4096] of byte;

  6045.   end;

  6046. 

  6047. procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;

  6048. begin

  6049.   //DUMMY

  6050. end;

  6051. 

  6052. 

  6053. procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;

  6054. begin

  6055.   //DUMMY

  6056. end;

  6057. 

  6058. 

  6059. procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;

  6060. begin

  6061.   //DUMMY

  6062. end;

  6063. 

  6064. procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;

  6065. begin

  6066.   //DUMMY

  6067. end;

  6068. 

  6069. 

  6070. procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;

  6071. begin

  6072.   //DUMMY

  6073. end;

  6074. 

  6075. 

  6076. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6077. function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;

  6078. var

  6079.   src: glBitmap_libJPEG_source_mgr_ptr;

  6080.   bytes: integer;

  6081. begin

  6082.   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);

  6083. 

  6084.   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);

  6085. 	if (bytes <= 0) then begin

  6086. 		src^.SrcBuffer[1] := $FF;

  6087. 		src^.SrcBuffer[2] := JPEG_EOI;

  6088. 		bytes := 2;

  6089. 	end;

  6090. 

  6091. 	src^.pub.next_input_byte := @(src^.SrcBuffer[1]);

  6092. 	src^.pub.bytes_in_buffer := bytes;

  6093. 

  6094.   result := true;

  6095. end;

  6096. 

  6097. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6098. procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;

  6099. var

  6100.   src: glBitmap_libJPEG_source_mgr_ptr;

  6101. begin

  6102.   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);

  6103. 

  6104.   if num_bytes > 0 then begin

  6105.     // wanted byte isn't in buffer so set stream position and read buffer

  6106.     if num_bytes > src^.pub.bytes_in_buffer then begin

  6107.       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;

  6108.       src^.pub.fill_input_buffer(cinfo);

  6109.     end else begin

  6110.       // wanted byte is in buffer so only skip

  6111.   		inc(src^.pub.next_input_byte, num_bytes);

  6112. 	  	dec(src^.pub.bytes_in_buffer, num_bytes);

  6113.     end;

  6114.   end;

  6115. end;

  6116. 

  6117. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6118. function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;

  6119. var

  6120.   dest: glBitmap_libJPEG_dest_mgr_ptr;

  6121. begin

  6122.   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);

  6123. 

  6124.   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin

  6125.     // write complete buffer

  6126.     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));

  6127. 

  6128.     // reset buffer

  6129.     dest^.pub.next_output_byte := @dest^.DestBuffer[1];

  6130.     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);

  6131.   end;

  6132. 

  6133.   result := true;

  6134. end;

  6135. 

  6136. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6137. procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;

  6138. var

  6139.   Idx: Integer;

  6140.   dest: glBitmap_libJPEG_dest_mgr_ptr;

  6141. begin

  6142.   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);

  6143. 

  6144.   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin

  6145.     // check for endblock

  6146.     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin

  6147.       // write endblock

  6148.       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);

  6149. 

  6150.       // leave

  6151.       break;

  6152.     end else

  6153.       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);

  6154.   end;

  6155. end;

  6156. {$ENDIF}

  6157. 

  6158. {$IFDEF GLB_SUPPORT_JPEG_READ}

  6159. {$IF DEFINED(GLB_SDL_IMAGE)}

  6160. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6161. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;

  6162. var

  6163.   Surface: PSDL_Surface;

  6164.   RWops: PSDL_RWops;

  6165. begin

  6166.   result := false;

  6167. 

  6168.   RWops := glBitmapCreateRWops(aStream);

  6169.   try

  6170.     if IMG_isJPG(RWops) > 0 then begin

  6171.       Surface := IMG_LoadJPG_RW(RWops);

  6172.       try

  6173.         AssignFromSurface(Surface);

  6174.         result := true;

  6175.       finally

  6176.         SDL_FreeSurface(Surface);

  6177.       end;

  6178.     end;

  6179.   finally

  6180.     SDL_FreeRW(RWops);

  6181.   end;

  6182. end;

  6183. 

  6184. {$ELSEIF DEFINED(GLB_LIB_JPEG)}

  6185. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6186. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;

  6187. var

  6188.   StreamPos: Int64;

  6189.   Temp: array[0..1]of Byte;

  6190. 

  6191.   jpeg: jpeg_decompress_struct;

  6192.   jpeg_err: jpeg_error_mgr;

  6193. 

  6194.   IntFormat: TglBitmapFormat;

  6195.   pImage: pByte;

  6196.   TempHeight, TempWidth: Integer;

  6197. 

  6198.   pTemp: pByte;

  6199.   Row: Integer;

  6200. 

  6201.   FormatDesc: TFormatDescriptor;

  6202. begin

  6203.   result := false;

  6204. 

  6205.   if not init_libJPEG then

  6206.     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');

  6207. 

  6208.   try

  6209.     // reading first two bytes to test file and set cursor back to begin

  6210.     StreamPos := aStream.Position;

  6211.     aStream.Read({%H-}Temp[0], 2);

  6212.     aStream.Position := StreamPos;

  6213. 

  6214.     // if Bitmap then read file.

  6215.     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin

  6216.       FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);

  6217.       FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);

  6218. 

  6219.       // error managment

  6220.       jpeg.err := jpeg_std_error(@jpeg_err);

  6221.       jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;

  6222.       jpeg_err.output_message := glBitmap_libJPEG_output_message;

  6223. 

  6224.       // decompression struct

  6225.       jpeg_create_decompress(@jpeg);

  6226. 

  6227.       // allocation space for streaming methods

  6228.       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));

  6229. 

  6230.       // seeting up custom functions

  6231.       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin

  6232.         pub.init_source       := glBitmap_libJPEG_init_source;

  6233.         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;

  6234.         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;

  6235.         pub.resync_to_restart := jpeg_resync_to_restart; // use default method

  6236.         pub.term_source       := glBitmap_libJPEG_term_source;

  6237. 

  6238.         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read

  6239.         pub.next_input_byte := nil;   // until buffer loaded

  6240. 

  6241.         SrcStream := aStream;

  6242.       end;

  6243. 

  6244.       // set global decoding state

  6245.       jpeg.global_state := DSTATE_START;

  6246. 

  6247.       // read header of jpeg

  6248.       jpeg_read_header(@jpeg, false);

  6249. 

  6250.       // setting output parameter

  6251.       case jpeg.jpeg_color_space of

  6252.         JCS_GRAYSCALE:

  6253.           begin

  6254.             jpeg.out_color_space := JCS_GRAYSCALE;

  6255.             IntFormat := tfLuminance8;

  6256.           end;

  6257.         else

  6258.           jpeg.out_color_space := JCS_RGB;

  6259.           IntFormat := tfRGB8;

  6260.       end;

  6261. 

  6262.       // reading image

  6263.       jpeg_start_decompress(@jpeg);

  6264. 

  6265.       TempHeight := jpeg.output_height;

  6266.       TempWidth := jpeg.output_width;

  6267. 

  6268.       FormatDesc := TFormatDescriptor.Get(IntFormat);

  6269. 

  6270.       // creating new image

  6271.       GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));

  6272.       try

  6273.         pTemp := pImage;

  6274. 

  6275.         for Row := 0 to TempHeight -1 do begin

  6276.           jpeg_read_scanlines(@jpeg, @pTemp, 1);

  6277.           Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));

  6278.         end;

  6279. 

  6280.         // finish decompression

  6281.         jpeg_finish_decompress(@jpeg);

  6282. 

  6283.         // destroy decompression

  6284.         jpeg_destroy_decompress(@jpeg);

  6285. 

  6286.         SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method

  6287. 

  6288.         result := true;

  6289.       except

  6290.         if Assigned(pImage) then

  6291.           FreeMem(pImage);

  6292.         raise;

  6293.       end;

  6294.     end;

  6295.   finally

  6296.     quit_libJPEG;

  6297.   end;

  6298. end;

  6299. 

  6300. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}

  6301. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6302. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;

  6303. var

  6304.   bmp: TBitmap;

  6305.   jpg: TJPEGImage;

  6306.   StreamPos: Int64;

  6307.   Temp: array[0..1]of Byte;

  6308. begin

  6309.   result := false;

  6310. 

  6311.   // reading first two bytes to test file and set cursor back to begin

  6312.   StreamPos := aStream.Position;

  6313.   aStream.Read(Temp[0], 2);

  6314.   aStream.Position := StreamPos;

  6315. 

  6316.   // if Bitmap then read file.

  6317.   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin

  6318.     bmp := TBitmap.Create;

  6319.     try

  6320.       jpg := TJPEGImage.Create;

  6321.       try

  6322.         jpg.LoadFromStream(aStream);

  6323.         bmp.Assign(jpg);

  6324.         result := AssignFromBitmap(bmp);

  6325.       finally

  6326.         jpg.Free;

  6327.       end;

  6328.     finally

  6329.       bmp.Free;

  6330.     end;

  6331.   end;

  6332. end;

  6333. {$IFEND}

  6334. {$ENDIF}

  6335. 

  6336. {$IFDEF GLB_SUPPORT_JPEG_WRITE}

  6337. {$IF DEFINED(GLB_LIB_JPEG)}

  6338. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6339. procedure TglBitmap.SaveJPEG(const aStream: TStream);

  6340. var

  6341.   jpeg: jpeg_compress_struct;

  6342.   jpeg_err: jpeg_error_mgr;

  6343.   Row: Integer;

  6344.   pTemp, pTemp2: pByte;

  6345. 

  6346.   procedure CopyRow(pDest, pSource: pByte);

  6347.   var

  6348.     X: Integer;

  6349.   begin

  6350.     for X := 0 to Width - 1 do begin

  6351.       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];

  6352.       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];

  6353.       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];

  6354.       Inc(pDest, 3);

  6355.       Inc(pSource, 3);

  6356.     end;

  6357.   end;

  6358. 

  6359. begin

  6360.   if not (ftJPEG in FormatGetSupportedFiles(Format)) then

  6361.     raise EglBitmapUnsupportedFormat.Create(Format);

  6362. 

  6363.   if not init_libJPEG then

  6364.     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');

  6365. 

  6366.   try

  6367.     FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);

  6368.     FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);

  6369. 

  6370.     // error managment

  6371.     jpeg.err := jpeg_std_error(@jpeg_err);

  6372.     jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;

  6373.     jpeg_err.output_message := glBitmap_libJPEG_output_message;

  6374. 

  6375.     // compression struct

  6376.     jpeg_create_compress(@jpeg);

  6377. 

  6378.     // allocation space for streaming methods

  6379.     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));

  6380. 

  6381.     // seeting up custom functions

  6382.     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin

  6383.       pub.init_destination    := glBitmap_libJPEG_init_destination;

  6384.       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;

  6385.       pub.term_destination    := glBitmap_libJPEG_term_destination;

  6386. 

  6387.       pub.next_output_byte  := @DestBuffer[1];

  6388.       pub.free_in_buffer    := Length(DestBuffer);

  6389. 

  6390.       DestStream := aStream;

  6391.     end;

  6392. 

  6393.     // very important state

  6394.     jpeg.global_state := CSTATE_START;

  6395.     jpeg.image_width  := Width;

  6396.     jpeg.image_height := Height;

  6397.     case Format of

  6398.       tfAlpha8, tfLuminance8: begin

  6399.         jpeg.input_components := 1;

  6400.         jpeg.in_color_space   := JCS_GRAYSCALE;

  6401.       end;

  6402.       tfRGB8, tfBGR8: begin

  6403.         jpeg.input_components := 3;

  6404.         jpeg.in_color_space   := JCS_RGB;

  6405.       end;

  6406.     end;

  6407. 

  6408.     jpeg_set_defaults(@jpeg);

  6409.     jpeg_set_quality(@jpeg, 95, true);

  6410.     jpeg_start_compress(@jpeg, true);

  6411.     pTemp := Data;

  6412. 

  6413.     if Format = tfBGR8 then

  6414.       GetMem(pTemp2, fRowSize)

  6415.     else

  6416.       pTemp2 := pTemp;

  6417. 

  6418.     try

  6419.       for Row := 0 to jpeg.image_height -1 do begin

  6420.         // prepare row

  6421.         if Format = tfBGR8 then

  6422.           CopyRow(pTemp2, pTemp)

  6423.         else

  6424.           pTemp2 := pTemp;

  6425. 

  6426.         // write row

  6427.         jpeg_write_scanlines(@jpeg, @pTemp2, 1);

  6428.         inc(pTemp, fRowSize);

  6429.       end;

  6430.     finally

  6431.       // free memory

  6432.       if Format = tfBGR8 then

  6433.         FreeMem(pTemp2);

  6434.     end;

  6435.     jpeg_finish_compress(@jpeg);

  6436.     jpeg_destroy_compress(@jpeg);

  6437.   finally

  6438.     quit_libJPEG;

  6439.   end;

  6440. end;

  6441. 

  6442. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}

  6443. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6444. procedure TglBitmap.SaveJPEG(const aStream: TStream);

  6445. var

  6446.   Bmp: TBitmap;

  6447.   Jpg: TJPEGImage;

  6448. begin

  6449.   if not (ftJPEG in FormatGetSupportedFiles(Format)) then

  6450.     raise EglBitmapUnsupportedFormat.Create(Format);

  6451. 

  6452.   Bmp := TBitmap.Create;

  6453.   try

  6454.     Jpg := TJPEGImage.Create;

  6455.     try

  6456.       AssignToBitmap(Bmp);

  6457.       if (Format in [tfAlpha8, tfLuminance8]) then begin

  6458.         Jpg.Grayscale   := true;

  6459.         Jpg.PixelFormat := jf8Bit;

  6460.       end;

  6461.       Jpg.Assign(Bmp);

  6462.       Jpg.SaveToStream(aStream);

  6463.     finally

  6464.       FreeAndNil(Jpg);

  6465.     end;

  6466.   finally

  6467.     FreeAndNil(Bmp);

  6468.   end;

  6469. end;

  6470. {$IFEND}

  6471. {$ENDIF}

  6472. 

  6473. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6474. //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6475. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6476. const

  6477.   BMP_MAGIC          = $4D42;

  6478. 

  6479.   BMP_COMP_RGB       = 0;

  6480.   BMP_COMP_RLE8      = 1;

  6481.   BMP_COMP_RLE4      = 2;

  6482.   BMP_COMP_BITFIELDS = 3;

  6483. 

  6484. type

  6485.   TBMPHeader = packed record

  6486.     bfType: Word;

  6487.     bfSize: Cardinal;

  6488.     bfReserved1: Word;

  6489.     bfReserved2: Word;

  6490.     bfOffBits: Cardinal;

  6491.   end;

  6492. 

  6493.   TBMPInfo = packed record

  6494.     biSize: Cardinal;

  6495.     biWidth: Longint;

  6496.     biHeight: Longint;

  6497.     biPlanes: Word;

  6498.     biBitCount: Word;

  6499.     biCompression: Cardinal;

  6500.     biSizeImage: Cardinal;

  6501.     biXPelsPerMeter: Longint;

  6502.     biYPelsPerMeter: Longint;

  6503.     biClrUsed: Cardinal;

  6504.     biClrImportant: Cardinal;

  6505.   end;

  6506. 

  6507. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6508. function TglBitmap.LoadBMP(const aStream: TStream): Boolean;

  6509. 

  6510.   //////////////////////////////////////////////////////////////////////////////////////////////////

  6511.   function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapColorRec): TglBitmapFormat;

  6512.   begin

  6513.     result := tfEmpty;

  6514.     aStream.Read(aInfo{%H-}, SizeOf(aInfo));

  6515.     FillChar(aMask{%H-}, SizeOf(aMask), 0);

  6516. 

  6517.     //Read Compression

  6518.     case aInfo.biCompression of

  6519.       BMP_COMP_RLE4,

  6520.       BMP_COMP_RLE8: begin

  6521.         raise EglBitmap.Create('RLE compression is not supported');

  6522.       end;

  6523.       BMP_COMP_BITFIELDS: begin

  6524.         if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin

  6525.           aStream.Read(aMask.r, SizeOf(aMask.r));

  6526.           aStream.Read(aMask.g, SizeOf(aMask.g));

  6527.           aStream.Read(aMask.b, SizeOf(aMask.b));

  6528.           aStream.Read(aMask.a, SizeOf(aMask.a));

  6529.         end else

  6530.           raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');

  6531.       end;

  6532.     end;

  6533. 

  6534.     //get suitable format

  6535.     case aInfo.biBitCount of

  6536.        8: result := tfLuminance8;

  6537.       16: result := tfBGR5;

  6538.       24: result := tfBGR8;

  6539.       32: result := tfBGRA8;

  6540.     end;

  6541.   end;

  6542. 

  6543.   function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;

  6544.   var

  6545.     i, c: Integer;

  6546.     ColorTable: TbmpColorTable;

  6547.   begin

  6548.     result := nil;

  6549.     if (aInfo.biBitCount >= 16) then

  6550.       exit;

  6551.     aFormat := tfLuminance8;

  6552.     c := aInfo.biClrUsed;

  6553.     if (c = 0) then

  6554.       c := 1 shl aInfo.biBitCount;

  6555.     SetLength(ColorTable, c);

  6556.     for i := 0 to c-1 do begin

  6557.       aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));

  6558.       if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then

  6559.         aFormat := tfRGB8;

  6560.     end;

  6561. 

  6562.     result := TbmpColorTableFormat.Create;

  6563.     result.PixelSize  := aInfo.biBitCount / 8;

  6564.     result.ColorTable := ColorTable;

  6565.     result.Range      := glBitmapColorRec($FF, $FF, $FF, $00);

  6566.   end;

  6567. 

  6568.   //////////////////////////////////////////////////////////////////////////////////////////////////

  6569.   function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;

  6570.     const aInfo: TBMPInfo): TbmpBitfieldFormat;

  6571.   var

  6572.     TmpFormat: TglBitmapFormat;

  6573.     FormatDesc: TFormatDescriptor;

  6574.   begin

  6575.     result := nil;

  6576.     if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin

  6577.       for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin

  6578.         FormatDesc := TFormatDescriptor.Get(TmpFormat);

  6579.         if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin

  6580.           aFormat := FormatDesc.Format;

  6581.           exit;

  6582.         end;

  6583.       end;

  6584. 

  6585.       if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then

  6586.         aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;

  6587.       if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then

  6588.         aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;

  6589. 

  6590.       result := TbmpBitfieldFormat.Create;

  6591.       result.PixelSize := aInfo.biBitCount / 8;

  6592.       result.RedMask   := aMask.r;

  6593.       result.GreenMask := aMask.g;

  6594.       result.BlueMask  := aMask.b;

  6595.       result.AlphaMask := aMask.a;

  6596.     end;

  6597.   end;

  6598. 

  6599. var

  6600.   //simple types

  6601.   StartPos: Int64;

  6602.   ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;

  6603.   PaddingBuff: Cardinal;

  6604.   LineBuf, ImageData, TmpData: PByte;

  6605.   SourceMD, DestMD: Pointer;

  6606.   BmpFormat: TglBitmapFormat;

  6607. 

  6608.   //records

  6609.   Mask: TglBitmapColorRec;

  6610.   Header: TBMPHeader;

  6611.   Info: TBMPInfo;

  6612. 

  6613.   //classes

  6614.   SpecialFormat: TFormatDescriptor;

  6615.   FormatDesc: TFormatDescriptor;

  6616. 

  6617.   //////////////////////////////////////////////////////////////////////////////////////////////////

  6618.   procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);

  6619.   var

  6620.     i: Integer;

  6621.     Pixel: TglBitmapPixelData;

  6622.   begin

  6623.     aStream.Read(aLineBuf^, rbLineSize);

  6624.     SpecialFormat.PreparePixel(Pixel);

  6625.     for i := 0 to Info.biWidth-1 do begin

  6626.       SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);

  6627.       glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);

  6628.       FormatDesc.Map(Pixel, aData, DestMD);

  6629.     end;

  6630.   end;

  6631. 

  6632. begin

  6633.   result        := false;

  6634.   BmpFormat     := tfEmpty;

  6635.   SpecialFormat := nil;

  6636.   LineBuf       := nil;

  6637.   SourceMD      := nil;

  6638.   DestMD        := nil;

  6639. 

  6640.   // Header

  6641.   StartPos := aStream.Position;

  6642.   aStream.Read(Header{%H-}, SizeOf(Header));

  6643. 

  6644.   if Header.bfType = BMP_MAGIC then begin

  6645.     try try

  6646.       BmpFormat        := ReadInfo(Info, Mask);

  6647.       SpecialFormat    := ReadColorTable(BmpFormat, Info);

  6648.       if not Assigned(SpecialFormat) then

  6649.         SpecialFormat  := CheckBitfields(BmpFormat, Mask, Info);

  6650.       aStream.Position := StartPos + Header.bfOffBits;

  6651. 

  6652.       if (BmpFormat <> tfEmpty) then begin

  6653.         FormatDesc := TFormatDescriptor.Get(BmpFormat);

  6654.         rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize

  6655.         wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);

  6656.         Padding    := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;

  6657. 

  6658.         //get Memory

  6659.         DestMD    := FormatDesc.CreateMappingData;

  6660.         ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));

  6661.         GetMem(ImageData, ImageSize);

  6662.         if Assigned(SpecialFormat) then begin

  6663.           GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields

  6664.           SourceMD := SpecialFormat.CreateMappingData;

  6665.         end;

  6666. 

  6667.         //read Data

  6668.         try try

  6669.           FillChar(ImageData^, ImageSize, $FF);

  6670.           TmpData := ImageData;

  6671.           if (Info.biHeight > 0) then

  6672.             Inc(TmpData, wbLineSize * (Info.biHeight-1));

  6673.           for i := 0 to Abs(Info.biHeight)-1 do begin

  6674.             if Assigned(SpecialFormat) then

  6675.               SpecialFormatReadLine(TmpData, LineBuf)  //if is special format read and convert data

  6676.             else

  6677.               aStream.Read(TmpData^, wbLineSize);   //else only read data

  6678.             if (Info.biHeight > 0) then

  6679.               dec(TmpData, wbLineSize)

  6680.             else

  6681.               inc(TmpData, wbLineSize);

  6682.             aStream.Read(PaddingBuff{%H-}, Padding);

  6683.           end;

  6684.           SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method

  6685.           result := true;

  6686.         finally

  6687.           if Assigned(LineBuf) then

  6688.             FreeMem(LineBuf);

  6689.           if Assigned(SourceMD) then

  6690.             SpecialFormat.FreeMappingData(SourceMD);

  6691.           FormatDesc.FreeMappingData(DestMD);

  6692.         end;

  6693.         except

  6694.           if Assigned(ImageData) then

  6695.             FreeMem(ImageData);

  6696.           raise;

  6697.         end;

  6698.       end else

  6699.         raise EglBitmap.Create('LoadBMP - No suitable format found');

  6700.     except

  6701.       aStream.Position := StartPos;

  6702.       raise;

  6703.     end;

  6704.     finally

  6705.       FreeAndNil(SpecialFormat);

  6706.     end;

  6707.   end

  6708.     else aStream.Position := StartPos;

  6709. end;

  6710. 

  6711. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6712. procedure TglBitmap.SaveBMP(const aStream: TStream);

  6713. var

  6714.   Header: TBMPHeader;

  6715.   Info: TBMPInfo;

  6716.   Converter: TbmpColorTableFormat;

  6717.   FormatDesc: TFormatDescriptor;

  6718.   SourceFD, DestFD: Pointer;

  6719.   pData, srcData, dstData, ConvertBuffer: pByte;

  6720. 

  6721.   Pixel: TglBitmapPixelData;

  6722.   ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;

  6723.   RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;

  6724. 

  6725.   PaddingBuff: Cardinal;

  6726. 

  6727.   function GetLineWidth : Integer;

  6728.   begin

  6729.     result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;

  6730.   end;

  6731. 

  6732. begin

  6733.   if not (ftBMP in FormatGetSupportedFiles(Format)) then

  6734.     raise EglBitmapUnsupportedFormat.Create(Format);

  6735. 

  6736.   Converter  := nil;

  6737.   FormatDesc := TFormatDescriptor.Get(Format);

  6738.   ImageSize  := FormatDesc.GetSize(Dimension);

  6739. 

  6740.   FillChar(Header{%H-}, SizeOf(Header), 0);

  6741.   Header.bfType      := BMP_MAGIC;

  6742.   Header.bfSize      := SizeOf(Header) + SizeOf(Info) + ImageSize;

  6743.   Header.bfReserved1 := 0;

  6744.   Header.bfReserved2 := 0;

  6745.   Header.bfOffBits   := SizeOf(Header) + SizeOf(Info);

  6746. 

  6747.   FillChar(Info{%H-}, SizeOf(Info), 0);

  6748.   Info.biSize        := SizeOf(Info);

  6749.   Info.biWidth       := Width;

  6750.   Info.biHeight      := Height;

  6751.   Info.biPlanes      := 1;

  6752.   Info.biCompression := BMP_COMP_RGB;

  6753.   Info.biSizeImage   := ImageSize;

  6754. 

  6755.   try

  6756.     case Format of

  6757.       tfLuminance4: begin

  6758.         Info.biBitCount  := 4;

  6759.         Header.bfSize    := Header.bfSize    + 16 * SizeOf(Cardinal);

  6760.         Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries

  6761.         Converter           := TbmpColorTableFormat.Create;

  6762.         Converter.PixelSize := 0.5;

  6763.         Converter.Format    := Format;

  6764.         Converter.Range     := glBitmapColorRec($F, $F, $F, $0);

  6765.         Converter.CreateColorTable;

  6766.       end;

  6767. 

  6768.       tfR3G3B2, tfLuminance8: begin

  6769.         Info.biBitCount  :=  8;

  6770.         Header.bfSize    := Header.bfSize    + 256 * SizeOf(Cardinal);

  6771.         Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries

  6772.         Converter           := TbmpColorTableFormat.Create;

  6773.         Converter.PixelSize := 1;

  6774.         Converter.Format    := Format;

  6775.         if (Format = tfR3G3B2) then begin

  6776.           Converter.Range := glBitmapColorRec($7, $7, $3, $0);

  6777.           Converter.Shift := glBitmapShiftRec(0, 3, 6, 0);

  6778.         end else

  6779.           Converter.Range := glBitmapColorRec($FF, $FF, $FF, $0);

  6780.         Converter.CreateColorTable;

  6781.       end;

  6782. 

  6783.       tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,

  6784.       tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin

  6785.         Info.biBitCount    := 16;

  6786.         Info.biCompression := BMP_COMP_BITFIELDS;

  6787.       end;

  6788. 

  6789.       tfBGR8, tfRGB8: begin

  6790.         Info.biBitCount := 24;

  6791.       end;

  6792. 

  6793.       tfRGB10, tfRGB10A2, tfRGBA8,

  6794.       tfBGR10, tfBGR10A2, tfBGRA8: begin

  6795.         Info.biBitCount    := 32;

  6796.         Info.biCompression := BMP_COMP_BITFIELDS;

  6797.       end;

  6798.     else

  6799.       raise EglBitmapUnsupportedFormat.Create(Format);

  6800.     end;

  6801.     Info.biXPelsPerMeter := 2835;

  6802.     Info.biYPelsPerMeter := 2835;

  6803. 

  6804.     // prepare bitmasks

  6805.     if Info.biCompression = BMP_COMP_BITFIELDS then begin

  6806.       Header.bfSize    := Header.bfSize    + 4 * SizeOf(Cardinal);

  6807.       Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);

  6808. 

  6809.       RedMask    := FormatDesc.RedMask;

  6810.       GreenMask  := FormatDesc.GreenMask;

  6811.       BlueMask   := FormatDesc.BlueMask;

  6812.       AlphaMask  := FormatDesc.AlphaMask;

  6813.     end;

  6814. 

  6815.     // headers

  6816.     aStream.Write(Header, SizeOf(Header));

  6817.     aStream.Write(Info, SizeOf(Info));

  6818. 

  6819.     // colortable

  6820.     if Assigned(Converter) then

  6821.       aStream.Write(Converter.ColorTable[0].b,

  6822.         SizeOf(TbmpColorTableEnty) * Length(Converter.ColorTable));

  6823. 

  6824.     // bitmasks

  6825.     if Info.biCompression = BMP_COMP_BITFIELDS then begin

  6826.       aStream.Write(RedMask,   SizeOf(Cardinal));

  6827.       aStream.Write(GreenMask, SizeOf(Cardinal));

  6828.       aStream.Write(BlueMask,  SizeOf(Cardinal));

  6829.       aStream.Write(AlphaMask, SizeOf(Cardinal));

  6830.     end;

  6831. 

  6832.     // image data

  6833.     rbLineSize  := Round(Info.biWidth * FormatDesc.PixelSize);

  6834.     wbLineSize  := Round(Info.biWidth * Info.biBitCount / 8);

  6835.     Padding     := GetLineWidth - wbLineSize;

  6836.     PaddingBuff := 0;

  6837. 

  6838.     pData := Data;

  6839.     inc(pData, (Height-1) * rbLineSize);

  6840. 

  6841.     // prepare row buffer. But only for RGB because RGBA supports color masks

  6842.     // so it's possible to change color within the image.

  6843.     if Assigned(Converter) then begin

  6844.       FormatDesc.PreparePixel(Pixel);

  6845.       GetMem(ConvertBuffer, wbLineSize);

  6846.       SourceFD := FormatDesc.CreateMappingData;

  6847.       DestFD   := Converter.CreateMappingData;

  6848.     end else

  6849.       ConvertBuffer := nil;

  6850. 

  6851.     try

  6852.       for LineIdx := 0 to Height - 1 do begin

  6853.         // preparing row

  6854.         if Assigned(Converter) then begin

  6855.           srcData := pData;

  6856.           dstData := ConvertBuffer;

  6857.           for PixelIdx := 0 to Info.biWidth-1 do begin

  6858.             FormatDesc.Unmap(srcData, Pixel, SourceFD);

  6859.             glBitmapConvertPixel(Pixel, FormatDesc, Converter);

  6860.             Converter.Map(Pixel, dstData, DestFD);

  6861.           end;

  6862.           aStream.Write(ConvertBuffer^, wbLineSize);

  6863.         end else begin

  6864.           aStream.Write(pData^, rbLineSize);

  6865.         end;

  6866.         dec(pData, rbLineSize);

  6867.         if (Padding > 0) then

  6868.           aStream.Write(PaddingBuff, Padding);

  6869.       end;

  6870.     finally

  6871.       // destroy row buffer

  6872.       if Assigned(ConvertBuffer) then begin

  6873.         FormatDesc.FreeMappingData(SourceFD);

  6874.         Converter.FreeMappingData(DestFD);

  6875.         FreeMem(ConvertBuffer);

  6876.       end;

  6877.     end;

  6878.   finally

  6879.     if Assigned(Converter) then

  6880.       Converter.Free;

  6881.   end;

  6882. end;

  6883. 

  6884. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6885. //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6886. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6887. type

  6888.   TTGAHeader = packed record

  6889.     ImageID: Byte;

  6890.     ColorMapType: Byte;

  6891.     ImageType: Byte;

  6892.     //ColorMapSpec: Array[0..4] of Byte;

  6893.     ColorMapStart: Word;

  6894.     ColorMapLength: Word;

  6895.     ColorMapEntrySize: Byte;

  6896.     OrigX: Word;

  6897.     OrigY: Word;

  6898.     Width: Word;

  6899.     Height: Word;

  6900.     Bpp: Byte;

  6901.     ImageDesc: Byte;

  6902.   end;

  6903. 

  6904. const

  6905.   TGA_UNCOMPRESSED_RGB  =  2;

  6906.   TGA_UNCOMPRESSED_GRAY =  3;

  6907.   TGA_COMPRESSED_RGB    = 10;

  6908.   TGA_COMPRESSED_GRAY   = 11;

  6909. 

  6910.   TGA_NONE_COLOR_TABLE  = 0;

  6911. 

  6912. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6913. function TglBitmap.LoadTGA(const aStream: TStream): Boolean;

  6914. var

  6915.   Header: TTGAHeader;

  6916.   ImageData: System.PByte;

  6917.   StartPosition: Int64;

  6918.   PixelSize, LineSize: Integer;

  6919.   tgaFormat: TglBitmapFormat;

  6920.   FormatDesc: TFormatDescriptor;

  6921.   Counter: packed record

  6922.     X, Y: packed record

  6923.       low, high, dir: Integer;

  6924.     end;

  6925.   end;

  6926. 

  6927. const

  6928.   CACHE_SIZE = $4000;

  6929. 

  6930.   ////////////////////////////////////////////////////////////////////////////////////////

  6931.   procedure ReadUncompressed;

  6932.   var

  6933.     i, j: Integer;

  6934.     buf, tmp1, tmp2: System.PByte;

  6935.   begin

  6936.     buf := nil;

  6937.     if (Counter.X.dir < 0) then

  6938.       GetMem(buf, LineSize);

  6939.     try

  6940.       while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin

  6941.         tmp1 := ImageData;

  6942.         inc(tmp1, (Counter.Y.low * LineSize));          //pointer to LineStart

  6943.         if (Counter.X.dir < 0) then begin               //flip X

  6944.           aStream.Read(buf^, LineSize);

  6945.           tmp2 := buf;

  6946.           inc(tmp2, LineSize - PixelSize);              //pointer to last pixel in line

  6947.           for i := 0 to Header.Width-1 do begin         //for all pixels in line

  6948.             for j := 0 to PixelSize-1 do begin          //for all bytes in pixel

  6949.               tmp1^ := tmp2^;

  6950.               inc(tmp1);

  6951.               inc(tmp2);

  6952.             end;

  6953.             dec(tmp2, 2*PixelSize);                     //move 2 backwards, because j-loop moved 1 forward

  6954.           end;

  6955.         end else

  6956.           aStream.Read(tmp1^, LineSize);

  6957.         inc(Counter.Y.low, Counter.Y.dir);              //move to next line index

  6958.       end;

  6959.     finally

  6960.       if Assigned(buf) then

  6961.         FreeMem(buf);

  6962.     end;

  6963.   end;

  6964. 

  6965.   ////////////////////////////////////////////////////////////////////////////////////////

  6966.   procedure ReadCompressed;

  6967. 

  6968.     /////////////////////////////////////////////////////////////////

  6969.     var

  6970.       TmpData: System.PByte;

  6971.       LinePixelsRead: Integer;

  6972.     procedure CheckLine;

  6973.     begin

  6974.       if (LinePixelsRead >= Header.Width) then begin

  6975.         LinePixelsRead := 0;

  6976.         inc(Counter.Y.low, Counter.Y.dir);                //next line index

  6977.         TmpData := ImageData;

  6978.         inc(TmpData, Counter.Y.low * LineSize);           //set line

  6979.         if (Counter.X.dir < 0) then                       //if x flipped then

  6980.           inc(TmpData, LineSize - PixelSize);             //set last pixel

  6981.       end;

  6982.     end;

  6983. 

  6984.     /////////////////////////////////////////////////////////////////

  6985.     var

  6986.       Cache: PByte;

  6987.       CacheSize, CachePos: Integer;

  6988.     procedure CachedRead(out Buffer; Count: Integer);

  6989.     var

  6990.       BytesRead: Integer;

  6991.     begin

  6992.       if (CachePos + Count > CacheSize) then begin

  6993.         //if buffer overflow save non read bytes

  6994.         BytesRead := 0;

  6995.         if (CacheSize - CachePos > 0) then begin

  6996.           BytesRead := CacheSize - CachePos;

  6997.           Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);

  6998.           inc(CachePos, BytesRead);

  6999.         end;

  7000. 

  7001.         //load cache from file

  7002.         CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);

  7003.         aStream.Read(Cache^, CacheSize);

  7004.         CachePos := 0;

  7005. 

  7006.         //read rest of requested bytes

  7007.         if (Count - BytesRead > 0) then begin

  7008.           Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);

  7009.           inc(CachePos, Count - BytesRead);

  7010.         end;

  7011.       end else begin

  7012.         //if no buffer overflow just read the data

  7013.         Move(PByteArray(Cache)^[CachePos], Buffer, Count);

  7014.         inc(CachePos, Count);

  7015.       end;

  7016.     end;

  7017. 

  7018.     procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);

  7019.     begin

  7020.       case PixelSize of

  7021.         1: begin

  7022.           aBuffer^ := aData^;

  7023.           inc(aBuffer, Counter.X.dir);

  7024.         end;

  7025.         2: begin

  7026.           PWord(aBuffer)^ := PWord(aData)^;

  7027.           inc(aBuffer, 2 * Counter.X.dir);

  7028.         end;

  7029.         3: begin

  7030.           PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];

  7031.           PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];

  7032.           PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];

  7033.           inc(aBuffer, 3 * Counter.X.dir);

  7034.         end;

  7035.         4: begin

  7036.           PCardinal(aBuffer)^ := PCardinal(aData)^;

  7037.           inc(aBuffer, 4 * Counter.X.dir);

  7038.         end;

  7039.       end;

  7040.     end;

  7041. 

  7042.   var

  7043.     TotalPixelsToRead, TotalPixelsRead: Integer;

  7044.     Temp: Byte;

  7045.     buf: array [0..3] of Byte; //1 pixel is max 32bit long

  7046.     PixelRepeat: Boolean;

  7047.     PixelsToRead, PixelCount: Integer;

  7048.   begin

  7049.     CacheSize := 0;

  7050.     CachePos  := 0;

  7051. 

  7052.     TotalPixelsToRead := Header.Width * Header.Height;

  7053.     TotalPixelsRead   := 0;

  7054.     LinePixelsRead    := 0;

  7055. 

  7056.     GetMem(Cache, CACHE_SIZE);

  7057.     try

  7058.       TmpData := ImageData;

  7059.       inc(TmpData, Counter.Y.low * LineSize);           //set line

  7060.       if (Counter.X.dir < 0) then                       //if x flipped then

  7061.         inc(TmpData, LineSize - PixelSize);             //set last pixel

  7062. 

  7063.       repeat

  7064.         //read CommandByte

  7065.         CachedRead(Temp, 1);

  7066.         PixelRepeat  := (Temp and $80) > 0;

  7067.         PixelsToRead := (Temp and $7F) + 1;

  7068.         inc(TotalPixelsRead, PixelsToRead);

  7069. 

  7070.         if PixelRepeat then

  7071.           CachedRead(buf[0], PixelSize);

  7072.         while (PixelsToRead > 0) do begin

  7073.           CheckLine;

  7074.           PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF

  7075.           while (PixelCount > 0) do begin

  7076.             if not PixelRepeat then

  7077.               CachedRead(buf[0], PixelSize);

  7078.             PixelToBuffer(@buf[0], TmpData);

  7079.             inc(LinePixelsRead);

  7080.             dec(PixelsToRead);

  7081.             dec(PixelCount);

  7082.           end;

  7083.         end;

  7084.       until (TotalPixelsRead >= TotalPixelsToRead);

  7085.     finally

  7086.       FreeMem(Cache);

  7087.     end;

  7088.   end;

  7089. 

  7090.   function IsGrayFormat: Boolean;

  7091.   begin

  7092.     result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];

  7093.   end;

  7094. 

  7095. begin

  7096.   result := false;

  7097. 

  7098.   // reading header to test file and set cursor back to begin

  7099.   StartPosition := aStream.Position;

  7100.   aStream.Read(Header{%H-}, SizeOf(Header));

  7101. 

  7102.   // no colormapped files

  7103.   if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [

  7104.     TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then

  7105.   begin

  7106.     try

  7107.       if Header.ImageID <> 0 then       // skip image ID

  7108.         aStream.Position := aStream.Position + Header.ImageID;

  7109. 

  7110.       tgaFormat := tfEmpty;        

  7111.       case Header.Bpp of

  7112.          8: if IsGrayFormat then case (Header.ImageDesc and $F) of

  7113.                0: tgaFormat := tfLuminance8;

  7114.                8: tgaFormat := tfAlpha8;

  7115.             end;

  7116. 

  7117.         16: if IsGrayFormat then case (Header.ImageDesc and $F) of

  7118.                0: tgaFormat := tfLuminance16;

  7119.                8: tgaFormat := tfLuminance8Alpha8;

  7120.             end else case (Header.ImageDesc and $F) of

  7121.                0: tgaFormat := tfBGR5;

  7122.                1: tgaFormat := tfBGR5A1;

  7123.                4: tgaFormat := tfBGRA4;

  7124.             end;

  7125. 

  7126.         24: if not IsGrayFormat then case (Header.ImageDesc and $F) of

  7127.                0: tgaFormat := tfBGR8;

  7128.             end;

  7129. 

  7130.         32: if not IsGrayFormat then case (Header.ImageDesc and $F) of

  7131.                2: tgaFormat := tfBGR10A2;

  7132.                8: tgaFormat := tfBGRA8;

  7133.             end;

  7134.       end;

  7135. 

  7136.       if (tgaFormat = tfEmpty) then

  7137.         raise EglBitmap.Create('LoadTga - unsupported format');

  7138. 

  7139.       FormatDesc := TFormatDescriptor.Get(tgaFormat);

  7140.       PixelSize  := FormatDesc.GetSize(1, 1);

  7141.       LineSize   := FormatDesc.GetSize(Header.Width, 1);

  7142. 

  7143.       GetMem(ImageData, LineSize * Header.Height);

  7144.       try

  7145.         //column direction

  7146.         if ((Header.ImageDesc and (1 shl 4)) > 0) then begin

  7147.           Counter.X.low  := Header.Height-1;;

  7148.           Counter.X.high := 0;

  7149.           Counter.X.dir  := -1;

  7150.         end else begin

  7151.           Counter.X.low  := 0;

  7152.           Counter.X.high := Header.Height-1;

  7153.           Counter.X.dir  := 1;

  7154.         end;

  7155. 

  7156.         // Row direction

  7157.         if ((Header.ImageDesc and (1 shl 5)) > 0) then begin

  7158.           Counter.Y.low  := 0;

  7159.           Counter.Y.high := Header.Height-1;

  7160.           Counter.Y.dir  := 1;

  7161.         end else begin

  7162.           Counter.Y.low  := Header.Height-1;;

  7163.           Counter.Y.high := 0;

  7164.           Counter.Y.dir  := -1;

  7165.         end;

  7166. 

  7167.         // Read Image

  7168.         case Header.ImageType of

  7169.           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:

  7170.             ReadUncompressed;

  7171.           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:

  7172.             ReadCompressed;

  7173.         end;

  7174. 

  7175.         SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method

  7176.         result := true;

  7177.       except

  7178.         if Assigned(ImageData) then

  7179.           FreeMem(ImageData);

  7180.         raise;

  7181.       end;

  7182.     finally

  7183.       aStream.Position := StartPosition;

  7184.     end;

  7185.   end

  7186.     else aStream.Position := StartPosition;

  7187. end;

  7188. 

  7189. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7190. procedure TglBitmap.SaveTGA(const aStream: TStream);

  7191. var

  7192.   Header: TTGAHeader;

  7193.   LineSize, Size, x, y: Integer;

  7194.   Pixel: TglBitmapPixelData;

  7195.   LineBuf, SourceData, DestData: PByte;

  7196.   SourceMD, DestMD: Pointer;

  7197.   FormatDesc: TFormatDescriptor;

  7198.   Converter: TFormatDescriptor;

  7199. begin

  7200.   if not (ftTGA in FormatGetSupportedFiles(Format)) then

  7201.     raise EglBitmapUnsupportedFormat.Create(Format);

  7202. 

  7203.   //prepare header

  7204.   FillChar(Header{%H-}, SizeOf(Header), 0);

  7205. 

  7206.   //set ImageType

  7207.   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,

  7208.                  tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then

  7209.     Header.ImageType := TGA_UNCOMPRESSED_GRAY

  7210.   else

  7211.     Header.ImageType := TGA_UNCOMPRESSED_RGB;

  7212. 

  7213.   //set BitsPerPixel

  7214.   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then

  7215.     Header.Bpp := 8

  7216.   else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,

  7217.                       tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then

  7218.     Header.Bpp := 16

  7219.   else if (Format in [tfBGR8, tfRGB8]) then

  7220.     Header.Bpp := 24

  7221.   else

  7222.     Header.Bpp := 32;

  7223. 

  7224.   //set AlphaBitCount

  7225.   case Format of

  7226.     tfRGB5A1, tfBGR5A1:

  7227.       Header.ImageDesc := 1 and $F;

  7228.     tfRGB10A2, tfBGR10A2:

  7229.       Header.ImageDesc := 2 and $F;

  7230.     tfRGBA4, tfBGRA4:

  7231.       Header.ImageDesc := 4 and $F;

  7232.     tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:

  7233.       Header.ImageDesc := 8 and $F;

  7234.   end;

  7235. 

  7236.   Header.Width     := Width;

  7237.   Header.Height    := Height;

  7238.   Header.ImageDesc := Header.ImageDesc or $20; //flip y

  7239.   aStream.Write(Header, SizeOf(Header));

  7240. 

  7241.   // convert RGB(A) to BGR(A)

  7242.   Converter  := nil;

  7243.   FormatDesc := TFormatDescriptor.Get(Format);

  7244.   Size       := FormatDesc.GetSize(Dimension);

  7245.   if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin

  7246.     if (FormatDesc.RGBInverted = tfEmpty) then

  7247.       raise EglBitmap.Create('inverted RGB format is empty');

  7248.     Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);

  7249.     if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or

  7250.        (Converter.PixelSize <> FormatDesc.PixelSize) then

  7251.       raise EglBitmap.Create('invalid inverted RGB format');

  7252.   end;

  7253. 

  7254.   if Assigned(Converter) then begin

  7255.     LineSize := FormatDesc.GetSize(Width, 1);

  7256.     GetMem(LineBuf, LineSize);

  7257.     SourceMD := FormatDesc.CreateMappingData;

  7258.     DestMD   := Converter.CreateMappingData;

  7259.     try

  7260.       SourceData := Data;

  7261.       for y := 0 to Height-1 do begin

  7262.         DestData := LineBuf;

  7263.         for x := 0 to Width-1 do begin

  7264.           FormatDesc.Unmap(SourceData, Pixel, SourceMD);

  7265.           Converter.Map(Pixel, DestData, DestMD);

  7266.         end;

  7267.         aStream.Write(LineBuf^, LineSize);

  7268.       end;

  7269.     finally

  7270.       FreeMem(LineBuf);

  7271.       FormatDesc.FreeMappingData(SourceMD);

  7272.       FormatDesc.FreeMappingData(DestMD);

  7273.     end;

  7274.   end else

  7275.     aStream.Write(Data^, Size);

  7276. end;

  7277. 

  7278. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7279. //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7280. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7281. const

  7282.   DDS_MAGIC: Cardinal         = $20534444;

  7283. 

  7284.   // DDS_header.dwFlags

  7285.   DDSD_CAPS                   = $00000001;

  7286.   DDSD_HEIGHT                 = $00000002;

  7287.   DDSD_WIDTH                  = $00000004;

  7288.   DDSD_PIXELFORMAT            = $00001000;

  7289. 

  7290.   // DDS_header.sPixelFormat.dwFlags

  7291.   DDPF_ALPHAPIXELS            = $00000001;

  7292.   DDPF_ALPHA                  = $00000002;

  7293.   DDPF_FOURCC                 = $00000004;

  7294.   DDPF_RGB                    = $00000040;

  7295.   DDPF_LUMINANCE              = $00020000;

  7296. 

  7297.   // DDS_header.sCaps.dwCaps1

  7298.   DDSCAPS_TEXTURE             = $00001000;

  7299. 

  7300.   // DDS_header.sCaps.dwCaps2

  7301.   DDSCAPS2_CUBEMAP            = $00000200;

  7302. 

  7303.   D3DFMT_DXT1                 = $31545844;

  7304.   D3DFMT_DXT3                 = $33545844;

  7305.   D3DFMT_DXT5                 = $35545844;

  7306. 

  7307. type

  7308.   TDDSPixelFormat = packed record

  7309.     dwSize: Cardinal;

  7310.     dwFlags: Cardinal;

  7311.     dwFourCC: Cardinal;

  7312.     dwRGBBitCount: Cardinal;

  7313.     dwRBitMask: Cardinal;

  7314.     dwGBitMask: Cardinal;

  7315.     dwBBitMask: Cardinal;

  7316.     dwABitMask: Cardinal;

  7317.   end;

  7318. 

  7319.   TDDSCaps = packed record

  7320.     dwCaps1: Cardinal;

  7321.     dwCaps2: Cardinal;

  7322.     dwDDSX: Cardinal;

  7323.     dwReserved: Cardinal;

  7324.   end;

  7325. 

  7326.   TDDSHeader = packed record

  7327.     dwSize: Cardinal;

  7328.     dwFlags: Cardinal;

  7329.     dwHeight: Cardinal;

  7330.     dwWidth: Cardinal;

  7331.     dwPitchOrLinearSize: Cardinal;

  7332.     dwDepth: Cardinal;

  7333.     dwMipMapCount: Cardinal;

  7334.     dwReserved: array[0..10] of Cardinal;

  7335.     PixelFormat: TDDSPixelFormat;

  7336.     Caps: TDDSCaps;

  7337.     dwReserved2: Cardinal;

  7338.   end;

  7339. 

  7340. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7341. function TglBitmap.LoadDDS(const aStream: TStream): Boolean;

  7342. var

  7343.   Header: TDDSHeader;

  7344.   Converter: TbmpBitfieldFormat;

  7345. 

  7346.   function GetDDSFormat: TglBitmapFormat;

  7347.   var

  7348.     fd: TFormatDescriptor;

  7349.     i: Integer;

  7350.     Range: TglBitmapColorRec;

  7351.     match: Boolean;

  7352.   begin

  7353.     result := tfEmpty;

  7354.     with Header.PixelFormat do begin

  7355.       // Compresses

  7356.       if ((dwFlags and DDPF_FOURCC) > 0) then begin

  7357.         case Header.PixelFormat.dwFourCC of

  7358.           D3DFMT_DXT1: result := tfS3tcDtx1RGBA;

  7359.           D3DFMT_DXT3: result := tfS3tcDtx3RGBA;

  7360.           D3DFMT_DXT5: result := tfS3tcDtx5RGBA;

  7361.         end;

  7362.       end else if ((Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin

  7363. 

  7364.         //find matching format

  7365.         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin

  7366.           fd := TFormatDescriptor.Get(result);

  7367.           if fd.MaskMatch(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask) and

  7368.              (8 * fd.PixelSize = dwRGBBitCount) then

  7369.             exit;

  7370.         end;

  7371. 

  7372.         //find format with same Range

  7373.         Range.r := dwRBitMask;

  7374.         Range.g := dwGBitMask;

  7375.         Range.b := dwBBitMask;

  7376.         Range.a := dwABitMask;

  7377.         for i := 0 to 3 do begin

  7378.           while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do

  7379.             Range.arr[i] := Range.arr[i] shr 1;

  7380.         end;

  7381.         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin

  7382.           fd := TFormatDescriptor.Get(result);

  7383.           match := true;

  7384.           for i := 0 to 3 do

  7385.             if (fd.Range.arr[i] <> Range.arr[i]) then begin

  7386.               match := false;

  7387.               break;

  7388.             end;

  7389.           if match then

  7390.             break;

  7391.         end;

  7392. 

  7393.         //no format with same range found -> use default

  7394.         if (result = tfEmpty) then begin

  7395.           if (dwABitMask > 0) then

  7396.             result := tfBGRA8

  7397.           else

  7398.             result := tfBGR8;

  7399.         end;

  7400. 

  7401.         Converter := TbmpBitfieldFormat.Create;

  7402.         Converter.RedMask   := dwRBitMask;

  7403.         Converter.GreenMask := dwGBitMask;

  7404.         Converter.BlueMask  := dwBBitMask;

  7405.         Converter.AlphaMask := dwABitMask;

  7406.         Converter.PixelSize := dwRGBBitCount / 8;

  7407.       end;

  7408.     end;

  7409.   end;

  7410. 

  7411. var

  7412.   StreamPos: Int64;

  7413.   x, y, LineSize, RowSize, Magic: Cardinal;

  7414.   NewImage, TmpData, RowData, SrcData: System.PByte;

  7415.   SourceMD, DestMD: Pointer;

  7416.   Pixel: TglBitmapPixelData;

  7417.   ddsFormat: TglBitmapFormat;

  7418.   FormatDesc: TFormatDescriptor;

  7419. 

  7420. begin

  7421.   result    := false;

  7422.   Converter := nil;

  7423.   StreamPos := aStream.Position;

  7424. 

  7425.   // Magic

  7426.   aStream.Read(Magic{%H-}, sizeof(Magic));

  7427.   if (Magic <> DDS_MAGIC) then begin

  7428.     aStream.Position := StreamPos;

  7429.     exit;

  7430.   end;

  7431. 

  7432.   //Header

  7433.   aStream.Read(Header{%H-}, sizeof(Header));

  7434.   if (Header.dwSize <> SizeOf(Header)) or

  7435.      ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>

  7436.         (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then

  7437.   begin

  7438.     aStream.Position := StreamPos;

  7439.     exit;

  7440.   end;

  7441. 

  7442.   if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then

  7443.     raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');

  7444. 

  7445.   ddsFormat := GetDDSFormat;

  7446.   try

  7447.     if (ddsFormat = tfEmpty) then

  7448.       raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');

  7449. 

  7450.     FormatDesc := TFormatDescriptor.Get(ddsFormat);

  7451.     LineSize   := Trunc(Header.dwWidth * FormatDesc.PixelSize);

  7452.     GetMem(NewImage, Header.dwHeight * LineSize);

  7453.     try

  7454.       TmpData := NewImage;

  7455. 

  7456.       //Converter needed

  7457.       if Assigned(Converter) then begin

  7458.         RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);

  7459.         GetMem(RowData, RowSize);

  7460.         SourceMD := Converter.CreateMappingData;

  7461.         DestMD   := FormatDesc.CreateMappingData;

  7462.         try

  7463.           for y := 0 to Header.dwHeight-1 do begin

  7464.             TmpData := NewImage;

  7465.             inc(TmpData, y * LineSize);

  7466.             SrcData := RowData;

  7467.             aStream.Read(SrcData^, RowSize);

  7468.             for x := 0 to Header.dwWidth-1 do begin

  7469.               Converter.Unmap(SrcData, Pixel, SourceMD);

  7470.               glBitmapConvertPixel(Pixel, Converter, FormatDesc);

  7471.               FormatDesc.Map(Pixel, TmpData, DestMD);

  7472.             end;

  7473.           end;

  7474.         finally

  7475.           Converter.FreeMappingData(SourceMD);

  7476.           FormatDesc.FreeMappingData(DestMD);

  7477.           FreeMem(RowData);

  7478.         end;

  7479.       end else

  7480. 

  7481.       // Compressed

  7482.       if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin

  7483.         RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;

  7484.         for Y := 0 to Header.dwHeight-1 do begin

  7485.           aStream.Read(TmpData^, RowSize);

  7486.           Inc(TmpData, LineSize);

  7487.         end;

  7488.       end else

  7489. 

  7490.       // Uncompressed

  7491.       if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin

  7492.         RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;

  7493.         for Y := 0 to Header.dwHeight-1 do begin

  7494.           aStream.Read(TmpData^, RowSize);

  7495.           Inc(TmpData, LineSize);

  7496.         end;

  7497.       end else

  7498.         raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');

  7499. 

  7500.       SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method

  7501.       result := true;

  7502.     except

  7503.       if Assigned(NewImage) then

  7504.         FreeMem(NewImage);

  7505.       raise;

  7506.     end;

  7507.   finally

  7508.     FreeAndNil(Converter);

  7509.   end;

  7510. end;

  7511. 

  7512. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7513. procedure TglBitmap.SaveDDS(const aStream: TStream);

  7514. var

  7515.   Header: TDDSHeader;

  7516.   FormatDesc: TFormatDescriptor;

  7517. begin

  7518.   if not (ftDDS in FormatGetSupportedFiles(Format)) then

  7519.     raise EglBitmapUnsupportedFormat.Create(Format);

  7520. 

  7521.   FormatDesc := TFormatDescriptor.Get(Format);

  7522. 

  7523.   // Generell

  7524.   FillChar(Header{%H-}, SizeOf(Header), 0);

  7525.   Header.dwSize  := SizeOf(Header);

  7526.   Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;

  7527. 

  7528.   Header.dwWidth  := Max(1, Width);

  7529.   Header.dwHeight := Max(1, Height);

  7530. 

  7531.   // Caps

  7532.   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;

  7533. 

  7534.   // Pixelformat

  7535.   Header.PixelFormat.dwSize := sizeof(Header);

  7536.   if (FormatDesc.IsCompressed) then begin

  7537.     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;

  7538.     case Format of

  7539.       tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;

  7540.       tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;

  7541.       tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;

  7542.     end;

  7543.   end else if (Format in [tfAlpha8, tfAlpha16]) then begin

  7544.     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_ALPHA;

  7545.     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);

  7546.     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;

  7547.   end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin

  7548.     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;

  7549.     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);

  7550.     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;

  7551.     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;

  7552.   end else begin

  7553.     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;

  7554.     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);

  7555.     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;

  7556.     Header.PixelFormat.dwGBitMask    := FormatDesc.GreenMask;

  7557.     Header.PixelFormat.dwBBitMask    := FormatDesc.BlueMask;

  7558.     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;

  7559.   end;

  7560. 

  7561.   if (FormatDesc.HasAlpha) then

  7562.     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;

  7563. 

  7564.   aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));

  7565.   aStream.Write(Header, SizeOf(Header));

  7566.   aStream.Write(Data^, FormatDesc.GetSize(Dimension));

  7567. end;

  7568. 

  7569. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7570. //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7571. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7572. procedure TglBitmap1D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;

  7573.   const aWidth: Integer; const aHeight: Integer);

  7574. var

  7575.   pTemp: pByte;

  7576.   Size: Integer;

  7577. begin

  7578.   if (aHeight > 1) then begin

  7579.     Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);

  7580.     GetMem(pTemp, Size);

  7581.     try

  7582.       Move(aData^, pTemp^, Size);

  7583.       FreeMem(aData);

  7584.       aData := nil;

  7585.     except

  7586.       FreeMem(pTemp);

  7587.       raise;

  7588.     end;

  7589.   end else

  7590.     pTemp := aData;

  7591.   inherited SetDataPointer(pTemp, aFormat, aWidth);

  7592. end;

  7593. 

  7594. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7595. function TglBitmap1D.FlipHorz: Boolean;

  7596. var

  7597.   Col: Integer;

  7598.   pTempDest, pDest, pSource: PByte;

  7599. begin

  7600.   result := inherited FlipHorz;

  7601.   if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin

  7602.     pSource := Data;

  7603.     GetMem(pDest, fRowSize);

  7604.     try

  7605.       pTempDest := pDest;

  7606.       Inc(pTempDest, fRowSize);

  7607.       for Col := 0 to Width-1 do begin

  7608.         dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data

  7609.         Move(pSource^, pTempDest^, fPixelSize);

  7610.         Inc(pSource, fPixelSize);

  7611.       end;

  7612.       SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method

  7613.       result := true;

  7614.     except

  7615.       if Assigned(pDest) then

  7616.         FreeMem(pDest);

  7617.       raise;

  7618.     end;

  7619.   end;

  7620. end;

  7621. 

  7622. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7623. procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);

  7624. var

  7625.   FormatDesc: TFormatDescriptor;

  7626. begin

  7627.   // Upload data

  7628.   FormatDesc := TFormatDescriptor.Get(Format);

  7629.   if FormatDesc.IsCompressed then

  7630.     glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)

  7631.   else if aBuildWithGlu then

  7632.     gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)

  7633.   else

  7634.     glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);

  7635. 

  7636.   // Free Data

  7637.   if (FreeDataAfterGenTexture) then

  7638.     FreeData;

  7639. end;

  7640. 

  7641. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7642. procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);

  7643. var

  7644.   BuildWithGlu, TexRec: Boolean;

  7645.   TexSize: Integer;

  7646. begin

  7647.   if Assigned(Data) then begin

  7648.     // Check Texture Size

  7649.     if (aTestTextureSize) then begin

  7650.       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);

  7651. 

  7652.       if (Width > TexSize) then

  7653.         raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');

  7654. 

  7655.       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and

  7656.                 (Target = GL_TEXTURE_RECTANGLE);

  7657.       if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then

  7658.         raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');

  7659.     end;

  7660. 

  7661.     CreateId;

  7662.     SetupParameters(BuildWithGlu);

  7663.     UploadData(BuildWithGlu);

  7664.     glAreTexturesResident(1, @fID, @fIsResident);

  7665.   end;

  7666. end;

  7667. 

  7668. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7669. procedure TglBitmap1D.AfterConstruction;

  7670. begin

  7671.   inherited;

  7672.   Target := GL_TEXTURE_1D;

  7673. end;

  7674. 

  7675. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7676. //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7677. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7678. function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;

  7679. begin

  7680.   if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then

  7681.     result := fLines[aIndex]

  7682.   else

  7683.     result := nil;

  7684. end;

  7685. 

  7686. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7687. procedure TglBitmap2D.SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat;

  7688.   const aWidth: Integer; const aHeight: Integer);

  7689. var

  7690.   Idx, LineWidth: Integer;

  7691. begin

  7692.   inherited SetDataPointer(aData, aFormat, aWidth, aHeight);

  7693. 

  7694.   if not TFormatDescriptor.Get(aFormat).IsCompressed then begin

  7695.     // Assigning Data

  7696.     if Assigned(Data) then begin

  7697.       SetLength(fLines, GetHeight);

  7698.       LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);

  7699. 

  7700.       for Idx := 0 to GetHeight-1 do begin

  7701.         fLines[Idx] := Data;

  7702.         Inc(fLines[Idx], Idx * LineWidth);

  7703.       end;

  7704.     end

  7705.       else SetLength(fLines, 0);

  7706.   end else begin

  7707.     SetLength(fLines, 0);

  7708.   end;

  7709. end;

  7710. 

  7711. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7712. procedure TglBitmap2D.UploadData(const aTarget: GLenum; const aBuildWithGlu: Boolean);

  7713. var

  7714.   FormatDesc: TFormatDescriptor;

  7715. begin

  7716.   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);

  7717. 

  7718.   FormatDesc := TFormatDescriptor.Get(Format);

  7719.   if FormatDesc.IsCompressed then begin

  7720.     glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)

  7721.   end else if aBuildWithGlu then begin

  7722.     gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,

  7723.       FormatDesc.glFormat, FormatDesc.glDataFormat, Data)

  7724.   end else begin

  7725.     glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,

  7726.       FormatDesc.glFormat, FormatDesc.glDataFormat, Data);

  7727.   end;

  7728. 

  7729.   // Freigeben

  7730.   if (FreeDataAfterGenTexture) then

  7731.     FreeData;

  7732. end;

  7733. 

  7734. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7735. procedure TglBitmap2D.AfterConstruction;

  7736. begin

  7737.   inherited;

  7738.   Target := GL_TEXTURE_2D;

  7739. end;

  7740. 

  7741. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7742. procedure TglBitmap2D.GrabScreen(const aTop, aLeft, aRight, aBottom: Integer; const aFormat: TglBitmapFormat);

  7743. var

  7744.   Temp: pByte;

  7745.   Size, w, h: Integer;

  7746.   FormatDesc: TFormatDescriptor;

  7747. begin

  7748.   FormatDesc := TFormatDescriptor.Get(aFormat);

  7749.   if FormatDesc.IsCompressed then

  7750.     raise EglBitmapUnsupportedFormat.Create(aFormat);

  7751. 

  7752.   w    := aRight  - aLeft;

  7753.   h    := aBottom - aTop;

  7754.   Size := FormatDesc.GetSize(w, h);

  7755.   GetMem(Temp, Size);

  7756.   try

  7757.     glPixelStorei(GL_PACK_ALIGNMENT, 1);

  7758.     glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);

  7759.     SetDataPointer(Temp, aFormat, w, h); //be careful, Data could be freed by this method

  7760.     FlipVert;

  7761.   except

  7762.     if Assigned(Temp) then

  7763.       FreeMem(Temp);

  7764.     raise;

  7765.   end;

  7766. end;

  7767. 

  7768. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7769. procedure TglBitmap2D.GetDataFromTexture;

  7770. var

  7771.   Temp: PByte;

  7772.   TempWidth, TempHeight: Integer;

  7773.   TempIntFormat: Cardinal;

  7774.   IntFormat, f: TglBitmapFormat;

  7775.   FormatDesc: TFormatDescriptor;

  7776. begin

  7777.   Bind;

  7778. 

  7779.   // Request Data

  7780.   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH,           @TempWidth);

  7781.   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT,          @TempHeight);

  7782.   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);

  7783. 

  7784.   IntFormat := tfEmpty;

  7785.   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin

  7786.     FormatDesc := TFormatDescriptor.Get(f);

  7787.     if (FormatDesc.glInternalFormat = TempIntFormat) then begin

  7788.       IntFormat := FormatDesc.Format;

  7789.       break;

  7790.     end;

  7791.   end;

  7792. 

  7793.   // Getting data from OpenGL

  7794.   FormatDesc := TFormatDescriptor.Get(IntFormat);

  7795.   GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));

  7796.   try

  7797.     if FormatDesc.IsCompressed then

  7798.       glGetCompressedTexImage(Target, 0, Temp)

  7799.     else

  7800.      glGetTexImage(Target, 0, FormatDesc.glInternalFormat, FormatDesc.glDataFormat, Temp);

  7801.     SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method

  7802.   except

  7803.     if Assigned(Temp) then

  7804.       FreeMem(Temp);

  7805.     raise;

  7806.   end;

  7807. end;

  7808. 

  7809. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7810. procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);

  7811. var

  7812.   BuildWithGlu, PotTex, TexRec: Boolean;

  7813.   TexSize: Integer;

  7814. begin

  7815.   if Assigned(Data) then begin

  7816.     // Check Texture Size

  7817.     if (aTestTextureSize) then begin

  7818.       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);

  7819. 

  7820.       if ((Height > TexSize) or (Width > TexSize)) then

  7821.         raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');

  7822. 

  7823.       PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);

  7824.       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);

  7825.       if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then

  7826.         raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');

  7827.     end;

  7828. 

  7829.     CreateId;

  7830.     SetupParameters(BuildWithGlu);

  7831.     UploadData(Target, BuildWithGlu);

  7832.     glAreTexturesResident(1, @fID, @fIsResident);

  7833.   end;

  7834. end;

  7835. 

  7836. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7837. function TglBitmap2D.FlipHorz: Boolean;

  7838. var

  7839.   Col, Row: Integer;

  7840.   TempDestData, DestData, SourceData: PByte;

  7841.   ImgSize: Integer;

  7842. begin

  7843.   result := inherited FlipHorz;

  7844.   if Assigned(Data) then begin

  7845.     SourceData := Data;

  7846.     ImgSize := Height * fRowSize;

  7847.     GetMem(DestData, ImgSize);

  7848.     try

  7849.       TempDestData := DestData;

  7850.       Dec(TempDestData, fRowSize + fPixelSize);

  7851.       for Row := 0 to Height -1 do begin

  7852.         Inc(TempDestData, fRowSize * 2);

  7853.         for Col := 0 to Width -1 do begin

  7854.           Move(SourceData^, TempDestData^, fPixelSize);

  7855.           Inc(SourceData, fPixelSize);

  7856.           Dec(TempDestData, fPixelSize);

  7857.         end;

  7858.       end;

  7859.       SetDataPointer(DestData, Format); //be careful, Data could be freed by this method

  7860.       result := true;

  7861.     except

  7862.       if Assigned(DestData) then

  7863.         FreeMem(DestData);

  7864.       raise;

  7865.     end;

  7866.   end;

  7867. end;

  7868. 

  7869. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7870. function TglBitmap2D.FlipVert: Boolean;

  7871. var

  7872.   Row: Integer;

  7873.   TempDestData, DestData, SourceData: PByte;

  7874. begin

  7875.   result := inherited FlipVert;

  7876.   if Assigned(Data) then begin

  7877.     SourceData := Data;

  7878.     GetMem(DestData, Height * fRowSize);

  7879.     try

  7880.       TempDestData := DestData;

  7881.       Inc(TempDestData, Width * (Height -1) * fPixelSize);

  7882.       for Row := 0 to Height -1 do begin

  7883.         Move(SourceData^, TempDestData^, fRowSize);

  7884.         Dec(TempDestData, fRowSize);

  7885.         Inc(SourceData, fRowSize);

  7886.       end;

  7887.       SetDataPointer(DestData, Format); //be careful, Data could be freed by this method

  7888.       result := true;

  7889.     except

  7890.       if Assigned(DestData) then

  7891.         FreeMem(DestData);

  7892.       raise;

  7893.     end;

  7894.   end;

  7895. end;

  7896. 

  7897. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7898. //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7899. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7900. type

  7901.   TMatrixItem = record

  7902.     X, Y: Integer;

  7903.     W: Single;

  7904.   end;

  7905. 

  7906.   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;

  7907.   TglBitmapToNormalMapRec = Record

  7908.     Scale: Single;

  7909.     Heights: array of Single;

  7910.     MatrixU : array of TMatrixItem;

  7911.     MatrixV : array of TMatrixItem;

  7912.   end;

  7913. 

  7914. const

  7915.   ONE_OVER_255 = 1 / 255;

  7916. 

  7917.   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7918. procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);

  7919. var

  7920.   Val: Single;

  7921. begin

  7922.   with FuncRec do begin

  7923.     Val :=

  7924.       Source.Data.r * LUMINANCE_WEIGHT_R +

  7925.       Source.Data.g * LUMINANCE_WEIGHT_G +

  7926.       Source.Data.b * LUMINANCE_WEIGHT_B;

  7927.     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;

  7928.   end;

  7929. end;

  7930. 

  7931. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7932. procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);

  7933. begin

  7934.   with FuncRec do

  7935.     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;

  7936. end;

  7937. 

  7938. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7939. procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);

  7940. type

  7941.   TVec = Array[0..2] of Single;

  7942. var

  7943.   Idx: Integer;

  7944.   du, dv: Double;

  7945.   Len: Single;

  7946.   Vec: TVec;

  7947. 

  7948.   function GetHeight(X, Y: Integer): Single;

  7949.   begin

  7950.     with FuncRec do begin

  7951.       X := Max(0, Min(Size.X -1, X));

  7952.       Y := Max(0, Min(Size.Y -1, Y));

  7953.       result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];

  7954.     end;

  7955.   end;

  7956. 

  7957. begin

  7958.   with FuncRec do begin

  7959.     with PglBitmapToNormalMapRec(Args)^ do begin

  7960.       du := 0;

  7961.       for Idx := Low(MatrixU) to High(MatrixU) do

  7962.         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;

  7963. 

  7964.       dv := 0;

  7965.       for Idx := Low(MatrixU) to High(MatrixU) do

  7966.         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;

  7967. 

  7968.       Vec[0] := -du * Scale;

  7969.       Vec[1] := -dv * Scale;

  7970.       Vec[2] := 1;

  7971.     end;

  7972. 

  7973.     // Normalize

  7974.     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));

  7975.     if Len <> 0 then begin

  7976.       Vec[0] := Vec[0] * Len;

  7977.       Vec[1] := Vec[1] * Len;

  7978.       Vec[2] := Vec[2] * Len;

  7979.     end;

  7980. 

  7981.     // Farbe zuweisem

  7982.     Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);

  7983.     Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);

  7984.     Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);

  7985.   end;

  7986. end;

  7987. 

  7988. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7989. procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);

  7990. var

  7991.   Rec: TglBitmapToNormalMapRec;

  7992. 

  7993.   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);

  7994.   begin

  7995.     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin

  7996.       Matrix[Index].X := X;

  7997.       Matrix[Index].Y := Y;

  7998.       Matrix[Index].W := W;

  7999.     end;

  8000.   end;

  8001. 

  8002. begin

  8003.   if TFormatDescriptor.Get(Format).IsCompressed then

  8004.     raise EglBitmapUnsupportedFormat.Create(Format);

  8005. 

  8006.   if aScale > 100 then

  8007.     Rec.Scale := 100

  8008.   else if aScale < -100 then

  8009.     Rec.Scale := -100

  8010.   else

  8011.     Rec.Scale := aScale;

  8012. 

  8013.   SetLength(Rec.Heights, Width * Height);

  8014.   try

  8015.     case aFunc of

  8016.       nm4Samples: begin

  8017.         SetLength(Rec.MatrixU, 2);

  8018.         SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);

  8019.         SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);

  8020. 

  8021.         SetLength(Rec.MatrixV, 2);

  8022.         SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);

  8023.         SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);

  8024.       end;

  8025. 

  8026.       nmSobel: begin

  8027.         SetLength(Rec.MatrixU, 6);

  8028.         SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);

  8029.         SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);

  8030.         SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);

  8031.         SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);

  8032.         SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);

  8033.         SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);

  8034. 

  8035.         SetLength(Rec.MatrixV, 6);

  8036.         SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);

  8037.         SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);

  8038.         SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);

  8039.         SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);

  8040.         SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);

  8041.         SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);

  8042.       end;

  8043. 

  8044.       nm3x3: begin

  8045.         SetLength(Rec.MatrixU, 6);

  8046.         SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);

  8047.         SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);

  8048.         SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);

  8049.         SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);

  8050.         SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);

  8051.         SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);

  8052. 

  8053.         SetLength(Rec.MatrixV, 6);

  8054.         SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);

  8055.         SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);

  8056.         SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);

  8057.         SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);

  8058.         SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);

  8059.         SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);

  8060.       end;

  8061. 

  8062.       nm5x5: begin

  8063.         SetLength(Rec.MatrixU, 20);

  8064.         SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);

  8065.         SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);

  8066.         SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);

  8067.         SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);

  8068.         SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);

  8069.         SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);

  8070.         SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);

  8071.         SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);

  8072.         SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);

  8073.         SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);

  8074.         SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);

  8075.         SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);

  8076.         SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);

  8077.         SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);

  8078.         SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);

  8079.         SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);

  8080.         SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);

  8081.         SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);

  8082.         SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);

  8083.         SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);

  8084. 

  8085.         SetLength(Rec.MatrixV, 20);

  8086.         SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);

  8087.         SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);

  8088.         SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);

  8089.         SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);

  8090.         SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);

  8091.         SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);

  8092.         SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);

  8093.         SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);

  8094.         SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);

  8095.         SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);

  8096.         SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);

  8097.         SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);

  8098.         SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);

  8099.         SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);

  8100.         SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);

  8101.         SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);

  8102.         SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);

  8103.         SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);

  8104.         SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);

  8105.         SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);

  8106.       end;

  8107.     end;

  8108. 

  8109.     // Daten Sammeln

  8110.     if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then

  8111.       AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)

  8112.     else

  8113.       AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);

  8114.     AddFunc(glBitmapToNormalMapFunc, false, @Rec);

  8115.   finally

  8116.     SetLength(Rec.Heights, 0);

  8117.   end;

  8118. end;

  8119. 

  8120. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  8121. //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  8122. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  8123. procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);

  8124. begin

  8125.   Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');

  8126. end;

  8127. 

  8128. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  8129. procedure TglBitmapCubeMap.AfterConstruction;

  8130. begin

  8131.   inherited;

  8132. 

  8133.   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then

  8134.     raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');

  8135. 

  8136.   SetWrap;

  8137.   Target   := GL_TEXTURE_CUBE_MAP;

  8138.   fGenMode := GL_REFLECTION_MAP;

  8139. end;

  8140. 

  8141. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  8142. procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);

  8143. var

  8144.   BuildWithGlu: Boolean;

  8145.   TexSize: Integer;

  8146. begin

  8147.   if (aTestTextureSize) then begin

  8148.     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);

  8149. 

  8150.     if (Height > TexSize) or (Width > TexSize) then

  8151.       raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');

  8152. 

  8153.     if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then

  8154.       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');

  8155.   end;

  8156. 

  8157.   if (ID = 0) then

  8158.     CreateID;

  8159.   SetupParameters(BuildWithGlu);

  8160.   UploadData(aCubeTarget, BuildWithGlu);

  8161. end;

  8162. 

  8163. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  8164. procedure TglBitmapCubeMap.Bind(const aEnableTexCoordsGen: Boolean; const aEnableTextureUnit: Boolean);

  8165. begin

  8166.   inherited Bind (aEnableTextureUnit);

  8167.   if aEnableTexCoordsGen then begin

  8168.     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);

  8169.     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);

  8170.     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);

  8171.     glEnable(GL_TEXTURE_GEN_S);

  8172.     glEnable(GL_TEXTURE_GEN_T);

  8173.     glEnable(GL_TEXTURE_GEN_R);

  8174.   end;

  8175. end;

  8176. 

  8177. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  8178. procedure TglBitmapCubeMap.Unbind(const aDisableTexCoordsGen: Boolean; const aDisableTextureUnit: Boolean);

  8179. begin

  8180.   inherited Unbind(aDisableTextureUnit);

  8181.   if aDisableTexCoordsGen then begin

  8182.     glDisable(GL_TEXTURE_GEN_S);

  8183.     glDisable(GL_TEXTURE_GEN_T);

  8184.     glDisable(GL_TEXTURE_GEN_R);

  8185.   end;

  8186. end;

  8187. 

  8188. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  8189. //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  8190. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  8191. type

  8192.   TVec = Array[0..2] of Single;

  8193.   TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);

  8194. 

  8195.   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;

  8196.   TglBitmapNormalMapRec = record

  8197.     HalfSize : Integer;

  8198.     Func: TglBitmapNormalMapGetVectorFunc;

  8199.   end;

  8200. 

  8201.   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  8202. procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);

  8203. begin

  8204.   aVec[0] := aHalfSize;

  8205.   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);

  8206.   aVec[2] := - (aPosition.X + 0.5 - aHalfSize);

  8207. end;

  8208. 

  8209. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  8210. procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);

  8211. begin

  8212.   aVec[0] := - aHalfSize;

  8213.   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);

  8214.   aVec[2] := aPosition.X + 0.5 - aHalfSize;

  8215. end;

  8216. 

  8217. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  8218. procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);

  8219. begin

  8220.   aVec[0] := aPosition.X + 0.5 - aHalfSize;

  8221.   aVec[1] := aHalfSize;

  8222.   aVec[2] := aPosition.Y + 0.5 - aHalfSize;

  8223. end;

  8224. 

  8225. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  8226. procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);

  8227. begin

  8228.   aVec[0] := aPosition.X + 0.5 - aHalfSize;

  8229.   aVec[1] := - aHalfSize;

  8230.   aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);

  8231. end;

  8232. 

  8233. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  8234. procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);

  8235. begin

  8236.   aVec[0] := aPosition.X + 0.5 - aHalfSize;

  8237.   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);

  8238.   aVec[2] := aHalfSize;

  8239. end;

  8240. 

  8241. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  8242. procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);

  8243. begin

  8244.   aVec[0] := - (aPosition.X + 0.5 - aHalfSize);

  8245.   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);

  8246.   aVec[2] := - aHalfSize;

  8247. end;

  8248. 

  8249. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  8250. procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);

  8251. var

  8252.   i: Integer;

  8253.   Vec: TVec;

  8254.   Len: Single;

  8255. begin

  8256.   with FuncRec do begin

  8257.     with PglBitmapNormalMapRec(Args)^ do begin

  8258.       Func(Vec, Position, HalfSize);

  8259. 

  8260.       // Normalize

  8261.       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));

  8262.       if Len <> 0 then begin

  8263.         Vec[0] := Vec[0] * Len;

  8264.         Vec[1] := Vec[1] * Len;

  8265.         Vec[2] := Vec[2] * Len;

  8266.       end;

  8267. 

  8268.       // Scale Vector and AddVectro

  8269.       Vec[0] := Vec[0] * 0.5 + 0.5;

  8270.       Vec[1] := Vec[1] * 0.5 + 0.5;

  8271.       Vec[2] := Vec[2] * 0.5 + 0.5;

  8272.     end;

  8273. 

  8274.     // Set Color

  8275.     for i := 0 to 2 do

  8276.       Dest.Data.arr[i] := Round(Vec[i] * 255);

  8277.   end;

  8278. end;

  8279. 

  8280. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  8281. procedure TglBitmapNormalMap.AfterConstruction;

  8282. begin

  8283.   inherited;

  8284.   fGenMode := GL_NORMAL_MAP;

  8285. end;

  8286. 

  8287. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  8288. procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);

  8289. var

  8290.   Rec: TglBitmapNormalMapRec;

  8291.   SizeRec: TglBitmapPixelPosition;

  8292. begin

  8293.   Rec.HalfSize := aSize div 2;

  8294.   FreeDataAfterGenTexture := false;

  8295. 

  8296.   SizeRec.Fields := [ffX, ffY];

  8297.   SizeRec.X := aSize;

  8298.   SizeRec.Y := aSize;

  8299. 

  8300.   // Positive X

  8301.   Rec.Func := glBitmapNormalMapPosX;

  8302.   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);

  8303.   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);

  8304. 

  8305.   // Negative X

  8306.   Rec.Func := glBitmapNormalMapNegX;

  8307.   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);

  8308.   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);

  8309. 

  8310.   // Positive Y

  8311.   Rec.Func := glBitmapNormalMapPosY;

  8312.   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);

  8313.   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);

  8314. 

  8315.   // Negative Y

  8316.   Rec.Func := glBitmapNormalMapNegY;

  8317.   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);

  8318.   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);

  8319. 

  8320.   // Positive Z

  8321.   Rec.Func := glBitmapNormalMapPosZ;

  8322.   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);

  8323.   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);

  8324. 

  8325.   // Negative Z

  8326.   Rec.Func := glBitmapNormalMapNegZ;

  8327.   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8, @Rec);

  8328.   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);

  8329. end;

  8330. 

  8331. 

  8332. initialization

  8333.   glBitmapSetDefaultFormat (tfEmpty);

  8334.   glBitmapSetDefaultMipmap (mmMipmap);

  8335.   glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);

  8336.   glBitmapSetDefaultWrap   (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);

  8337.   glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);

  8338. 

  8339.   glBitmapSetDefaultFreeDataAfterGenTexture(true);

  8340.   glBitmapSetDefaultDeleteTextureOnFree    (true);

  8341. 

  8342.   TFormatDescriptor.Init;

  8343. 

  8344. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}

  8345.   OpenGLInitialized := false;

  8346.   InitOpenGLCS := TCriticalSection.Create;

  8347. {$ENDIF}

  8348. 

  8349. finalization

  8350.   TFormatDescriptor.Finalize;

  8351. 

  8352. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}

  8353.   FreeAndNil(InitOpenGLCS);

  8354. {$ENDIF}

  8355. 

  8356. end.