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.
17 Commits
2 Ramas
1.7 MiB
 
 
Árbol: ecbecb3fd9
Ramas Etiquetas
${ item.name }
Crear rama ${ searchTerm }
desde 'ecbecb3fd9'
${ noResults }
glBitmap/glBitmap.pas

8264 líneas
276 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/)

  6. 

  7. 

  8. ------------------------------------------------------------

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

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

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

  12. obtain a copy of the License at

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

  14. ------------------------------------------------------------

  15. Version 2.0.3

  16. ------------------------------------------------------------

  17. History

  18. 21-03-2010

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

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

  21.   with newer versions of Delphi.

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

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

  24. 10-08-2008

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

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

  27. 24-07-2008

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

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

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

  31.   - CustomName  (free for use string)

  32.   - CustomNameW (free for use widestring)

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

  34. 27-05-2008

  35. - RLE TGAs loaded much faster

  36. 26-05-2008

  37. - fixed some problem with reading RLE TGAs.

  38. 21-05-2008

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

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

  41. 01-05-2008

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

  43. - define GLB_NO_NATIVE_GL deactivated by default

  44. 27-04-2008

  45. - Now supports the following libraries

  46.   - SDL and SDL_image

  47.   - libPNG

  48.   - libJPEG

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

  50. - BMPs now loaded manuel

  51. - Large restructuring

  52. - Property DataPtr now has the name Data

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

  54. - Unused Depth removed

  55. - Function FreeData to freeing image data added 

  56. 24-10-2007

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

  58. 15-11-2006

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

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

  61. - Function ReadOpenGLExtension is now only intern

  62. 29-06-2006

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

  64. 26-06-2006

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

  66. 22-06-2006

  67. - Fixed some Problem with Delphi 5

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

  69. 22-03-2006

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

  71. 09-03-2006

  72. - Internal Format ifDepth8 added

  73. - function GrabScreen now supports all uncompressed formats

  74. 31-01-2006

  75. - AddAlphaFromglBitmap implemented

  76. 29-12-2005

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

  78. 28-12-2005

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

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

  81. 11-12-2005

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

  83. 19-10-2005

  84. - Added function GrabScreen to class TglBitmap2D

  85. 18-10-2005

  86. - Added support to Save images

  87. - Added function Clone to Clone Instance

  88. 11-10-2005

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

  90.   Usefull for Future

  91. - Several speed optimizations

  92. 09-10-2005

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

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

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

  96. - Some Funtions moved to Baseclass TglBitmap

  97. 06-10-2005

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

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

  100. 05-10-2005

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

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

  103. - Added Support to decompress DXT1 compressed Images.

  104. - SwapColors replaced by ConvertTo

  105. 04-10-2005

  106. - Added Support for compressed DDSs

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

  108. 29-09-2005

  109. - Parameter Components renamed to InternalFormat

  110. 23-09-2005

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

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

  113. 22-09-2005

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

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

  116. 07-09-2005

  117. - Added support for Grayscale textures

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

  119. 10-07-2005

  120. - Added support for GL_VERSION_2_0

  121. - Added support for GL_EXT_texture_filter_anisotropic

  122. 04-07-2005

  123. - Function FillWithColor fills the Image with one Color

  124. - Function LoadNormalMap added

  125. 30-06-2005

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

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

  128. 29-06-2005

  129. - support for RLE Compressed RGB TGAs added

  130. 28-06-2005

  131. - Class TglBitmapNormalMap added to support Normalmap generation

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

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

  134. 16-06-2005

  135. - Method LoadCubeMapClass removed

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

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

  138. 12-06-2005

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

  140. 10-06-2005

  141. - little enhancement for IsPowerOfTwo

  142. - TglBitmap1D.GenTexture now tests NPOT Textures

  143. 06-06-2005

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

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

  146. 03-06-2005

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

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

  149. 02-06-2005

  150. - added support for GL_ARB_texture_rectangle, GL_EXT_texture_rectangle and GL_NV_texture_rectangle

  151. 25-04-2005

  152. - Function Unbind added

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

  154. 21-04-2005

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

  156. 29-03-2005

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

  158.   To Enable png's use the define pngimage

  159. 22-03-2005

  160. - New Functioninterface added

  161. - Function GetPixel added

  162. 27-11-2004

  163. - Property BuildMipMaps renamed to MipMap

  164. 21-11-2004

  165. - property Name removed.

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

  167. 22-05-2004

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

  169. 26-11-2003

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

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

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

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

  174. 29-09-2003

  175. - property BuildMipsMaps added (default = true)

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

  177. - property FreeDataAfterGenTexture added (default = true)

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

  179. - parameter DisableOtherTextureUnits of Bind removed

  180. - parameter FreeDataAfterGeneration of GenTextures removed

  181. 12-09-2003

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

  183. 09-09-2003

  184. - Bind now enables TextureUnits (by params)

  185. - GenTextures can leave data (by param)

  186. - LoadTextures now optimal

  187. 03-09-2003

  188. - Performance optimization in AddFunc

  189. - procedure Bind moved to subclasses

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

  191. 19-08-2003

  192. - Texturefilter and texturewrap now also as defaults

  193.   Minfilter = GL_LINEAR_MIPMAP_LINEAR

  194.   Magfilter = GL_LINEAR

  195.   Wrap(str) = GL_CLAMP_TO_EDGE

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

  197. - propertys IsCompressed, TextureSize and IsResident added

  198.   IsCompressed and TextureSize only contains data from level 0

  199. 18-08-2003

  200. - Added function AddFunc to add PerPixelEffects to Image

  201. - LoadFromFunc now based on AddFunc

  202. - Invert now based on AddFunc

  203. - SwapColors now based on AddFunc

  204. 16-08-2003

  205. - Added function FlipHorz

  206. 15-08-2003

  207. - Added function LaodFromFunc to create images with function

  208. - Added function FlipVert

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

  210. 29-07-2003

  211. - Added Alphafunctions to calculate alpha per function

  212. - Added Alpha from ColorKey using alphafunctions

  213. 28-07-2003

  214. - First full functionally Version of glBitmap

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

  216. 25-07-2003

  217. - begin of programming

  218. ***********************************************************}

  219. unit glBitmap;

  220. 

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

  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. 

  225. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  226. // Preferences ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  227. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  229. // use dglOpenGL.pas if not enabled

  230. {.$DEFINE GLB_NATIVE_OGL_STATIC}

  231. 

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

  233. // use dglOpenGL.pas if not enabled

  234. {.$DEFINE GLB_NATIVE_OGL_DYNAMIC}

  235. 

  236. // activate to enable the support for SDL_surfaces

  237. {.$DEFINE GLB_SDL}

  238. 

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

  240. {.$DEFINE GLB_DELPHI}

  241. 

  242. 

  243. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

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

  246. {.$DEFINE GLB_SDL_IMAGE}

  247. 

  248. // PNG /////////////////////////////////////////////////////////////////////////////////////////////

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

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

  251. {$DEFINE GLB_PNGIMAGE}

  252. 

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

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

  255. {.$DEFINE GLB_LIB_PNG}

  256. 

  257. // JPEG ////////////////////////////////////////////////////////////////////////////////////////////

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

  259. {.$DEFINE GLB_DELPHI_JPEG}

  260. 

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

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

  263. {.$DEFINE GLB_LIB_JPEG}

  264. 

  265. 

  266. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  268. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  269. // Delphi Versions

  270. {$IFDEF fpc}

  271.   {$MODE Delphi}

  272. 

  273.   {$IFDEF CPUI386}

  274.     {$DEFINE CPU386}

  275.     {$ASMMODE INTEL}

  276.   {$ENDIF}

  277. 

  278.   {$IFNDEF WINDOWS}

  279.     {$linklib c}

  280.   {$ENDIF}

  281. {$ENDIF}

  282. 

  283. // Operation System

  284. {$IF DEFINED(WIN32) or DEFINED(WIN64)}

  285.   {$DEFINE GLB_WIN}

  286. {$ELSEIF DEFINED(LINUX)}

  287.   {$DEFINE GLB_LINUX}

  288. {$IFEND}

  289. 

  290. // native OpenGL Support

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

  292.   {$DEFINE GLB_NATIVE_OGL}

  293. {$IFEND}

  294. 

  295. // checking define combinations

  296. //SDL Image

  297. {$IFDEF GLB_SDL_IMAGE}

  298.   {$IFNDEF GLB_SDL}

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

  300.     {$DEFINE GLB_SDL}

  301.   {$ENDIF}

  302.   {$IFDEF GLB_PNGIMAGE}

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

  304.     {$undef GLB_PNGIMAGE}

  305.   {$ENDIF}

  306.   {$IFDEF GLB_DELPHI_JPEG}

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

  308.     {$undef GLB_DELPHI_JPEG}

  309.   {$ENDIF}

  310.   {$IFDEF GLB_LIB_PNG}

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

  312.     {$undef GLB_LIB_PNG}

  313.   {$ENDIF}

  314.   {$IFDEF GLB_LIB_JPEG}

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

  316.     {$undef GLB_LIB_JPEG}

  317.   {$ENDIF}

  318. 

  319.   {$DEFINE GLB_SUPPORT_PNG_READ}

  320.   {$DEFINE GLB_SUPPORT_JPEG_READ}

  321. {$ENDIF}

  322. 

  323. // PNG Image

  324. {$IFDEF GLB_PNGIMAGE}

  325.   {$IFDEF GLB_LIB_PNG}

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

  327.     {$undef GLB_LIB_PNG}

  328.   {$ENDIF}

  329. 

  330.   {$DEFINE GLB_SUPPORT_PNG_READ}

  331.   {$DEFINE GLB_SUPPORT_PNG_WRITE}

  332. {$ENDIF}

  333. 

  334. // libPNG

  335. {$IFDEF GLB_LIB_PNG}

  336.   {$DEFINE GLB_SUPPORT_PNG_READ}

  337.   {$DEFINE GLB_SUPPORT_PNG_WRITE}

  338. {$ENDIF}

  339. 

  340. // JPEG Image

  341. {$IFDEF GLB_DELPHI_JPEG}

  342.   {$IFDEF GLB_LIB_JPEG}

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

  344.     {$undef GLB_LIB_JPEG}

  345.   {$ENDIF}

  346. 

  347.   {$DEFINE GLB_SUPPORT_JPEG_READ}

  348.   {$DEFINE GLB_SUPPORT_JPEG_WRITE}

  349. {$ENDIF}

  350. 

  351. // libJPEG

  352. {$IFDEF GLB_LIB_JPEG}

  353.   {$DEFINE GLB_SUPPORT_JPEG_READ}

  354.   {$DEFINE GLB_SUPPORT_JPEG_WRITE}

  355. {$ENDIF}

  356. 

  357. // native OpenGL

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

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

  360. {$ENDIF}

  361. 

  362. // general options

  363. {$EXTENDEDSYNTAX ON}

  364. {$LONGSTRINGS ON}

  365. {$ALIGN ON}

  366. {$IFNDEF FPC}

  367.   {$OPTIMIZATION ON}

  368. {$ENDIF}

  369. 

  370. interface

  371. 

  372. uses

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

  374.   {$IF DEFINED(GLB_WIN) AND

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

  376. 

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

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

  379. 

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

  381. 

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

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

  384. 

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

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

  387. 

  388.   Classes, SysUtils;

  389. 

  390. {$IFNDEF GLB_DELPHI}

  391. type

  392.   HGLRC = Cardinal;

  393.   DWORD = Cardinal;

  394.   PDWORD = ^DWORD;

  395. 

  396.   TRGBQuad = packed record

  397.     rgbBlue: Byte;

  398.     rgbGreen: Byte;

  399.     rgbRed: Byte;

  400.     rgbReserved: Byte;

  401.   end;

  402. {$ENDIF}

  403. 

  404. {$IFDEF GLB_NATIVE_OGL}

  405. const

  406.   GL_TRUE   = 1;

  407.   GL_FALSE  = 0;

  408. 

  409.   GL_VERSION    = $1F02;

  410.   GL_EXTENSIONS = $1F03;

  411. 

  412.   GL_TEXTURE_1D         = $0DE0;

  413.   GL_TEXTURE_2D         = $0DE1;

  414.   GL_TEXTURE_RECTANGLE  = $84F5;

  415. 

  416.   GL_TEXTURE_WIDTH            = $1000;

  417.   GL_TEXTURE_HEIGHT           = $1001;

  418.   GL_TEXTURE_INTERNAL_FORMAT  = $1003;

  419. 

  420.   GL_ALPHA    = $1906;

  421.   GL_ALPHA4   = $803B;

  422.   GL_ALPHA8   = $803C;

  423.   GL_ALPHA12  = $803D;

  424.   GL_ALPHA16  = $803E;

  425. 

  426.   GL_LUMINANCE    = $1909;

  427.   GL_LUMINANCE4   = $803F;

  428.   GL_LUMINANCE8   = $8040;

  429.   GL_LUMINANCE12  = $8041;

  430.   GL_LUMINANCE16  = $8042;

  431. 

  432.   GL_LUMINANCE_ALPHA      = $190A;

  433.   GL_LUMINANCE4_ALPHA4    = $8043;

  434.   GL_LUMINANCE6_ALPHA2    = $8044;

  435.   GL_LUMINANCE8_ALPHA8    = $8045;

  436.   GL_LUMINANCE12_ALPHA4   = $8046;

  437.   GL_LUMINANCE12_ALPHA12  = $8047;

  438.   GL_LUMINANCE16_ALPHA16  = $8048;

  439. 

  440.   GL_RGB      = $1907;

  441.   GL_BGR      = $80E0;

  442.   GL_R3_G3_B2 = $2A10;

  443.   GL_RGB4     = $804F;

  444.   GL_RGB5     = $8050;

  445.   GL_RGB565   = $8D62;

  446.   GL_RGB8     = $8051;

  447.   GL_RGB10    = $8052;

  448.   GL_RGB12    = $8053;

  449.   GL_RGB16    = $8054;

  450. 

  451.   GL_RGBA     = $1908;

  452.   GL_BGRA     = $80E1;

  453.   GL_RGBA2    = $8055;

  454.   GL_RGBA4    = $8056;

  455.   GL_RGB5_A1  = $8057;

  456.   GL_RGBA8    = $8058;

  457.   GL_RGB10_A2 = $8059;

  458.   GL_RGBA12   = $805A;

  459.   GL_RGBA16   = $805B;

  460. 

  461.   GL_DEPTH_COMPONENT    = $1902;

  462.   GL_DEPTH_COMPONENT16  = $81A5;

  463.   GL_DEPTH_COMPONENT24  = $81A6;

  464.   GL_DEPTH_COMPONENT32  = $81A7;

  465. 

  466.   GL_COMPRESSED_RGB                 = $84ED;

  467.   GL_COMPRESSED_RGBA                = $84EE;

  468.   GL_COMPRESSED_RGB_S3TC_DXT1_EXT   = $83F0;

  469.   GL_COMPRESSED_RGBA_S3TC_DXT1_EXT  = $83F1;

  470.   GL_COMPRESSED_RGBA_S3TC_DXT3_EXT  = $83F2;

  471.   GL_COMPRESSED_RGBA_S3TC_DXT5_EXT  = $83F3;

  472. 

  473.   GL_UNSIGNED_BYTE            = $1401;

  474.   GL_UNSIGNED_BYTE_3_3_2      = $8032;

  475.   GL_UNSIGNED_BYTE_2_3_3_REV  = $8362;

  476. 

  477.   GL_UNSIGNED_SHORT             = $1403;

  478.   GL_UNSIGNED_SHORT_5_6_5       = $8363;

  479.   GL_UNSIGNED_SHORT_4_4_4_4     = $8033;

  480.   GL_UNSIGNED_SHORT_5_5_5_1     = $8034;

  481.   GL_UNSIGNED_SHORT_5_6_5_REV   = $8364;

  482.   GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;

  483.   GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;

  484. 

  485.   GL_UNSIGNED_INT                 = $1405;

  486.   GL_UNSIGNED_INT_8_8_8_8         = $8035;

  487.   GL_UNSIGNED_INT_10_10_10_2      = $8036;

  488.   GL_UNSIGNED_INT_8_8_8_8_REV     = $8367;

  489.   GL_UNSIGNED_INT_2_10_10_10_REV  = $8368;

  490. 

  491.   { Texture Filter }

  492.   GL_TEXTURE_MAG_FILTER     = $2800;

  493.   GL_TEXTURE_MIN_FILTER     = $2801;

  494.   GL_NEAREST                = $2600;

  495.   GL_NEAREST_MIPMAP_NEAREST = $2700;

  496.   GL_NEAREST_MIPMAP_LINEAR  = $2702;

  497.   GL_LINEAR                 = $2601;

  498.   GL_LINEAR_MIPMAP_NEAREST  = $2701;

  499.   GL_LINEAR_MIPMAP_LINEAR   = $2703;

  500. 

  501.   { Texture Wrap }

  502.   GL_TEXTURE_WRAP_S   = $2802;

  503.   GL_TEXTURE_WRAP_T   = $2803;

  504.   GL_TEXTURE_WRAP_R   = $8072;

  505.   GL_CLAMP            = $2900;

  506.   GL_REPEAT           = $2901;

  507.   GL_CLAMP_TO_EDGE    = $812F;

  508.   GL_CLAMP_TO_BORDER  = $812D;

  509.   GL_MIRRORED_REPEAT  = $8370;

  510. 

  511.   { Other }

  512.   GL_GENERATE_MIPMAP      = $8191;

  513.   GL_TEXTURE_BORDER_COLOR = $1004;

  514.   GL_MAX_TEXTURE_SIZE     = $0D33;

  515.   GL_PACK_ALIGNMENT       = $0D05;

  516.   GL_UNPACK_ALIGNMENT     = $0CF5;

  517. 

  518.   GL_TEXTURE_MAX_ANISOTROPY_EXT     = $84FE;

  519.   GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;

  520. 

  521. {$ifdef LINUX}

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

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

  524. {$else}

  525.   libglu    = 'glu32.dll';

  526.   libopengl = 'opengl32.dll';

  527. {$endif}

  528. 

  529. type

  530.   GLboolean = BYTEBOOL;

  531.   GLint     = Integer;

  532.   GLsizei   = Integer;

  533.   GLuint    = Cardinal;

  534.   GLfloat   = Single;

  535.   GLenum    = Cardinal;

  536. 

  537.   PGLvoid    = Pointer;

  538.   PGLboolean = ^GLboolean;

  539.   PGLint     = ^GLint;

  540.   PGLuint    = ^GLuint;

  541.   PGLfloat   = ^GLfloat;

  542. 

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

  544.   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}

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

  546. 

  547. {$IF DEFINED(GLB_NATIVE_OGL_DYNAMIC)}

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

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

  550. 

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

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

  553. 

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

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

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

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

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

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

  560. 

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

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

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

  564. 

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

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

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

  568. 

  569.   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}

  570.   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}

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

  572. 

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

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

  575. 

  576.   {$IFDEF GLB_LINUX}

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

  578.   {$ELSE}

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

  580.   {$ENDIF}

  581. 

  582. {$ELSEIF DEFINED(GLB_NATIVE_OGL_STATIC)}

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

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

  585. 

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

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

  588. 

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

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

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

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

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

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

  595. 

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

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

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

  599. 

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

  601.   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;

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

  603. 

  604.   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;

  605.   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;

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

  607. 

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

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

  610. {$ENDIF}

  611. 

  612. var

  613.   GL_VERSION_1_2,

  614.   GL_VERSION_1_3,

  615.   GL_VERSION_1_4,

  616.   GL_VERSION_2_0,

  617. 

  618.   GL_SGIS_generate_mipmap,

  619. 

  620.   GL_ARB_texture_border_clamp,

  621.   GL_ARB_texture_mirrored_repeat,

  622.   GL_ARB_texture_rectangle,

  623.   GL_ARB_texture_non_power_of_two,

  624. 

  625.   GL_IBM_texture_mirrored_repeat,

  626. 

  627.   GL_NV_texture_rectangle,

  628. 

  629.   GL_EXT_texture_edge_clamp,

  630.   GL_EXT_texture_rectangle,

  631.   GL_EXT_texture_filter_anisotropic: Boolean;

  632. 

  633.   glCompressedTexImage1D: TglCompressedTexImage1D;

  634.   glCompressedTexImage2D: TglCompressedTexImage2D;

  635.   glGetCompressedTexImage: TglGetCompressedTexImage;

  636. 

  637. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}

  638.   glEnable: TglEnable;

  639.   glDisable: TglDisable;

  640. 

  641.   glGetString: TglGetString;

  642.   glGetIntegerv: TglGetIntegerv;

  643. 

  644.   glTexParameteri: TglTexParameteri;

  645.   glTexParameterfv: TglTexParameterfv;

  646.   glGetTexParameteriv: TglGetTexParameteriv;

  647.   glGetTexParameterfv: TglGetTexParameterfv;

  648.   glGetTexLevelParameteriv: TglGetTexLevelParameteriv;

  649.   glGetTexLevelParameterfv: TglGetTexLevelParameterfv;

  650. 

  651.   glGenTextures: TglGenTextures;

  652.   glBindTexture: TglBindTexture;

  653.   glDeleteTextures: TglDeleteTextures;

  654. 

  655.   glAreTexturesResident: TglAreTexturesResident;

  656.   glReadPixels: TglReadPixels;

  657.   glPixelStorei: TglPixelStorei;

  658. 

  659.   glTexImage1D: TglTexImage1D;

  660.   glTexImage2D: TglTexImage2D;

  661.   glGetTexImage: TglGetTexImage;

  662. 

  663.   gluBuild1DMipmaps: TgluBuild1DMipmaps;

  664.   gluBuild2DMipmaps: TgluBuild2DMipmaps;

  665. 

  666.   {$IF DEFINED(GLB_WIN)}

  667.   wglGetProcAddress: TwglGetProcAddress;

  668.   {$ELSEIF DEFINED(GLB_LINUX)}

  669.   glXGetProcAddress: TglXGetProcAddress;

  670.   glXGetProcAddressARB: TglXGetProcAddressARB;

  671.   {$ENDIF}

  672. {$ENDIF}

  673. 

  674. (*

  675. {$IFDEF GLB_DELPHI}

  676. var

  677.   gLastContext: HGLRC;

  678. {$ENDIF}

  679. *)

  680. 

  681. {$ENDIF}

  682. 

  683. type

  684. ////////////////////////////////////////////////////////////////////////////////////////////////////

  685.   TglBitmapFormat = (

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

  687. 

  688.     tfAlpha4,

  689.     tfAlpha8,

  690.     tfAlpha12,

  691.     tfAlpha16,

  692. 

  693.     tfLuminance4,

  694.     tfLuminance8,

  695.     tfLuminance12,

  696.     tfLuminance16,

  697. 

  698.     tfLuminance4Alpha4,

  699.     tfLuminance6Alpha2,

  700.     tfLuminance8Alpha8,

  701.     tfLuminance12Alpha4,

  702.     tfLuminance12Alpha12,

  703.     tfLuminance16Alpha16,

  704. 

  705.     tfR3G3B2,

  706.     tfRGB4,

  707.     tfR5G6B5,

  708.     tfRGB5,

  709.     tfRGB8,

  710.     tfRGB10,

  711.     tfRGB12,

  712.     tfRGB16,

  713. 

  714.     tfRGBA2,

  715.     tfRGBA4,

  716.     tfRGB5A1,

  717.     tfRGBA8,

  718.     tfRGB10A2,

  719.     tfRGBA12,

  720.     tfRGBA16,

  721. 

  722.     tfBGR4,

  723.     tfB5G6R5,

  724.     tfBGR5,

  725.     tfBGR8,

  726.     tfBGR10,

  727.     tfBGR12,

  728.     tfBGR16,

  729. 

  730.     tfBGRA2,

  731.     tfBGRA4,

  732.     tfBGR5A1,

  733.     tfBGRA8,

  734.     tfBGR10A2,

  735.     tfBGRA12,

  736.     tfBGRA16,

  737. 

  738.     tfDepth16,

  739.     tfDepth24,

  740.     tfDepth32,

  741. 

  742.     tfS3tcDtx1RGBA,

  743.     tfS3tcDtx3RGBA,

  744.     tfS3tcDtx5RGBA

  745.   );

  746. 

  747.   TglBitmapFileType = (

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

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

  750.      ftDDS,

  751.      ftTGA,

  752.      ftBMP);

  753.    TglBitmapFileTypes = set of TglBitmapFileType;

  754. 

  755.    TglBitmapMipMap = (

  756.      mmNone,

  757.      mmMipmap,

  758.      mmMipmapGlu);

  759. 

  760.    TglBitmapNormalMapFunc = (

  761.      nm4Samples,

  762.      nmSobel,

  763.      nm3x3,

  764.      nm5x5);

  765. 

  766.  ////////////////////////////////////////////////////////////////////////////////////////////////////

  767.    EglBitmapException               = class(Exception);

  768.    EglBitmapSizeToLargeException    = class(EglBitmapException);

  769.    EglBitmapNonPowerOfTwoException  = class(EglBitmapException);

  770.    EglBitmapUnsupportedFormat       = class(EglBitmapException)

  771.      constructor Create(const aFormat: TglBitmapFormat);

  772.    end;

  773. 

  774. ////////////////////////////////////////////////////////////////////////////////////////////////////

  775.   TglBitmapColorRec = packed record

  776.   case Integer of

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

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

  779.   end;

  780. 

  781.   TglBitmapPixelData = packed record

  782.     Data, Range: TglBitmapColorRec;

  783.     Format: TglBitmapFormat;

  784.   end;

  785.   PglBitmapPixelData = ^TglBitmapPixelData;

  786. 

  787. ////////////////////////////////////////////////////////////////////////////////////////////////////

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

  789.   TglBitmapPixelPosition = record

  790.     Fields : TglBitmapPixelPositionFields;

  791.     X : Word;

  792.     Y : Word;

  793.   end;

  794. 

  795. ////////////////////////////////////////////////////////////////////////////////////////////////////

  796.   TglBitmap = class;

  797.   TglBitmapFunctionRec = record

  798.     Sender:   TglBitmap;

  799.     Size:     TglBitmapPixelPosition;

  800.     Position: TglBitmapPixelPosition;

  801.     Source:   TglBitmapPixelData;

  802.     Dest:     TglBitmapPixelData;

  803.     Args:     Pointer;

  804.   end;

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

  806. 

  807. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  808.   TglBitmap = class

  809.   protected

  810.     fID: GLuint;

  811.     fTarget: GLuint;

  812.     fAnisotropic: Integer;

  813.     fDeleteTextureOnFree: Boolean;

  814.     fFreeDataAfterGenTexture: Boolean;

  815.     fData: PByte;

  816.     fIsResident: Boolean;

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

  818. 

  819.     fDimension: TglBitmapPixelPosition;

  820.     fMipMap: TglBitmapMipMap;

  821.     fFormat: TglBitmapFormat;

  822. 

  823.     // Mapping

  824.     fPixelSize: Integer;

  825.     fRowSize: Integer;

  826. 

  827.     // Filtering

  828.     fFilterMin: Cardinal;

  829.     fFilterMag: Cardinal;

  830. 

  831.     // TexturWarp

  832.     fWrapS: Cardinal;

  833.     fWrapT: Cardinal;

  834.     fWrapR: Cardinal;

  835. 

  836.     // CustomData

  837.     fFilename: String;

  838.     fCustomName: String;

  839.     fCustomNameW: WideString;

  840.     fCustomData: Pointer;

  841. 

  842.     //Getter

  843.     function GetWidth:  Integer; virtual;

  844.     function GetHeight: Integer; virtual;

  845. 

  846.     function GetFileWidth:  Integer; virtual;

  847.     function GetFileHeight: Integer; virtual;

  848. 

  849.     //Setter

  850.     procedure SetCustomData(const aValue: Pointer);

  851.     procedure SetCustomName(const aValue: String);

  852.     procedure SetCustomNameW(const aValue: WideString);

  853.     procedure SetDeleteTextureOnFree(const aValue: Boolean);

  854.     procedure SetFormat(const aValue: TglBitmapFormat);

  855.     procedure SetFreeDataAfterGenTexture(const aValue: Boolean);

  856.     procedure SetID(const aValue: Cardinal);

  857.     procedure SetMipMap(const aValue: TglBitmapMipMap);

  858.     procedure SetTarget(const aValue: Cardinal);

  859.     procedure SetAnisotropic(const aValue: Integer);

  860. 

  861.     procedure CreateID;

  862.     procedure SetupParameters(out aBuildWithGlu: Boolean);

  863.     procedure SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;

  864.       const aWidth: Integer = -1; const aHeight: Integer = -1); virtual;

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

  866. 

  867.     function FlipHorz: Boolean; virtual;

  868.     function FlipVert: Boolean; virtual;

  869. 

  870.     property Width:  Integer read GetWidth;

  871.     property Height: Integer read GetHeight;

  872. 

  873.     property FileWidth:  Integer read GetFileWidth;

  874.     property FileHeight: Integer read GetFileHeight;

  875.   public

  876.     //Properties

  877.     property ID:           Cardinal        read fID          write SetID;

  878.     property Target:       Cardinal        read fTarget      write SetTarget;

  879.     property Format:       TglBitmapFormat read fFormat      write SetFormat;

  880.     property MipMap:       TglBitmapMipMap read fMipMap      write SetMipMap;

  881.     property Anisotropic:  Integer         read fAnisotropic write SetAnisotropic;

  882. 

  883.     property Filename:    String     read fFilename;

  884.     property CustomName:  String     read fCustomName  write SetCustomName;

  885.     property CustomNameW: WideString read fCustomNameW write SetCustomNameW;

  886.     property CustomData:  Pointer    read fCustomData  write SetCustomData;

  887. 

  888.     property DeleteTextureOnFree:     Boolean read fDeleteTextureOnFree     write SetDeleteTextureOnFree;

  889.     property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;

  890. 

  891.     property Dimension:  TglBitmapPixelPosition  read fDimension;

  892.     property Data:       PByte                   read fData;

  893.     property IsResident: Boolean                 read fIsResident;

  894. 

  895.     procedure AfterConstruction; override;

  896.     procedure BeforeDestruction; override;

  897. 

  898.     //Load

  899.     procedure LoadFromFile(const aFilename: String);

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

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

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

  903.     {$IFDEF GLB_DELPHI}

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

  905.     procedure LoadFromResourceID(const sInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);

  906.     {$ENDIF}

  907. 

  908.     //Save

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

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

  911. 

  912.     //Convert

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

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

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

  916.   public

  917.     //Alpha & Co

  918.     {$IFDEF GLB_SDL}

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

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

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

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

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

  924.     {$ENDIF}

  925. 

  926.     {$IFDEF GLB_DELPHI}

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

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

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

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

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

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

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

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

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

  936.     {$ENDIF}

  937. 

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

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

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

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

  942. 

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

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

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

  946. 

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

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

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

  950. 

  951.     function RemoveAlpha: Boolean; virtual;

  952.   public

  953.     //Common

  954.     function Clone: TglBitmap;

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

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

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

  958.     procedure FreeData;

  959. 

  960.     //ColorFill

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

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

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

  964. 

  965.     //TexParameters

  966.     procedure SetFilter(const aMin, aMag: Cardinal);

  967.     procedure SetWrap(

  968.       const S: Cardinal = GL_CLAMP_TO_EDGE;

  969.       const T: Cardinal = GL_CLAMP_TO_EDGE;

  970.       const R: Cardinal = GL_CLAMP_TO_EDGE);

  971. 

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

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

  974. 

  975.     //Constructors

  976.     constructor Create; overload;

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

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

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

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

  981.     {$IFDEF GLB_DELPHI}

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

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

  984.     {$ENDIF}

  985.   private

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

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

  988. 

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

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

  991. 

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

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

  994. 

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

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

  997. 

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

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

  1000.   end;

  1001. 

  1002. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1003.   TglBitmap2D = class(TglBitmap)

  1004.   protected

  1005.     // Bildeinstellungen

  1006.     fLines: array of PByte;

  1007. 

  1008.     (* TODO

  1009.     procedure GetDXTColorBlock(pData: pByte; relX, relY: Integer; var Pixel: TglBitmapPixelData);

  1010.     procedure GetPixel2DDXT1(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);

  1011.     procedure GetPixel2DDXT3(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);

  1012.     procedure GetPixel2DDXT5(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);

  1013.     procedure GetPixel2DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);

  1014.     procedure SetPixel2DUnmap(const Pos: TglBitmapPixelPosition; const Pixel: TglBitmapPixelData);

  1015.     *)

  1016. 

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

  1018.     procedure SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;

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

  1020.     procedure UploadData(const aTarget: Cardinal; const aBuildWithGlu: Boolean);

  1021.   public

  1022.     property Width;

  1023.     property Height;

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

  1025. 

  1026.     procedure AfterConstruction; override;

  1027. 

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

  1029.     procedure GetDataFromTexture;

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

  1031. 

  1032.     function FlipHorz: Boolean; override;

  1033.     function FlipVert: Boolean; override;

  1034. 

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

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

  1037.   end;

  1038. 

  1039. (* TODO

  1040.   TglBitmapCubeMap = class(TglBitmap2D)

  1041.   protected

  1042.     fGenMode: Integer;

  1043. 

  1044.     // Hide GenTexture

  1045.     procedure GenTexture(TestTextureSize: Boolean = true); reintroduce;

  1046.   public

  1047.     procedure AfterConstruction; override;

  1048. 

  1049.     procedure GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean = true);

  1050. 

  1051.     procedure Unbind(DisableTexCoordsGen: Boolean = true; DisableTextureUnit: Boolean = true); reintroduce; virtual;

  1052.     procedure Bind(EnableTexCoordsGen: Boolean = true; EnableTextureUnit: Boolean = true); reintroduce; virtual;

  1053.   end;

  1054. 

  1055. 

  1056.   TglBitmapNormalMap = class(TglBitmapCubeMap)

  1057.   public

  1058.     procedure AfterConstruction; override;

  1059. 

  1060.     procedure GenerateNormalMap(Size: Integer = 32; TestTextureSize: Boolean = true);

  1061.   end;

  1062. 

  1063. 

  1064.   TglBitmap1D = class(TglBitmap)

  1065.   protected

  1066.     procedure GetPixel1DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);

  1067. 

  1068.     procedure SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width: Integer = -1; Height: Integer = -1); override;

  1069.     procedure UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);

  1070.   public

  1071.     // propertys

  1072.     property Width;

  1073. 

  1074.     procedure AfterConstruction; override;

  1075. 

  1076.     // Other

  1077.     function FlipHorz: Boolean; override;

  1078. 

  1079.     // Generation

  1080.     procedure GenTexture(TestTextureSize: Boolean = true); override;

  1081.   end;

  1082. *)

  1083. 

  1084. const

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

  1086. 

  1087. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);

  1088. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);

  1089. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);

  1090. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);

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

  1092. procedure glBitmapSetDefaultWrap(

  1093.   const S: Cardinal = GL_CLAMP_TO_EDGE;

  1094.   const T: Cardinal = GL_CLAMP_TO_EDGE;

  1095.   const R: Cardinal = GL_CLAMP_TO_EDGE);

  1096. 

  1097. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;

  1098. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;

  1099. function glBitmapGetDefaultMipmap: TglBitmapMipMap;

  1100. function glBitmapGetDefaultFormat: TglBitmapFormat;

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

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

  1103. 

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

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

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

  1107. 

  1108. var

  1109.   glBitmapDefaultDeleteTextureOnFree: Boolean;

  1110.   glBitmapDefaultFreeDataAfterGenTextures: Boolean;

  1111.   glBitmapDefaultFormat: TglBitmapFormat;

  1112.   glBitmapDefaultMipmap: TglBitmapMipMap;

  1113.   glBitmapDefaultFilterMin: Cardinal;

  1114.   glBitmapDefaultFilterMag: Cardinal;

  1115.   glBitmapDefaultWrapS: Cardinal;

  1116.   glBitmapDefaultWrapT: Cardinal;

  1117.   glBitmapDefaultWrapR: Cardinal;

  1118. 

  1119. {$IFDEF GLB_DELPHI}

  1120. function CreateGrayPalette: HPALETTE;

  1121. {$ENDIF}

  1122. 

  1123. implementation

  1124. 

  1125. 

  1126.     (* TODO

  1127.     function FormatIsCompressed(Format: TglBitmapInternalFormat): boolean;

  1128.     function FormatIsUncompressed(Format: TglBitmapInternalFormat): boolean;

  1129.     function LoadTexture(Filename: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal = 0{$ENDIF}): Boolean;

  1130.     function LoadCubeMap(PositiveX, NegativeX, PositiveY, NegativeY, PositiveZ, NegativeZ: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal = 0{$ENDIF}): Boolean;

  1131.     function LoadNormalMap(Size: Integer; var Texture: Cardinal): Boolean;

  1132.     *)

  1133. 

  1134. uses

  1135.   Math, syncobjs, typinfo;

  1136. 

  1137. type

  1138. ////////////////////////////////////////////////////////////////////////////////////////////////////

  1139.   TShiftRec = packed record

  1140.   case Integer of

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

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

  1143.   end;

  1144. 

  1145.   TFormatDescriptor = class(TObject)

  1146.   private

  1147.     function GetRedMask: QWord;

  1148.     function GetGreenMask: QWord;

  1149.     function GetBlueMask: QWord;

  1150.     function GetAlphaMask: QWord;

  1151.   protected

  1152.     fFormat: TglBitmapFormat;

  1153.     fWithAlpha: TglBitmapFormat;

  1154.     fWithoutAlpha: TglBitmapFormat;

  1155.     fRGBInverted: TglBitmapFormat;

  1156.     fUncompressed: TglBitmapFormat;

  1157.     fPixelSize: Single;

  1158.     fIsCompressed: Boolean;

  1159. 

  1160.     fRange: TglBitmapColorRec;

  1161.     fShift: TShiftRec;

  1162. 

  1163.     fglFormat:         Cardinal;

  1164.     fglInternalFormat: Cardinal;

  1165.     fglDataFormat:     Cardinal;

  1166. 

  1167.     function GetComponents: Integer; virtual;

  1168.   public

  1169.     property Format:       TglBitmapFormat read fFormat;

  1170.     property WithAlpha:    TglBitmapFormat read fWithAlpha;

  1171.     property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;

  1172.     property RGBInverted:  TglBitmapFormat read fRGBInverted;

  1173.     property Components:   Integer         read GetComponents;

  1174.     property PixelSize:    Single          read fPixelSize;

  1175.     property IsCompressed: Boolean         read fIsCompressed;

  1176. 

  1177.     property glFormat:         Cardinal read fglFormat;

  1178.     property glInternalFormat: Cardinal read fglInternalFormat;

  1179.     property glDataFormat:     Cardinal read fglDataFormat;

  1180. 

  1181.     property Range: TglBitmapColorRec read fRange;

  1182.     property Shift: TShiftRec         read fShift;

  1183. 

  1184.     property RedMask:   QWord read GetRedMask;

  1185.     property GreenMask: QWord read GetGreenMask;

  1186.     property BlueMask:  QWord read GetBlueMask;

  1187.     property AlphaMask: QWord read GetAlphaMask;

  1188. 

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

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

  1191. 

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

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

  1194. 

  1195.     function CreateMappingData: Pointer; virtual;

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

  1197. 

  1198.     function IsEmpty:  Boolean; virtual;

  1199.     function HasAlpha: Boolean; virtual;

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

  1201. 

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

  1203. 

  1204.     constructor Create; virtual;

  1205.   public

  1206.     class procedure Init;

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

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

  1209.     class procedure Clear;

  1210.     class procedure Finalize;

  1211.   end;

  1212.   TFormatDescriptorClass = class of TFormatDescriptor;

  1213. 

  1214.   TfdEmpty = class(TFormatDescriptor);

  1215. 

  1216. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

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

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

  1220.     constructor Create; override;

  1221.   end;

  1222. 

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

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

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

  1226.     constructor Create; override;

  1227.   end;

  1228. 

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

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

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

  1232.     constructor Create; override;

  1233.   end;

  1234. 

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

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

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

  1238.     constructor Create; override;

  1239.   end;

  1240. 

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

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

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

  1244.     constructor Create; override;

  1245.   end;

  1246. 

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

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

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

  1250.     constructor Create; override;

  1251.   end;

  1252. 

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

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

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

  1256.     constructor Create; override;

  1257.   end;

  1258. 

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

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

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

  1262.     constructor Create; override;

  1263.   end;

  1264. 

  1265. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  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.   TfdLuminance_US1 = class(TFormatDescriptor) //1* unsigned short

  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.   TfdUniversal_US1 = class(TFormatDescriptor) //1* unsigned short

  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.   TfdDepth_US1 = class(TFormatDescriptor) //1* unsigned short

  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.   TfdLuminanceAlpha_US2 = class(TfdLuminance_US1) //2* unsigned short

  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.   TfdRGB_US3 = class(TFormatDescriptor) //3* unsigned short

  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.   TfdBGR_US3 = class(TFormatDescriptor) //3* unsigned short (inverse)

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

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

  1305.     constructor Create; override;

  1306.   end;

  1307. 

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

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

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

  1311.     constructor Create; override;

  1312.   end;

  1313. 

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

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

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

  1317.     constructor Create; override;

  1318.   end;

  1319. 

  1320. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  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.   TfdDepth_UI1 = class(TFormatDescriptor) //1* unsigned int

  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. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1334.   TfdAlpha4 = class(TfdAlpha_UB1)

  1335.     constructor Create; override;

  1336.   end;

  1337. 

  1338.   TfdAlpha8 = class(TfdAlpha_UB1)

  1339.     constructor Create; override;

  1340.   end;

  1341. 

  1342.   TfdAlpha12 = class(TfdAlpha_US1)

  1343.     constructor Create; override;

  1344.   end;

  1345. 

  1346.   TfdAlpha16 = class(TfdAlpha_US1)

  1347.     constructor Create; override;

  1348.   end;

  1349. 

  1350.   TfdLuminance4 = class(TfdLuminance_UB1)

  1351.     constructor Create; override;

  1352.   end;

  1353. 

  1354.   TfdLuminance8 = class(TfdLuminance_UB1)

  1355.     constructor Create; override;

  1356.   end;

  1357. 

  1358.   TfdLuminance12 = class(TfdLuminance_US1)

  1359.     constructor Create; override;

  1360.   end;

  1361. 

  1362.   TfdLuminance16 = class(TfdLuminance_US1)

  1363.     constructor Create; override;

  1364.   end;

  1365. 

  1366.   TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)

  1367.     constructor Create; override;

  1368.   end;

  1369. 

  1370.   TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)

  1371.     constructor Create; override;

  1372.   end;

  1373. 

  1374.   TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)

  1375.     constructor Create; override;

  1376.   end;

  1377. 

  1378.   TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)

  1379.     constructor Create; override;

  1380.   end;

  1381. 

  1382.   TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)

  1383.     constructor Create; override;

  1384.   end;

  1385. 

  1386.   TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)

  1387.     constructor Create; override;

  1388.   end;

  1389. 

  1390.   TfdR3G3B2 = class(TfdUniversal_UB1)

  1391.     constructor Create; override;

  1392.   end;

  1393. 

  1394.   TfdRGB4 = class(TfdUniversal_US1)

  1395.     constructor Create; override;

  1396.   end;

  1397. 

  1398.   TfdR5G6B5 = class(TfdUniversal_US1)

  1399.     constructor Create; override;

  1400.   end;

  1401. 

  1402.   TfdRGB5 = class(TfdUniversal_US1)

  1403.     constructor Create; override;

  1404.   end;

  1405. 

  1406.   TfdRGB8 = class(TfdRGB_UB3)

  1407.     constructor Create; override;

  1408.   end;

  1409. 

  1410.   TfdRGB10 = class(TfdUniversal_UI1)

  1411.     constructor Create; override;

  1412.   end;

  1413. 

  1414.   TfdRGB12 = class(TfdRGB_US3)

  1415.     constructor Create; override;

  1416.   end;

  1417. 

  1418.   TfdRGB16 = class(TfdRGB_US3)

  1419.     constructor Create; override;

  1420.   end;

  1421. 

  1422.   TfdRGBA2 = class(TfdRGBA_UB4)

  1423.     constructor Create; override;

  1424.   end;

  1425. 

  1426.   TfdRGBA4 = class(TfdUniversal_US1)

  1427.     constructor Create; override;

  1428.   end;

  1429. 

  1430.   TfdRGB5A1 = class(TfdUniversal_US1)

  1431.     constructor Create; override;

  1432.   end;

  1433. 

  1434.   TfdRGBA8 = class(TfdRGBA_UB4)

  1435.     constructor Create; override;

  1436.   end;

  1437. 

  1438.   TfdRGB10A2 = class(TfdUniversal_UI1)

  1439.     constructor Create; override;

  1440.   end;

  1441. 

  1442.   TfdRGBA12 = class(TfdRGBA_US4)

  1443.     constructor Create; override;

  1444.   end;

  1445. 

  1446.   TfdRGBA16 = class(TfdRGBA_US4)

  1447.     constructor Create; override;

  1448.   end;

  1449. 

  1450.   TfdBGR4 = class(TfdUniversal_US1)

  1451.     constructor Create; override;

  1452.   end;

  1453. 

  1454.   TfdB5G6R5 = class(TfdUniversal_US1)

  1455.     constructor Create; override;

  1456.   end;

  1457. 

  1458.   TfdBGR5 = class(TfdUniversal_US1)

  1459.     constructor Create; override;

  1460.   end;

  1461. 

  1462.   TfdBGR8 = class(TfdBGR_UB3)

  1463.     constructor Create; override;

  1464.   end;

  1465. 

  1466.   TfdBGR10 = class(TfdUniversal_UI1)

  1467.     constructor Create; override;

  1468.   end;

  1469. 

  1470.   TfdBGR12 = class(TfdBGR_US3)

  1471.     constructor Create; override;

  1472.   end;

  1473. 

  1474.   TfdBGR16 = class(TfdBGR_US3)

  1475.     constructor Create; override;

  1476.   end;

  1477. 

  1478.   TfdBGRA2 = class(TfdBGRA_UB4)

  1479.     constructor Create; override;

  1480.   end;

  1481. 

  1482.   TfdBGRA4 = class(TfdUniversal_US1)

  1483.     constructor Create; override;

  1484.   end;

  1485. 

  1486.   TfdBGR5A1 = class(TfdUniversal_US1)

  1487.     constructor Create; override;

  1488.   end;

  1489. 

  1490.   TfdBGRA8 = class(TfdBGRA_UB4)

  1491.     constructor Create; override;

  1492.   end;

  1493. 

  1494.   TfdBGR10A2 = class(TfdUniversal_UI1)

  1495.     constructor Create; override;

  1496.   end;

  1497. 

  1498.   TfdBGRA12 = class(TfdBGRA_US4)

  1499.     constructor Create; override;

  1500.   end;

  1501. 

  1502.   TfdBGRA16 = class(TfdBGRA_US4)

  1503.     constructor Create; override;

  1504.   end;

  1505. 

  1506.   TfdDepth16 = class(TfdDepth_US1)

  1507.     constructor Create; override;

  1508.   end;

  1509. 

  1510.   TfdDepth24 = class(TfdDepth_UI1)

  1511.     constructor Create; override;

  1512.   end;

  1513. 

  1514.   TfdDepth32 = class(TfdDepth_UI1)

  1515.     constructor Create; override;

  1516.   end;

  1517. 

  1518.   TfdS3tcDtx1RGBA = class(TFormatDescriptor)

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

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

  1521.     constructor Create; override;

  1522.   end;

  1523. 

  1524.   TfdS3tcDtx3RGBA = class(TFormatDescriptor)

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

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

  1527.     constructor Create; override;

  1528.   end;

  1529. 

  1530.   TfdS3tcDtx5RGBA = class(TFormatDescriptor)

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

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

  1533.     constructor Create; override;

  1534.   end;

  1535. 

  1536. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1537.   TbmpBitfieldFormat = class(TFormatDescriptor)

  1538.   private

  1539.     procedure SetRedMask  (const aValue: QWord);

  1540.     procedure SetGreenMask(const aValue: QWord);

  1541.     procedure SetBlueMask (const aValue: QWord);

  1542.     procedure SetAlphaMask(const aValue: QWord);

  1543. 

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

  1545.   public

  1546.     property RedMask:   QWord read GetRedMask   write SetRedMask;

  1547.     property GreenMask: QWord read GetGreenMask write SetGreenMask;

  1548.     property BlueMask:  QWord read GetBlueMask  write SetBlueMask;

  1549.     property AlphaMask: QWord read GetAlphaMask write SetAlphaMask;

  1550. 

  1551.     property PixelSize: Single read fPixelSize write fPixelSize;

  1552. 

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

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

  1555.   end;

  1556. 

  1557. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1558.   TbmpColorTableEnty = packed record

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

  1560.   end;

  1561.   TbmpColorTable = array of TbmpColorTableEnty;

  1562.   TbmpColorTableFormat = class(TFormatDescriptor)

  1563.   private

  1564.     fColorTable: TbmpColorTable;

  1565.   public

  1566.     property PixelSize:  Single            read fPixelSize  write fPixelSize;

  1567.     property ColorTable: TbmpColorTable    read fColorTable write fColorTable;

  1568.     property Range:      TglBitmapColorRec read fRange      write fRange;

  1569.     property Shift:      TShiftRec         read fShift      write fShift;

  1570.     property Format:     TglBitmapFormat   read fFormat     write fFormat;

  1571. 

  1572.     procedure CreateColorTable;

  1573. 

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

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

  1576.     destructor Destroy; override;

  1577.   end;

  1578. 

  1579. const

  1580.   LUMINANCE_WEIGHT_R = 0.30;

  1581.   LUMINANCE_WEIGHT_G = 0.59;

  1582.   LUMINANCE_WEIGHT_B = 0.11;

  1583. 

  1584.   ALPHA_WEIGHT_R = 0.30;

  1585.   ALPHA_WEIGHT_G = 0.59;

  1586.   ALPHA_WEIGHT_B = 0.11;

  1587. 

  1588.   DEPTH_WEIGHT_R = 0.333333333;

  1589.   DEPTH_WEIGHT_G = 0.333333333;

  1590.   DEPTH_WEIGHT_B = 0.333333333;

  1591. 

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

  1593. 

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

  1595.     TfdEmpty,

  1596. 

  1597.     TfdAlpha4,

  1598.     TfdAlpha8,

  1599.     TfdAlpha12,

  1600.     TfdAlpha16,

  1601. 

  1602.     TfdLuminance4,

  1603.     TfdLuminance8,

  1604.     TfdLuminance12,

  1605.     TfdLuminance16,

  1606. 

  1607.     TfdLuminance4Alpha4,

  1608.     TfdLuminance6Alpha2,

  1609.     TfdLuminance8Alpha8,

  1610.     TfdLuminance12Alpha4,

  1611.     TfdLuminance12Alpha12,

  1612.     TfdLuminance16Alpha16,

  1613. 

  1614.     TfdR3G3B2,

  1615.     TfdRGB4,

  1616.     TfdR5G6B5,

  1617.     TfdRGB5,

  1618.     TfdRGB8,

  1619.     TfdRGB10,

  1620.     TfdRGB12,

  1621.     TfdRGB16,

  1622. 

  1623.     TfdRGBA2,

  1624.     TfdRGBA4,

  1625.     TfdRGB5A1,

  1626.     TfdRGBA8,

  1627.     TfdRGB10A2,

  1628.     TfdRGBA12,

  1629.     TfdRGBA16,

  1630. 

  1631.     TfdBGR4,

  1632.     TfdB5G6R5,

  1633.     TfdBGR5,

  1634.     TfdBGR8,

  1635.     TfdBGR10,

  1636.     TfdBGR12,

  1637.     TfdBGR16,

  1638. 

  1639.     TfdBGRA2,

  1640.     TfdBGRA4,

  1641.     TfdBGR5A1,

  1642.     TfdBGRA8,

  1643.     TfdBGR10A2,

  1644.     TfdBGRA12,

  1645.     TfdBGRA16,

  1646. 

  1647.     TfdDepth16,

  1648.     TfdDepth24,

  1649.     TfdDepth32,

  1650. 

  1651.     TfdS3tcDtx1RGBA,

  1652.     TfdS3tcDtx3RGBA,

  1653.     TfdS3tcDtx5RGBA

  1654.   );

  1655. 

  1656. var

  1657.   FormatDescriptorCS: TCriticalSection;

  1658.   FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;

  1659. 

  1660. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  1662. begin

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

  1664. end;

  1665. 

  1666. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  1668. begin

  1669.   result.Fields := [];

  1670. 

  1671.   if X >= 0 then

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

  1673.   if Y >= 0 then

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

  1675. 

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

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

  1678. end;

  1679. 

  1680. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  1682. begin

  1683.   result.r := r;

  1684.   result.g := g;

  1685.   result.b := b;

  1686.   result.a := a;

  1687. end;

  1688. 

  1689. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  1691. var

  1692.   i: Integer;

  1693. begin

  1694.   result := false;

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

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

  1697.       exit;

  1698.   result := true;

  1699. end;

  1700. 

  1701. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  1703. begin

  1704.   result.r := r;

  1705.   result.g := g;

  1706.   result.b := b;

  1707.   result.a := a;

  1708. end;

  1709. 

  1710. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  1712. begin

  1713.   result := [];

  1714. 

  1715.   if (aFormat in [

  1716.         //4 bbp

  1717.         tfLuminance4,

  1718. 

  1719.         //8bpp

  1720.         tfR3G3B2, tfLuminance8,

  1721. 

  1722.         //16bpp

  1723.         tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,

  1724.         tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,

  1725. 

  1726.         //24bpp

  1727.         tfBGR8, tfRGB8,

  1728. 

  1729.         //32bpp

  1730.         tfRGB10, tfRGB10A2, tfRGBA8,

  1731.         tfBGR10, tfBGR10A2, tfBGRA8]) then

  1732.     result := result + [ftBMP];

  1733. 

  1734.   if (aFormat in [

  1735.         //8 bpp

  1736.         tfLuminance8, tfAlpha8,

  1737. 

  1738.         //16 bpp

  1739.         tfLuminance16, tfLuminance8Alpha8,

  1740.         tfRGB5, tfRGB5A1, tfRGBA4,

  1741.         tfBGR5, tfBGR5A1, tfBGRA4,

  1742. 

  1743.         //24 bpp

  1744.         tfRGB8, tfBGR8,

  1745. 

  1746.         //32 bpp

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

  1748.     result := result + [ftTGA];

  1749. 

  1750.   if (aFormat in [

  1751.         //8 bpp

  1752.         tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,

  1753.         tfR3G3B2, tfRGBA2, tfBGRA2,

  1754. 

  1755.         //16 bpp

  1756.         tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,

  1757.         tfRGB4, tfR5G6B5, tfRGB5, tfRGBA4, tfRGB5A1,

  1758.         tfBGR4, tfB5G6R5, tfBGR5, tfBGRA4, tfBGR5A1,

  1759. 

  1760.         //24 bpp

  1761.         tfRGB8, tfBGR8,

  1762. 

  1763.         //32 bbp

  1764.         tfLuminance16Alpha16,

  1765.         tfRGBA8, tfRGB10A2,

  1766.         tfBGRA8, tfBGR10A2,

  1767. 

  1768.         //compressed

  1769.         tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then

  1770.     result := result + [ftDDS];

  1771. 

  1772.   {$IFDEF GLB_SUPPORT_PNG_WRITE}

  1773.   if aFormat in [

  1774.       tfAlpha8, tfLuminance8, tfLuminance8Alpha8,

  1775.       tfRGB8, tfRGBA8,

  1776.       tfBGR8, tfBGRA8] then

  1777.     result := result + [ftPNG];

  1778.   {$ENDIF}

  1779. 

  1780.   {$IFDEF GLB_SUPPORT_JPEG_WRITE}

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

  1782.     result := result + [ftJPEG];

  1783.   {$ENDIF}

  1784. end;

  1785. 

  1786. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  1788. begin

  1789.   while (aNumber and 1) = 0 do

  1790.     aNumber := aNumber shr 1;

  1791.   result := aNumber = 1;

  1792. end;

  1793. 

  1794. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  1796. begin

  1797.   result := 0;

  1798.   while aBitSet > 0 do begin

  1799.     inc(result);

  1800.     aBitSet := aBitSet shr 1;

  1801.   end;

  1802. end;

  1803. 

  1804. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  1806. begin

  1807.   result := 0;

  1808.   while aBitSet > 0 do begin

  1809.     if (aBitSet and 1) = 1 then

  1810.       inc(result);

  1811.     aBitSet := aBitSet shr 1;

  1812.   end;

  1813. end;

  1814. 

  1815. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  1817. begin

  1818.   result := Trunc(

  1819.     LUMINANCE_WEIGHT_R * aPixel.Data.r +

  1820.     LUMINANCE_WEIGHT_G * aPixel.Data.g +

  1821.     LUMINANCE_WEIGHT_B * aPixel.Data.b);

  1822. end;

  1823. 

  1824. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  1826. begin

  1827.   result := Trunc(

  1828.     DEPTH_WEIGHT_R * aPixel.Data.r +

  1829.     DEPTH_WEIGHT_G * aPixel.Data.g +

  1830.     DEPTH_WEIGHT_B * aPixel.Data.b);

  1831. end;

  1832. 

  1833. {$IFDEF GLB_NATIVE_OGL}

  1834. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1835. //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1836. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1837. var

  1838.   GL_LibHandle: Pointer = nil;

  1839. 

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

  1841. begin

  1842.   result :=  nil;

  1843. 

  1844.   if not Assigned(aLibHandle) then

  1845.     aLibHandle := GL_LibHandle;

  1846. 

  1847. {$IF DEFINED(GLB_WIN)}

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

  1849.   if Assigned(result) then

  1850.     exit;

  1851. 

  1852.   if Assigned(wglGetProcAddress) then

  1853.     result := wglGetProcAddress(aProcName);

  1854. {$ELSEIF DEFINED(GLB_LINUX)}

  1855.   if Assigned(glXGetProcAddress) then begin

  1856.     result := glXGetProcAddress(aProcName);

  1857.     if Assigned(result) then

  1858.       exit;

  1859.   end;

  1860. 

  1861.   if Assigned(glXGetProcAddressARB) then begin

  1862.     result := glXGetProcAddressARB(aProcName);

  1863.     if Assigned(result) then

  1864.       exit;

  1865.   end;

  1866. 

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

  1868. {$ENDIF}

  1869.   if not Assigned(result) then

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

  1871. end;

  1872. 

  1873. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}

  1874. var

  1875.   GLU_LibHandle: Pointer = nil;

  1876.   OpenGLInitialized: Boolean;

  1877.   InitOpenGLCS: TCriticalSection;

  1878. 

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

  1880. procedure glbInitOpenGL;

  1881. 

  1882.   ////////////////////////////////////////////////////////////////////////////////

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

  1884.   begin

  1885.     {$IF DEFINED(GLB_WIN)}

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

  1887.     {$ELSEIF DEFINED(GLB_LINUX)}

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

  1889.     {$ELSE}

  1890.     result := nil;

  1891.     {$ENDIF}

  1892.   end;

  1893. 

  1894.   ////////////////////////////////////////////////////////////////////////////////

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

  1896.   begin

  1897.     result := false;

  1898.     if not Assigned(aLibHandle) then

  1899.       exit;

  1900. 

  1901.     {$IF DEFINED(GLB_WIN)}

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

  1903.     {$ELSEIF DEFINED(GLB_LINUX)}

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

  1905.     {$ENDIF}

  1906.   end;

  1907. 

  1908. begin

  1909.   if Assigned(GL_LibHandle) then

  1910.     glbFreeLibrary(GL_LibHandle);

  1911. 

  1912.   if Assigned(GLU_LibHandle) then

  1913.     glbFreeLibrary(GLU_LibHandle);

  1914. 

  1915.   GL_LibHandle := glbLoadLibrary(libopengl);

  1916.   if not Assigned(GL_LibHandle) then

  1917.     raise EglBitmapException.Create('unable to load library: ' + libopengl);

  1918. 

  1919.   GLU_LibHandle := glbLoadLibrary(libglu);

  1920.   if not Assigned(GLU_LibHandle) then

  1921.     raise EglBitmapException.Create('unable to load library: ' + libglu);

  1922. 

  1923.   try

  1924.   {$IF DEFINED(GLB_WIN)}

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

  1926.   {$ELSEIF DEFINED(GLB_LINUX)}

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

  1928.     glXGetProcAddressARB := dglGetProcAddress('glXGetProcAddressARB');

  1929.   {$ENDIF}

  1930. 

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

  1950. 

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

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

  1953.   finally

  1954.     glbFreeLibrary(GL_LibHandle);

  1955.     glbFreeLibrary(GLU_LibHandle);

  1956.   end;

  1957. end;

  1958. {$ENDIF}

  1959. 

  1960. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1961. procedure glbReadOpenGLExtensions;

  1962. var

  1963.   {$IFDEF GLB_DELPHI}

  1964.   Context: HGLRC;

  1965.   {$ENDIF}

  1966.   Buffer: AnsiString;

  1967.   MajorVersion, MinorVersion: Integer;

  1968. 

  1969.   ///////////////////////////////////////////////////////////////////////////////////////////

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

  1971.   var

  1972.     Separator: Integer;

  1973.   begin

  1974.     aMinor := 0;

  1975.     aMajor := 0;

  1976. 

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

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

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

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

  1981. 

  1982.       Dec(Separator);

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

  1984.         Dec(Separator);

  1985. 

  1986.       Delete(aBuffer, 1, Separator);

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

  1988. 

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

  1990.         Inc(Separator);

  1991. 

  1992.       Delete(aBuffer, Separator, 255);

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

  1994. 

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

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

  1997.     end;

  1998.   end;

  1999. 

  2000.   ///////////////////////////////////////////////////////////////////////////////////////////

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

  2002.   var

  2003.     ExtPos: Integer;

  2004.   begin

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

  2006.     result := ExtPos > 0;

  2007.     if result then

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

  2009.   end;

  2010. 

  2011. begin

  2012. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}

  2013.   InitOpenGLCS.Enter;

  2014.   try

  2015.     if not OpenGLInitialized then begin

  2016.       glbInitOpenGL;

  2017.       OpenGLInitialized := true;

  2018.     end;

  2019.   finally

  2020.     InitOpenGLCS.Leave;

  2021.   end;

  2022. {$ENDIF}

  2023. 

  2024. {$IFDEF GLB_DELPHI}

  2025.   Context := wglGetCurrentContext;

  2026.   if (Context <> gLastContext) then begin

  2027.     gLastContext := Context;

  2028. {$ENDIF}

  2029. 

  2030.     // Version

  2031.     Buffer := glGetString(GL_VERSION);

  2032.     TrimVersionString(Buffer, MajorVersion, MinorVersion);

  2033. 

  2034.     GL_VERSION_1_2 := false;

  2035.     GL_VERSION_1_3 := false;

  2036.     GL_VERSION_1_4 := false;

  2037.     GL_VERSION_2_0 := false;

  2038.     if MajorVersion = 1 then begin

  2039.       if MinorVersion >= 2 then

  2040.         GL_VERSION_1_2 := true;

  2041. 

  2042.       if MinorVersion >= 3 then

  2043.         GL_VERSION_1_3 := true;

  2044. 

  2045.       if MinorVersion >= 4 then

  2046.         GL_VERSION_1_4 := true;

  2047.     end else if MajorVersion >= 2 then begin

  2048.       GL_VERSION_1_2 := true;

  2049.       GL_VERSION_1_3 := true;

  2050.       GL_VERSION_1_4 := true;

  2051.       GL_VERSION_2_0 := true;

  2052.     end;

  2053. 

  2054.     // Extensions

  2055.     Buffer := glGetString(GL_EXTENSIONS);

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

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

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

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

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

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

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

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

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

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

  2066. 

  2067.     if GL_VERSION_1_3 then begin

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

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

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

  2071.     end else begin

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

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

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

  2075.     end;

  2076. {$IFDEF GLB_DELPHI}

  2077.   end;

  2078. {$ENDIF}

  2079. end;

  2080. {$ENDIF}

  2081. 

  2082. (* TODO GLB_DELPHI

  2083. {$IFDEF GLB_DELPHI}

  2084. function CreateGrayPalette: HPALETTE;

  2085. var

  2086.   Idx: Integer;

  2087.   Pal: PLogPalette;

  2088. begin

  2089.   GetMem(Pal, SizeOf(TLogPalette) + (SizeOf(TPaletteEntry) * 256));

  2090. 

  2091.   Pal.palVersion := $300;

  2092.   Pal.palNumEntries := 256;

  2093. 

  2094.   {$IFOPT R+}

  2095.     {$DEFINE GLB_TEMPRANGECHECK}

  2096.     {$R-}

  2097.   {$ENDIF}

  2098. 

  2099.   for Idx := 0 to 256 - 1 do begin

  2100.     Pal.palPalEntry[Idx].peRed   := Idx;

  2101.     Pal.palPalEntry[Idx].peGreen := Idx;

  2102.     Pal.palPalEntry[Idx].peBlue  := Idx;

  2103.     Pal.palPalEntry[Idx].peFlags := 0;

  2104.   end;

  2105. 

  2106.   {$IFDEF GLB_TEMPRANGECHECK}

  2107.     {$UNDEF GLB_TEMPRANGECHECK}

  2108.     {$R+}

  2109.   {$ENDIF}

  2110. 

  2111.   result := CreatePalette(Pal^);

  2112. 

  2113.   FreeMem(Pal);

  2114. end;

  2115. {$ENDIF}

  2116. *)

  2117. 

  2118. {$IFDEF GLB_SDL_IMAGE}

  2119. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2120. // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2121. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2123. begin

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

  2125. end;

  2126. 

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

  2128. begin

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

  2130. end;

  2131. 

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

  2133. begin

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

  2135. end;

  2136. 

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

  2138. begin

  2139.   result := 0;

  2140. end;

  2141. 

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

  2143. begin

  2144.   result := SDL_AllocRW;

  2145. 

  2146.   if result = nil then

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

  2148. 

  2149.   result^.seek := glBitmapRWseek;

  2150.   result^.read := glBitmapRWread;

  2151.   result^.write := glBitmapRWwrite;

  2152.   result^.close := glBitmapRWclose;

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

  2154. end;

  2155. {$ENDIF}

  2156. 

  2157. (* TODO LoadFuncs

  2158. function LoadTexture(Filename: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal{$ENDIF}): Boolean;

  2159. var

  2160.   glBitmap: TglBitmap2D;

  2161. begin

  2162.   result := false;

  2163.   Texture := 0;

  2164. 

  2165.   {$IFDEF GLB_DELPHI}

  2166.   if Instance = 0 then

  2167.     Instance := HInstance;

  2168. 

  2169.   if (LoadFromRes) then

  2170.     glBitmap := TglBitmap2D.CreateFromResourceName(Instance, FileName)

  2171.   else

  2172.   {$ENDIF}

  2173.     glBitmap := TglBitmap2D.Create(FileName);

  2174. 

  2175.   try

  2176.     glBitmap.DeleteTextureOnFree := false;

  2177.     glBitmap.FreeDataAfterGenTexture := false;

  2178.     glBitmap.GenTexture(true);

  2179.     if (glBitmap.ID > 0) then begin

  2180.       Texture := glBitmap.ID;

  2181.       result := true;

  2182.     end;

  2183.   finally

  2184.     glBitmap.Free;

  2185.   end;

  2186. end;

  2187. 

  2188. function LoadCubeMap(PositiveX, NegativeX, PositiveY, NegativeY, PositiveZ, NegativeZ: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal{$ENDIF}): Boolean;

  2189. var

  2190.   CM: TglBitmapCubeMap;

  2191. begin

  2192.   Texture := 0;

  2193. 

  2194.   {$IFDEF GLB_DELPHI}

  2195.   if Instance = 0 then

  2196.     Instance := HInstance;

  2197.   {$ENDIF}

  2198. 

  2199.   CM := TglBitmapCubeMap.Create;

  2200.   try

  2201.     CM.DeleteTextureOnFree := false;

  2202. 

  2203.     // Maps

  2204.     {$IFDEF GLB_DELPHI}

  2205.     if (LoadFromRes) then

  2206.       CM.LoadFromResource(Instance, PositiveX)

  2207.     else

  2208.     {$ENDIF}

  2209.       CM.LoadFromFile(PositiveX);

  2210.     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X);

  2211. 

  2212.     {$IFDEF GLB_DELPHI}

  2213.     if (LoadFromRes) then

  2214.       CM.LoadFromResource(Instance, NegativeX)

  2215.     else

  2216.     {$ENDIF}

  2217.       CM.LoadFromFile(NegativeX);

  2218.     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X);

  2219. 

  2220.     {$IFDEF GLB_DELPHI}

  2221.     if (LoadFromRes) then

  2222.       CM.LoadFromResource(Instance, PositiveY)

  2223.     else

  2224.     {$ENDIF}

  2225.       CM.LoadFromFile(PositiveY);

  2226.     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y);

  2227. 

  2228.     {$IFDEF GLB_DELPHI}

  2229.     if (LoadFromRes) then

  2230.       CM.LoadFromResource(Instance, NegativeY)

  2231.     else

  2232.     {$ENDIF}

  2233.       CM.LoadFromFile(NegativeY);

  2234.     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y);

  2235. 

  2236.     {$IFDEF GLB_DELPHI}

  2237.     if (LoadFromRes) then

  2238.       CM.LoadFromResource(Instance, PositiveZ)

  2239.     else

  2240.     {$ENDIF}

  2241.       CM.LoadFromFile(PositiveZ);

  2242.     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z);

  2243. 

  2244.     {$IFDEF GLB_DELPHI}

  2245.     if (LoadFromRes) then

  2246.       CM.LoadFromResource(Instance, NegativeZ)

  2247.     else

  2248.     {$ENDIF}

  2249.       CM.LoadFromFile(NegativeZ);

  2250.     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z);

  2251. 

  2252.     Texture := CM.ID;

  2253.     result := true;

  2254.   finally

  2255.     CM.Free;

  2256.   end;

  2257. end;

  2258. 

  2259. function LoadNormalMap(Size: Integer; var Texture: Cardinal): Boolean;

  2260. var

  2261.   NM: TglBitmapNormalMap;

  2262. begin

  2263.   Texture := 0;

  2264. 

  2265.   NM := TglBitmapNormalMap.Create;

  2266.   try

  2267.     NM.DeleteTextureOnFree := false;

  2268.     NM.GenerateNormalMap(Size);

  2269. 

  2270.     Texture := NM.ID;

  2271.     result := true;

  2272.   finally

  2273.     NM.Free;

  2274.   end;

  2275. end;

  2276. *)

  2277. 

  2278. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2279. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);

  2280. begin

  2281.   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;

  2282. end;

  2283. 

  2284. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2285. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);

  2286. begin

  2287.   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;

  2288. end;

  2289. 

  2290. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2291. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);

  2292. begin

  2293.   glBitmapDefaultMipmap := aValue;

  2294. end;

  2295. 

  2296. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2297. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);

  2298. begin

  2299.   glBitmapDefaultFormat := aFormat;

  2300. end;

  2301. 

  2302. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2304. begin

  2305.   glBitmapDefaultFilterMin := aMin;

  2306.   glBitmapDefaultFilterMag := aMag;

  2307. end;

  2308. 

  2309. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2311. begin

  2312.   glBitmapDefaultWrapS := S;

  2313.   glBitmapDefaultWrapT := T;

  2314.   glBitmapDefaultWrapR := R;

  2315. end;

  2316. 

  2317. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2318. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;

  2319. begin

  2320.   result := glBitmapDefaultDeleteTextureOnFree;

  2321. end;

  2322. 

  2323. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2324. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;

  2325. begin

  2326.   result := glBitmapDefaultFreeDataAfterGenTextures;

  2327. end;

  2328. 

  2329. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2330. function glBitmapGetDefaultMipmap: TglBitmapMipMap;

  2331. begin

  2332.   result := glBitmapDefaultMipmap;

  2333. end;

  2334. 

  2335. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2336. function glBitmapGetDefaultFormat: TglBitmapFormat;

  2337. begin

  2338.   result := glBitmapDefaultFormat;

  2339. end;

  2340. 

  2341. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2343. begin

  2344.   aMin := glBitmapDefaultFilterMin;

  2345.   aMag := glBitmapDefaultFilterMag;

  2346. end;

  2347. 

  2348. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2350. begin

  2351.   S := glBitmapDefaultWrapS;

  2352.   T := glBitmapDefaultWrapT;

  2353.   R := glBitmapDefaultWrapR;

  2354. end;

  2355. 

  2356. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2357. //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2358. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2359. function TFormatDescriptor.GetRedMask: QWord;

  2360. begin

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

  2362. end;

  2363. 

  2364. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2365. function TFormatDescriptor.GetGreenMask: QWord;

  2366. begin

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

  2368. end;

  2369. 

  2370. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2371. function TFormatDescriptor.GetBlueMask: QWord;

  2372. begin

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

  2374. end;

  2375. 

  2376. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2377. function TFormatDescriptor.GetAlphaMask: QWord;

  2378. begin

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

  2380. end;

  2381. 

  2382. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2383. function TFormatDescriptor.GetComponents: Integer;

  2384. var

  2385.   i: Integer;

  2386. begin

  2387.   result := 0;

  2388.   for i := 0 to 3 do

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

  2390.       inc(result);

  2391. end;

  2392. 

  2393. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2395. var

  2396.   w, h: Integer;

  2397. begin

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

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

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

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

  2402.   end else

  2403.     result := 0;

  2404. end;

  2405. 

  2406. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2408. begin

  2409.   result := 0;

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

  2411.     exit;

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

  2413. end;

  2414. 

  2415. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2416. function TFormatDescriptor.CreateMappingData: Pointer;

  2417. begin

  2418.   result := nil;

  2419. end;

  2420. 

  2421. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2423. begin

  2424.   //DUMMY

  2425. end;

  2426. 

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

  2428. function TFormatDescriptor.IsEmpty: Boolean;

  2429. begin

  2430.   result := (fFormat = tfEmpty);

  2431. end;

  2432. 

  2433. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2434. function TFormatDescriptor.HasAlpha: Boolean;

  2435. begin

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

  2437. end;

  2438. 

  2439. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2441. begin

  2442.   result := false;

  2443. 

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

  2445.     raise EglBitmapException.Create('FormatCheckFormat - All Masks are 0');

  2446. 

  2447.   if (aRedMask   <> RedMask) then

  2448.     exit;

  2449.   if (aGreenMask <> GreenMask) then

  2450.     exit;

  2451.   if (aBlueMask  <> BlueMask) then

  2452.     exit;

  2453.   if (aAlphaMask <> AlphaMask) then

  2454.     exit;

  2455.   result := true;

  2456. end;

  2457. 

  2458. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2460. begin

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

  2462.   aPixel.Data   := fRange;

  2463.   aPixel.Range  := fRange;

  2464.   aPixel.Format := fFormat;

  2465. end;

  2466. 

  2467. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2468. constructor TFormatDescriptor.Create;

  2469. begin

  2470.   inherited Create;

  2471. 

  2472.   fFormat       := tfEmpty;

  2473.   fWithAlpha    := tfEmpty;

  2474.   fWithoutAlpha := tfEmpty;

  2475.   fRGBInverted  := tfEmpty;

  2476.   fUncompressed := tfEmpty;

  2477.   fPixelSize    := 0.0;

  2478.   fIsCompressed := false;

  2479. 

  2480.   fglFormat         := 0;

  2481.   fglInternalFormat := 0;

  2482.   fglDataFormat     := 0;

  2483. 

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

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

  2486. end;

  2487. 

  2488. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2489. //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2490. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2492. begin

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

  2494.   inc(aData);

  2495. end;

  2496. 

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

  2498. begin

  2499.   aPixel.Data.r := 0;

  2500.   aPixel.Data.g := 0;

  2501.   aPixel.Data.b := 0;

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

  2503.   inc(aData^);

  2504. end;

  2505. 

  2506. constructor TfdAlpha_UB1.Create;

  2507. begin

  2508.   inherited Create;

  2509.   fPixelSize        := 1.0;

  2510.   fRange.a          := $FF;

  2511.   fglFormat         := GL_ALPHA;

  2512.   fglDataFormat     := GL_UNSIGNED_BYTE;

  2513. end;

  2514. 

  2515. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2516. //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2517. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2519. begin

  2520.   aData^ := LuminanceWeight(aPixel);

  2521.   inc(aData);

  2522. end;

  2523. 

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

  2525. begin

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

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

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

  2529.   aPixel.Data.a := 0;

  2530.   inc(aData);

  2531. end;

  2532. 

  2533. constructor TfdLuminance_UB1.Create;

  2534. begin

  2535.   inherited Create;

  2536.   fPixelSize        := 1.0;

  2537.   fRange.r          := $FF;

  2538.   fRange.g          := $FF;

  2539.   fRange.b          := $FF;

  2540.   fglFormat         := GL_LUMINANCE;

  2541.   fglDataFormat     := GL_UNSIGNED_BYTE;

  2542. end;

  2543. 

  2544. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2545. //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2546. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2548. var

  2549.   i: Integer;

  2550. begin

  2551.   aData^ := 0;

  2552.   for i := 0 to 3 do

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

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

  2555.   inc(aData);

  2556. end;

  2557. 

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

  2559. var

  2560.   i: Integer;

  2561. begin

  2562.   for i := 0 to 3 do

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

  2564.   inc(aData);

  2565. end;

  2566. 

  2567. constructor TfdUniversal_UB1.Create;

  2568. begin

  2569.   inherited Create;

  2570.   fPixelSize := 1.0;

  2571. end;

  2572. 

  2573. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2574. //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2575. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2577. begin

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

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

  2580.   inc(aData);

  2581. end;

  2582. 

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

  2584. begin

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

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

  2587.   inc(aData);

  2588. end;

  2589. 

  2590. constructor TfdLuminanceAlpha_UB2.Create;

  2591. begin

  2592.   inherited Create;

  2593.   fPixelSize        := 2.0;

  2594.   fRange.a          := $FF;

  2595.   fShift.a          :=   8;

  2596.   fglFormat         := GL_LUMINANCE_ALPHA;

  2597.   fglDataFormat     := GL_UNSIGNED_BYTE;

  2598. end;

  2599. 

  2600. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2601. //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2602. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2604. begin

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

  2606.   inc(aData);

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

  2608.   inc(aData);

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

  2610.   inc(aData);

  2611. end;

  2612. 

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

  2614. begin

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

  2616.   inc(aData);

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

  2618.   inc(aData);

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

  2620.   inc(aData);

  2621.   aPixel.Data.a := 0;

  2622. end;

  2623. 

  2624. constructor TfdRGB_UB3.Create;

  2625. begin

  2626.   inherited Create;

  2627.   fPixelSize        := 3.0;

  2628.   fRange.r          := $FF;

  2629.   fRange.g          := $FF;

  2630.   fRange.b          := $FF;

  2631.   fShift.r          :=   0;

  2632.   fShift.g          :=   8;

  2633.   fShift.b          :=  16;

  2634.   fglFormat         := GL_RGB;

  2635.   fglDataFormat     := GL_UNSIGNED_BYTE;

  2636. end;

  2637. 

  2638. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2639. //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2640. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2642. begin

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

  2644.   inc(aData);

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

  2646.   inc(aData);

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

  2648.   inc(aData);

  2649. end;

  2650. 

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

  2652. begin

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

  2654.   inc(aData);

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

  2656.   inc(aData);

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

  2658.   inc(aData);

  2659.   aPixel.Data.a := 0;

  2660. end;

  2661. 

  2662. constructor TfdBGR_UB3.Create;

  2663. begin

  2664.   fPixelSize        := 3.0;

  2665.   fRange.r          := $FF;

  2666.   fRange.g          := $FF;

  2667.   fRange.b          := $FF;

  2668.   fShift.r          :=  16;

  2669.   fShift.g          :=   8;

  2670.   fShift.b          :=   0;

  2671.   fglFormat         := GL_BGR;

  2672.   fglDataFormat     := GL_UNSIGNED_BYTE;

  2673. end;

  2674. 

  2675. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2676. //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2677. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2679. begin

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

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

  2682.   inc(aData);

  2683. end;

  2684. 

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

  2686. begin

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

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

  2689.   inc(aData);

  2690. end;

  2691. 

  2692. constructor TfdRGBA_UB4.Create;

  2693. begin

  2694.   inherited Create;

  2695.   fPixelSize        := 4.0;

  2696.   fRange.a          := $FF;

  2697.   fShift.a          :=  24;

  2698.   fglFormat         := GL_RGBA;

  2699.   fglDataFormat     := GL_UNSIGNED_BYTE;

  2700. end;

  2701. 

  2702. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2703. //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2704. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2706. begin

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

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

  2709.   inc(aData);

  2710. end;

  2711. 

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

  2713. begin

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

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

  2716.   inc(aData);

  2717. end;

  2718. 

  2719. constructor TfdBGRA_UB4.Create;

  2720. begin

  2721.   inherited Create;

  2722.   fPixelSize        := 4.0;

  2723.   fRange.a          := $FF;

  2724.   fShift.a          :=  24;

  2725.   fglFormat         := GL_BGRA;

  2726.   fglDataFormat     := GL_UNSIGNED_BYTE;

  2727. end;

  2728. 

  2729. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2730. //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2731. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2733. begin

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

  2735.   inc(aData, 2);

  2736. end;

  2737. 

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

  2739. begin

  2740.   aPixel.Data.r := 0;

  2741.   aPixel.Data.g := 0;

  2742.   aPixel.Data.b := 0;

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

  2744.   inc(aData, 2);

  2745. end;

  2746. 

  2747. constructor TfdAlpha_US1.Create;

  2748. begin

  2749.   inherited Create;

  2750.   fPixelSize        := 2.0;

  2751.   fRange.a          := $FFFF;

  2752.   fglFormat         := GL_ALPHA;

  2753.   fglDataFormat     := GL_UNSIGNED_SHORT;

  2754. end;

  2755. 

  2756. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2757. //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2758. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2760. begin

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

  2762.   inc(aData, 2);

  2763. end;

  2764. 

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

  2766. begin

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

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

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

  2770.   aPixel.Data.a := 0;

  2771.   inc(aData, 2);

  2772. end;

  2773. 

  2774. constructor TfdLuminance_US1.Create;

  2775. begin

  2776.   inherited Create;

  2777.   fPixelSize        := 2.0;

  2778.   fRange.r          := $FFFF;

  2779.   fRange.g          := $FFFF;

  2780.   fRange.b          := $FFFF;

  2781.   fglFormat         := GL_LUMINANCE;

  2782.   fglDataFormat     := GL_UNSIGNED_SHORT;

  2783. end;

  2784. 

  2785. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2786. //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2787. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2789. var

  2790.   i: Integer;

  2791. begin

  2792.   PWord(aData)^ := 0;

  2793.   for i := 0 to 3 do

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

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

  2796.   inc(aData, 2);

  2797. end;

  2798. 

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

  2800. var

  2801.   i: Integer;

  2802. begin

  2803.   for i := 0 to 3 do

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

  2805.   inc(aData, 2);

  2806. end;

  2807. 

  2808. constructor TfdUniversal_US1.Create;

  2809. begin

  2810.   inherited Create;

  2811.   fPixelSize := 2.0;

  2812. end;

  2813. 

  2814. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2815. //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2816. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2818. begin

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

  2820.   inc(aData, 2);

  2821. end;

  2822. 

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

  2824. begin

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

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

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

  2828.   aPixel.Data.a := 0;

  2829.   inc(aData, 2);

  2830. end;

  2831. 

  2832. constructor TfdDepth_US1.Create;

  2833. begin

  2834.   inherited Create;

  2835.   fPixelSize        := 2.0;

  2836.   fRange.r          := $FFFF;

  2837.   fRange.g          := $FFFF;

  2838.   fRange.b          := $FFFF;

  2839.   fglFormat         := GL_DEPTH_COMPONENT;

  2840.   fglDataFormat     := GL_UNSIGNED_SHORT;

  2841. end;

  2842. 

  2843. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2844. //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2845. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2847. begin

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

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

  2850.   inc(aData, 2);

  2851. end;

  2852. 

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

  2854. begin

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

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

  2857.   inc(aData, 2);

  2858. end;

  2859. 

  2860. constructor TfdLuminanceAlpha_US2.Create;

  2861. begin

  2862.   inherited Create;

  2863.   fPixelSize        :=   4.0;

  2864.   fRange.a          := $FFFF;

  2865.   fShift.a          :=    16;

  2866.   fglFormat         := GL_LUMINANCE_ALPHA;

  2867.   fglDataFormat     := GL_UNSIGNED_SHORT;

  2868. end;

  2869. 

  2870. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2871. //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2872. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2874. begin

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

  2876.   inc(aData, 2);

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

  2878.   inc(aData, 2);

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

  2880.   inc(aData, 2);

  2881. end;

  2882. 

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

  2884. begin

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

  2886.   inc(aData, 2);

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

  2888.   inc(aData, 2);

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

  2890.   inc(aData, 2);

  2891.   aPixel.Data.a := 0;

  2892. end;

  2893. 

  2894. constructor TfdRGB_US3.Create;

  2895. begin

  2896.   inherited Create;

  2897.   fPixelSize        :=   6.0;

  2898.   fRange.r          := $FFFF;

  2899.   fRange.g          := $FFFF;

  2900.   fRange.b          := $FFFF;

  2901.   fShift.r          :=     0;

  2902.   fShift.g          :=    16;

  2903.   fShift.b          :=    32;

  2904.   fglFormat         := GL_RGB;

  2905.   fglDataFormat     := GL_UNSIGNED_SHORT;

  2906. end;

  2907. 

  2908. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2909. //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

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

  2912. begin

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

  2914.   inc(aData, 2);

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

  2916.   inc(aData, 2);

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

  2918.   inc(aData, 2);

  2919. end;

  2920. 

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

  2922. begin

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

  2924.   inc(aData, 2);

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

  2926.   inc(aData, 2);

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

  2928.   inc(aData, 2);

  2929.   aPixel.Data.a := 0;

  2930. end;

  2931. 

  2932. constructor TfdBGR_US3.Create;

  2933. begin

  2934.   inherited Create;

  2935.   fPixelSize        :=   6.0;

  2936.   fRange.r          := $FFFF;

  2937.   fRange.g          := $FFFF;

  2938.   fRange.b          := $FFFF;

  2939.   fShift.r          :=    32;

  2940.   fShift.g          :=    16;

  2941.   fShift.b          :=     0;

  2942.   fglFormat         := GL_BGR;

  2943.   fglDataFormat     := GL_UNSIGNED_SHORT;

  2944. end;

  2945. 

  2946. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2947. //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2948. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2950. begin

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

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

  2953.   inc(aData, 2);

  2954. end;

  2955. 

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

  2957. begin

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

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

  2960.   inc(aData, 2);

  2961. end;

  2962. 

  2963. constructor TfdRGBA_US4.Create;

  2964. begin

  2965.   inherited Create;

  2966.   fPixelSize        :=   8.0;

  2967.   fRange.a          := $FFFF;

  2968.   fShift.a          :=    48;

  2969.   fglFormat         := GL_RGBA;

  2970.   fglDataFormat     := GL_UNSIGNED_SHORT;

  2971. end;

  2972. 

  2973. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2974. //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2975. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2977. begin

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

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

  2980.   inc(aData, 2);

  2981. end;

  2982. 

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

  2984. begin

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

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

  2987.   inc(aData, 2);

  2988. end;

  2989. 

  2990. constructor TfdBGRA_US4.Create;

  2991. begin

  2992.   inherited Create;

  2993.   fPixelSize        :=   8.0;

  2994.   fRange.a          := $FFFF;

  2995.   fShift.a          :=    48;

  2996.   fglFormat         := GL_BGRA;

  2997.   fglDataFormat     := GL_UNSIGNED_SHORT;

  2998. end;

  2999. 

  3000. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3001. //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3002. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  3004. var

  3005.   i: Integer;

  3006. begin

  3007.   PCardinal(aData)^ := 0;

  3008.   for i := 0 to 3 do

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

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

  3011.   inc(aData, 4);

  3012. end;

  3013. 

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

  3015. var

  3016.   i: Integer;

  3017. begin

  3018.   for i := 0 to 3 do

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

  3020.   inc(aData, 2);

  3021. end;

  3022. 

  3023. constructor TfdUniversal_UI1.Create;

  3024. begin

  3025.   inherited Create;

  3026.   fPixelSize := 4.0;

  3027. end;

  3028. 

  3029. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3030. //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3031. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  3033. begin

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

  3035.   inc(aData, 4);

  3036. end;

  3037. 

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

  3039. begin

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

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

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

  3043.   aPixel.Data.a := 0;

  3044.   inc(aData, 4);

  3045. end;

  3046. 

  3047. constructor TfdDepth_UI1.Create;

  3048. begin

  3049.   inherited Create;

  3050.   fPixelSize        := 4.0;

  3051.   fRange.r          := $FFFFFFFF;

  3052.   fRange.g          := $FFFFFFFF;

  3053.   fRange.b          := $FFFFFFFF;

  3054.   fglFormat         := GL_DEPTH_COMPONENT;

  3055.   fglDataFormat     := GL_UNSIGNED_INT;

  3056. end;

  3057. 

  3058. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3059. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3060. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3061. constructor TfdAlpha4.Create;

  3062. begin

  3063.   inherited Create;

  3064.   fFormat           := tfAlpha4;

  3065.   fWithAlpha        := tfAlpha4;

  3066.   fglInternalFormat := GL_ALPHA4;

  3067. end;

  3068. 

  3069. constructor TfdAlpha8.Create;

  3070. begin

  3071.   inherited Create;

  3072.   fFormat           := tfAlpha8;

  3073.   fWithAlpha        := tfAlpha8;

  3074.   fglInternalFormat := GL_ALPHA8;

  3075. end;

  3076. 

  3077. constructor TfdAlpha12.Create;

  3078. begin

  3079.   inherited Create;

  3080.   fFormat           := tfAlpha12;

  3081.   fWithAlpha        := tfAlpha12;

  3082.   fglInternalFormat := GL_ALPHA12;

  3083. end;

  3084. 

  3085. constructor TfdAlpha16.Create;

  3086. begin

  3087.   inherited Create;

  3088.   fFormat           := tfAlpha16;

  3089.   fWithAlpha        := tfAlpha16;

  3090.   fglInternalFormat := GL_ALPHA16;

  3091. end;

  3092. 

  3093. constructor TfdLuminance4.Create;

  3094. begin

  3095.   inherited Create;

  3096.   fFormat           := tfLuminance4;

  3097.   fWithAlpha        := tfLuminance4Alpha4;

  3098.   fWithoutAlpha     := tfLuminance4;

  3099.   fglInternalFormat := GL_LUMINANCE4;

  3100. end;

  3101. 

  3102. constructor TfdLuminance8.Create;

  3103. begin

  3104.   inherited Create;

  3105.   fFormat           := tfLuminance8;

  3106.   fWithAlpha        := tfLuminance8Alpha8;

  3107.   fWithoutAlpha     := tfLuminance8;

  3108.   fglInternalFormat := GL_LUMINANCE8;

  3109. end;

  3110. 

  3111. constructor TfdLuminance12.Create;

  3112. begin

  3113.   inherited Create;

  3114.   fFormat           := tfLuminance12;

  3115.   fWithAlpha        := tfLuminance12Alpha12;

  3116.   fWithoutAlpha     := tfLuminance12;

  3117.   fglInternalFormat := GL_LUMINANCE12;

  3118. end;

  3119. 

  3120. constructor TfdLuminance16.Create;

  3121. begin

  3122.   inherited Create;

  3123.   fFormat           := tfLuminance16;

  3124.   fWithAlpha        := tfLuminance16Alpha16;

  3125.   fWithoutAlpha     := tfLuminance16;

  3126.   fglInternalFormat := GL_LUMINANCE16;

  3127. end;

  3128. 

  3129. constructor TfdLuminance4Alpha4.Create;

  3130. begin

  3131.   inherited Create;

  3132.   fFormat           := tfLuminance4Alpha4;

  3133.   fWithAlpha        := tfLuminance4Alpha4;

  3134.   fWithoutAlpha     := tfLuminance4;

  3135.   fglInternalFormat := GL_LUMINANCE4_ALPHA4;

  3136. end;

  3137. 

  3138. constructor TfdLuminance6Alpha2.Create;

  3139. begin

  3140.   inherited Create;

  3141.   fFormat           := tfLuminance6Alpha2;

  3142.   fWithAlpha        := tfLuminance6Alpha2;

  3143.   fWithoutAlpha     := tfLuminance8;

  3144.   fglInternalFormat := GL_LUMINANCE6_ALPHA2;

  3145. end;

  3146. 

  3147. constructor TfdLuminance8Alpha8.Create;

  3148. begin

  3149.   inherited Create;

  3150.   fFormat           := tfLuminance8Alpha8;

  3151.   fWithAlpha        := tfLuminance8Alpha8;

  3152.   fWithoutAlpha     := tfLuminance8;

  3153.   fglInternalFormat := GL_LUMINANCE8_ALPHA8;

  3154. end;

  3155. 

  3156. constructor TfdLuminance12Alpha4.Create;

  3157. begin

  3158.   inherited Create;

  3159.   fFormat           := tfLuminance12Alpha4;

  3160.   fWithAlpha        := tfLuminance12Alpha4;

  3161.   fWithoutAlpha     := tfLuminance12;

  3162.   fglInternalFormat := GL_LUMINANCE12_ALPHA4;

  3163. end;

  3164. 

  3165. constructor TfdLuminance12Alpha12.Create;

  3166. begin

  3167.   inherited Create;

  3168.   fFormat           := tfLuminance12Alpha12;

  3169.   fWithAlpha        := tfLuminance12Alpha12;

  3170.   fWithoutAlpha     := tfLuminance12;

  3171.   fglInternalFormat := GL_LUMINANCE12_ALPHA12;

  3172. end;

  3173. 

  3174. constructor TfdLuminance16Alpha16.Create;

  3175. begin

  3176.   inherited Create;

  3177.   fFormat           := tfLuminance16Alpha16;

  3178.   fWithAlpha        := tfLuminance16Alpha16;

  3179.   fWithoutAlpha     := tfLuminance16;

  3180.   fglInternalFormat := GL_LUMINANCE16_ALPHA16;

  3181. end;

  3182. 

  3183. constructor TfdR3G3B2.Create;

  3184. begin

  3185.   inherited Create;

  3186.   fFormat           := tfR3G3B2;

  3187.   fWithAlpha        := tfRGBA2;

  3188.   fWithoutAlpha     := tfR3G3B2;

  3189.   fRange.r          := $7;

  3190.   fRange.g          := $7;

  3191.   fRange.b          := $3;

  3192.   fShift.r          :=  0;

  3193.   fShift.g          :=  3;

  3194.   fShift.b          :=  6;

  3195.   fglFormat         := GL_RGB;

  3196.   fglInternalFormat := GL_R3_G3_B2;

  3197.   fglDataFormat     := GL_UNSIGNED_BYTE_2_3_3_REV;

  3198. end;

  3199. 

  3200. constructor TfdRGB4.Create;

  3201. begin

  3202.   inherited Create;

  3203.   fFormat           := tfRGB4;

  3204.   fWithAlpha        := tfRGBA4;

  3205.   fWithoutAlpha     := tfRGB4;

  3206.   fRGBInverted      := tfBGR4;

  3207.   fRange.r          := $F;

  3208.   fRange.g          := $F;

  3209.   fRange.b          := $F;

  3210.   fShift.r          :=  0;

  3211.   fShift.g          :=  4;

  3212.   fShift.b          :=  8;

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

  3214.   fglInternalFormat := GL_RGB4;

  3215.   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;

  3216. end;

  3217. 

  3218. constructor TfdR5G6B5.Create;

  3219. begin

  3220.   inherited Create;

  3221.   fFormat           := tfR5G6B5;

  3222.   fWithAlpha        := tfRGBA4;

  3223.   fWithoutAlpha     := tfR5G6B5;

  3224.   fRGBInverted      := tfB5G6R5;

  3225.   fRange.r          := $1F;

  3226.   fRange.g          := $3F;

  3227.   fRange.b          := $1F;

  3228.   fShift.r          :=   0;

  3229.   fShift.g          :=   5;

  3230.   fShift.b          :=  11;

  3231.   fglFormat         := GL_RGB;

  3232.   fglInternalFormat := GL_RGB565;

  3233.   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5_REV;

  3234. end;

  3235. 

  3236. constructor TfdRGB5.Create;

  3237. begin

  3238.   inherited Create;

  3239.   fFormat           := tfRGB5;

  3240.   fWithAlpha        := tfRGB5A1;

  3241.   fWithoutAlpha     := tfRGB5;

  3242.   fRGBInverted      := tfBGR5;

  3243.   fRange.r          := $1F;

  3244.   fRange.g          := $1F;

  3245.   fRange.b          := $1F;

  3246.   fShift.r          :=   0;

  3247.   fShift.g          :=   5;

  3248.   fShift.b          :=  10;

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

  3250.   fglInternalFormat := GL_RGB5;

  3251.   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;

  3252. end;

  3253. 

  3254. constructor TfdRGB8.Create;

  3255. begin

  3256.   inherited Create;

  3257.   fFormat           := tfRGB8;

  3258.   fWithAlpha        := tfRGBA8;

  3259.   fWithoutAlpha     := tfRGB8;

  3260.   fRGBInverted      := tfBGR8;

  3261.   fglInternalFormat := GL_RGB8;

  3262. end;

  3263. 

  3264. constructor TfdRGB10.Create;

  3265. begin

  3266.   inherited Create;

  3267.   fFormat           := tfRGB10;

  3268.   fWithAlpha        := tfRGB10A2;

  3269.   fWithoutAlpha     := tfRGB10;

  3270.   fRGBInverted      := tfBGR10;

  3271.   fRange.r          := $3FF;

  3272.   fRange.g          := $3FF;

  3273.   fRange.b          := $3FF;

  3274.   fShift.r          :=    0;

  3275.   fShift.g          :=   10;

  3276.   fShift.b          :=   20;

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

  3278.   fglInternalFormat := GL_RGB10;

  3279.   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;

  3280. end;

  3281. 

  3282. constructor TfdRGB12.Create;

  3283. begin

  3284.   inherited Create;

  3285.   fFormat           := tfRGB12;

  3286.   fWithAlpha        := tfRGBA12;

  3287.   fWithoutAlpha     := tfRGB12;

  3288.   fRGBInverted      := tfBGR12;

  3289.   fglInternalFormat := GL_RGB12;

  3290. end;

  3291. 

  3292. constructor TfdRGB16.Create;

  3293. begin

  3294.   inherited Create;

  3295.   fFormat           := tfRGB16;

  3296.   fWithAlpha        := tfRGBA16;

  3297.   fWithoutAlpha     := tfRGB16;

  3298.   fRGBInverted      := tfBGR16;

  3299.   fglInternalFormat := GL_RGB16;

  3300. end;

  3301. 

  3302. constructor TfdRGBA2.Create;

  3303. begin

  3304.   inherited Create;

  3305.   fFormat           := tfRGBA2;

  3306.   fWithAlpha        := tfRGBA2;

  3307.   fWithoutAlpha     := tfR3G3B2;

  3308.   fRGBInverted      := tfBGRA2;

  3309.   fglInternalFormat := GL_RGBA2;

  3310. end;

  3311. 

  3312. constructor TfdRGBA4.Create;

  3313. begin

  3314.   inherited Create;

  3315.   fFormat           := tfRGBA4;

  3316.   fWithAlpha        := tfRGBA4;

  3317.   fWithoutAlpha     := tfRGB4;

  3318.   fRGBInverted      := tfBGRA4;

  3319.   fRange.r          := $F;

  3320.   fRange.g          := $F;

  3321.   fRange.b          := $F;

  3322.   fRange.a          := $F;

  3323.   fShift.r          :=  0;

  3324.   fShift.g          :=  4;

  3325.   fShift.b          :=  8;

  3326.   fShift.a          := 12;

  3327.   fglFormat         := GL_RGBA;

  3328.   fglInternalFormat := GL_RGBA4;

  3329.   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;

  3330. end;

  3331. 

  3332. constructor TfdRGB5A1.Create;

  3333. begin

  3334.   inherited Create;

  3335.   fFormat           := tfRGB5A1;

  3336.   fWithAlpha        := tfRGB5A1;

  3337.   fWithoutAlpha     := tfRGB5;

  3338.   fRGBInverted      := tfBGR5A1;

  3339.   fRange.r          := $1F;

  3340.   fRange.g          := $1F;

  3341.   fRange.b          := $1F;

  3342.   fRange.a          := $01;

  3343.   fShift.r          :=   0;

  3344.   fShift.g          :=   5;

  3345.   fShift.b          :=  10;

  3346.   fShift.a          :=  15;

  3347.   fglFormat         := GL_RGBA;

  3348.   fglInternalFormat := GL_RGB5_A1;

  3349.   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;

  3350. end;

  3351. 

  3352. constructor TfdRGBA8.Create;

  3353. begin

  3354.   inherited Create;

  3355.   fFormat           := tfRGBA8;

  3356.   fWithAlpha        := tfRGBA8;

  3357.   fWithoutAlpha     := tfRGB8;

  3358.   fRGBInverted      := tfBGRA8;

  3359.   fglInternalFormat := GL_RGBA8;

  3360. end;

  3361. 

  3362. constructor TfdRGB10A2.Create;

  3363. begin

  3364.   inherited Create;

  3365.   fFormat           := tfRGB10A2;

  3366.   fWithAlpha        := tfRGB10A2;

  3367.   fWithoutAlpha     := tfRGB10;

  3368.   fRGBInverted      := tfBGR10A2;

  3369.   fRange.r          := $3FF;

  3370.   fRange.g          := $3FF;

  3371.   fRange.b          := $3FF;

  3372.   fRange.a          := $003;

  3373.   fShift.r          :=    0;

  3374.   fShift.g          :=   10;

  3375.   fShift.b          :=   20;

  3376.   fShift.a          :=   30;

  3377.   fglFormat         := GL_RGBA;

  3378.   fglInternalFormat := GL_RGB10_A2;

  3379.   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;

  3380. end;

  3381. 

  3382. constructor TfdRGBA12.Create;

  3383. begin

  3384.   inherited Create;

  3385.   fFormat           := tfRGBA12;

  3386.   fWithAlpha        := tfRGBA12;

  3387.   fWithoutAlpha     := tfRGB12;

  3388.   fRGBInverted      := tfBGRA12;

  3389.   fglInternalFormat := GL_RGBA12;

  3390. end;

  3391. 

  3392. constructor TfdRGBA16.Create;

  3393. begin

  3394.   inherited Create;

  3395.   fFormat           := tfRGBA16;

  3396.   fWithAlpha        := tfRGBA16;

  3397.   fWithoutAlpha     := tfRGB16;

  3398.   fRGBInverted      := tfBGRA16;

  3399.   fglInternalFormat := GL_RGBA16;

  3400. end;

  3401. 

  3402. constructor TfdBGR4.Create;

  3403. begin

  3404.   inherited Create;

  3405.   fPixelSize        := 2.0;

  3406.   fFormat           := tfBGR4;

  3407.   fWithAlpha        := tfBGRA4;

  3408.   fWithoutAlpha     := tfBGR4;

  3409.   fRGBInverted      := tfRGB4;

  3410.   fRange.r          := $F;

  3411.   fRange.g          := $F;

  3412.   fRange.b          := $F;

  3413.   fRange.a          := $0;

  3414.   fShift.r          :=  8;

  3415.   fShift.g          :=  4;

  3416.   fShift.b          :=  0;

  3417.   fShift.a          :=  0;

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

  3419.   fglInternalFormat := GL_RGB4;

  3420.   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;

  3421. end;

  3422. 

  3423. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3424. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3425. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3426. constructor TfdB5G6R5.Create;

  3427. begin

  3428.   inherited Create;

  3429.   fFormat           := tfB5G6R5;

  3430.   fWithAlpha        := tfBGRA4;

  3431.   fWithoutAlpha     := tfB5G6R5;

  3432.   fRGBInverted      := tfR5G6B5;

  3433.   fRange.r          := $1F;

  3434.   fRange.g          := $3F;

  3435.   fRange.b          := $1F;

  3436.   fShift.r          :=  11;

  3437.   fShift.g          :=   5;

  3438.   fShift.b          :=   0;

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

  3440.   fglInternalFormat := GL_RGB8;

  3441.   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5;

  3442. end;

  3443. 

  3444. constructor TfdBGR5.Create;

  3445. begin

  3446.   inherited Create;

  3447.   fPixelSize        := 2.0;

  3448.   fFormat           := tfBGR5;

  3449.   fWithAlpha        := tfBGR5A1;

  3450.   fWithoutAlpha     := tfBGR5;

  3451.   fRGBInverted      := tfRGB5;

  3452.   fRange.r          := $1F;

  3453.   fRange.g          := $1F;

  3454.   fRange.b          := $1F;

  3455.   fRange.a          := $00;

  3456.   fShift.r          :=  10;

  3457.   fShift.g          :=   5;

  3458.   fShift.b          :=   0;

  3459.   fShift.a          :=   0;

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

  3461.   fglInternalFormat := GL_RGB5;

  3462.   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;

  3463. end;

  3464. 

  3465. constructor TfdBGR8.Create;

  3466. begin

  3467.   inherited Create;

  3468.   fFormat           := tfBGR8;

  3469.   fWithAlpha        := tfBGRA8;

  3470.   fWithoutAlpha     := tfBGR8;

  3471.   fRGBInverted      := tfRGB8;

  3472.   fglInternalFormat := GL_RGB8;

  3473. end;

  3474. 

  3475. constructor TfdBGR10.Create;

  3476. begin

  3477.   inherited Create;

  3478.   fFormat           := tfBGR10;

  3479.   fWithAlpha        := tfBGR10A2;

  3480.   fWithoutAlpha     := tfBGR10;

  3481.   fRGBInverted      := tfRGB10;

  3482.   fRange.r          := $3FF;

  3483.   fRange.g          := $3FF;

  3484.   fRange.b          := $3FF;

  3485.   fRange.a          := $000;

  3486.   fShift.r          :=   20;

  3487.   fShift.g          :=   10;

  3488.   fShift.b          :=    0;

  3489.   fShift.a          :=    0;

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

  3491.   fglInternalFormat := GL_RGB10;

  3492.   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;

  3493. end;

  3494. 

  3495. constructor TfdBGR12.Create;

  3496. begin

  3497.   inherited Create;

  3498.   fFormat           := tfBGR12;

  3499.   fWithAlpha        := tfBGRA12;

  3500.   fWithoutAlpha     := tfBGR12;

  3501.   fRGBInverted      := tfRGB12;

  3502.   fglInternalFormat := GL_RGB12;

  3503. end;

  3504. 

  3505. constructor TfdBGR16.Create;

  3506. begin

  3507.   inherited Create;

  3508.   fFormat           := tfBGR16;

  3509.   fWithAlpha        := tfBGRA16;

  3510.   fWithoutAlpha     := tfBGR16;

  3511.   fRGBInverted      := tfRGB16;

  3512.   fglInternalFormat := GL_RGB16;

  3513. end;

  3514. 

  3515. constructor TfdBGRA2.Create;

  3516. begin

  3517.   inherited Create;

  3518.   fFormat           := tfBGRA2;

  3519.   fWithAlpha        := tfBGRA4;

  3520.   fWithoutAlpha     := tfBGR4;

  3521.   fRGBInverted      := tfRGBA2;

  3522.   fglInternalFormat := GL_RGBA2;

  3523. end;

  3524. 

  3525. constructor TfdBGRA4.Create;

  3526. begin

  3527.   inherited Create;

  3528.   fFormat           := tfBGRA4;

  3529.   fWithAlpha        := tfBGRA4;

  3530.   fWithoutAlpha     := tfBGR4;

  3531.   fRGBInverted      := tfRGBA4;

  3532.   fRange.r          := $F;

  3533.   fRange.g          := $F;

  3534.   fRange.b          := $F;

  3535.   fRange.a          := $F;

  3536.   fShift.r          :=  8;

  3537.   fShift.g          :=  4;

  3538.   fShift.b          :=  0;

  3539.   fShift.a          := 12;

  3540.   fglFormat         := GL_BGRA;

  3541.   fglInternalFormat := GL_RGBA4;

  3542.   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;

  3543. end;

  3544. 

  3545. constructor TfdBGR5A1.Create;

  3546. begin

  3547.   inherited Create;

  3548.   fFormat           := tfBGR5A1;

  3549.   fWithAlpha        := tfBGR5A1;

  3550.   fWithoutAlpha     := tfBGR5;

  3551.   fRGBInverted      := tfRGB5A1;

  3552.   fRange.r          := $1F;

  3553.   fRange.g          := $1F;

  3554.   fRange.b          := $1F;

  3555.   fRange.a          := $01;

  3556.   fShift.r          :=  10;

  3557.   fShift.g          :=   5;

  3558.   fShift.b          :=   0;

  3559.   fShift.a          :=  15;

  3560.   fglFormat         := GL_BGRA;

  3561.   fglInternalFormat := GL_RGB5_A1;

  3562.   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;

  3563. end;

  3564. 

  3565. constructor TfdBGRA8.Create;

  3566. begin

  3567.   inherited Create;

  3568.   fFormat           := tfBGRA8;

  3569.   fWithAlpha        := tfBGRA8;

  3570.   fWithoutAlpha     := tfBGR8;

  3571.   fRGBInverted      := tfRGBA8;

  3572.   fglInternalFormat := GL_RGBA8;

  3573. end;

  3574. 

  3575. constructor TfdBGR10A2.Create;

  3576. begin

  3577.   inherited Create;

  3578.   fFormat           := tfBGR10A2;

  3579.   fWithAlpha        := tfBGR10A2;

  3580.   fWithoutAlpha     := tfBGR10;

  3581.   fRGBInverted      := tfRGB10A2;

  3582.   fRange.r          := $3FF;

  3583.   fRange.g          := $3FF;

  3584.   fRange.b          := $3FF;

  3585.   fRange.a          := $003;

  3586.   fShift.r          :=   20;

  3587.   fShift.g          :=   10;

  3588.   fShift.b          :=    0;

  3589.   fShift.a          :=   30;

  3590.   fglFormat         := GL_BGRA;

  3591.   fglInternalFormat := GL_RGB10_A2;

  3592.   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;

  3593. end;

  3594. 

  3595. constructor TfdBGRA12.Create;

  3596. begin

  3597.   inherited Create;

  3598.   fFormat           := tfBGRA12;

  3599.   fWithAlpha        := tfBGRA12;

  3600.   fWithoutAlpha     := tfBGR12;

  3601.   fRGBInverted      := tfRGBA12;

  3602.   fglInternalFormat := GL_RGBA12;

  3603. end;

  3604. 

  3605. constructor TfdBGRA16.Create;

  3606. begin

  3607.   inherited Create;

  3608.   fFormat           := tfBGRA16;

  3609.   fWithAlpha        := tfBGRA16;

  3610.   fWithoutAlpha     := tfBGR16;

  3611.   fRGBInverted      := tfRGBA16;

  3612.   fglInternalFormat := GL_RGBA16;

  3613. end;

  3614. 

  3615. constructor TfdDepth16.Create;

  3616. begin

  3617.   inherited Create;

  3618.   fFormat           := tfDepth16;

  3619.   fWithAlpha        := tfEmpty;

  3620.   fWithoutAlpha     := tfDepth16;

  3621.   fglInternalFormat := GL_DEPTH_COMPONENT16;

  3622. end;

  3623. 

  3624. constructor TfdDepth24.Create;

  3625. begin

  3626.   inherited Create;

  3627.   fFormat           := tfDepth24;

  3628.   fWithAlpha        := tfEmpty;

  3629.   fWithoutAlpha     := tfDepth24;

  3630.   fglInternalFormat := GL_DEPTH_COMPONENT24;

  3631. end;

  3632. 

  3633. constructor TfdDepth32.Create;

  3634. begin

  3635.   inherited Create;

  3636.   fFormat           := tfDepth32;

  3637.   fWithAlpha        := tfEmpty;

  3638.   fWithoutAlpha     := tfDepth32;

  3639.   fglInternalFormat := GL_DEPTH_COMPONENT32;

  3640. end;

  3641. 

  3642. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3643. //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3644. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  3646. begin

  3647.   raise EglBitmapException.Create('mapping for compressed formats is not supported');

  3648. end;

  3649. 

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

  3651. begin

  3652.   raise EglBitmapException.Create('mapping for compressed formats is not supported');

  3653. end;

  3654. 

  3655. constructor TfdS3tcDtx1RGBA.Create;

  3656. begin

  3657.   inherited Create;

  3658.   fFormat           := tfS3tcDtx1RGBA;

  3659.   fWithAlpha        := tfS3tcDtx1RGBA;

  3660.   fUncompressed     := tfRGB5A1;

  3661.   fPixelSize        := 0.5;

  3662.   fIsCompressed     := true;

  3663.   fglFormat         := GL_COMPRESSED_RGBA;

  3664.   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;

  3665.   fglDataFormat     := GL_UNSIGNED_BYTE;

  3666. end;

  3667. 

  3668. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3669. //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3670. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  3672. begin

  3673.   raise EglBitmapException.Create('mapping for compressed formats is not supported');

  3674. end;

  3675. 

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

  3677. begin

  3678.   raise EglBitmapException.Create('mapping for compressed formats is not supported');

  3679. end;

  3680. 

  3681. constructor TfdS3tcDtx3RGBA.Create;

  3682. begin

  3683.   inherited Create;

  3684.   fFormat           := tfS3tcDtx3RGBA;

  3685.   fWithAlpha        := tfS3tcDtx3RGBA;

  3686.   fUncompressed     := tfRGBA8;

  3687.   fPixelSize        := 1.0;

  3688.   fIsCompressed     := true;

  3689.   fglFormat         := GL_COMPRESSED_RGBA;

  3690.   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;

  3691.   fglDataFormat     := GL_UNSIGNED_BYTE;

  3692. end;

  3693. 

  3694. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3695. //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3696. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  3698. begin

  3699.   raise EglBitmapException.Create('mapping for compressed formats is not supported');

  3700. end;

  3701. 

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

  3703. begin

  3704.   raise EglBitmapException.Create('mapping for compressed formats is not supported');

  3705. end;

  3706. 

  3707. constructor TfdS3tcDtx5RGBA.Create;

  3708. begin

  3709.   inherited Create;

  3710.   fFormat           := tfS3tcDtx3RGBA;

  3711.   fWithAlpha        := tfS3tcDtx3RGBA;

  3712.   fUncompressed     := tfRGBA8;

  3713.   fPixelSize        := 1.0;

  3714.   fIsCompressed     := true;

  3715.   fglFormat         := GL_COMPRESSED_RGBA;

  3716.   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;

  3717.   fglDataFormat     := GL_UNSIGNED_BYTE;

  3718. end;

  3719. 

  3720. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3721. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3722. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3723. class procedure TFormatDescriptor.Init;

  3724. begin

  3725.   if not Assigned(FormatDescriptorCS) then

  3726.     FormatDescriptorCS := TCriticalSection.Create;

  3727. end;

  3728. 

  3729. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  3731. begin

  3732.   FormatDescriptorCS.Enter;

  3733.   try

  3734.     result := FormatDescriptors[aFormat];

  3735.     if not Assigned(result) then begin

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

  3737.       FormatDescriptors[aFormat] := result;

  3738.     end;

  3739.   finally

  3740.     FormatDescriptorCS.Leave;

  3741.   end;

  3742. end;

  3743. 

  3744. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  3746. begin

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

  3748. end;

  3749. 

  3750. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3751. class procedure TFormatDescriptor.Clear;

  3752. var

  3753.   f: TglBitmapFormat;

  3754. begin

  3755.   FormatDescriptorCS.Enter;

  3756.   try

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

  3758.       FreeAndNil(FormatDescriptors[f]);

  3759.   finally

  3760.     FormatDescriptorCS.Leave;

  3761.   end;

  3762. end;

  3763. 

  3764. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3765. class procedure TFormatDescriptor.Finalize;

  3766. begin

  3767.   Clear;

  3768.   FreeAndNil(FormatDescriptorCS);

  3769. end;

  3770. 

  3771. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3772. //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3773. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3774. procedure TbmpBitfieldFormat.SetRedMask(const aValue: QWord);

  3775. begin

  3776.   Update(aValue, fRange.r, fShift.r);

  3777. end;

  3778. 

  3779. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3780. procedure TbmpBitfieldFormat.SetGreenMask(const aValue: QWord);

  3781. begin

  3782.   Update(aValue, fRange.g, fShift.g);

  3783. end;

  3784. 

  3785. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3786. procedure TbmpBitfieldFormat.SetBlueMask(const aValue: QWord);

  3787. begin

  3788.   Update(aValue, fRange.b, fShift.b);

  3789. end;

  3790. 

  3791. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3792. procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: QWord);

  3793. begin

  3794.   Update(aValue, fRange.a, fShift.a);

  3795. end;

  3796. 

  3797. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3798. procedure TbmpBitfieldFormat.Update(aMask: QWord; out aRange: Cardinal; out

  3799.   aShift: Byte);

  3800. begin

  3801.   aShift := 0;

  3802.   aRange := 0;

  3803.   if (aMask = 0) then

  3804.     exit;

  3805.   while (aMask > 0) and ((aMask and 1) = 0) do begin

  3806.     inc(aShift);

  3807.     aMask := aMask shr 1;

  3808.   end;

  3809.   aRange := 1;

  3810.   while (aMask > 0) do begin

  3811.     aRange := aRange shl 1;

  3812.     aMask  := aMask  shr 1;

  3813.   end;

  3814.   dec(aRange);

  3815. 

  3816.   fPixelSize := Round(GetTopMostBit(RedMask or GreenMask or BlueMask or AlphaMask) / 8);

  3817. end;

  3818. 

  3819. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3820. procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);

  3821. var

  3822.   data: QWord;

  3823.   s: Integer;

  3824. begin

  3825.   data :=

  3826.     ((aPixel.Data.r and fRange.r) shl fShift.r) or

  3827.     ((aPixel.Data.g and fRange.g) shl fShift.g) or

  3828.     ((aPixel.Data.b and fRange.b) shl fShift.b) or

  3829.     ((aPixel.Data.a and fRange.a) shl fShift.a);

  3830.   s := Round(fPixelSize);

  3831.   case s of

  3832.     1:           aData^  := data;

  3833.     2:     PWord(aData)^ := data;

  3834.     4: PCardinal(aData)^ := data;

  3835.     8:    PQWord(aData)^ := data;

  3836.   else

  3837.     raise EglBitmapException.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);

  3838.   end;

  3839.   inc(aData, s);

  3840. end;

  3841. 

  3842. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3843. procedure TbmpBitfieldFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);

  3844. var

  3845.   data: QWord;

  3846.   s, i: Integer;

  3847. begin

  3848.   s := Round(fPixelSize);

  3849.   case s of

  3850.     1: data :=           aData^;

  3851.     2: data :=     PWord(aData)^;

  3852.     4: data := PCardinal(aData)^;

  3853.     8: data :=    PQWord(aData)^;

  3854.   else

  3855.     raise EglBitmapException.CreateFmt('invalid pixel size: %.1f', [fPixelSize]);

  3856.   end;

  3857.   for i := 0 to 3 do

  3858.     aPixel.Data.arr[i] := (data shr fShift.arr[i]) and fRange.arr[i];

  3859.   inc(aData, s);

  3860. end;

  3861. 

  3862. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3863. //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3864. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3865. procedure TbmpColorTableFormat.CreateColorTable;

  3866. var

  3867.   i: Integer;

  3868. begin

  3869.   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then

  3870.     raise EglBitmapException.Create(UNSUPPORTED_FORMAT);

  3871. 

  3872.   if (Format = tfLuminance4) then

  3873.     SetLength(fColorTable, 16)

  3874.   else

  3875.     SetLength(fColorTable, 256);

  3876. 

  3877.   case Format of

  3878.     tfLuminance4: begin

  3879.       for i := 0 to High(fColorTable) do begin

  3880.         fColorTable[i].r := 16 * i;

  3881.         fColorTable[i].g := 16 * i;

  3882.         fColorTable[i].b := 16 * i;

  3883.         fColorTable[i].a := 0;

  3884.       end;

  3885.     end;

  3886. 

  3887.     tfLuminance8: begin

  3888.       for i := 0 to High(fColorTable) do begin

  3889.         fColorTable[i].r := i;

  3890.         fColorTable[i].g := i;

  3891.         fColorTable[i].b := i;

  3892.         fColorTable[i].a := 0;

  3893.       end;

  3894.     end;

  3895. 

  3896.     tfR3G3B2: begin

  3897.       for i := 0 to High(fColorTable) do begin

  3898.         fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);

  3899.         fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);

  3900.         fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);

  3901.         fColorTable[i].a := 0;

  3902.       end;

  3903.     end;

  3904.   end;

  3905. end;

  3906. 

  3907. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3908. procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);

  3909. var

  3910.   d: Byte;

  3911. begin

  3912.   if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then

  3913.     raise EglBitmapException.Create(UNSUPPORTED_FORMAT);

  3914. 

  3915.   case Format of

  3916.     tfLuminance4: begin

  3917.       if (aMapData = nil) then

  3918.         aData^ := 0;

  3919.       d := LuminanceWeight(aPixel) and Range.r;

  3920.       aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData)));

  3921.       inc(aMapData, 4);

  3922.       if ({%H-}PtrUInt(aMapData) >= 8) then begin

  3923.         inc(aData);

  3924.         aMapData := nil;

  3925.       end;

  3926.     end;

  3927. 

  3928.     tfLuminance8: begin

  3929.       aData^ := LuminanceWeight(aPixel) and Range.r;

  3930.       inc(aData);

  3931.     end;

  3932. 

  3933.     tfR3G3B2: begin

  3934.       aData^ := Round(

  3935.         ((aPixel.Data.r and Range.r) shl Shift.r) or

  3936.         ((aPixel.Data.g and Range.g) shl Shift.g) or

  3937.         ((aPixel.Data.b and Range.b) shl Shift.b));

  3938.       inc(aData);

  3939.     end;

  3940.   end;

  3941. end;

  3942. 

  3943. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3944. procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);

  3945. var

  3946.   idx: QWord;

  3947.   s: Integer;

  3948.   bits: Byte;

  3949.   f: Single;

  3950. begin

  3951.   s    := Trunc(fPixelSize);

  3952.   f    := fPixelSize - s;

  3953.   bits := Round(8 * f);

  3954.   case s of

  3955.     0: idx :=          (aData^ shr (8 - bits - {%H-}PtrUInt(aMapData))) and ((1 shl bits) - 1);

  3956.     1: idx :=           aData^;

  3957.     2: idx :=     PWord(aData)^;

  3958.     4: idx := PCardinal(aData)^;

  3959.     8: idx :=    PQWord(aData)^;

  3960.   else

  3961.     raise EglBitmapException.CreateFmt('invalid pixel size: %.3f', [fPixelSize]);

  3962.   end;

  3963.   if (idx >= Length(fColorTable)) then

  3964.     raise EglBitmapException.CreateFmt('invalid color index: %d', [idx]);

  3965.   with fColorTable[idx] do begin

  3966.     aPixel.Data.r := r;

  3967.     aPixel.Data.g := g;

  3968.     aPixel.Data.b := b;

  3969.     aPixel.Data.a := a;

  3970.   end;

  3971.   inc(aMapData, bits);

  3972.   if ({%H-}PtrUInt(aMapData) >= 8) then begin

  3973.     inc(aData, 1);

  3974.     dec(aMapData, 8);

  3975.   end;

  3976.   inc(aData, s);

  3977. end;

  3978. 

  3979. destructor TbmpColorTableFormat.Destroy;

  3980. begin

  3981.   SetLength(fColorTable, 0);

  3982.   inherited Destroy;

  3983. end;

  3984. 

  3985. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3986. //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3987. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3988. procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);

  3989. var

  3990.   i: Integer;

  3991. begin

  3992.   for i := 0 to 3 do begin

  3993.     if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin

  3994.       if (aSourceFD.Range.arr[i] > 0) then

  3995.         aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])

  3996.       else

  3997.         aPixel.Data.arr[i] := aDestFD.Range.arr[i];

  3998.     end;

  3999.   end;

  4000. end;

  4001. 

  4002. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4003. procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);

  4004. begin

  4005.   with aFuncRec do begin

  4006.     if (Source.Range.r   > 0) then

  4007.       Dest.Data.r := Source.Data.r;

  4008.     if (Source.Range.g > 0) then

  4009.       Dest.Data.g := Source.Data.g;

  4010.     if (Source.Range.b  > 0) then

  4011.       Dest.Data.b := Source.Data.b;

  4012.     if (Source.Range.a > 0) then

  4013.       Dest.Data.a := Source.Data.a;

  4014.   end;

  4015. end;

  4016. 

  4017. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4018. procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);

  4019. var

  4020.   i: Integer;

  4021. begin

  4022.   with aFuncRec do begin

  4023.     for i := 0 to 3 do

  4024.       if (Source.Range.arr[i] > 0) then

  4025.         Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);

  4026.   end;

  4027. end;

  4028. 

  4029. type

  4030.   TShiftData = packed record

  4031.     case Integer of

  4032.       0: (r, g, b, a: SmallInt);

  4033.       1: (arr: array[0..3] of SmallInt);

  4034.   end;

  4035.   PShiftData = ^TShiftData;

  4036. 

  4037. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4038. procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);

  4039. var

  4040.   i: Integer;

  4041. begin

  4042.   with aFuncRec do

  4043.     for i := 0 to 3 do

  4044.       if (Source.Range.arr[i] > 0) then

  4045.         Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];

  4046. end;

  4047. 

  4048. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4049. procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);

  4050. begin

  4051.   with aFuncRec do begin

  4052.     Dest.Data := Source.Data;

  4053.     if ({%H-}PtrUInt(Args) and $1 > 0) then begin

  4054.       Dest.Data.r := Dest.Data.r xor Dest.Range.r;

  4055.       Dest.Data.g := Dest.Data.g xor Dest.Range.g;

  4056.       Dest.Data.b := Dest.Data.b xor Dest.Range.b;

  4057.     end;

  4058.     if ({%H-}PtrUInt(Args) and $2 > 0) then begin

  4059.       Dest.Data.a := Dest.Data.a xor Dest.Range.a;

  4060.     end;

  4061.   end;

  4062. end;

  4063. 

  4064. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4065. procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);

  4066. var

  4067.   i: Integer;

  4068. begin

  4069.   with aFuncRec do begin

  4070.     for i := 0 to 3 do

  4071.       Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];

  4072.   end;

  4073. end;

  4074. 

  4075. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4076. procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);

  4077. var

  4078.   Temp: Single;

  4079. begin

  4080.   with FuncRec do begin

  4081.     if (FuncRec.Args = nil) then begin //source has no alpha

  4082.       Temp :=

  4083.         Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +

  4084.         Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +

  4085.         Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;

  4086.       Dest.Data.a := Round(Dest.Range.a * Temp);

  4087.     end else

  4088.       Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);

  4089.   end;

  4090. end;

  4091. 

  4092. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4093. procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);

  4094. type

  4095.   PglBitmapPixelData = ^TglBitmapPixelData;

  4096. begin

  4097.   with FuncRec do begin

  4098.     Dest.Data.r := Source.Data.r;

  4099.     Dest.Data.g := Source.Data.g;

  4100.     Dest.Data.b := Source.Data.b;

  4101. 

  4102.     with PglBitmapPixelData(Args)^ do

  4103.       if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and

  4104.           (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and

  4105.           (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then

  4106.         Dest.Data.a := 0

  4107.       else

  4108.         Dest.Data.a := Dest.Range.a;

  4109.   end;

  4110. end;

  4111. 

  4112. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4113. procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);

  4114. begin

  4115.   with FuncRec do begin

  4116.     Dest.Data.r := Source.Data.r;

  4117.     Dest.Data.g := Source.Data.g;

  4118.     Dest.Data.b := Source.Data.b;

  4119.     Dest.Data.a := PCardinal(Args)^;

  4120.   end;

  4121. end;

  4122. 

  4123. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4124. procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);

  4125. type

  4126.   PRGBPix = ^TRGBPix;

  4127.   TRGBPix = array [0..2] of byte;

  4128. var

  4129.   Temp: Byte;

  4130. begin

  4131.   while aWidth > 0 do begin

  4132.     Temp := PRGBPix(aData)^[0];

  4133.     PRGBPix(aData)^[0] := PRGBPix(aData)^[2];

  4134.     PRGBPix(aData)^[2] := Temp;

  4135. 

  4136.     if aHasAlpha then

  4137.       Inc(aData, 4)

  4138.     else

  4139.       Inc(aData, 3);

  4140.     dec(aWidth);

  4141.   end;

  4142. end;

  4143. 

  4144. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4145. //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4146. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4147. function TglBitmap.GetWidth: Integer;

  4148. begin

  4149.   if (ffX in fDimension.Fields) then

  4150.     result := fDimension.X

  4151.   else

  4152.     result := -1;

  4153. end;

  4154. 

  4155. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4156. function TglBitmap.GetHeight: Integer;

  4157. begin

  4158.   if (ffY in fDimension.Fields) then

  4159.     result := fDimension.Y

  4160.   else

  4161.     result := -1;

  4162. end;

  4163. 

  4164. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4165. function TglBitmap.GetFileWidth: Integer;

  4166. begin

  4167.   result := Max(1, Width);

  4168. end;

  4169. 

  4170. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4171. function TglBitmap.GetFileHeight: Integer;

  4172. begin

  4173.   result := Max(1, Height);

  4174. end;

  4175. 

  4176. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4177. procedure TglBitmap.SetCustomData(const aValue: Pointer);

  4178. begin

  4179.   if fCustomData = aValue then

  4180.     exit;

  4181.   fCustomData := aValue;

  4182. end;

  4183. 

  4184. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4185. procedure TglBitmap.SetCustomName(const aValue: String);

  4186. begin

  4187.   if fCustomName = aValue then

  4188.     exit;

  4189.   fCustomName := aValue;

  4190. end;

  4191. 

  4192. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4193. procedure TglBitmap.SetCustomNameW(const aValue: WideString);

  4194. begin

  4195.   if fCustomNameW = aValue then

  4196.     exit;

  4197.   fCustomNameW := aValue;

  4198. end;

  4199. 

  4200. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4201. procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);

  4202. begin

  4203.   if fDeleteTextureOnFree = aValue then

  4204.     exit;

  4205.   fDeleteTextureOnFree := aValue;

  4206. end;

  4207. 

  4208. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4209. procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);

  4210. begin

  4211.   if fFormat = aValue then

  4212.     exit;

  4213.   if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then

  4214.     raise EglBitmapUnsupportedFormat.Create(Format);

  4215.   SetDataPointer(Data, aValue, Width, Height);

  4216. end;

  4217. 

  4218. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4219. procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);

  4220. begin

  4221.   if fFreeDataAfterGenTexture = aValue then

  4222.     exit;

  4223.   fFreeDataAfterGenTexture := aValue;

  4224. end;

  4225. 

  4226. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4227. procedure TglBitmap.SetID(const aValue: Cardinal);

  4228. begin

  4229.   if fID = aValue then

  4230.     exit;

  4231.   fID := aValue;

  4232. end;

  4233. 

  4234. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4235. procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);

  4236. begin

  4237.   if fMipMap = aValue then

  4238.     exit;

  4239.   fMipMap := aValue;

  4240. end;

  4241. 

  4242. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4243. procedure TglBitmap.SetTarget(const aValue: Cardinal);

  4244. begin

  4245.   if fTarget = aValue then

  4246.     exit;

  4247.   fTarget := aValue;

  4248. end;

  4249. 

  4250. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4251. procedure TglBitmap.SetAnisotropic(const aValue: Integer);

  4252. var

  4253.   MaxAnisotropic: Integer;

  4254. begin

  4255.   fAnisotropic := aValue;

  4256.   if (ID > 0) then begin

  4257.     if GL_EXT_texture_filter_anisotropic then begin

  4258.       if fAnisotropic > 0 then begin

  4259.         Bind(false);

  4260.         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);

  4261.         if aValue > MaxAnisotropic then

  4262.           fAnisotropic := MaxAnisotropic;

  4263.         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);

  4264.       end;

  4265.     end else begin

  4266.       fAnisotropic := 0;

  4267.     end;

  4268.   end;

  4269. end;

  4270. 

  4271. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4272. procedure TglBitmap.CreateID;

  4273. begin

  4274.   if (ID <> 0) then

  4275.     glDeleteTextures(1, @fID);

  4276.   glGenTextures(1, @fID);

  4277.   Bind(false);

  4278. end;

  4279. 

  4280. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4281. procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);

  4282. begin

  4283.   // Set Up Parameters

  4284.   SetWrap(fWrapS, fWrapT, fWrapR);

  4285.   SetFilter(fFilterMin, fFilterMag);

  4286.   SetAnisotropic(fAnisotropic);

  4287.   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);

  4288. 

  4289.   // Mip Maps Generation Mode

  4290.   aBuildWithGlu := false;

  4291.   if (MipMap = mmMipmap) then begin

  4292.     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then

  4293.       glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)

  4294.     else

  4295.       aBuildWithGlu := true;

  4296.   end else if (MipMap = mmMipmapGlu) then

  4297.     aBuildWithGlu := true;

  4298. end;

  4299. 

  4300. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4301. procedure TglBitmap.SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;

  4302.   const aWidth: Integer; const aHeight: Integer);

  4303. var

  4304.   s: Single;

  4305. begin

  4306.   if (Data <> aData) then begin

  4307.     if (Assigned(Data)) then

  4308.       FreeMem(Data);

  4309.     fData := aData;

  4310.   end;

  4311. 

  4312.   FillChar(fDimension, SizeOf(fDimension), 0);

  4313.   if not Assigned(fData) then begin

  4314.     fFormat    := tfEmpty;

  4315.     fPixelSize := 0;

  4316.     fRowSize   := 0;

  4317.   end else begin

  4318.     if aWidth <> -1 then begin

  4319.       fDimension.Fields := fDimension.Fields + [ffX];

  4320.       fDimension.X := aWidth;

  4321.     end;

  4322. 

  4323.     if aHeight <> -1 then begin

  4324.       fDimension.Fields := fDimension.Fields + [ffY];

  4325.       fDimension.Y := aHeight;

  4326.     end;

  4327. 

  4328.     s := TFormatDescriptor.Get(aFormat).PixelSize;

  4329.     fFormat    := aFormat;

  4330.     fPixelSize := Ceil(s);

  4331.     fRowSize   := Ceil(s * aWidth);

  4332.   end;

  4333. end;

  4334. 

  4335. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4336. function TglBitmap.FlipHorz: Boolean;

  4337. begin

  4338.   result := false;

  4339. end;

  4340. 

  4341. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4342. function TglBitmap.FlipVert: Boolean;

  4343. begin

  4344.   result := false;

  4345. end;

  4346. 

  4347. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4348. //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4349. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4350. procedure TglBitmap.AfterConstruction;

  4351. begin

  4352.   inherited AfterConstruction;

  4353. 

  4354.   fID         := 0;

  4355.   fTarget     := 0;

  4356.   fIsResident := false;

  4357. 

  4358.   fFormat                  := glBitmapGetDefaultFormat;

  4359.   fMipMap                  := glBitmapDefaultMipmap;

  4360.   fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;

  4361.   fDeleteTextureOnFree     := glBitmapGetDefaultDeleteTextureOnFree;

  4362. 

  4363.   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);

  4364.   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);

  4365. end;

  4366. 

  4367. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4368. procedure TglBitmap.BeforeDestruction;

  4369. begin

  4370.   SetDataPointer(nil, tfEmpty);

  4371.   if (fID > 0) and fDeleteTextureOnFree then

  4372.     glDeleteTextures(1, @fID);

  4373.   inherited BeforeDestruction;

  4374. end;

  4375. 

  4376. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4377. procedure TglBitmap.LoadFromFile(const aFilename: String);

  4378. var

  4379.   fs: TFileStream;

  4380. begin

  4381.   if not FileExists(aFilename) then

  4382.     raise EglBitmapException.Create('file does not exist: ' + aFilename);

  4383.   fFilename := aFilename;

  4384.   fs := TFileStream.Create(fFilename, fmOpenRead);

  4385.   try

  4386.     fs.Position := 0;

  4387.     LoadFromStream(fs);

  4388.   finally

  4389.     fs.Free;

  4390.   end;

  4391. end;

  4392. 

  4393. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4394. procedure TglBitmap.LoadFromStream(const aStream: TStream);

  4395. begin

  4396.   {$IFDEF GLB_SUPPORT_PNG_READ}

  4397.   if not LoadPNG(aStream) then

  4398.   {$ENDIF}

  4399.   {$IFDEF GLB_SUPPORT_JPEG_READ}

  4400.   if not LoadJPEG(aStream) then

  4401.   {$ENDIF}

  4402.   if not LoadDDS(aStream) then

  4403.   if not LoadTGA(aStream) then

  4404.   if not LoadBMP(aStream) then

  4405.     raise EglBitmapException.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');

  4406. end;

  4407. 

  4408. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4409. procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;

  4410.   const aFormat: TglBitmapFormat; const aArgs: Pointer);

  4411. var

  4412.   tmpData: PByte;

  4413.   size: Integer;

  4414. begin

  4415.   size := TFormatDescriptor.Get(aFormat).GetSize(aSize);

  4416.   GetMem(tmpData, size);

  4417.   try

  4418.     FillChar(tmpData^, size, #$FF);

  4419.     SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y);

  4420.   except

  4421.     FreeMem(tmpData);

  4422.     raise;

  4423.   end;

  4424.   AddFunc(Self, aFunc, false, Format, aArgs);

  4425. end;

  4426. 

  4427. {$IFDEF GLB_DELPHI}

  4428. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  4430. var

  4431.   rs: TResourceStream;

  4432.   TempPos: Integer;

  4433.   ResTypeStr: String;

  4434.   TempResType: PChar;

  4435. begin

  4436.   if not Assigned(ResType) then begin

  4437.     TempPos     := Pos('.', Resource);

  4438.     ResTypeStr  := UpperCase(Copy(Resource, TempPos + 1, Length(Resource) - TempPos));

  4439.     Resource    := UpperCase(Copy(Resource, 0, TempPos -1));

  4440.     TempResType := PChar(ResTypeStr);

  4441.   end else

  4442.     TempResType := ResType

  4443. 

  4444.   rs := TResourceStream.Create(Instance, Resource, TempResType);

  4445.   try

  4446.     LoadFromStream(rs);

  4447.   finally

  4448.     rs.Free;

  4449.   end;

  4450. end;

  4451. 

  4452. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4453. procedure TglBitmap.LoadFromResourceID(const sInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);

  4454. var

  4455.   rs: TResourceStream;

  4456. begin

  4457.   rs := TResourceStream.CreateFromID(Instance, ResourceID, ResType);

  4458.   try

  4459.     LoadFromStream(rs);

  4460.   finally

  4461.     rs.Free;

  4462.   end;

  4463. end;

  4464. {$ENDIF}

  4465. 

  4466. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  4468. var

  4469.   fs: TFileStream;

  4470. begin

  4471.   fs := TFileStream.Create(aFileName, fmCreate);

  4472.   try

  4473.     fs.Position := 0;

  4474.     SaveToStream(fs, aFileType);

  4475.   finally

  4476.     fs.Free;

  4477.   end;

  4478. end;

  4479. 

  4480. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4481. procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);

  4482. begin

  4483.   case aFileType of

  4484.     {$IFDEF GLB_SUPPORT_PNG_WRITE}

  4485.     ftPNG:  SavePNG(aStream);

  4486.     {$ENDIF}

  4487.     {$IFDEF GLB_SUPPORT_JPEG_WRITE}

  4488.     ftJPEG: SaveJPEG(aStream);

  4489.     {$ENDIF}

  4490.     ftDDS:  SaveDDS(aStream);

  4491.     ftTGA:  SaveTGA(aStream);

  4492.     ftBMP:  SaveBMP(aStream);

  4493.   end;

  4494. end;

  4495. 

  4496. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4497. function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;

  4498. begin

  4499.   result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);

  4500. end;

  4501. 

  4502. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  4504.   const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;

  4505. var

  4506.   DestData, TmpData, SourceData: pByte;

  4507.   TempHeight, TempWidth: Integer;

  4508.   SourceFD, DestFD: TFormatDescriptor;

  4509.   SourceMD, DestMD: Pointer;

  4510. 

  4511.   FuncRec: TglBitmapFunctionRec;

  4512. begin

  4513.   Assert(Assigned(Data));

  4514.   Assert(Assigned(aSource));

  4515.   Assert(Assigned(aSource.Data));

  4516. 

  4517.   result := false;

  4518.   if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin

  4519.     SourceFD := TFormatDescriptor.Get(aSource.Format);

  4520.     DestFD   := TFormatDescriptor.Get(aFormat);

  4521. 

  4522.     // inkompatible Formats so CreateTemp

  4523.     if (SourceFD.PixelSize <> DestFD.PixelSize) then

  4524.       aCreateTemp := true;

  4525. 

  4526.     // Values

  4527.     TempHeight := Max(1, aSource.Height);

  4528.     TempWidth  := Max(1, aSource.Width);

  4529. 

  4530.     FuncRec.Sender := Self;

  4531.     FuncRec.Args   := aArgs;

  4532. 

  4533.     TmpData := nil;

  4534.     if aCreateTemp then begin

  4535.       GetMem(TmpData, TFormatDescriptor.Get(aFormat).GetSize(TempWidth, TempHeight));

  4536.       DestData := TmpData;

  4537.     end else

  4538.       DestData := Data;

  4539. 

  4540.     try

  4541.       SourceFD.PreparePixel(FuncRec.Source);

  4542.       DestFD.PreparePixel  (FuncRec.Dest);

  4543. 

  4544.       SourceMD := SourceFD.CreateMappingData;

  4545.       DestMD   := DestFD.CreateMappingData;

  4546. 

  4547.       FuncRec.Size            := aSource.Dimension;

  4548.       FuncRec.Position.Fields := FuncRec.Size.Fields;

  4549. 

  4550.       try

  4551.         SourceData := aSource.Data;

  4552.         FuncRec.Position.Y := 0;

  4553.         while FuncRec.Position.Y < TempHeight do begin

  4554.           FuncRec.Position.X := 0;

  4555.           while FuncRec.Position.X < TempWidth do begin

  4556.             SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);

  4557.             aFunc(FuncRec);

  4558.             DestFD.Map(FuncRec.Dest, DestData, DestMD);

  4559.             inc(FuncRec.Position.X);

  4560.           end;

  4561.           inc(FuncRec.Position.Y);

  4562.         end;

  4563. 

  4564.         // Updating Image or InternalFormat

  4565.         if aCreateTemp then

  4566.           SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height)

  4567.         else if (aFormat <> fFormat) then

  4568.           Format := aFormat;

  4569. 

  4570.         result := true;

  4571.       finally

  4572.         SourceFD.FreeMappingData(SourceMD);

  4573.         DestFD.FreeMappingData(DestMD);

  4574.       end;

  4575.     except

  4576.       if aCreateTemp then

  4577.         FreeMem(TmpData);

  4578.       raise;

  4579.     end;

  4580.   end;

  4581. end;

  4582. 

  4583. {$IFDEF GLB_SDL}

  4584. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4585. function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;

  4586. var

  4587.   Row, RowSize: Integer;

  4588.   SourceData, TmpData: PByte;

  4589.   TempDepth: Integer;

  4590.   FormatDesc: TFormatDescriptor;

  4591. 

  4592.   function GetRowPointer(Row: Integer): pByte;

  4593.   begin

  4594.     result := aSurface.pixels;

  4595.     Inc(result, Row * RowSize);

  4596.   end;

  4597. 

  4598. begin

  4599.   result := false;

  4600. 

  4601.   FormatDesc := TFormatDescriptor.Get(Format);

  4602.   if FormatDesc.IsCompressed then

  4603.     raise EglBitmapUnsupportedFormat.Create(Format);

  4604. 

  4605.   if Assigned(Data) then begin

  4606.     case Trunc(FormatDesc.PixelSize) of

  4607.       1: TempDepth :=  8;

  4608.       2: TempDepth := 16;

  4609.       3: TempDepth := 24;

  4610.       4: TempDepth := 32;

  4611.     else

  4612.       raise EglBitmapUnsupportedFormat.Create(Format);

  4613.     end;

  4614. 

  4615.     aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,

  4616.       FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);

  4617.     SourceData := Data;

  4618.     RowSize    := FormatDesc.GetSize(FileWidth, 1);

  4619. 

  4620.     for Row := 0 to FileHeight-1 do begin

  4621.       TmpData := GetRowPointer(Row);

  4622.       if Assigned(TmpData) then begin

  4623.         Move(SourceData^, TmpData^, RowSize);

  4624.         inc(SourceData, RowSize);

  4625.       end;

  4626.     end;

  4627.     result := true;

  4628.   end;

  4629. end;

  4630. 

  4631. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4632. function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;

  4633. var

  4634.   pSource, pData, pTempData: PByte;

  4635.   Row, RowSize, TempWidth, TempHeight: Integer;

  4636.   IntFormat: TglBitmapFormat;

  4637.   FormatDesc: TFormatDescriptor;

  4638. 

  4639.   function GetRowPointer(Row: Integer): pByte;

  4640.   begin

  4641.     result := aSurface^.pixels;

  4642.     Inc(result, Row * RowSize);

  4643.   end;

  4644. 

  4645. begin

  4646.   result := false;

  4647.   if (Assigned(aSurface)) then begin

  4648.     with aSurface^.format^ do begin

  4649.       for IntFormat := High(TglBitmapFormat) to Low(TglBitmapFormat) do begin

  4650.         FormatDesc := TFormatDescriptor.Get(IntFormat);

  4651.         if (FormatDesc.MaskMatch(RMask, GMask, BMask, AMask)) then

  4652.           break;

  4653.       end;

  4654.       if (IntFormat = tfEmpty) then

  4655.         raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');

  4656.     end;

  4657. 

  4658.     TempWidth  := aSurface^.w;

  4659.     TempHeight := aSurface^.h;

  4660.     RowSize := FormatDesc.GetSize(TempWidth, 1);

  4661.     GetMem(pData, TempHeight * RowSize);

  4662.     try

  4663.       pTempData := pData;

  4664.       for Row := 0 to TempHeight -1 do begin

  4665.         pSource := GetRowPointer(Row);

  4666.         if (Assigned(pSource)) then begin

  4667.           Move(pSource^, pTempData^, RowSize);

  4668.           Inc(pTempData, RowSize);

  4669.         end;

  4670.       end;

  4671.       SetDataPointer(pData, IntFormat, TempWidth, TempHeight);

  4672.       result := true;

  4673.     except

  4674.       FreeMem(pData);

  4675.       raise;

  4676.     end;

  4677.   end;

  4678. end;

  4679. 

  4680. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4681. function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;

  4682. var

  4683.   Row, Col, AlphaInterleave: Integer;

  4684.   pSource, pDest: PByte;

  4685. 

  4686.   function GetRowPointer(Row: Integer): pByte;

  4687.   begin

  4688.     result := aSurface.pixels;

  4689.     Inc(result, Row * Width);

  4690.   end;

  4691. 

  4692. begin

  4693.   result := false;

  4694.   if Assigned(Data) then begin

  4695.     if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin

  4696.       aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);

  4697. 

  4698.       AlphaInterleave := 0;

  4699.       case Format of

  4700.         tfLuminance8Alpha8:

  4701.           AlphaInterleave := 1;

  4702.         tfBGRA8, tfRGBA8:

  4703.           AlphaInterleave := 3;

  4704.       end;

  4705. 

  4706.       pSource := Data;

  4707.       for Row := 0 to Height -1 do begin

  4708.         pDest := GetRowPointer(Row);

  4709.         if Assigned(pDest) then begin

  4710.           for Col := 0 to Width -1 do begin

  4711.             Inc(pSource, AlphaInterleave);

  4712.             pDest^ := pSource^;

  4713.             Inc(pDest);

  4714.             Inc(pSource);

  4715.           end;

  4716.         end;

  4717.       end;

  4718.       result := true;

  4719.     end;

  4720.   end;

  4721. end;

  4722. 

  4723. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4724. function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;

  4725. var

  4726.   bmp: TglBitmap2D;

  4727. begin

  4728.   bmp := TglBitmap2D.Create;

  4729.   try

  4730.     bmp.AssignFromSurface(aSurface);

  4731.     result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);

  4732.   finally

  4733.     bmp.Free;

  4734.   end;

  4735. end;

  4736. {$ENDIF}

  4737. 

  4738. {$IFDEF GLB_DELPHI}

  4739. //TODO rework & test

  4740. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4741. function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;

  4742. var

  4743.   Row: Integer;

  4744.   pSource, pData: PByte;

  4745. begin

  4746.   result := false;

  4747.   if Assigned(Data) then begin

  4748.     if Assigned(aBitmap) then begin

  4749.       aBitmap.Width  := Width;

  4750.       aBitmap.Height := Height;

  4751. 

  4752.       case Format of

  4753.         tfAlpha8, ifLuminance, ifDepth8:

  4754.           begin

  4755.             Bitmap.PixelFormat := pf8bit;

  4756.             Bitmap.Palette := CreateGrayPalette;

  4757.           end;

  4758.         ifRGB5A1:

  4759.           Bitmap.PixelFormat := pf15bit;

  4760.         ifR5G6B5:

  4761.           Bitmap.PixelFormat := pf16bit;

  4762.         ifRGB8, ifBGR8:

  4763.           Bitmap.PixelFormat := pf24bit;

  4764.         ifRGBA8, ifBGRA8:

  4765.           Bitmap.PixelFormat := pf32bit;

  4766.         else

  4767.           raise EglBitmapException.Create('AssignToBitmap - Invalid Pixelformat.');

  4768.       end;

  4769. 

  4770.       pSource := Data;

  4771.       for Row := 0 to FileHeight -1 do begin

  4772.         pData := Bitmap.Scanline[Row];

  4773. 

  4774.         Move(pSource^, pData^, fRowSize);

  4775.         Inc(pSource, fRowSize);

  4776. 

  4777.         // swap RGB(A) to BGR(A)

  4778.         if InternalFormat in [ifRGB8, ifRGBA8] then

  4779.           SwapRGB(pData, FileWidth, InternalFormat = ifRGBA8);

  4780.       end;

  4781. 

  4782.       result := true;

  4783.     end;

  4784.   end;

  4785. end;

  4786. 

  4787. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4788. function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;

  4789. var

  4790.   pSource, pData, pTempData: PByte;

  4791.   Row, RowSize, TempWidth, TempHeight: Integer;

  4792.   IntFormat: TglBitmapInternalFormat;

  4793. begin

  4794.   result := false;

  4795. 

  4796.   if (Assigned(Bitmap)) then begin

  4797.     case Bitmap.PixelFormat of

  4798.       pf8bit:

  4799.         IntFormat := ifLuminance;

  4800.       pf15bit:

  4801.         IntFormat := ifRGB5A1;

  4802.       pf16bit:

  4803.         IntFormat := ifR5G6B5;

  4804.       pf24bit:

  4805.         IntFormat := ifBGR8;

  4806.       pf32bit:

  4807.         IntFormat := ifBGRA8;

  4808.       else

  4809.         raise EglBitmapException.Create('AssignFromBitmap - Invalid Pixelformat.');

  4810.     end;

  4811. 

  4812.     TempWidth := Bitmap.Width;

  4813.     TempHeight := Bitmap.Height;

  4814. 

  4815.     RowSize := Trunc(TempWidth * FormatGetSize(IntFormat));

  4816. 

  4817.     GetMem(pData, TempHeight * RowSize);

  4818.     try

  4819.       pTempData := pData;

  4820. 

  4821.       for Row := 0 to TempHeight -1 do begin

  4822.         pSource := Bitmap.Scanline[Row];

  4823. 

  4824.         if (Assigned(pSource)) then begin

  4825.           Move(pSource^, pTempData^, RowSize);

  4826.           Inc(pTempData, RowSize);

  4827.         end;

  4828.       end;

  4829. 

  4830.       SetDataPointer(pData, IntFormat, TempWidth, TempHeight);

  4831. 

  4832.       result := true;

  4833.     except

  4834.       FreeMem(pData);

  4835.       raise;

  4836.     end;

  4837.   end;

  4838. end;

  4839. 

  4840. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4841. function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;

  4842. var

  4843.   Row, Col, AlphaInterleave: Integer;

  4844.   pSource, pDest: PByte;

  4845. begin

  4846.   result := false;

  4847. 

  4848.   if Assigned(Data) then begin

  4849.     if InternalFormat in [ifAlpha, ifLuminanceAlpha, ifRGBA8, ifBGRA8] then begin

  4850.       if Assigned(Bitmap) then begin

  4851.         Bitmap.PixelFormat := pf8bit;

  4852.         Bitmap.Palette := CreateGrayPalette;

  4853.         Bitmap.Width := Width;

  4854.         Bitmap.Height := Height;

  4855. 

  4856.         case InternalFormat of

  4857.           ifLuminanceAlpha:

  4858.             AlphaInterleave := 1;

  4859.           ifRGBA8, ifBGRA8:

  4860.             AlphaInterleave := 3;

  4861.           else

  4862.             AlphaInterleave := 0;

  4863.         end;

  4864. 

  4865.         // Copy Data

  4866.         pSource := Data;

  4867. 

  4868.         for Row := 0 to Height -1 do begin

  4869.           pDest := Bitmap.Scanline[Row];

  4870. 

  4871.           if Assigned(pDest) then begin

  4872.             for Col := 0 to Width -1 do begin

  4873.               Inc(pSource, AlphaInterleave);

  4874.               pDest^ := pSource^;

  4875.               Inc(pDest);

  4876.               Inc(pSource);

  4877.             end;

  4878.           end;

  4879.         end;

  4880. 

  4881.         result := true;

  4882.       end;

  4883.     end;

  4884.   end;

  4885. end;

  4886. 

  4887. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4888. function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;

  4889. var

  4890.   tex: TglBitmap2D;

  4891. begin

  4892.   tex := TglBitmap2D.Create;

  4893.   try

  4894.     tex.AssignFromBitmap(Bitmap);

  4895.     result := AddAlphaFromglBitmap(tex, Func, CustomData);

  4896.   finally

  4897.     tex.Free;

  4898.   end;

  4899. end;

  4900. 

  4901. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4902. function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar;

  4903.   const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;

  4904. var

  4905.   RS: TResourceStream;

  4906.   TempPos: Integer;

  4907.   ResTypeStr: String;

  4908.   TempResType: PChar;

  4909. begin

  4910.   if Assigned(ResType) then

  4911.     TempResType := ResType

  4912.   else

  4913.     begin

  4914.       TempPos := Pos('.', Resource);

  4915.       ResTypeStr := UpperCase(Copy(Resource, TempPos + 1, Length(Resource) - TempPos));

  4916.       Resource   := UpperCase(Copy(Resource, 0, TempPos -1));

  4917.       TempResType := PChar(ResTypeStr);

  4918.     end;

  4919. 

  4920.   RS := TResourceStream.Create(Instance, Resource, TempResType);

  4921.   try

  4922.     result := AddAlphaFromStream(RS, Func, CustomData);

  4923.   finally

  4924.     RS.Free;

  4925.   end;

  4926. end;

  4927. 

  4928. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  4930.   const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;

  4931. var

  4932.   RS: TResourceStream;

  4933. begin

  4934.   RS := TResourceStream.CreateFromID(Instance, ResourceID, ResType);

  4935.   try

  4936.     result := AddAlphaFromStream(RS, Func, CustomData);

  4937.   finally

  4938.     RS.Free;

  4939.   end;

  4940. end;

  4941. {$ENDIF}

  4942. 

  4943. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4944. function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;

  4945. begin

  4946.   if TFormatDescriptor.Get(Format).IsCompressed then

  4947.     raise EglBitmapUnsupportedFormat.Create(Format);

  4948.   result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);

  4949. end;

  4950. 

  4951. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4952. function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;

  4953. var

  4954.   FS: TFileStream;

  4955. begin

  4956.   FS := TFileStream.Create(FileName, fmOpenRead);

  4957.   try

  4958.     result := AddAlphaFromStream(FS, aFunc, aArgs);

  4959.   finally

  4960.     FS.Free;

  4961.   end;

  4962. end;

  4963. 

  4964. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4965. function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;

  4966. var

  4967.   tex: TglBitmap2D;

  4968. begin

  4969.   tex := TglBitmap2D.Create(aStream);

  4970.   try

  4971.     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);

  4972.   finally

  4973.     tex.Free;

  4974.   end;

  4975. end;

  4976. 

  4977. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4978. function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;

  4979. var

  4980.   DestData, DestData2, SourceData: pByte;

  4981.   TempHeight, TempWidth: Integer;

  4982.   SourceFD, DestFD: TFormatDescriptor;

  4983.   SourceMD, DestMD, DestMD2: Pointer;

  4984. 

  4985.   FuncRec: TglBitmapFunctionRec;

  4986. begin

  4987.   result := false;

  4988. 

  4989.   Assert(Assigned(Data));

  4990.   Assert(Assigned(aBitmap));

  4991.   Assert(Assigned(aBitmap.Data));

  4992. 

  4993.   if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin

  4994.     result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);

  4995. 

  4996.     SourceFD := TFormatDescriptor.Get(aBitmap.Format);

  4997.     DestFD   := TFormatDescriptor.Get(Format);

  4998. 

  4999.     if not Assigned(aFunc) then begin

  5000.       aFunc        := glBitmapAlphaFunc;

  5001.       FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);

  5002.     end else

  5003.       FuncRec.Args := aArgs;

  5004. 

  5005.     // Values

  5006.     TempHeight := aBitmap.FileHeight;

  5007.     TempWidth  := aBitmap.FileWidth;

  5008. 

  5009.     FuncRec.Sender          := Self;

  5010.     FuncRec.Size            := Dimension;

  5011.     FuncRec.Position.Fields := FuncRec.Size.Fields;

  5012. 

  5013.     DestData   := Data;

  5014.     DestData2  := Data;

  5015.     SourceData := aBitmap.Data;

  5016. 

  5017.     // Mapping

  5018.     SourceFD.PreparePixel(FuncRec.Source);

  5019.     DestFD.PreparePixel  (FuncRec.Dest);

  5020. 

  5021.     SourceMD := SourceFD.CreateMappingData;

  5022.     DestMD   := DestFD.CreateMappingData;

  5023.     DestMD2  := DestFD.CreateMappingData;

  5024.     try

  5025.       FuncRec.Position.Y := 0;

  5026.       while FuncRec.Position.Y < TempHeight do begin

  5027.         FuncRec.Position.X := 0;

  5028.         while FuncRec.Position.X < TempWidth do begin

  5029.           SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);

  5030.           DestFD.Unmap  (DestData,   FuncRec.Dest,   DestMD);

  5031.           aFunc(FuncRec);

  5032.           DestFD.Map(FuncRec.Dest, DestData2, DestMD2);

  5033.           inc(FuncRec.Position.X);

  5034.         end;

  5035.         inc(FuncRec.Position.Y);

  5036.       end;

  5037.     finally

  5038.       SourceFD.FreeMappingData(SourceMD);

  5039.       DestFD.FreeMappingData(DestMD);

  5040.       DestFD.FreeMappingData(DestMD2);

  5041.     end;

  5042.   end;

  5043. end;

  5044. 

  5045. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5046. function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;

  5047. begin

  5048.   result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);

  5049. end;

  5050. 

  5051. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5052. function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;

  5053. var

  5054.   PixelData: TglBitmapPixelData;

  5055. begin

  5056.   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);

  5057.   result := AddAlphaFromColorKeyFloat(

  5058.     aRed   / PixelData.Range.r,

  5059.     aGreen / PixelData.Range.g,

  5060.     aBlue  / PixelData.Range.b,

  5061.     aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));

  5062. end;

  5063. 

  5064. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5065. function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;

  5066. var

  5067.   values: array[0..2] of Single;

  5068.   tmp: Cardinal;

  5069.   i: Integer;

  5070.   PixelData: TglBitmapPixelData;

  5071. begin

  5072.   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);

  5073.   with PixelData do begin

  5074.     values[0] := aRed;

  5075.     values[1] := aGreen;

  5076.     values[2] := aBlue;

  5077. 

  5078.     for i := 0 to 2 do begin

  5079.       tmp          := Trunc(Range.arr[i] * aDeviation);

  5080.       Data.arr[i]  := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));

  5081.       Range.arr[i] := Max(0,            Trunc(Range.arr[i] * values[i] - tmp));

  5082.     end;

  5083.     Data.a  := 0;

  5084.     Range.a := 0;

  5085.   end;

  5086.   result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);

  5087. end;

  5088. 

  5089. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5090. function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;

  5091. begin

  5092.   result := AddAlphaFromValueFloat(aAlpha / $FF);

  5093. end;

  5094. 

  5095. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5096. function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;

  5097. var

  5098.   PixelData: TglBitmapPixelData;

  5099. begin

  5100.   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);

  5101.   result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);

  5102. end;

  5103. 

  5104. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5105. function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;

  5106. var

  5107.   PixelData: TglBitmapPixelData;

  5108. begin

  5109.   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);

  5110.   with PixelData do

  5111.     Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));

  5112.   result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);

  5113. end;

  5114. 

  5115. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5116. function TglBitmap.RemoveAlpha: Boolean;

  5117. var

  5118.   FormatDesc: TFormatDescriptor;

  5119. begin

  5120.   result := false;

  5121.   FormatDesc := TFormatDescriptor.Get(Format);

  5122.   if Assigned(Data) then begin

  5123.     if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then

  5124.       raise EglBitmapUnsupportedFormat.Create(Format);

  5125.     result := ConvertTo(FormatDesc.WithoutAlpha);

  5126.   end;

  5127. end;

  5128. 

  5129. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5130. function TglBitmap.Clone: TglBitmap;

  5131. var

  5132.   Temp: TglBitmap;

  5133.   TempPtr: PByte;

  5134.   Size: Integer;

  5135. begin

  5136.   result := nil;

  5137.   Temp := (ClassType.Create as TglBitmap);

  5138.   try

  5139.     // copy texture data if assigned

  5140.     if Assigned(Data) then begin

  5141.       Size := TFormatDescriptor.Get(Format).GetSize(fDimension);

  5142.       GetMem(TempPtr, Size);

  5143.       try

  5144.         Move(Data^, TempPtr^, Size);

  5145.         Temp.SetDataPointer(TempPtr, Format, Width, Height);

  5146.       except

  5147.         FreeMem(TempPtr);

  5148.         raise;

  5149.       end;

  5150.     end else

  5151.       Temp.SetDataPointer(nil, Format, Width, Height);

  5152. 

  5153. 	// copy properties

  5154.     Temp.fID                      := ID;

  5155.     Temp.fTarget                  := Target;

  5156.     Temp.fFormat                  := Format;

  5157.     Temp.fMipMap                  := MipMap;

  5158.     Temp.fAnisotropic             := Anisotropic;

  5159.     Temp.fBorderColor             := fBorderColor;

  5160.     Temp.fDeleteTextureOnFree     := DeleteTextureOnFree;

  5161.     Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;

  5162.     Temp.fFilterMin               := fFilterMin;

  5163.     Temp.fFilterMag               := fFilterMag;

  5164.     Temp.fWrapS                   := fWrapS;

  5165.     Temp.fWrapT                   := fWrapT;

  5166.     Temp.fWrapR                   := fWrapR;

  5167.     Temp.fFilename                := fFilename;

  5168.     Temp.fCustomName              := fCustomName;

  5169.     Temp.fCustomNameW             := fCustomNameW;

  5170.     Temp.fCustomData              := fCustomData;

  5171. 

  5172.     result := Temp;

  5173.   except

  5174.     FreeAndNil(Temp);

  5175.     raise;

  5176.   end;

  5177. end;

  5178. 

  5179. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5180. function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;

  5181. var

  5182.   SourceFD, DestFD: TFormatDescriptor;

  5183.   SourcePD, DestPD: TglBitmapPixelData;

  5184.   ShiftData: TShiftData;

  5185. 

  5186.   function CanCopyDirect: Boolean;

  5187.   begin

  5188.     result :=

  5189.       ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and

  5190.       ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and

  5191.       ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and

  5192.       ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));

  5193.   end;

  5194. 

  5195.   function CanShift: Boolean;

  5196.   begin

  5197.     result :=

  5198.       ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and

  5199.       ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and

  5200.       ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and

  5201.       ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));

  5202.   end;

  5203. 

  5204.   function GetShift(aSource, aDest: Cardinal) : ShortInt;

  5205.   begin

  5206.     result := 0;

  5207.     while (aSource > aDest) and (aSource > 0) do begin

  5208.       inc(result);

  5209.       aSource := aSource shr 1;

  5210.     end;

  5211.   end;

  5212. 

  5213. begin

  5214.   if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin

  5215.     SourceFD := TFormatDescriptor.Get(Format);

  5216.     DestFD   := TFormatDescriptor.Get(aFormat);

  5217. 

  5218.     SourceFD.PreparePixel(SourcePD);

  5219.     DestFD.PreparePixel  (DestPD);

  5220. 

  5221.     if CanCopyDirect then

  5222.       result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)

  5223.     else if CanShift then begin

  5224.       ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);

  5225.       ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);

  5226.       ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);

  5227.       ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);

  5228.       result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);

  5229.     end else

  5230.       result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);

  5231.   end else

  5232.     result := true;

  5233. end;

  5234. 

  5235. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5236. procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);

  5237. begin

  5238.   if aUseRGB or aUseAlpha then

  5239.     AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(

  5240.       ((PtrInt(aUseAlpha) and 1) shl 1) or

  5241.        (PtrInt(aUseRGB)   and 1)      ));

  5242. end;

  5243. 

  5244. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  5246. begin

  5247.   fBorderColor[0] := aRed;

  5248.   fBorderColor[1] := aGreen;

  5249.   fBorderColor[2] := aBlue;

  5250.   fBorderColor[3] := aAlpha;

  5251.   if (ID > 0) then begin

  5252.     Bind(false);

  5253.     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);

  5254.   end;

  5255. end;

  5256. 

  5257. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5258. procedure TglBitmap.FreeData;

  5259. begin

  5260.   SetDataPointer(nil, tfEmpty);

  5261. end;

  5262. 

  5263. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5264. procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;

  5265.   const aAlpha: Byte);

  5266. begin

  5267.   FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);

  5268. end;

  5269. 

  5270. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5271. procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);

  5272. var

  5273.   PixelData: TglBitmapPixelData;

  5274. begin

  5275.   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);

  5276.   FillWithColorFloat(

  5277.     aRed   / PixelData.Range.r,

  5278.     aGreen / PixelData.Range.g,

  5279.     aBlue  / PixelData.Range.b,

  5280.     aAlpha / PixelData.Range.a);

  5281. end;

  5282. 

  5283. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5284. procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);

  5285. var

  5286.   PixelData: TglBitmapPixelData;

  5287. begin

  5288.   TFormatDescriptor.Get(Format).PreparePixel(PixelData);

  5289.   with PixelData do begin

  5290.     Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));

  5291.     Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));

  5292.     Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));

  5293.     Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));

  5294.   end;

  5295.   AddFunc(glBitmapFillWithColorFunc, false, @PixelData);

  5296. end;

  5297. 

  5298. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5299. procedure TglBitmap.SetFilter(const aMin, aMag: Cardinal);

  5300. begin

  5301.   //check MIN filter

  5302.   case aMin of

  5303.     GL_NEAREST:

  5304.       fFilterMin := GL_NEAREST;

  5305.     GL_LINEAR:

  5306.       fFilterMin := GL_LINEAR;

  5307.     GL_NEAREST_MIPMAP_NEAREST:

  5308.       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;

  5309.     GL_LINEAR_MIPMAP_NEAREST:

  5310.       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;

  5311.     GL_NEAREST_MIPMAP_LINEAR:

  5312.       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;

  5313.     GL_LINEAR_MIPMAP_LINEAR:

  5314.       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;

  5315.     else

  5316.       raise EglBitmapException.Create('SetFilter - Unknow MIN filter.');

  5317.   end;

  5318. 

  5319.   //check MAG filter

  5320.   case aMag of

  5321.     GL_NEAREST:

  5322.       fFilterMag := GL_NEAREST;

  5323.     GL_LINEAR:

  5324.       fFilterMag := GL_LINEAR;

  5325.     else

  5326.       raise EglBitmapException.Create('SetFilter - Unknow MAG filter.');

  5327.   end;

  5328. 

  5329.   //apply filter

  5330.   if (ID > 0) then begin

  5331.     Bind(false);

  5332.     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);

  5333. 

  5334.     if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin

  5335.       case fFilterMin of

  5336.         GL_NEAREST, GL_LINEAR:

  5337.           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);

  5338.         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:

  5339.           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);

  5340.         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:

  5341.           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);

  5342.       end;

  5343.     end else

  5344.       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);

  5345.   end;

  5346. end;

  5347. 

  5348. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5349. procedure TglBitmap.SetWrap(const S: Cardinal; const T: Cardinal; const R: Cardinal);

  5350. 

  5351.   procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);

  5352.   begin

  5353.     case aValue of

  5354.       GL_CLAMP:

  5355.         aTarget := GL_CLAMP;

  5356. 

  5357.       GL_REPEAT:

  5358.         aTarget := GL_REPEAT;

  5359. 

  5360.       GL_CLAMP_TO_EDGE: begin

  5361.         if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then

  5362.           aTarget := GL_CLAMP_TO_EDGE

  5363.         else

  5364.           aTarget := GL_CLAMP;

  5365.       end;

  5366. 

  5367.       GL_CLAMP_TO_BORDER: begin

  5368.         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then

  5369.           aTarget := GL_CLAMP_TO_BORDER

  5370.         else

  5371.           aTarget := GL_CLAMP;

  5372.       end;

  5373. 

  5374.       GL_MIRRORED_REPEAT: begin

  5375.         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then

  5376.           aTarget := GL_MIRRORED_REPEAT

  5377.         else

  5378.           raise EglBitmapException.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');

  5379.       end;

  5380.     else

  5381.       raise EglBitmapException.Create('SetWrap - Unknow Texturewrap (S).');

  5382.     end;

  5383.   end;

  5384. 

  5385. begin

  5386.   CheckAndSetWrap(S, fWrapS);

  5387.   CheckAndSetWrap(T, fWrapT);

  5388.   CheckAndSetWrap(R, fWrapR);

  5389. 

  5390.   if (ID > 0) then begin

  5391.     Bind(false);

  5392.     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);

  5393.     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);

  5394.     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);

  5395.   end;

  5396. end;

  5397. 

  5398. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5399. procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);

  5400. begin

  5401.   if aEnableTextureUnit then

  5402.     glEnable(Target);

  5403.   if (ID > 0) then

  5404.     glBindTexture(Target, ID);

  5405. end;

  5406. 

  5407. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5408. procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);

  5409. begin

  5410.   if aDisableTextureUnit then

  5411.     glDisable(Target);

  5412.   glBindTexture(Target, 0);

  5413. end;

  5414. 

  5415. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5416. constructor TglBitmap.Create;

  5417. begin

  5418. {$IFDEF GLB_NATIVE_OGL}

  5419.   glbReadOpenGLExtensions;

  5420. {$ENDIF}

  5421.   if (ClassType = TglBitmap) then

  5422.     raise EglBitmapException.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');

  5423.   inherited Create;

  5424. end;

  5425. 

  5426. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5427. constructor TglBitmap.Create(const aFileName: String);

  5428. begin

  5429.   Create;

  5430.   LoadFromFile(FileName);

  5431. end;

  5432. 

  5433. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5434. constructor TglBitmap.Create(const aStream: TStream);

  5435. begin

  5436.   Create;

  5437.   LoadFromStream(aStream);

  5438. end;

  5439. 

  5440. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5441. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat);

  5442. var

  5443.   Image: PByte;

  5444.   ImageSize: Integer;

  5445. begin

  5446.   Create;

  5447.   ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);

  5448.   GetMem(Image, ImageSize);

  5449.   try

  5450.     FillChar(Image^, ImageSize, #$FF);

  5451.     SetDataPointer(Image, aFormat, aSize.X, aSize.Y);

  5452.   except

  5453.     FreeMem(Image);

  5454.     raise;

  5455.   end;

  5456. end;

  5457. 

  5458. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5459. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat;

  5460.   const aFunc: TglBitmapFunction; const aArgs: Pointer);

  5461. begin

  5462.   Create;

  5463.   LoadFromFunc(aSize, aFunc, aFormat, aArgs);

  5464. end;

  5465. 

  5466. {$IFDEF GLB_DELPHI}

  5467. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5468. constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);

  5469. begin

  5470.   Create;

  5471.   LoadFromResource(aInstance, aResource, aResType);

  5472. end;

  5473. 

  5474. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5475. constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);

  5476. begin

  5477.   Create;

  5478.   LoadFromResourceID(aInstance, aResourceID, aResType);

  5479. end;

  5480. {$ENDIF}

  5481. 

  5482. {$IFDEF GLB_SUPPORT_PNG_READ}

  5483. {$IF DEFINED(GLB_SDL_IMAGE)}

  5484. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5485. //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5486. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5487. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;

  5488. var

  5489.   Surface: PSDL_Surface;

  5490.   RWops: PSDL_RWops;

  5491. begin

  5492.   result := false;

  5493.   RWops := glBitmapCreateRWops(aStream);

  5494.   try

  5495.     if IMG_isPNG(RWops) > 0 then begin

  5496.       Surface := IMG_LoadPNG_RW(RWops);

  5497.       try

  5498.         AssignFromSurface(Surface);

  5499.         result := true;

  5500.       finally

  5501.         SDL_FreeSurface(Surface);

  5502.       end;

  5503.     end;

  5504.   finally

  5505.     SDL_FreeRW(RWops);

  5506.   end;

  5507. end;

  5508. 

  5509. {$ELSEIF DEFINED(GLB_LIB_PNG)}

  5510. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5511. procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;

  5512. begin

  5513.   TStream(png_get_io_ptr(png)).Read(buffer^, size);

  5514. end;

  5515. 

  5516. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5517. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;

  5518. var

  5519.   StreamPos: Int64;

  5520.   signature: array [0..7] of byte;

  5521.   png: png_structp;

  5522.   png_info: png_infop;

  5523. 

  5524.   TempHeight, TempWidth: Integer;

  5525.   Format: TglBitmapFormat;

  5526. 

  5527.   png_data: pByte;

  5528.   png_rows: array of pByte;

  5529.   Row, LineSize: Integer;

  5530. begin

  5531.   result := false;

  5532. 

  5533.   if not init_libPNG then

  5534.     raise Exception.Create('LoadPNG - unable to initialize libPNG.');

  5535. 

  5536.   try

  5537.     // signature

  5538.     StreamPos := aStream.Position;

  5539.     aStream.Read(signature{%H-}, 8);

  5540.     aStream.Position := StreamPos;

  5541. 

  5542.     if png_check_sig(@signature, 8) <> 0 then begin

  5543.       // png read struct

  5544.       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);

  5545.       if png = nil then

  5546.         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');

  5547. 

  5548.       // png info

  5549.       png_info := png_create_info_struct(png);

  5550.       if png_info = nil then begin

  5551.         png_destroy_read_struct(@png, nil, nil);

  5552.         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');

  5553.       end;

  5554. 

  5555.       // set read callback

  5556.       png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);

  5557. 

  5558.       // read informations

  5559.       png_read_info(png, png_info);

  5560. 

  5561.       // size 

  5562.       TempHeight := png_get_image_height(png, png_info);

  5563.       TempWidth := png_get_image_width(png, png_info);

  5564. 

  5565.       // format

  5566.       case png_get_color_type(png, png_info) of

  5567.         PNG_COLOR_TYPE_GRAY:

  5568.           Format := tfLuminance8;

  5569.         PNG_COLOR_TYPE_GRAY_ALPHA:

  5570.           Format := tfLuminance8Alpha8;

  5571.         PNG_COLOR_TYPE_RGB:

  5572.           Format := tfRGB8;

  5573.         PNG_COLOR_TYPE_RGB_ALPHA:

  5574.           Format := tfRGBA8;

  5575.         else

  5576.           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');

  5577.       end;

  5578. 

  5579.       // cut upper 8 bit from 16 bit formats

  5580.       if png_get_bit_depth(png, png_info) > 8 then

  5581.         png_set_strip_16(png);

  5582. 

  5583.       // expand bitdepth smaller than 8

  5584.       if png_get_bit_depth(png, png_info) < 8 then

  5585.         png_set_expand(png);

  5586. 

  5587.       // allocating mem for scanlines

  5588.       LineSize := png_get_rowbytes(png, png_info);

  5589.       GetMem(png_data, TempHeight * LineSize);

  5590.       try

  5591.         SetLength(png_rows, TempHeight);

  5592.         for Row := Low(png_rows) to High(png_rows) do begin

  5593.           png_rows[Row] := png_data;

  5594.           Inc(png_rows[Row], Row * LineSize);

  5595.         end;

  5596. 

  5597.         // read complete image into scanlines

  5598.         png_read_image(png, @png_rows[0]);

  5599. 

  5600.         // read end

  5601.         png_read_end(png, png_info);

  5602. 

  5603.         // destroy read struct

  5604.         png_destroy_read_struct(@png, @png_info, nil);

  5605. 

  5606.         SetLength(png_rows, 0);

  5607. 

  5608.         // set new data

  5609.         SetDataPointer(png_data, Format, TempWidth, TempHeight);

  5610. 

  5611.         result := true;

  5612.       except

  5613.         FreeMem(png_data);

  5614.         raise;

  5615.       end;

  5616.     end;

  5617.   finally

  5618.     quit_libPNG;

  5619.   end;

  5620. end;

  5621. 

  5622. {$ELSEIF DEFINED(GLB_PNGIMAGE)}

  5623. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5624. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;

  5625. var

  5626.   StreamPos: Int64;

  5627.   Png: TPNGObject;

  5628.   Header: String[8];

  5629.   Row, Col, PixSize, LineSize: Integer;

  5630.   NewImage, pSource, pDest, pAlpha: pByte;

  5631.   PngFormat: TglBitmapFormat;

  5632.   FormatDesc: TFormatDescriptor;

  5633. 

  5634. const

  5635.   PngHeader: String[8] = #137#80#78#71#13#10#26#10;

  5636. 

  5637. begin

  5638.   result := false;

  5639. 

  5640.   StreamPos := aStream.Position;

  5641.   aStream.Read(Header[0], SizeOf(Header));

  5642.   aStream.Position := StreamPos;

  5643. 

  5644.   {Test if the header matches}

  5645.   if Header = PngHeader then begin

  5646.     Png := TPNGObject.Create;

  5647.     try

  5648.       Png.LoadFromStream(aStream);

  5649. 

  5650.       case Png.Header.ColorType of

  5651.         COLOR_GRAYSCALE:

  5652.           PngFormat := tfLuminance8;

  5653.         COLOR_GRAYSCALEALPHA:

  5654.           PngFormat := tfLuminance8Alpha8;

  5655.         COLOR_RGB:

  5656.           PngFormat := tfBGR8;

  5657.         COLOR_RGBALPHA:

  5658.           PngFormat := tfBGRA8;

  5659.         else

  5660.           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');

  5661.       end;

  5662. 

  5663.       FormatDesc := TFormatDescriptor.Get(PngFormat);

  5664.       PixSize    := Round(FormatDesc.PixelSize);

  5665.       LineSize   := FormatDesc.GetSize(Png.Header.Width, 1);

  5666. 

  5667.       GetMem(NewImage, LineSize * Integer(Png.Header.Height));

  5668.       try

  5669.         pDest := NewImage;

  5670. 

  5671.         case Png.Header.ColorType of

  5672.           COLOR_RGB, COLOR_GRAYSCALE:

  5673.             begin

  5674.               for Row := 0 to Png.Height -1 do begin

  5675.                 Move (Png.Scanline[Row]^, pDest^, LineSize);

  5676.                 Inc(pDest, LineSize);

  5677.               end;

  5678.             end;

  5679.           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:

  5680.             begin

  5681.               PixSize := PixSize -1;

  5682. 

  5683.               for Row := 0 to Png.Height -1 do begin

  5684.                 pSource := Png.Scanline[Row];

  5685.                 pAlpha := pByte(Png.AlphaScanline[Row]);

  5686. 

  5687.                 for Col := 0 to Png.Width -1 do begin

  5688.                   Move (pSource^, pDest^, PixSize);

  5689.                   Inc(pSource, PixSize);

  5690.                   Inc(pDest, PixSize);

  5691. 

  5692.                   pDest^ := pAlpha^;

  5693.                   inc(pAlpha);

  5694.                   Inc(pDest);

  5695.                 end;

  5696.               end;

  5697.             end;

  5698.           else

  5699.             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');

  5700.         end;

  5701. 

  5702.         SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height);

  5703. 

  5704.         result := true;

  5705.       except

  5706.         FreeMem(NewImage);

  5707.         raise;

  5708.       end;

  5709.     finally

  5710.       Png.Free;

  5711.     end;

  5712.   end;

  5713. end;

  5714. {$IFEND}

  5715. {$ENDIF}

  5716. 

  5717. {$IFDEF GLB_SUPPORT_PNG_WRITE}

  5718. {$IFDEF GLB_LIB_PNG}

  5719. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5720. procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;

  5721. begin

  5722.   TStream(png_get_io_ptr(png)).Write(buffer^, size);

  5723. end;

  5724. {$ENDIF}

  5725. 

  5726. {$IF DEFINED(GLB_LIB_PNG)}

  5727. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5728. procedure TglBitmap.SavePNG(const aStream: TStream);

  5729. var

  5730.   png: png_structp;

  5731.   png_info: png_infop;

  5732.   png_rows: array of pByte;

  5733.   LineSize: Integer;

  5734.   ColorType: Integer;

  5735.   Row: Integer;

  5736.   FormatDesc: TFormatDescriptor;

  5737. begin

  5738.   if not (ftPNG in FormatGetSupportedFiles(Format)) then

  5739.     raise EglBitmapUnsupportedFormat.Create(Format);

  5740. 

  5741.   if not init_libPNG then

  5742.     raise Exception.Create('unable to initialize libPNG.');

  5743. 

  5744.   try

  5745.     case Format of

  5746.       tfAlpha8, tfLuminance8:

  5747.         ColorType := PNG_COLOR_TYPE_GRAY;

  5748.       tfLuminance8Alpha8:

  5749.         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;

  5750.       tfBGR8, tfRGB8:

  5751.         ColorType := PNG_COLOR_TYPE_RGB;

  5752.       tfBGRA8, tfRGBA8:

  5753.         ColorType := PNG_COLOR_TYPE_RGBA;

  5754.       else

  5755.         raise EglBitmapUnsupportedFormat.Create(Format);

  5756.     end;

  5757. 

  5758.     FormatDesc := TFormatDescriptor.Get(Format);

  5759.     LineSize := FormatDesc.GetSize(Width, 1);

  5760. 

  5761.     // creating array for scanline

  5762.     SetLength(png_rows, Height);

  5763.     try

  5764.       for Row := 0 to Height - 1 do begin

  5765.         png_rows[Row] := Data;

  5766.         Inc(png_rows[Row], Row * LineSize)

  5767.       end;

  5768. 

  5769.       // write struct

  5770.       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);

  5771.       if png = nil then

  5772.         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');

  5773. 

  5774.       // create png info

  5775.       png_info := png_create_info_struct(png);

  5776.       if png_info = nil then begin

  5777.         png_destroy_write_struct(@png, nil);

  5778.         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');

  5779.       end;

  5780. 

  5781.       // set read callback

  5782.       png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);

  5783. 

  5784.       // set compression

  5785.       png_set_compression_level(png, 6);

  5786. 

  5787.       if Format in [tfBGR8, tfBGRA8] then

  5788.         png_set_bgr(png);

  5789. 

  5790.       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);

  5791.       png_write_info(png, png_info);

  5792.       png_write_image(png, @png_rows[0]);

  5793.       png_write_end(png, png_info);

  5794.       png_destroy_write_struct(@png, @png_info);

  5795.     finally

  5796.       SetLength(png_rows, 0);

  5797.     end;

  5798.   finally

  5799.     quit_libPNG;

  5800.   end;

  5801. end;

  5802. 

  5803. {$ELSEIF DEFINED(GLB_PNGIMAGE)}

  5804. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5805. procedure TglBitmap.SavePNG(const aStream: TStream);

  5806. var

  5807.   Png: TPNGObject;

  5808. 

  5809.   pSource, pDest: pByte;

  5810.   X, Y, PixSize: Integer;

  5811.   ColorType: Cardinal;

  5812.   Alpha: Boolean;

  5813. 

  5814.   pTemp: pByte;

  5815.   Temp: Byte;

  5816. begin

  5817.   if not (ftPNG in FormatGetSupportedFiles (Format)) then

  5818.     raise EglBitmapUnsupportedFormat.Create(Format);

  5819. 

  5820.   case Format of

  5821.     tfAlpha8, tfLuminance8: begin

  5822.       ColorType := COLOR_GRAYSCALE;

  5823.       PixSize   := 1;

  5824.       Alpha     := false;

  5825.     end;

  5826.     tfLuminance8Alpha8: begin

  5827.       ColorType := COLOR_GRAYSCALEALPHA;

  5828.       PixSize   := 1;

  5829.       Alpha     := true;

  5830.     end;

  5831.     tfBGR8, tfRGB8: begin

  5832.       ColorType := COLOR_RGB;

  5833.       PixSize   := 3;

  5834.       Alpha     := false;

  5835.     end;

  5836.     tfBGRA8, tfRGBA8: begin

  5837.       ColorType := COLOR_RGBALPHA;

  5838.       PixSize   := 3;

  5839.       Alpha     := true

  5840.     end;

  5841.   else

  5842.     raise EglBitmapUnsupportedFormat.Create(Format);

  5843.   end;

  5844. 

  5845.   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);

  5846.   try

  5847.     // Copy ImageData

  5848.     pSource := Data;

  5849.     for Y := 0 to Height -1 do begin

  5850.       pDest := png.ScanLine[Y];

  5851.       for X := 0 to Width -1 do begin

  5852.         Move(pSource^, pDest^, PixSize);

  5853.         Inc(pDest, PixSize);

  5854.         Inc(pSource, PixSize);

  5855.         if Alpha then begin

  5856.           png.AlphaScanline[Y]^[X] := pSource^;

  5857.           Inc(pSource);

  5858.         end;

  5859.       end;

  5860. 

  5861.       // convert RGB line to BGR

  5862.       if Format in [tfRGB8, tfRGBA8] then begin

  5863.         pTemp := png.ScanLine[Y];

  5864.         for X := 0 to Width -1 do begin

  5865.           Temp := pByteArray(pTemp)^[0];

  5866.           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];

  5867.           pByteArray(pTemp)^[2] := Temp;

  5868.           Inc(pTemp, 3);

  5869.         end;

  5870.       end;

  5871.     end;

  5872. 

  5873.     // Save to Stream

  5874.     Png.CompressionLevel := 6;

  5875.     Png.SaveToStream(aStream);

  5876.   finally

  5877.     FreeAndNil(Png);

  5878.   end;

  5879. end;

  5880. {$IFEND}

  5881. {$ENDIF}

  5882. 

  5883. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5884. //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5885. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5886. {$IFDEF GLB_LIB_JPEG}

  5887. type

  5888.   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;

  5889.   glBitmap_libJPEG_source_mgr = record

  5890.     pub: jpeg_source_mgr;

  5891. 

  5892.     SrcStream: TStream;

  5893.     SrcBuffer: array [1..4096] of byte;

  5894.   end;

  5895. 

  5896.   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;

  5897.   glBitmap_libJPEG_dest_mgr = record

  5898.     pub: jpeg_destination_mgr;

  5899. 

  5900.     DestStream: TStream;

  5901.     DestBuffer: array [1..4096] of byte;

  5902.   end;

  5903. 

  5904. procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;

  5905. begin

  5906.   //DUMMY

  5907. end;

  5908. 

  5909. 

  5910. procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;

  5911. begin

  5912.   //DUMMY

  5913. end;

  5914. 

  5915. 

  5916. procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;

  5917. begin

  5918.   //DUMMY

  5919. end;

  5920. 

  5921. procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;

  5922. begin

  5923.   //DUMMY

  5924. end;

  5925. 

  5926. 

  5927. procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;

  5928. begin

  5929.   //DUMMY

  5930. end;

  5931. 

  5932. 

  5933. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5934. function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;

  5935. var

  5936.   src: glBitmap_libJPEG_source_mgr_ptr;

  5937.   bytes: integer;

  5938. begin

  5939.   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);

  5940. 

  5941.   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);

  5942. 	if (bytes <= 0) then begin

  5943. 		src^.SrcBuffer[1] := $FF;

  5944. 		src^.SrcBuffer[2] := JPEG_EOI;

  5945. 		bytes := 2;

  5946. 	end;

  5947. 

  5948. 	src^.pub.next_input_byte := @(src^.SrcBuffer[1]);

  5949. 	src^.pub.bytes_in_buffer := bytes;

  5950. 

  5951.   result := true;

  5952. end;

  5953. 

  5954. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5955. procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;

  5956. var

  5957.   src: glBitmap_libJPEG_source_mgr_ptr;

  5958. begin

  5959.   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);

  5960. 

  5961.   if num_bytes > 0 then begin

  5962.     // wanted byte isn't in buffer so set stream position and read buffer

  5963.     if num_bytes > src^.pub.bytes_in_buffer then begin

  5964.       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;

  5965.       src^.pub.fill_input_buffer(cinfo);

  5966.     end else begin

  5967.       // wanted byte is in buffer so only skip

  5968.   		inc(src^.pub.next_input_byte, num_bytes);

  5969. 	  	dec(src^.pub.bytes_in_buffer, num_bytes);

  5970.     end;

  5971.   end;

  5972. end;

  5973. 

  5974. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5975. function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;

  5976. var

  5977.   dest: glBitmap_libJPEG_dest_mgr_ptr;

  5978. begin

  5979.   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);

  5980. 

  5981.   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin

  5982.     // write complete buffer

  5983.     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));

  5984. 

  5985.     // reset buffer

  5986.     dest^.pub.next_output_byte := @dest^.DestBuffer[1];

  5987.     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);

  5988.   end;

  5989. 

  5990.   result := true;

  5991. end;

  5992. 

  5993. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5994. procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;

  5995. var

  5996.   Idx: Integer;

  5997.   dest: glBitmap_libJPEG_dest_mgr_ptr;

  5998. begin

  5999.   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);

  6000. 

  6001.   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin

  6002.     // check for endblock

  6003.     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin

  6004.       // write endblock

  6005.       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);

  6006. 

  6007.       // leave

  6008.       break;

  6009.     end else

  6010.       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);

  6011.   end;

  6012. end;

  6013. {$ENDIF}

  6014. 

  6015. {$IFDEF GLB_SUPPORT_JPEG_READ}

  6016. {$IF DEFINED(GLB_SDL_IMAGE)}

  6017. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6018. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;

  6019. var

  6020.   Surface: PSDL_Surface;

  6021.   RWops: PSDL_RWops;

  6022. begin

  6023.   result := false;

  6024. 

  6025.   RWops := glBitmapCreateRWops(aStream);

  6026.   try

  6027.     if IMG_isJPG(RWops) > 0 then begin

  6028.       Surface := IMG_LoadJPG_RW(RWops);

  6029.       try

  6030.         AssignFromSurface(Surface);

  6031.         result := true;

  6032.       finally

  6033.         SDL_FreeSurface(Surface);

  6034.       end;

  6035.     end;

  6036.   finally

  6037.     SDL_FreeRW(RWops);

  6038.   end;

  6039. end;

  6040. 

  6041. {$ELSEIF DEFINED(GLB_LIB_JPEG)}

  6042. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6043. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;

  6044. var

  6045.   StreamPos: Int64;

  6046.   Temp: array[0..1]of Byte;

  6047. 

  6048.   jpeg: jpeg_decompress_struct;

  6049.   jpeg_err: jpeg_error_mgr;

  6050. 

  6051.   IntFormat: TglBitmapFormat;

  6052.   pImage: pByte;

  6053.   TempHeight, TempWidth: Integer;

  6054. 

  6055.   pTemp: pByte;

  6056.   Row: Integer;

  6057. 

  6058.   FormatDesc: TFormatDescriptor;

  6059. begin

  6060.   result := false;

  6061. 

  6062.   if not init_libJPEG then

  6063.     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');

  6064. 

  6065.   try

  6066.     // reading first two bytes to test file and set cursor back to begin

  6067.     StreamPos := aStream.Position;

  6068.     aStream.Read({%H-}Temp[0], 2);

  6069.     aStream.Position := StreamPos;

  6070. 

  6071.     // if Bitmap then read file.

  6072.     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin

  6073.       FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);

  6074.       FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);

  6075. 

  6076.       // error managment

  6077.       jpeg.err := jpeg_std_error(@jpeg_err);

  6078.       jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;

  6079.       jpeg_err.output_message := glBitmap_libJPEG_output_message;

  6080. 

  6081.       // decompression struct

  6082.       jpeg_create_decompress(@jpeg);

  6083. 

  6084.       // allocation space for streaming methods

  6085.       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));

  6086. 

  6087.       // seeting up custom functions

  6088.       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin

  6089.         pub.init_source       := glBitmap_libJPEG_init_source;

  6090.         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;

  6091.         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;

  6092.         pub.resync_to_restart := jpeg_resync_to_restart; // use default method

  6093.         pub.term_source       := glBitmap_libJPEG_term_source;

  6094. 

  6095.         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read

  6096.         pub.next_input_byte := nil;   // until buffer loaded

  6097. 

  6098.         SrcStream := aStream;

  6099.       end;

  6100. 

  6101.       // set global decoding state

  6102.       jpeg.global_state := DSTATE_START;

  6103. 

  6104.       // read header of jpeg

  6105.       jpeg_read_header(@jpeg, false);

  6106. 

  6107.       // setting output parameter

  6108.       case jpeg.jpeg_color_space of

  6109.         JCS_GRAYSCALE:

  6110.           begin

  6111.             jpeg.out_color_space := JCS_GRAYSCALE;

  6112.             IntFormat := tfLuminance8;

  6113.           end;

  6114.         else

  6115.           jpeg.out_color_space := JCS_RGB;

  6116.           IntFormat := tfRGB8;

  6117.       end;

  6118. 

  6119.       // reading image

  6120.       jpeg_start_decompress(@jpeg);

  6121. 

  6122.       TempHeight := jpeg.output_height;

  6123.       TempWidth := jpeg.output_width;

  6124. 

  6125.       FormatDesc := TFormatDescriptor.Get(IntFormat);

  6126. 

  6127.       // creating new image

  6128.       GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));

  6129.       try

  6130.         pTemp := pImage;

  6131. 

  6132.         for Row := 0 to TempHeight -1 do begin

  6133.           jpeg_read_scanlines(@jpeg, @pTemp, 1);

  6134.           Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));

  6135.         end;

  6136. 

  6137.         // finish decompression

  6138.         jpeg_finish_decompress(@jpeg);

  6139. 

  6140.         // destroy decompression

  6141.         jpeg_destroy_decompress(@jpeg);

  6142. 

  6143.         SetDataPointer(pImage, IntFormat, TempWidth, TempHeight);

  6144. 

  6145.         result := true;

  6146.       except

  6147.         FreeMem(pImage);

  6148.         raise;

  6149.       end;

  6150.     end;

  6151.   finally

  6152.     quit_libJPEG;

  6153.   end;

  6154. end;

  6155. 

  6156. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}

  6157. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6158. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;

  6159. var

  6160.   bmp: TBitmap;

  6161.   jpg: TJPEGImage;

  6162.   StreamPos: Int64;

  6163.   Temp: array[0..1]of Byte;

  6164. begin

  6165.   result := false;

  6166. 

  6167.   // reading first two bytes to test file and set cursor back to begin

  6168.   StreamPos := Stream.Position;

  6169.   Stream.Read(Temp[0], 2);

  6170.   Stream.Position := StreamPos;

  6171. 

  6172.   // if Bitmap then read file.

  6173.   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin

  6174.     bmp := TBitmap.Create;

  6175.     try

  6176.       jpg := TJPEGImage.Create;

  6177.       try

  6178.         jpg.LoadFromStream(Stream);

  6179.         bmp.Assign(jpg);

  6180.         result := AssignFromBitmap(bmp);

  6181.       finally

  6182.         jpg.Free;

  6183.       end;

  6184.     finally

  6185.       bmp.Free;

  6186.     end;

  6187.   end;

  6188. end;

  6189. {$IFEND}

  6190. {$ENDIF}

  6191. 

  6192. {$IFDEF GLB_SUPPORT_JPEG_WRITE}

  6193. {$IF DEFINED(GLB_LIB_JPEG)}

  6194. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6195. procedure TglBitmap.SaveJPEG(const aStream: TStream);

  6196. var

  6197.   jpeg: jpeg_compress_struct;

  6198.   jpeg_err: jpeg_error_mgr;

  6199.   Row: Integer;

  6200.   pTemp, pTemp2: pByte;

  6201. 

  6202.   procedure CopyRow(pDest, pSource: pByte);

  6203.   var

  6204.     X: Integer;

  6205.   begin

  6206.     for X := 0 to Width - 1 do begin

  6207.       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];

  6208.       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];

  6209.       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];

  6210.       Inc(pDest, 3);

  6211.       Inc(pSource, 3);

  6212.     end;

  6213.   end;

  6214. 

  6215. begin

  6216.   if not (ftJPEG in FormatGetSupportedFiles(Format)) then

  6217.     raise EglBitmapUnsupportedFormat.Create(Format);

  6218. 

  6219.   if not init_libJPEG then

  6220.     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');

  6221. 

  6222.   try

  6223.     FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);

  6224.     FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);

  6225. 

  6226.     // error managment

  6227.     jpeg.err := jpeg_std_error(@jpeg_err);

  6228.     jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;

  6229.     jpeg_err.output_message := glBitmap_libJPEG_output_message;

  6230. 

  6231.     // compression struct

  6232.     jpeg_create_compress(@jpeg);

  6233. 

  6234.     // allocation space for streaming methods

  6235.     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));

  6236. 

  6237.     // seeting up custom functions

  6238.     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin

  6239.       pub.init_destination    := glBitmap_libJPEG_init_destination;

  6240.       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;

  6241.       pub.term_destination    := glBitmap_libJPEG_term_destination;

  6242. 

  6243.       pub.next_output_byte  := @DestBuffer[1];

  6244.       pub.free_in_buffer    := Length(DestBuffer);

  6245. 

  6246.       DestStream := aStream;

  6247.     end;

  6248. 

  6249.     // very important state

  6250.     jpeg.global_state := CSTATE_START;

  6251.     jpeg.image_width  := Width;

  6252.     jpeg.image_height := Height;

  6253.     case Format of

  6254.       tfAlpha8, tfLuminance8: begin

  6255.         jpeg.input_components := 1;

  6256.         jpeg.in_color_space   := JCS_GRAYSCALE;

  6257.       end;

  6258.       tfRGB8, tfBGR8: begin

  6259.         jpeg.input_components := 3;

  6260.         jpeg.in_color_space   := JCS_RGB;

  6261.       end;

  6262.     end;

  6263. 

  6264.     jpeg_set_defaults(@jpeg);

  6265.     jpeg_set_quality(@jpeg, 95, true);

  6266.     jpeg_start_compress(@jpeg, true);

  6267.     pTemp := Data;

  6268. 

  6269.     if Format = tfBGR8 then

  6270.       GetMem(pTemp2, fRowSize)

  6271.     else

  6272.       pTemp2 := pTemp;

  6273. 

  6274.     try

  6275.       for Row := 0 to jpeg.image_height -1 do begin

  6276.         // prepare row

  6277.         if Format = tfBGR8 then

  6278.           CopyRow(pTemp2, pTemp)

  6279.         else

  6280.           pTemp2 := pTemp;

  6281. 

  6282.         // write row

  6283.         jpeg_write_scanlines(@jpeg, @pTemp2, 1);

  6284.         inc(pTemp, fRowSize);

  6285.       end;

  6286.     finally

  6287.       // free memory

  6288.       if Format = tfBGR8 then

  6289.         FreeMem(pTemp2);

  6290.     end;

  6291.     jpeg_finish_compress(@jpeg);

  6292.     jpeg_destroy_compress(@jpeg);

  6293.   finally

  6294.     quit_libJPEG;

  6295.   end;

  6296. end;

  6297. 

  6298. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}

  6299. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6300. procedure TglBitmap.SaveJPEG(Stream: TStream);

  6301. var

  6302.   Bmp: TBitmap;

  6303.   Jpg: TJPEGImage;

  6304. begin

  6305.   if not (ftJPEG in FormatGetSupportedFiles (InternalFormat)) then

  6306.     raise EglBitmapUnsupportedInternalFormat.Create('SaveJpg - ' + UNSUPPORTED_INTERNAL_FORMAT);

  6307. 

  6308.   Bmp := TBitmap.Create;

  6309.   try

  6310.     Jpg := TJPEGImage.Create;

  6311.     try

  6312.       AssignToBitmap(Bmp);

  6313.       if FInternalFormat in [ifAlpha, ifLuminance, ifDepth8] then begin

  6314.         Jpg.Grayscale := true;

  6315.         Jpg.PixelFormat := jf8Bit;

  6316.       end;

  6317.       Jpg.Assign(Bmp);

  6318.       Jpg.SaveToStream(Stream);

  6319.     finally

  6320.       FreeAndNil(Jpg);

  6321.     end;

  6322.   finally

  6323.     FreeAndNil(Bmp);

  6324.   end;

  6325. end;

  6326. {$ENDIF}

  6327. {$ENDIF}

  6328. 

  6329. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6330. //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6331. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6332. const

  6333.   BMP_MAGIC          = $4D42;

  6334. 

  6335.   BMP_COMP_RGB       = 0;

  6336.   BMP_COMP_RLE8      = 1;

  6337.   BMP_COMP_RLE4      = 2;

  6338.   BMP_COMP_BITFIELDS = 3;

  6339. 

  6340. type

  6341.   TBMPHeader = packed record

  6342.     bfType: Word;

  6343.     bfSize: Cardinal;

  6344.     bfReserved1: Word;

  6345.     bfReserved2: Word;

  6346.     bfOffBits: Cardinal;

  6347.   end;

  6348. 

  6349.   TBMPInfo = packed record

  6350.     biSize: Cardinal;

  6351.     biWidth: Longint;

  6352.     biHeight: Longint;

  6353.     biPlanes: Word;

  6354.     biBitCount: Word;

  6355.     biCompression: Cardinal;

  6356.     biSizeImage: Cardinal;

  6357.     biXPelsPerMeter: Longint;

  6358.     biYPelsPerMeter: Longint;

  6359.     biClrUsed: Cardinal;

  6360.     biClrImportant: Cardinal;

  6361.   end;

  6362. 

  6363. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6364. function TglBitmap.LoadBMP(const aStream: TStream): Boolean;

  6365. 

  6366.   //////////////////////////////////////////////////////////////////////////////////////////////////

  6367.   function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapColorRec): TglBitmapFormat;

  6368.   begin

  6369.     result := tfEmpty;

  6370.     aStream.Read(aInfo{%H-}, SizeOf(aInfo));

  6371.     FillChar(aMask{%H-}, SizeOf(aMask), 0);

  6372. 

  6373.     //Read Compression

  6374.     case aInfo.biCompression of

  6375.       BMP_COMP_RLE4,

  6376.       BMP_COMP_RLE8: begin

  6377.         raise EglBitmapException.Create('RLE compression is not supported');

  6378.       end;

  6379.       BMP_COMP_BITFIELDS: begin

  6380.         if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin

  6381.           aStream.Read(aMask.r, SizeOf(aMask.r));

  6382.           aStream.Read(aMask.g, SizeOf(aMask.g));

  6383.           aStream.Read(aMask.b, SizeOf(aMask.b));

  6384.           aStream.Read(aMask.a, SizeOf(aMask.a));

  6385.         end else

  6386.           raise EglBitmapException.Create('Bitfields are only supported for 16bit and 32bit formats');

  6387.       end;

  6388.     end;

  6389. 

  6390.     //get suitable format

  6391.     case aInfo.biBitCount of

  6392.        8: result := tfLuminance8;

  6393.       16: result := tfBGR5;

  6394.       24: result := tfBGR8;

  6395.       32: result := tfBGRA8;

  6396.     end;

  6397.   end;

  6398. 

  6399.   function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;

  6400.   var

  6401.     i, c: Integer;

  6402.     ColorTable: TbmpColorTable;

  6403.   begin

  6404.     result := nil;

  6405.     if (aInfo.biBitCount >= 16) then

  6406.       exit;

  6407.     aFormat := tfLuminance8;

  6408.     c := aInfo.biClrUsed;

  6409.     if (c = 0) then

  6410.       c := 1 shl aInfo.biBitCount;

  6411.     SetLength(ColorTable, c);

  6412.     for i := 0 to c-1 do begin

  6413.       aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));

  6414.       if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then

  6415.         aFormat := tfRGB8;

  6416.     end;

  6417. 

  6418.     result := TbmpColorTableFormat.Create;

  6419.     result.PixelSize  := aInfo.biBitCount / 8;

  6420.     result.ColorTable := ColorTable;

  6421.     result.Range      := glBitmapColorRec($FF, $FF, $FF, $00);

  6422.   end;

  6423. 

  6424.   //////////////////////////////////////////////////////////////////////////////////////////////////

  6425.   function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;

  6426.     const aInfo: TBMPInfo): TbmpBitfieldFormat;

  6427.   var

  6428.     TmpFormat: TglBitmapFormat;

  6429.     FormatDesc: TFormatDescriptor;

  6430.   begin

  6431.     result := nil;

  6432.     if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin

  6433.       for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin

  6434.         FormatDesc := TFormatDescriptor.Get(TmpFormat);

  6435.         if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin

  6436.           aFormat := FormatDesc.Format;

  6437.           exit;

  6438.         end;

  6439.       end;

  6440. 

  6441.       if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then

  6442.         aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;

  6443.       if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then

  6444.         aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;

  6445. 

  6446.       result := TbmpBitfieldFormat.Create;

  6447.       result.PixelSize := aInfo.biBitCount / 8;

  6448.       result.RedMask   := aMask.r;

  6449.       result.GreenMask := aMask.g;

  6450.       result.BlueMask  := aMask.b;

  6451.       result.AlphaMask := aMask.a;

  6452.     end;

  6453.   end;

  6454. 

  6455. var

  6456.   //simple types

  6457.   StartPos: Int64;

  6458.   ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;

  6459.   PaddingBuff: Cardinal;

  6460.   LineBuf, ImageData, TmpData: PByte;

  6461.   SourceMD, DestMD: Pointer;

  6462.   BmpFormat: TglBitmapFormat;

  6463. 

  6464.   //records

  6465.   Mask: TglBitmapColorRec;

  6466.   Header: TBMPHeader;

  6467.   Info: TBMPInfo;

  6468. 

  6469.   //classes

  6470.   SpecialFormat: TFormatDescriptor;

  6471.   FormatDesc: TFormatDescriptor;

  6472. 

  6473.   //////////////////////////////////////////////////////////////////////////////////////////////////

  6474.   procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);

  6475.   var

  6476.     i: Integer;

  6477.     Pixel: TglBitmapPixelData;

  6478.   begin

  6479.     aStream.Read(aLineBuf^, rbLineSize);

  6480.     SpecialFormat.PreparePixel(Pixel);

  6481.     for i := 0 to Info.biWidth-1 do begin

  6482.       SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);

  6483.       glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);

  6484.       FormatDesc.Map(Pixel, aData, DestMD);

  6485.     end;

  6486.   end;

  6487. 

  6488. begin

  6489.   result        := false;

  6490.   BmpFormat     := tfEmpty;

  6491.   SpecialFormat := nil;

  6492.   LineBuf       := nil;

  6493.   SourceMD      := nil;

  6494.   DestMD        := nil;

  6495. 

  6496.   // Header

  6497.   StartPos := aStream.Position;

  6498.   aStream.Read(Header{%H-}, SizeOf(Header));

  6499. 

  6500.   if Header.bfType = BMP_MAGIC then begin

  6501.     try try

  6502.       BmpFormat        := ReadInfo(Info, Mask);

  6503.       SpecialFormat    := ReadColorTable(BmpFormat, Info);

  6504.       if not Assigned(SpecialFormat) then

  6505.         SpecialFormat  := CheckBitfields(BmpFormat, Mask, Info);

  6506.       aStream.Position := StartPos + Header.bfOffBits;

  6507. 

  6508.       if (BmpFormat <> tfEmpty) then begin

  6509.         FormatDesc := TFormatDescriptor.Get(BmpFormat);

  6510.         rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize

  6511.         wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);

  6512.         Padding    := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;

  6513. 

  6514.         //get Memory

  6515.         DestMD    := FormatDesc.CreateMappingData;

  6516.         ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));

  6517.         GetMem(ImageData, ImageSize);

  6518.         if Assigned(SpecialFormat) then begin

  6519.           GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields

  6520.           SourceMD := SpecialFormat.CreateMappingData;

  6521.         end;

  6522. 

  6523.         //read Data

  6524.         try try

  6525.           FillChar(ImageData^, ImageSize, $FF);

  6526.           TmpData := ImageData;

  6527.           if (Info.biHeight > 0) then

  6528.             Inc(TmpData, wbLineSize * (Info.biHeight-1));

  6529.           for i := 0 to Abs(Info.biHeight)-1 do begin

  6530.             if Assigned(SpecialFormat) then

  6531.               SpecialFormatReadLine(TmpData, LineBuf)  //if is special format read and convert data

  6532.             else

  6533.               aStream.Read(TmpData^, wbLineSize);   //else only read data

  6534.             if (Info.biHeight > 0) then

  6535.               dec(TmpData, wbLineSize)

  6536.             else

  6537.               inc(TmpData, wbLineSize);

  6538.             aStream.Read(PaddingBuff{%H-}, Padding);

  6539.           end;

  6540.           SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight));

  6541.           result := true;

  6542.         finally

  6543.           if Assigned(LineBuf) then

  6544.             FreeMem(LineBuf);

  6545.           if Assigned(SourceMD) then

  6546.             SpecialFormat.FreeMappingData(SourceMD);

  6547.           FormatDesc.FreeMappingData(DestMD);

  6548.         end;

  6549.         except

  6550.           FreeMem(ImageData);

  6551.           raise;

  6552.         end;

  6553.       end else

  6554.         raise EglBitmapException.Create('LoadBMP - No suitable format found');

  6555.     except

  6556.       aStream.Position := StartPos;

  6557.       raise;

  6558.     end;

  6559.     finally

  6560.       FreeAndNil(SpecialFormat);

  6561.     end;

  6562.   end

  6563.     else aStream.Position := StartPos;

  6564. end;

  6565. 

  6566. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6567. procedure TglBitmap.SaveBMP(const aStream: TStream);

  6568. var

  6569.   Header: TBMPHeader;

  6570.   Info: TBMPInfo;

  6571.   Converter: TbmpColorTableFormat;

  6572.   FormatDesc: TFormatDescriptor;

  6573.   SourceFD, DestFD: Pointer;

  6574.   pData, srcData, dstData, ConvertBuffer: pByte;

  6575. 

  6576.   Pixel: TglBitmapPixelData;

  6577.   ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;

  6578.   RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;

  6579. 

  6580.   PaddingBuff: Cardinal;

  6581. 

  6582.   function GetLineWidth : Integer;

  6583.   begin

  6584.     result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;

  6585.   end;

  6586. 

  6587. begin

  6588.   if not (ftBMP in FormatGetSupportedFiles(Format)) then

  6589.     raise EglBitmapUnsupportedFormat.Create(Format);

  6590. 

  6591.   Converter  := nil;

  6592.   FormatDesc := TFormatDescriptor.Get(Format);

  6593.   ImageSize  := FormatDesc.GetSize(Dimension);

  6594. 

  6595.   FillChar(Header{%H-}, SizeOf(Header), 0);

  6596.   Header.bfType      := BMP_MAGIC;

  6597.   Header.bfSize      := SizeOf(Header) + SizeOf(Info) + ImageSize;

  6598.   Header.bfReserved1 := 0;

  6599.   Header.bfReserved2 := 0;

  6600.   Header.bfOffBits   := SizeOf(Header) + SizeOf(Info);

  6601. 

  6602.   FillChar(Info{%H-}, SizeOf(Info), 0);

  6603.   Info.biSize        := SizeOf(Info);

  6604.   Info.biWidth       := Width;

  6605.   Info.biHeight      := Height;

  6606.   Info.biPlanes      := 1;

  6607.   Info.biCompression := BMP_COMP_RGB;

  6608.   Info.biSizeImage   := ImageSize;

  6609. 

  6610.   try

  6611.     case Format of

  6612.       tfLuminance4: begin

  6613.         Info.biBitCount  := 4;

  6614.         Header.bfSize    := Header.bfSize    + 16 * SizeOf(Cardinal);

  6615.         Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries

  6616.         Converter           := TbmpColorTableFormat.Create;

  6617.         Converter.PixelSize := 0.5;

  6618.         Converter.Format    := Format;

  6619.         Converter.Range     := glBitmapColorRec($F, $F, $F, $0);

  6620.         Converter.CreateColorTable;

  6621.       end;

  6622. 

  6623.       tfR3G3B2, tfLuminance8: begin

  6624.         Info.biBitCount  :=  8;

  6625.         Header.bfSize    := Header.bfSize    + 256 * SizeOf(Cardinal);

  6626.         Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries

  6627.         Converter           := TbmpColorTableFormat.Create;

  6628.         Converter.PixelSize := 1;

  6629.         Converter.Format    := Format;

  6630.         if (Format = tfR3G3B2) then begin

  6631.           Converter.Range := glBitmapColorRec($7, $7, $3, $0);

  6632.           Converter.Shift := glBitmapShiftRec(0, 3, 6, 0);

  6633.         end else

  6634.           Converter.Range := glBitmapColorRec($FF, $FF, $FF, $0);

  6635.         Converter.CreateColorTable;

  6636.       end;

  6637. 

  6638.       tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,

  6639.       tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin

  6640.         Info.biBitCount    := 16;

  6641.         Info.biCompression := BMP_COMP_BITFIELDS;

  6642.       end;

  6643. 

  6644.       tfBGR8, tfRGB8: begin

  6645.         Info.biBitCount := 24;

  6646.       end;

  6647. 

  6648.       tfRGB10, tfRGB10A2, tfRGBA8,

  6649.       tfBGR10, tfBGR10A2, tfBGRA8: begin

  6650.         Info.biBitCount    := 32;

  6651.         Info.biCompression := BMP_COMP_BITFIELDS;

  6652.       end;

  6653.     else

  6654.       raise EglBitmapUnsupportedFormat.Create(Format);

  6655.     end;

  6656.     Info.biXPelsPerMeter := 2835;

  6657.     Info.biYPelsPerMeter := 2835;

  6658. 

  6659.     // prepare bitmasks

  6660.     if Info.biCompression = BMP_COMP_BITFIELDS then begin

  6661.       Header.bfSize    := Header.bfSize    + 4 * SizeOf(Cardinal);

  6662.       Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);

  6663. 

  6664.       RedMask    := FormatDesc.RedMask;

  6665.       GreenMask  := FormatDesc.GreenMask;

  6666.       BlueMask   := FormatDesc.BlueMask;

  6667.       AlphaMask  := FormatDesc.AlphaMask;

  6668.     end;

  6669. 

  6670.     // headers

  6671.     aStream.Write(Header, SizeOf(Header));

  6672.     aStream.Write(Info, SizeOf(Info));

  6673. 

  6674.     // colortable

  6675.     if Assigned(Converter) then

  6676.       aStream.Write(Converter.ColorTable[0].b,

  6677.         SizeOf(TbmpColorTableEnty) * Length(Converter.ColorTable));

  6678. 

  6679.     // bitmasks

  6680.     if Info.biCompression = BMP_COMP_BITFIELDS then begin

  6681.       aStream.Write(RedMask,   SizeOf(Cardinal));

  6682.       aStream.Write(GreenMask, SizeOf(Cardinal));

  6683.       aStream.Write(BlueMask,  SizeOf(Cardinal));

  6684.       aStream.Write(AlphaMask, SizeOf(Cardinal));

  6685.     end;

  6686. 

  6687.     // image data

  6688.     rbLineSize  := Round(Info.biWidth * FormatDesc.PixelSize);

  6689.     wbLineSize  := Round(Info.biWidth * Info.biBitCount / 8);

  6690.     Padding     := GetLineWidth - wbLineSize;

  6691.     PaddingBuff := 0;

  6692. 

  6693.     pData := Data;

  6694.     inc(pData, (Height-1) * rbLineSize);

  6695. 

  6696.     // prepare row buffer. But only for RGB because RGBA supports color masks

  6697.     // so it's possible to change color within the image.

  6698.     if Assigned(Converter) then begin

  6699.       FormatDesc.PreparePixel(Pixel);

  6700.       GetMem(ConvertBuffer, wbLineSize);

  6701.       SourceFD := FormatDesc.CreateMappingData;

  6702.       DestFD   := Converter.CreateMappingData;

  6703.     end else

  6704.       ConvertBuffer := nil;

  6705. 

  6706.     try

  6707.       for LineIdx := 0 to Height - 1 do begin

  6708.         // preparing row

  6709.         if Assigned(Converter) then begin

  6710.           srcData := pData;

  6711.           dstData := ConvertBuffer;

  6712.           for PixelIdx := 0 to Info.biWidth-1 do begin

  6713.             FormatDesc.Unmap(srcData, Pixel, SourceFD);

  6714.             glBitmapConvertPixel(Pixel, FormatDesc, Converter);

  6715.             Converter.Map(Pixel, dstData, DestFD);

  6716.           end;

  6717.           aStream.Write(ConvertBuffer^, wbLineSize);

  6718.         end else begin

  6719.           aStream.Write(pData^, rbLineSize);

  6720.         end;

  6721.         dec(pData, rbLineSize);

  6722.         if (Padding > 0) then

  6723.           aStream.Write(PaddingBuff, Padding);

  6724.       end;

  6725.     finally

  6726.       // destroy row buffer

  6727.       if Assigned(ConvertBuffer) then begin

  6728.         FormatDesc.FreeMappingData(SourceFD);

  6729.         Converter.FreeMappingData(DestFD);

  6730.         FreeMem(ConvertBuffer);

  6731.       end;

  6732.     end;

  6733.   finally

  6734.     if Assigned(Converter) then

  6735.       Converter.Free;

  6736.   end;

  6737. end;

  6738. 

  6739. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6740. //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6741. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6742. type

  6743.   TTGAHeader = packed record

  6744.     ImageID: Byte;

  6745.     ColorMapType: Byte;

  6746.     ImageType: Byte;

  6747.     //ColorMapSpec: Array[0..4] of Byte;

  6748.     ColorMapStart: Word;

  6749.     ColorMapLength: Word;

  6750.     ColorMapEntrySize: Byte;

  6751.     OrigX: Word;

  6752.     OrigY: Word;

  6753.     Width: Word;

  6754.     Height: Word;

  6755.     Bpp: Byte;

  6756.     ImageDesc: Byte;

  6757.   end;

  6758. 

  6759. const

  6760.   TGA_UNCOMPRESSED_RGB  =  2;

  6761.   TGA_UNCOMPRESSED_GRAY =  3;

  6762.   TGA_COMPRESSED_RGB    = 10;

  6763.   TGA_COMPRESSED_GRAY   = 11;

  6764. 

  6765.   TGA_NONE_COLOR_TABLE  = 0;

  6766. 

  6767. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6768. function TglBitmap.LoadTGA(const aStream: TStream): Boolean;

  6769. var

  6770.   Header: TTGAHeader;

  6771.   ImageData: System.PByte;

  6772.   StartPosition: Int64;

  6773.   PixelSize, LineSize: Integer;

  6774.   tgaFormat: TglBitmapFormat;

  6775.   FormatDesc: TFormatDescriptor;

  6776.   Counter: packed record

  6777.     X, Y: packed record

  6778.       low, high, dir: Integer;

  6779.     end;

  6780.   end;

  6781. 

  6782. const

  6783.   CACHE_SIZE = $4000;

  6784. 

  6785.   ////////////////////////////////////////////////////////////////////////////////////////

  6786.   procedure ReadUncompressed;

  6787.   var

  6788.     i, j: Integer;

  6789.     buf, tmp1, tmp2: System.PByte;

  6790.   begin

  6791.     buf := nil;

  6792.     if (Counter.X.dir < 0) then

  6793.       buf := GetMem(LineSize);

  6794.     try

  6795.       while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin

  6796.         tmp1 := ImageData + (Counter.Y.low * LineSize); //pointer to LineStart

  6797.         if (Counter.X.dir < 0) then begin               //flip X

  6798.           aStream.Read(buf^, LineSize);

  6799.           tmp2 := buf + LineSize - PixelSize;           //pointer to last pixel in line

  6800.           for i := 0 to Header.Width-1 do begin         //for all pixels in line

  6801.             for j := 0 to PixelSize-1 do begin          //for all bytes in pixel

  6802.               tmp1^ := tmp2^;

  6803.               inc(tmp1);

  6804.               inc(tmp2);

  6805.             end;

  6806.             dec(tmp2, 2*PixelSize);                     //move 2 backwards, because j-loop moved 1 forward

  6807.           end;

  6808.         end else

  6809.           aStream.Read(tmp1^, LineSize);

  6810.         inc(Counter.Y.low, Counter.Y.dir);              //move to next line index

  6811.       end;

  6812.     finally

  6813.       if Assigned(buf) then

  6814.         FreeMem(buf);

  6815.     end;

  6816.   end;

  6817. 

  6818.   ////////////////////////////////////////////////////////////////////////////////////////

  6819.   procedure ReadCompressed;

  6820. 

  6821.     /////////////////////////////////////////////////////////////////

  6822.     var

  6823.       TmpData: System.PByte;

  6824.       LinePixelsRead: Integer;

  6825.     procedure CheckLine;

  6826.     begin

  6827.       if (LinePixelsRead >= Header.Width) then begin

  6828.         LinePixelsRead := 0;

  6829.         inc(Counter.Y.low, Counter.Y.dir);                //next line index

  6830.         TmpData := ImageData + Counter.Y.low * LineSize;  //set line

  6831.         if (Counter.X.dir < 0) then                       //if x flipped then

  6832.           TmpData := TmpData + LineSize - PixelSize;      //set last pixel

  6833.       end;

  6834.     end;

  6835. 

  6836.     /////////////////////////////////////////////////////////////////

  6837.     var

  6838.       Cache: PByte;

  6839.       CacheSize, CachePos: Integer;

  6840.     procedure CachedRead(out Buffer; Count: Integer);

  6841.     var

  6842.       BytesRead: Integer;

  6843.     begin

  6844.       if (CachePos + Count > CacheSize) then begin

  6845.         //if buffer overflow save non read bytes

  6846.         BytesRead := 0;

  6847.         if (CacheSize - CachePos > 0) then begin

  6848.           BytesRead := CacheSize - CachePos;

  6849.           Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);

  6850.           inc(CachePos, BytesRead);

  6851.         end;

  6852. 

  6853.         //load cache from file

  6854.         CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);

  6855.         aStream.Read(Cache^, CacheSize);

  6856.         CachePos := 0;

  6857. 

  6858.         //read rest of requested bytes

  6859.         if (Count - BytesRead > 0) then begin

  6860.           Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);

  6861.           inc(CachePos, Count - BytesRead);

  6862.         end;

  6863.       end else begin

  6864.         //if no buffer overflow just read the data

  6865.         Move(PByteArray(Cache)^[CachePos], Buffer, Count);

  6866.         inc(CachePos, Count);

  6867.       end;

  6868.     end;

  6869. 

  6870.     procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);

  6871.     begin

  6872.       case PixelSize of

  6873.         1: begin

  6874.           aBuffer^ := aData^;

  6875.           inc(aBuffer, Counter.X.dir);

  6876.         end;

  6877.         2: begin

  6878.           PWord(aBuffer)^ := PWord(aData)^;

  6879.           inc(aBuffer, 2 * Counter.X.dir);

  6880.         end;

  6881.         3: begin

  6882.           PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];

  6883.           PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];

  6884.           PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];

  6885.           inc(aBuffer, 3 * Counter.X.dir);

  6886.         end;

  6887.         4: begin

  6888.           PCardinal(aBuffer)^ := PCardinal(aData)^;

  6889.           inc(aBuffer, 4 * Counter.X.dir);

  6890.         end;

  6891.       end;

  6892.     end;

  6893. 

  6894.   var

  6895.     TotalPixelsToRead, TotalPixelsRead: Integer;

  6896.     Temp: Byte;

  6897.     buf: array [0..3] of Byte; //1 pixel is max 32bit long

  6898.     PixelRepeat: Boolean;

  6899.     PixelsToRead, PixelCount: Integer;

  6900.   begin

  6901.     CacheSize := 0;

  6902.     CachePos  := 0;

  6903. 

  6904.     TotalPixelsToRead := Header.Width * Header.Height;

  6905.     TotalPixelsRead   := 0;

  6906.     LinePixelsRead    := 0;

  6907. 

  6908.     GetMem(Cache, CACHE_SIZE);

  6909.     try

  6910.       TmpData := ImageData + Counter.Y.low * LineSize;  //set line

  6911.       if (Counter.X.dir < 0) then                       //if x flipped then

  6912.         TmpData := TmpData + LineSize - PixelSize;      //set last pixel

  6913. 

  6914.       repeat

  6915.         //read CommandByte

  6916.         CachedRead(Temp, 1);

  6917.         PixelRepeat  := (Temp and $80) > 0;

  6918.         PixelsToRead := (Temp and $7F) + 1;

  6919.         inc(TotalPixelsRead, PixelsToRead);

  6920. 

  6921.         if PixelRepeat then

  6922.           CachedRead(buf[0], PixelSize);

  6923.         while (PixelsToRead > 0) do begin

  6924.           CheckLine;

  6925.           PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF

  6926.           while (PixelCount > 0) do begin

  6927.             if not PixelRepeat then

  6928.               CachedRead(buf[0], PixelSize);

  6929.             PixelToBuffer(@buf[0], TmpData);

  6930.             inc(LinePixelsRead);

  6931.             dec(PixelsToRead);

  6932.             dec(PixelCount);

  6933.           end;

  6934.         end;

  6935.       until (TotalPixelsRead >= TotalPixelsToRead);

  6936.     finally

  6937.       FreeMem(Cache);

  6938.     end;

  6939.   end;

  6940. 

  6941.   function IsGrayFormat: Boolean;

  6942.   begin

  6943.     result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];

  6944.   end;

  6945. 

  6946. begin

  6947.   result := false;

  6948. 

  6949.   // reading header to test file and set cursor back to begin

  6950.   StartPosition := aStream.Position;

  6951.   aStream.Read(Header{%H-}, SizeOf(Header));

  6952. 

  6953.   // no colormapped files

  6954.   if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [

  6955.     TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then

  6956.   begin

  6957.     try

  6958.       if Header.ImageID <> 0 then       // skip image ID

  6959.         aStream.Position := aStream.Position + Header.ImageID;

  6960. 

  6961.       case Header.Bpp of

  6962.          8: if IsGrayFormat then case (Header.ImageDesc and $F) of

  6963.                0: tgaFormat := tfLuminance8;

  6964.                8: tgaFormat := tfAlpha8;

  6965.             end;

  6966. 

  6967.         16: if IsGrayFormat then case (Header.ImageDesc and $F) of

  6968.                0: tgaFormat := tfLuminance16;

  6969.                8: tgaFormat := tfLuminance8Alpha8;

  6970.             end else case (Header.ImageDesc and $F) of

  6971.                0: tgaFormat := tfBGR5;

  6972.                1: tgaFormat := tfBGR5A1;

  6973.                4: tgaFormat := tfBGRA4;

  6974.             end;

  6975. 

  6976.         24: if not IsGrayFormat then case (Header.ImageDesc and $F) of

  6977.                0: tgaFormat := tfBGR8;

  6978.             end;

  6979. 

  6980.         32: if not IsGrayFormat then case (Header.ImageDesc and $F) of

  6981.                2: tgaFormat := tfBGR10A2;

  6982.                8: tgaFormat := tfBGRA8;

  6983.             end;

  6984.       end;

  6985. 

  6986.       if (tgaFormat = tfEmpty) then

  6987.         raise EglBitmapException.Create('LoadTga - unsupported format');

  6988. 

  6989.       FormatDesc := TFormatDescriptor.Get(tgaFormat);

  6990.       PixelSize  := FormatDesc.GetSize(1, 1);

  6991.       LineSize   := FormatDesc.GetSize(Header.Width, 1);

  6992. 

  6993.       GetMem(ImageData, LineSize * Header.Height);

  6994.       try

  6995.         //column direction

  6996.         if ((Header.ImageDesc and (1 shl 4)) > 0) then begin

  6997.           Counter.X.low  := Header.Height-1;;

  6998.           Counter.X.high := 0;

  6999.           Counter.X.dir  := -1;

  7000.         end else begin

  7001.           Counter.X.low  := 0;

  7002.           Counter.X.high := Header.Height-1;

  7003.           Counter.X.dir  := 1;

  7004.         end;

  7005. 

  7006.         // Row direction

  7007.         if ((Header.ImageDesc and (1 shl 5)) > 0) then begin

  7008.           Counter.Y.low  := 0;

  7009.           Counter.Y.high := Header.Height-1;

  7010.           Counter.Y.dir  := 1;

  7011.         end else begin

  7012.           Counter.Y.low  := Header.Height-1;;

  7013.           Counter.Y.high := 0;

  7014.           Counter.Y.dir  := -1;

  7015.         end;

  7016. 

  7017.         // Read Image

  7018.         case Header.ImageType of

  7019.           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:

  7020.             ReadUncompressed;

  7021.           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:

  7022.             ReadCompressed;

  7023.         end;

  7024. 

  7025.         SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height);

  7026.         result := true;

  7027.       except

  7028.         FreeMem(ImageData);

  7029.         raise;

  7030.       end;

  7031.     finally

  7032.       aStream.Position := StartPosition;

  7033.     end;

  7034.   end

  7035.     else aStream.Position := StartPosition;

  7036. end;

  7037. 

  7038. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7039. procedure TglBitmap.SaveTGA(const aStream: TStream);

  7040. var

  7041.   Header: TTGAHeader;

  7042.   LineSize, Size, x, y: Integer;

  7043.   Pixel: TglBitmapPixelData;

  7044.   LineBuf, SourceData, DestData: PByte;

  7045.   SourceMD, DestMD: Pointer;

  7046.   FormatDesc: TFormatDescriptor;

  7047.   Converter: TFormatDescriptor;

  7048. begin

  7049.   if not (ftTGA in FormatGetSupportedFiles(Format)) then

  7050.     raise EglBitmapUnsupportedFormat.Create(Format);

  7051. 

  7052.   //prepare header

  7053.   FillChar(Header{%H-}, SizeOf(Header), 0);

  7054. 

  7055.   //set ImageType

  7056.   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,

  7057.                  tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then

  7058.     Header.ImageType := TGA_UNCOMPRESSED_GRAY

  7059.   else

  7060.     Header.ImageType := TGA_UNCOMPRESSED_RGB;

  7061. 

  7062.   //set BitsPerPixel

  7063.   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then

  7064.     Header.Bpp := 8

  7065.   else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,

  7066.                       tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then

  7067.     Header.Bpp := 16

  7068.   else if (Format in [tfBGR8, tfRGB8]) then

  7069.     Header.Bpp := 24

  7070.   else

  7071.     Header.Bpp := 32;

  7072. 

  7073.   //set AlphaBitCount

  7074.   case Format of

  7075.     tfRGB5A1, tfBGR5A1:

  7076.       Header.ImageDesc := 1 and $F;

  7077.     tfRGB10A2, tfBGR10A2:

  7078.       Header.ImageDesc := 2 and $F;

  7079.     tfRGBA4, tfBGRA4:

  7080.       Header.ImageDesc := 4 and $F;

  7081.     tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:

  7082.       Header.ImageDesc := 8 and $F;

  7083.   end;

  7084. 

  7085.   Header.Width     := Width;

  7086.   Header.Height    := Height;

  7087.   Header.ImageDesc := Header.ImageDesc or $20; //flip y

  7088.   aStream.Write(Header, SizeOf(Header));

  7089. 

  7090.   // convert RGB(A) to BGR(A)

  7091.   Converter  := nil;

  7092.   FormatDesc := TFormatDescriptor.Get(Format);

  7093.   Size       := FormatDesc.GetSize(Dimension);

  7094.   if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin

  7095.     if (FormatDesc.RGBInverted = tfEmpty) then

  7096.       raise EglBitmapException.Create('inverted RGB format is empty');

  7097.     Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);

  7098.     if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or

  7099.        (Converter.PixelSize <> FormatDesc.PixelSize) then

  7100.       raise EglBitmapException.Create('invalid inverted RGB format');

  7101.   end;

  7102. 

  7103.   if Assigned(Converter) then begin

  7104.     LineSize := FormatDesc.GetSize(Width, 1);

  7105.     LineBuf  := GetMem(LineSize);

  7106.     SourceMD := FormatDesc.CreateMappingData;

  7107.     DestMD   := Converter.CreateMappingData;

  7108.     try

  7109.       SourceData := Data;

  7110.       for y := 0 to Height-1 do begin

  7111.         DestData := LineBuf;

  7112.         for x := 0 to Width-1 do begin

  7113.           FormatDesc.Unmap(SourceData, Pixel, SourceMD);

  7114.           Converter.Map(Pixel, DestData, DestMD);

  7115.         end;

  7116.         aStream.Write(LineBuf^, LineSize);

  7117.       end;

  7118.     finally

  7119.       FreeMem(LineBuf);

  7120.       FormatDesc.FreeMappingData(SourceMD);

  7121.       FormatDesc.FreeMappingData(DestMD);

  7122.     end;

  7123.   end else

  7124.     aStream.Write(Data^, Size);

  7125. end;

  7126. 

  7127. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7128. //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7129. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7130. const

  7131.   DDS_MAGIC: Cardinal         = $20534444;

  7132. 

  7133.   // DDS_header.dwFlags

  7134.   DDSD_CAPS                   = $00000001;

  7135.   DDSD_HEIGHT                 = $00000002;

  7136.   DDSD_WIDTH                  = $00000004;

  7137.   DDSD_PIXELFORMAT            = $00001000;

  7138. 

  7139.   // DDS_header.sPixelFormat.dwFlags

  7140.   DDPF_ALPHAPIXELS            = $00000001;

  7141.   DDPF_ALPHA                  = $00000002;

  7142.   DDPF_FOURCC                 = $00000004;

  7143.   DDPF_RGB                    = $00000040;

  7144.   DDPF_LUMINANCE              = $00020000;

  7145. 

  7146.   // DDS_header.sCaps.dwCaps1

  7147.   DDSCAPS_TEXTURE             = $00001000;

  7148. 

  7149.   // DDS_header.sCaps.dwCaps2

  7150.   DDSCAPS2_CUBEMAP            = $00000200;

  7151. 

  7152.   D3DFMT_DXT1                 = $31545844;

  7153.   D3DFMT_DXT3                 = $33545844;

  7154.   D3DFMT_DXT5                 = $35545844;

  7155. 

  7156. type

  7157.   TDDSPixelFormat = packed record

  7158.     dwSize: Cardinal;

  7159.     dwFlags: Cardinal;

  7160.     dwFourCC: Cardinal;

  7161.     dwRGBBitCount: Cardinal;

  7162.     dwRBitMask: Cardinal;

  7163.     dwGBitMask: Cardinal;

  7164.     dwBBitMask: Cardinal;

  7165.     dwABitMask: Cardinal;

  7166.   end;

  7167. 

  7168.   TDDSCaps = packed record

  7169.     dwCaps1: Cardinal;

  7170.     dwCaps2: Cardinal;

  7171.     dwDDSX: Cardinal;

  7172.     dwReserved: Cardinal;

  7173.   end;

  7174. 

  7175.   TDDSHeader = packed record

  7176.     dwSize: Cardinal;

  7177.     dwFlags: Cardinal;

  7178.     dwHeight: Cardinal;

  7179.     dwWidth: Cardinal;

  7180.     dwPitchOrLinearSize: Cardinal;

  7181.     dwDepth: Cardinal;

  7182.     dwMipMapCount: Cardinal;

  7183.     dwReserved: array[0..10] of Cardinal;

  7184.     PixelFormat: TDDSPixelFormat;

  7185.     Caps: TDDSCaps;

  7186.     dwReserved2: Cardinal;

  7187.   end;

  7188. 

  7189. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7190. function TglBitmap.LoadDDS(const aStream: TStream): Boolean;

  7191. var

  7192.   Header: TDDSHeader;

  7193.   Converter: TbmpBitfieldFormat;

  7194. 

  7195.   function GetDDSFormat: TglBitmapFormat;

  7196.   var

  7197.     fd: TFormatDescriptor;

  7198.     i: Integer;

  7199.     Range: TglBitmapColorRec;

  7200.     match: Boolean;

  7201.   begin

  7202.     result := tfEmpty;

  7203.     with Header.PixelFormat do begin

  7204.       // Compresses

  7205.       if ((dwFlags and DDPF_FOURCC) > 0) then begin

  7206.         case Header.PixelFormat.dwFourCC of

  7207.           D3DFMT_DXT1: result := tfS3tcDtx1RGBA;

  7208.           D3DFMT_DXT3: result := tfS3tcDtx3RGBA;

  7209.           D3DFMT_DXT5: result := tfS3tcDtx5RGBA;

  7210.         end;

  7211.       end else if ((Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin

  7212. 

  7213.         //find matching format

  7214.         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin

  7215.           fd := TFormatDescriptor.Get(result);

  7216.           if fd.MaskMatch(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask) and

  7217.              (8 * fd.PixelSize = dwRGBBitCount) then

  7218.             exit;

  7219.         end;

  7220. 

  7221.         //find format with same Range

  7222.         Range.r := dwRBitMask;

  7223.         Range.g := dwGBitMask;

  7224.         Range.b := dwBBitMask;

  7225.         Range.a := dwABitMask;

  7226.         for i := 0 to 3 do begin

  7227.           while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do

  7228.             Range.arr[i] := Range.arr[i] shr 1;

  7229.         end;

  7230.         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin

  7231.           fd := TFormatDescriptor.Get(result);

  7232.           match := true;

  7233.           for i := 0 to 3 do

  7234.             if (fd.Range.arr[i] <> Range.arr[i]) then begin

  7235.               match := false;

  7236.               break;

  7237.             end;

  7238.           if match then

  7239.             break;

  7240.         end;

  7241. 

  7242.         //no format with same range found -> use default

  7243.         if (result = tfEmpty) then begin

  7244.           if (dwABitMask > 0) then

  7245.             result := tfBGRA8

  7246.           else

  7247.             result := tfBGR8;

  7248.         end;

  7249. 

  7250.         Converter := TbmpBitfieldFormat.Create;

  7251.         Converter.RedMask   := dwRBitMask;

  7252.         Converter.GreenMask := dwGBitMask;

  7253.         Converter.BlueMask  := dwBBitMask;

  7254.         Converter.AlphaMask := dwABitMask;

  7255.         Converter.PixelSize := dwRGBBitCount / 8;

  7256.       end;

  7257.     end;

  7258.   end;

  7259. 

  7260. var

  7261.   StreamPos: Int64;

  7262.   x, y, LineSize, RowSize, Magic: Cardinal;

  7263.   NewImage, TmpData, RowData, SrcData: System.PByte;

  7264.   SourceMD, DestMD: Pointer;

  7265.   Pixel: TglBitmapPixelData;

  7266.   ddsFormat: TglBitmapFormat;

  7267.   FormatDesc: TFormatDescriptor;

  7268. 

  7269. begin

  7270.   result    := false;

  7271.   Converter := nil;

  7272.   StreamPos := aStream.Position;

  7273. 

  7274.   // Magic

  7275.   aStream.Read(Magic{%H-}, sizeof(Magic));

  7276.   if (Magic <> DDS_MAGIC) then begin

  7277.     aStream.Position := StreamPos;

  7278.     exit;

  7279.   end;

  7280. 

  7281.   //Header

  7282.   aStream.Read(Header{%H-}, sizeof(Header));

  7283.   if (Header.dwSize <> SizeOf(Header)) or

  7284.      ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>

  7285.         (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then

  7286.   begin

  7287.     aStream.Position := StreamPos;

  7288.     exit;

  7289.   end;

  7290. 

  7291.   if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then

  7292.     raise EglBitmapException.Create('LoadDDS - CubeMaps are not supported');

  7293. 

  7294.   ddsFormat := GetDDSFormat;

  7295.   try

  7296.     if (ddsFormat = tfEmpty) then

  7297.       raise EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');

  7298. 

  7299.     FormatDesc := TFormatDescriptor.Get(ddsFormat);

  7300.     LineSize   := Trunc(Header.dwWidth * FormatDesc.PixelSize);

  7301.     GetMem(NewImage, Header.dwHeight * LineSize);

  7302.     try

  7303.       TmpData := NewImage;

  7304. 

  7305.       //Converter needed

  7306.       if Assigned(Converter) then begin

  7307.         RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);

  7308.         GetMem(RowData, RowSize);

  7309.         SourceMD := Converter.CreateMappingData;

  7310.         DestMD   := FormatDesc.CreateMappingData;

  7311.         try

  7312.           for y := 0 to Header.dwHeight-1 do begin

  7313.             TmpData := NewImage + y * LineSize;

  7314.             SrcData := RowData;

  7315.             aStream.Read(SrcData^, RowSize);

  7316.             for x := 0 to Header.dwWidth-1 do begin

  7317.               Converter.Unmap(SrcData, Pixel, SourceMD);

  7318.               glBitmapConvertPixel(Pixel, Converter, FormatDesc);

  7319.               FormatDesc.Map(Pixel, TmpData, DestMD);

  7320.             end;

  7321.           end;

  7322.         finally

  7323.           Converter.FreeMappingData(SourceMD);

  7324.           FormatDesc.FreeMappingData(DestMD);

  7325.           FreeMem(RowData);

  7326.         end;

  7327.       end else

  7328. 

  7329.       // Compressed

  7330.       if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin

  7331.         RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;

  7332.         for Y := 0 to Header.dwHeight-1 do begin

  7333.           aStream.Read(TmpData^, RowSize);

  7334.           Inc(TmpData, LineSize);

  7335.         end;

  7336.       end else

  7337. 

  7338.       // Uncompressed

  7339.       if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin

  7340.         RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;

  7341.         for Y := 0 to Header.dwHeight-1 do begin

  7342.           aStream.Read(TmpData^, RowSize);

  7343.           Inc(TmpData, LineSize);

  7344.         end;

  7345.       end else

  7346.         raise EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');

  7347. 

  7348.       SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight);

  7349.       result := true;

  7350.     except

  7351.       FreeMem(NewImage);

  7352.       raise;

  7353.     end;

  7354.   finally

  7355.     FreeAndNil(Converter);

  7356.   end;

  7357. end;

  7358. 

  7359. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7360. procedure TglBitmap.SaveDDS(const aStream: TStream);

  7361. var

  7362.   Header: TDDSHeader;

  7363.   FormatDesc: TFormatDescriptor;

  7364. begin

  7365.   if not (ftDDS in FormatGetSupportedFiles(Format)) then

  7366.     raise EglBitmapUnsupportedFormat.Create(Format);

  7367. 

  7368.   FormatDesc := TFormatDescriptor.Get(Format);

  7369. 

  7370.   // Generell

  7371.   FillChar(Header{%H-}, SizeOf(Header), 0);

  7372.   Header.dwSize  := SizeOf(Header);

  7373.   Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;

  7374. 

  7375.   Header.dwWidth  := Max(1, Width);

  7376.   Header.dwHeight := Max(1, Height);

  7377. 

  7378.   // Caps

  7379.   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;

  7380. 

  7381.   // Pixelformat

  7382.   Header.PixelFormat.dwSize := sizeof(Header);

  7383.   if (FormatDesc.IsCompressed) then begin

  7384.     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;

  7385.     case Format of

  7386.       tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;

  7387.       tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;

  7388.       tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;

  7389.     end;

  7390.   end else if (Format in [tfAlpha8, tfAlpha16]) then begin

  7391.     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_ALPHA;

  7392.     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);

  7393.     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;

  7394.   end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin

  7395.     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;

  7396.     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);

  7397.     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;

  7398.     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;

  7399.   end else begin

  7400.     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;

  7401.     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);

  7402.     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;

  7403.     Header.PixelFormat.dwGBitMask    := FormatDesc.GreenMask;

  7404.     Header.PixelFormat.dwBBitMask    := FormatDesc.BlueMask;

  7405.     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;

  7406.   end;

  7407. 

  7408.   if (FormatDesc.HasAlpha) then

  7409.     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;

  7410. 

  7411.   aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));

  7412.   aStream.Write(Header, SizeOf(Header));

  7413.   aStream.Write(Data^, FormatDesc.GetSize(Dimension));

  7414. end;

  7415. 

  7416. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7417. //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7418. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7419. function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;

  7420. begin

  7421.   if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then

  7422.     result := fLines[aIndex]

  7423.   else

  7424.     result := nil;

  7425. end;

  7426. 

  7427. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7428. procedure TglBitmap2D.SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;

  7429.   const aWidth: Integer; const aHeight: Integer);

  7430. var

  7431.   Idx, LineWidth: Integer;

  7432. begin

  7433.   inherited SetDataPointer(aData, aFormat, aWidth, aHeight);

  7434. 

  7435.   if not TFormatDescriptor.Get(aFormat).IsCompressed then begin

  7436.     (* TODO PixelFuncs

  7437.     fGetPixelFunc := GetPixel2DUnmap;

  7438.     fSetPixelFunc := SetPixel2DUnmap;

  7439.     *)

  7440.     // Assigning Data

  7441.     if Assigned(Data) then begin

  7442.       SetLength(fLines, GetHeight);

  7443.       LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);

  7444. 

  7445.       for Idx := 0 to GetHeight -1 do begin

  7446.         fLines[Idx] := Data;

  7447.         Inc(fLines[Idx], Idx * LineWidth);

  7448.       end;

  7449.     end

  7450.       else SetLength(fLines, 0);

  7451.   end else begin

  7452.     SetLength(fLines, 0);

  7453.     (*

  7454.     fSetPixelFunc := nil;

  7455. 

  7456.     case Format of

  7457.       ifDXT1:

  7458.         fGetPixelFunc := GetPixel2DDXT1;

  7459.       ifDXT3:

  7460.         fGetPixelFunc := GetPixel2DDXT3;

  7461.       ifDXT5:

  7462.         fGetPixelFunc := GetPixel2DDXT5;

  7463.       else

  7464.         fGetPixelFunc := nil;

  7465.     end;

  7466.     *)

  7467.   end;

  7468. end;

  7469. 

  7470. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7471. procedure TglBitmap2D.UploadData(const aTarget: Cardinal; const aBuildWithGlu: Boolean);

  7472. var

  7473.   FormatDesc: TFormatDescriptor;

  7474. begin

  7475.   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);

  7476. 

  7477.   FormatDesc := TFormatDescriptor.Get(Format);

  7478.   if FormatDesc.IsCompressed then begin

  7479.     glCompressedTexImage2D(Target, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)

  7480.   end else if aBuildWithGlu then begin

  7481.     gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,

  7482.       FormatDesc.glFormat, FormatDesc.glDataFormat, Data)

  7483.   end else begin

  7484.     glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,

  7485.       FormatDesc.glFormat, FormatDesc.glDataFormat, Data);

  7486.   end;

  7487. 

  7488.   // Freigeben

  7489.   if (FreeDataAfterGenTexture) then

  7490.     FreeData;

  7491. end;

  7492. 

  7493. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7494. procedure TglBitmap2D.AfterConstruction;

  7495. begin

  7496.   inherited;

  7497.   Target := GL_TEXTURE_2D;

  7498. end;

  7499. 

  7500. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  7502. var

  7503.   Temp: pByte;

  7504.   Size, w, h: Integer;

  7505.   FormatDesc: TFormatDescriptor;

  7506. begin

  7507.   FormatDesc := TFormatDescriptor.Get(Format);

  7508.   if FormatDesc.IsCompressed then

  7509.     raise EglBitmapUnsupportedFormat.Create(Format);

  7510. 

  7511.   w    := aRight  - aLeft;

  7512.   h    := aBottom - aTop;

  7513.   Size := FormatDesc.GetSize(w, h);

  7514.   GetMem(Temp, Size);

  7515.   try

  7516.     glPixelStorei(GL_PACK_ALIGNMENT, 1);

  7517.     glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);

  7518.     SetDataPointer(Temp, Format, w, h);

  7519.     FlipVert;

  7520.   except

  7521.     FreeMem(Temp);

  7522.     raise;

  7523.   end;

  7524. end;

  7525. 

  7526. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7527. procedure TglBitmap2D.GetDataFromTexture;

  7528. var

  7529.   Temp: PByte;

  7530.   TempWidth, TempHeight: Integer;

  7531.   TempIntFormat: Cardinal;

  7532.   IntFormat, f: TglBitmapFormat;

  7533.   FormatDesc: TFormatDescriptor;

  7534. begin

  7535.   Bind;

  7536. 

  7537.   // Request Data

  7538.   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH,           @TempWidth);

  7539.   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT,          @TempHeight);

  7540.   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);

  7541. 

  7542.   IntFormat := tfEmpty;

  7543.   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin

  7544.     FormatDesc := TFormatDescriptor.Get(f);

  7545.     if (FormatDesc.glInternalFormat = TempIntFormat) then begin

  7546.       IntFormat := FormatDesc.Format;

  7547.       break;

  7548.     end;

  7549.   end;

  7550. 

  7551.   // Getting data from OpenGL

  7552.   FormatDesc := TFormatDescriptor.Get(IntFormat);

  7553.   GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));

  7554.   try

  7555.     if FormatDesc.IsCompressed then

  7556.       glGetCompressedTexImage(Target, 0, Temp)

  7557.     else

  7558.      glGetTexImage(Target, 0, FormatDesc.glInternalFormat, FormatDesc.glDataFormat, Temp);

  7559.     SetDataPointer(Temp, IntFormat, TempWidth, TempHeight);

  7560.   except

  7561.     FreeMem(Temp);

  7562.     raise;

  7563.   end;

  7564. end;

  7565. 

  7566. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7567. procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);

  7568. var

  7569.   BuildWithGlu, PotTex, TexRec: Boolean;

  7570.   TexSize: Integer;

  7571. begin

  7572.   if Assigned(Data) then begin

  7573.     // Check Texture Size

  7574.     if (aTestTextureSize) then begin

  7575.       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);

  7576. 

  7577.       if ((Height > TexSize) or (Width > TexSize)) then

  7578.         raise EglBitmapSizeToLargeException.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');

  7579. 

  7580.       PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);

  7581.       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);

  7582. 

  7583.       if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then

  7584.         raise EglBitmapNonPowerOfTwoException.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');

  7585.     end;

  7586. 

  7587.     CreateId;

  7588.     SetupParameters(BuildWithGlu);

  7589.     UploadData(Target, BuildWithGlu);

  7590.     glAreTexturesResident(1, @fID, @fIsResident);

  7591.   end;

  7592. end;

  7593. 

  7594. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7595. function TglBitmap2D.FlipHorz: Boolean;

  7596. var

  7597.   Col, Row: Integer;

  7598.   TempDestData, DestData, SourceData: PByte;

  7599.   ImgSize: Integer;

  7600. begin

  7601.   result := inherited FlipHorz;

  7602.   if Assigned(Data) then begin

  7603.     SourceData := Data;

  7604.     ImgSize := Height * fRowSize;

  7605.     GetMem(DestData, ImgSize);

  7606.     try

  7607.       TempDestData := DestData;

  7608.       Dec(TempDestData, fRowSize + fPixelSize);

  7609.       for Row := 0 to Height -1 do begin

  7610.         Inc(TempDestData, fRowSize * 2);

  7611.         for Col := 0 to Width -1 do begin

  7612.           Move(SourceData^, TempDestData^, fPixelSize);

  7613.           Inc(SourceData, fPixelSize);

  7614.           Dec(TempDestData, fPixelSize);

  7615.         end;

  7616.       end;

  7617.       SetDataPointer(DestData, Format);

  7618.       result := true;

  7619.     except

  7620.       FreeMem(DestData);

  7621.       raise;

  7622.     end;

  7623.   end;

  7624. end;

  7625. 

  7626. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7627. function TglBitmap2D.FlipVert: Boolean;

  7628. var

  7629.   Row: Integer;

  7630.   TempDestData, DestData, SourceData: PByte;

  7631. begin

  7632.   result := inherited FlipVert;

  7633.   if Assigned(Data) then begin

  7634.     SourceData := Data;

  7635.     GetMem(DestData, Height * fRowSize);

  7636.     try

  7637.       TempDestData := DestData;

  7638.       Inc(TempDestData, Width * (Height -1) * fPixelSize);

  7639.       for Row := 0 to Height -1 do begin

  7640.         Move(SourceData^, TempDestData^, fRowSize);

  7641.         Dec(TempDestData, fRowSize);

  7642.         Inc(SourceData, fRowSize);

  7643.       end;

  7644.       SetDataPointer(DestData, Format);

  7645.       result := true;

  7646.     except

  7647.       FreeMem(DestData);

  7648.       raise;

  7649.     end;

  7650.   end;

  7651. end;

  7652. 

  7653. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7654. //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7655. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7656. type

  7657.   TMatrixItem = record

  7658.     X, Y: Integer;

  7659.     W: Single;

  7660.   end;

  7661. 

  7662.   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;

  7663.   TglBitmapToNormalMapRec = Record

  7664.     Scale: Single;

  7665.     Heights: array of Single;

  7666.     MatrixU : array of TMatrixItem;

  7667.     MatrixV : array of TMatrixItem;

  7668.   end;

  7669. 

  7670. const

  7671.   ONE_OVER_255 = 1 / 255;

  7672. 

  7673.   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7674. procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);

  7675. var

  7676.   Val: Single;

  7677. begin

  7678.   with FuncRec do begin

  7679.     Val :=

  7680.       Source.Data.r * LUMINANCE_WEIGHT_R +

  7681.       Source.Data.g * LUMINANCE_WEIGHT_G +

  7682.       Source.Data.b * LUMINANCE_WEIGHT_B;

  7683.     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;

  7684.   end;

  7685. end;

  7686. 

  7687. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7688. procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);

  7689. begin

  7690.   with FuncRec do

  7691.     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;

  7692. end;

  7693. 

  7694. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7695. procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);

  7696. type

  7697.   TVec = Array[0..2] of Single;

  7698. var

  7699.   Idx: Integer;

  7700.   du, dv: Double;

  7701.   Len: Single;

  7702.   Vec: TVec;

  7703. 

  7704.   function GetHeight(X, Y: Integer): Single;

  7705.   begin

  7706.     with FuncRec do begin

  7707.       X := Max(0, Min(Size.X -1, X));

  7708.       Y := Max(0, Min(Size.Y -1, Y));

  7709.       result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];

  7710.     end;

  7711.   end;

  7712. 

  7713. begin

  7714.   with FuncRec do begin

  7715.     with PglBitmapToNormalMapRec(Args)^ do begin

  7716.       du := 0;

  7717.       for Idx := Low(MatrixU) to High(MatrixU) do

  7718.         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;

  7719. 

  7720.       dv := 0;

  7721.       for Idx := Low(MatrixU) to High(MatrixU) do

  7722.         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;

  7723. 

  7724.       Vec[0] := -du * Scale;

  7725.       Vec[1] := -dv * Scale;

  7726.       Vec[2] := 1;

  7727.     end;

  7728. 

  7729.     // Normalize

  7730.     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));

  7731.     if Len <> 0 then begin

  7732.       Vec[0] := Vec[0] * Len;

  7733.       Vec[1] := Vec[1] * Len;

  7734.       Vec[2] := Vec[2] * Len;

  7735.     end;

  7736. 

  7737.     // Farbe zuweisem

  7738.     Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);

  7739.     Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);

  7740.     Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);

  7741.   end;

  7742. end;

  7743. 

  7744. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7745. procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);

  7746. var

  7747.   Rec: TglBitmapToNormalMapRec;

  7748. 

  7749.   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);

  7750.   begin

  7751.     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin

  7752.       Matrix[Index].X := X;

  7753.       Matrix[Index].Y := Y;

  7754.       Matrix[Index].W := W;

  7755.     end;

  7756.   end;

  7757. 

  7758. begin

  7759.   if TFormatDescriptor.Get(Format).IsCompressed then

  7760.     raise EglBitmapUnsupportedFormat.Create(Format);

  7761. 

  7762.   if aScale > 100 then

  7763.     Rec.Scale := 100

  7764.   else if aScale < -100 then

  7765.     Rec.Scale := -100

  7766.   else

  7767.     Rec.Scale := aScale;

  7768. 

  7769.   SetLength(Rec.Heights, Width * Height);

  7770.   try

  7771.     case aFunc of

  7772.       nm4Samples: begin

  7773.         SetLength(Rec.MatrixU, 2);

  7774.         SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);

  7775.         SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);

  7776. 

  7777.         SetLength(Rec.MatrixV, 2);

  7778.         SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);

  7779.         SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);

  7780.       end;

  7781. 

  7782.       nmSobel: begin

  7783.         SetLength(Rec.MatrixU, 6);

  7784.         SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);

  7785.         SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);

  7786.         SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);

  7787.         SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);

  7788.         SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);

  7789.         SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);

  7790. 

  7791.         SetLength(Rec.MatrixV, 6);

  7792.         SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);

  7793.         SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);

  7794.         SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);

  7795.         SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);

  7796.         SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);

  7797.         SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);

  7798.       end;

  7799. 

  7800.       nm3x3: begin

  7801.         SetLength(Rec.MatrixU, 6);

  7802.         SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);

  7803.         SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);

  7804.         SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);

  7805.         SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);

  7806.         SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);

  7807.         SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);

  7808. 

  7809.         SetLength(Rec.MatrixV, 6);

  7810.         SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);

  7811.         SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);

  7812.         SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);

  7813.         SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);

  7814.         SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);

  7815.         SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);

  7816.       end;

  7817. 

  7818.       nm5x5: begin

  7819.         SetLength(Rec.MatrixU, 20);

  7820.         SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);

  7821.         SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);

  7822.         SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);

  7823.         SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);

  7824.         SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);

  7825.         SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);

  7826.         SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);

  7827.         SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);

  7828.         SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);

  7829.         SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);

  7830.         SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);

  7831.         SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);

  7832.         SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);

  7833.         SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);

  7834.         SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);

  7835.         SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);

  7836.         SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);

  7837.         SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);

  7838.         SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);

  7839.         SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);

  7840. 

  7841.         SetLength(Rec.MatrixV, 20);

  7842.         SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);

  7843.         SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);

  7844.         SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);

  7845.         SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);

  7846.         SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);

  7847.         SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);

  7848.         SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);

  7849.         SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);

  7850.         SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);

  7851.         SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);

  7852.         SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);

  7853.         SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);

  7854.         SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);

  7855.         SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);

  7856.         SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);

  7857.         SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);

  7858.         SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);

  7859.         SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);

  7860.         SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);

  7861.         SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);

  7862.       end;

  7863.     end;

  7864. 

  7865.     // Daten Sammeln

  7866.     if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then

  7867.       AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)

  7868.     else

  7869.       AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);

  7870.     AddFunc(glBitmapToNormalMapFunc, false, @Rec);

  7871.   finally

  7872.     SetLength(Rec.Heights, 0);

  7873.   end;

  7874. end;

  7875. 

  7876. 

  7877. 

  7878. 

  7879. 

  7880. 

  7881. 

  7882. 

  7883. 

  7884. (*

  7885. procedure TglBitmap1D.SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width, Height: Integer);

  7886. var

  7887.   pTemp: pByte;

  7888.   Size: Integer;

  7889. begin

  7890.   if Height > 1 then begin

  7891.     // extract first line of the data

  7892.     Size := FormatGetImageSize(glBitmapPosition(Width), Format);

  7893.     GetMem(pTemp, Size);

  7894. 

  7895.     Move(Data^, pTemp^, Size);

  7896. 

  7897.     FreeMem(Data);

  7898.   end else

  7899.     pTemp := Data;

  7900. 

  7901.   // set data pointer

  7902.   inherited SetDataPointer(pTemp, Format, Width);

  7903. 

  7904.   if FormatIsUncompressed(Format) then begin

  7905.     fUnmapFunc := FormatGetUnMapFunc(Format);

  7906.     fGetPixelFunc := GetPixel1DUnmap;

  7907.   end;

  7908. end;

  7909. 

  7910. 

  7911. procedure TglBitmap1D.GetPixel1DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);

  7912. var

  7913.   pTemp: pByte;

  7914. begin

  7915.   pTemp := Data;

  7916.   Inc(pTemp, Pos.X * fPixelSize);

  7917. 

  7918.   fUnmapFunc(pTemp, Pixel);

  7919. end;

  7920. 

  7921. 

  7922. function TglBitmap1D.FlipHorz: Boolean;

  7923. var

  7924.   Col: Integer;

  7925.   pTempDest, pDest, pSource: pByte;

  7926. begin

  7927.   result := inherited FlipHorz;

  7928. 

  7929.   if Assigned(Data) and FormatIsUncompressed(InternalFormat) then begin

  7930.     pSource := Data;

  7931. 

  7932.     GetMem(pDest, fRowSize);

  7933.     try

  7934.       pTempDest := pDest;

  7935. 

  7936.       Inc(pTempDest, fRowSize);

  7937.       for Col := 0 to Width -1 do begin

  7938.         Move(pSource^, pTempDest^, fPixelSize);

  7939. 

  7940.         Inc(pSource, fPixelSize);

  7941.         Dec(pTempDest, fPixelSize);

  7942.       end;

  7943. 

  7944.       SetDataPointer(pDest, InternalFormat);

  7945. 

  7946.       result := true;

  7947.     finally

  7948.       FreeMem(pDest);

  7949.     end;

  7950.   end;

  7951. end;

  7952. 

  7953. 

  7954. procedure TglBitmap1D.UploadData (Target, Format, InternalFormat, Typ: Cardinal; BuildWithGlu: Boolean);

  7955. begin

  7956.   // Upload data

  7957.   if Self.InternalFormat in [ifDXT1, ifDXT3, ifDXT5] then

  7958.     glCompressedTexImage1D(Target, 0, InternalFormat, Width, 0, Trunc(Width * FormatGetSize(Self.InternalFormat)), Data)

  7959.   else

  7960. 

  7961.   // Upload data

  7962.   if BuildWithGlu then

  7963.     gluBuild1DMipmaps(Target, InternalFormat, Width, Format, Typ, Data)

  7964.   else

  7965.     glTexImage1D(Target, 0, InternalFormat, Width, 0, Format, Typ, Data);

  7966. 

  7967.   // Freigeben

  7968.   if (FreeDataAfterGenTexture) then

  7969.     FreeData;

  7970. end;

  7971. 

  7972. 

  7973. procedure TglBitmap1D.GenTexture(TestTextureSize: Boolean);

  7974. var

  7975.   BuildWithGlu, TexRec: Boolean;

  7976.   glFormat, glInternalFormat, glType: Cardinal;

  7977.   TexSize: Integer;

  7978. begin

  7979.   if Assigned(Data) then begin

  7980.     // Check Texture Size

  7981.     if (TestTextureSize) then begin

  7982.       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);

  7983. 

  7984.       if (Width > TexSize) then

  7985.         raise EglBitmapSizeToLargeException.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');

  7986. 

  7987.       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and

  7988.                 (Target = GL_TEXTURE_RECTANGLE_ARB);

  7989. 

  7990.       if not (IsPowerOfTwo (Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then

  7991.         raise EglBitmapNonPowerOfTwoException.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');

  7992.     end;

  7993. 

  7994.     CreateId;

  7995. 

  7996.     SetupParameters(BuildWithGlu);

  7997.     SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);

  7998. 

  7999.     UploadData(Target, glFormat, glInternalFormat, glType, BuildWithGlu);

  8000. 

  8001.     // Infos sammeln

  8002.     glAreTexturesResident(1, @fID, @fIsResident);

  8003.   end;

  8004. end;

  8005. 

  8006. 

  8007. procedure TglBitmap1D.AfterConstruction;

  8008. begin

  8009.   inherited;

  8010. 

  8011.   Target := GL_TEXTURE_1D;

  8012. end;

  8013. 

  8014. 

  8015. { TglBitmapCubeMap }

  8016. 

  8017. procedure TglBitmapCubeMap.AfterConstruction;

  8018. begin

  8019.   inherited;

  8020. 

  8021.   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then

  8022.     raise EglBitmapException.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');

  8023. 

  8024.   SetWrap; // set all to GL_CLAMP_TO_EDGE

  8025.   Target := GL_TEXTURE_CUBE_MAP;

  8026.   fGenMode := GL_REFLECTION_MAP;

  8027. end;

  8028. 

  8029. 

  8030. procedure TglBitmapCubeMap.Bind(EnableTexCoordsGen, EnableTextureUnit: Boolean);

  8031. begin

  8032.   inherited Bind (EnableTextureUnit);

  8033. 

  8034.   if EnableTexCoordsGen then begin

  8035.     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);

  8036.     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);

  8037.     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);

  8038.     glEnable(GL_TEXTURE_GEN_S);

  8039.     glEnable(GL_TEXTURE_GEN_T);

  8040.     glEnable(GL_TEXTURE_GEN_R);

  8041.   end;

  8042. end;

  8043. 

  8044. 

  8045. procedure TglBitmapCubeMap.GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean);

  8046. var

  8047.   glFormat, glInternalFormat, glType: Cardinal;

  8048.   BuildWithGlu: Boolean;

  8049.   TexSize: Integer;

  8050. begin

  8051.   // Check Texture Size

  8052.   if (TestTextureSize) then begin

  8053.     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);

  8054. 

  8055.     if ((Height > TexSize) or (Width > TexSize)) then

  8056.       raise EglBitmapSizeToLargeException.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');

  8057. 

  8058.     if not ((IsPowerOfTwo (Height) and IsPowerOfTwo (Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then

  8059.       raise EglBitmapNonPowerOfTwoException.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');

  8060.   end;

  8061. 

  8062.   // create Texture

  8063.   if ID = 0 then begin

  8064.     CreateID;

  8065.     SetupParameters(BuildWithGlu);

  8066.   end;

  8067. 

  8068.   SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);

  8069. 

  8070.   UploadData (CubeTarget, glFormat, glInternalFormat, glType, BuildWithGlu);

  8071. end;

  8072. 

  8073. 

  8074. procedure TglBitmapCubeMap.GenTexture(TestTextureSize: Boolean);

  8075. begin

  8076.   Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');

  8077. end;

  8078. 

  8079. 

  8080. procedure TglBitmapCubeMap.Unbind(DisableTexCoordsGen,

  8081.   DisableTextureUnit: Boolean);

  8082. begin

  8083.   inherited Unbind (DisableTextureUnit);

  8084. 

  8085.   if DisableTexCoordsGen then begin

  8086.     glDisable(GL_TEXTURE_GEN_S);

  8087.     glDisable(GL_TEXTURE_GEN_T);

  8088.     glDisable(GL_TEXTURE_GEN_R);

  8089.   end;

  8090. end;

  8091. 

  8092. 

  8093. { TglBitmapNormalMap }

  8094. 

  8095. type

  8096.   TVec = Array[0..2] of Single;

  8097.   TglBitmapNormalMapGetVectorFunc = procedure (var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);

  8098. 

  8099.   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;

  8100.   TglBitmapNormalMapRec = record

  8101.     HalfSize : Integer;

  8102.     Func: TglBitmapNormalMapGetVectorFunc;

  8103.   end;

  8104. 

  8105. 

  8106. procedure glBitmapNormalMapPosX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);

  8107. begin

  8108.   Vec[0] := HalfSize;

  8109.   Vec[1] := - (Position.Y + 0.5 - HalfSize);

  8110.   Vec[2] := - (Position.X + 0.5 - HalfSize);

  8111. end;

  8112. 

  8113. 

  8114. procedure glBitmapNormalMapNegX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);

  8115. begin

  8116.   Vec[0] := - HalfSize;

  8117.   Vec[1] := - (Position.Y + 0.5 - HalfSize);

  8118.   Vec[2] := Position.X + 0.5 - HalfSize;

  8119. end;

  8120. 

  8121. 

  8122. procedure glBitmapNormalMapPosY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);

  8123. begin

  8124.   Vec[0] := Position.X + 0.5 - HalfSize;

  8125.   Vec[1] := HalfSize;

  8126.   Vec[2] := Position.Y + 0.5 - HalfSize;

  8127. end;

  8128. 

  8129. 

  8130. procedure glBitmapNormalMapNegY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);

  8131. begin

  8132.   Vec[0] := Position.X + 0.5 - HalfSize;

  8133.   Vec[1] := - HalfSize;

  8134.   Vec[2] := - (Position.Y + 0.5 - HalfSize);

  8135. end;

  8136. 

  8137. 

  8138. procedure glBitmapNormalMapPosZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);

  8139. begin

  8140.   Vec[0] := Position.X + 0.5 - HalfSize;

  8141.   Vec[1] := - (Position.Y + 0.5 - HalfSize);

  8142.   Vec[2] := HalfSize;

  8143. end;

  8144. 

  8145. 

  8146. procedure glBitmapNormalMapNegZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);

  8147. begin

  8148.   Vec[0] := - (Position.X + 0.5 - HalfSize);

  8149.   Vec[1] := - (Position.Y + 0.5 - HalfSize);

  8150.   Vec[2] := - HalfSize;

  8151. end;

  8152. 

  8153. 

  8154. procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);

  8155. var

  8156.   Vec : TVec;

  8157.   Len: Single;

  8158. begin

  8159.   with FuncRec do begin

  8160.     with PglBitmapNormalMapRec (CustomData)^ do begin

  8161.       Func(Vec, Position, HalfSize);

  8162. 

  8163.       // Normalize

  8164.       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));

  8165.       if Len <> 0 then begin

  8166.         Vec[0] := Vec[0] * Len;

  8167.         Vec[1] := Vec[1] * Len;

  8168.         Vec[2] := Vec[2] * Len;

  8169.       end;

  8170. 

  8171.       // Scale Vector and AddVectro

  8172.       Vec[0] := Vec[0] * 0.5 + 0.5;

  8173.       Vec[1] := Vec[1] * 0.5 + 0.5;

  8174.       Vec[2] := Vec[2] * 0.5 + 0.5;

  8175.     end;

  8176. 

  8177.     // Set Color

  8178.     Dest.Red   := Round(Vec[0] * 255);

  8179.     Dest.Green := Round(Vec[1] * 255);

  8180.     Dest.Blue  := Round(Vec[2] * 255);

  8181.   end;

  8182. end;

  8183. 

  8184. 

  8185. procedure TglBitmapNormalMap.AfterConstruction;

  8186. begin

  8187.   inherited;

  8188. 

  8189.   fGenMode := GL_NORMAL_MAP;

  8190. end;

  8191. 

  8192. 

  8193. procedure TglBitmapNormalMap.GenerateNormalMap(Size: Integer;

  8194.   TestTextureSize: Boolean);

  8195. var

  8196.   Rec: TglBitmapNormalMapRec;

  8197.   SizeRec: TglBitmapPixelPosition;

  8198. begin

  8199.   Rec.HalfSize := Size div 2;

  8200. 

  8201.   FreeDataAfterGenTexture := false;

  8202. 

  8203.   SizeRec.Fields := [ffX, ffY];

  8204.   SizeRec.X := Size;

  8205.   SizeRec.Y := Size;

  8206. 

  8207.   // Positive X

  8208.   Rec.Func := glBitmapNormalMapPosX;

  8209.   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);

  8210.   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, TestTextureSize);

  8211. 

  8212.   // Negative X

  8213.   Rec.Func := glBitmapNormalMapNegX;

  8214.   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);

  8215.   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, TestTextureSize);

  8216. 

  8217.   // Positive Y

  8218.   Rec.Func := glBitmapNormalMapPosY;

  8219.   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);

  8220.   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, TestTextureSize);

  8221. 

  8222.   // Negative Y

  8223.   Rec.Func := glBitmapNormalMapNegY;

  8224.   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);

  8225.   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, TestTextureSize);

  8226. 

  8227.   // Positive Z

  8228.   Rec.Func := glBitmapNormalMapPosZ;

  8229.   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);

  8230.   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, TestTextureSize);

  8231. 

  8232.   // Negative Z

  8233.   Rec.Func := glBitmapNormalMapNegZ;

  8234.   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);

  8235.   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, TestTextureSize);

  8236. end;

  8237. *)

  8238. 

  8239. initialization

  8240.   glBitmapSetDefaultFormat(tfEmpty);

  8241.   glBitmapSetDefaultMipmap(mmMipmap);

  8242.   glBitmapSetDefaultFilter(GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);

  8243.   glBitmapSetDefaultWrap  (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);

  8244. 

  8245.   glBitmapSetDefaultFreeDataAfterGenTexture(true);

  8246.   glBitmapSetDefaultDeleteTextureOnFree    (true);

  8247. 

  8248.   TFormatDescriptor.Init;

  8249. 

  8250. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}

  8251.   OpenGLInitialized := false;

  8252.   InitOpenGLCS := TCriticalSection.Create;

  8253. {$ENDIF}

  8254. 

  8255. finalization

  8256.   TFormatDescriptor.Finalize;

  8257. 

  8258. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}

  8259.   FreeAndNil(InitOpenGLCS);

  8260. {$ENDIF}

  8261. 

  8262. end.