opengl
/
glBitmap
1
0
Vork 0
Code Kwesties 0 Pull-aanvragen 0 Publicaties 0 Wiki Activiteit
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
19 Commits
2 Branches
1.7 MiB
 
 
Tree: 483a3227cc
Branches Labels
${ item.name }
Maak branch ${ searchTerm }
van '483a3227cc'
${ noResults }
glBitmap/glBitmap.pas

8285 regels
278 KiB
Ruw Blame Geschiedenis 

  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. // Please uncomment the defines below to configure the glBitmap to your preferences.

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

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

  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. 

  237. // activate to enable the support for SDL_surfaces

  238. {.$DEFINE GLB_SDL}

  239. 

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

  241. {.$DEFINE GLB_DELPHI}

  242. 

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

  244. {.$DEFINE GLB_LAZARUS}

  245. 

  246. 

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

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

  249. {.$DEFINE GLB_SDL_IMAGE}

  250. 

  251. 

  252. 

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

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

  255. {.$DEFINE GLB_PNGIMAGE}

  256. 

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

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

  259. {.$DEFINE GLB_LIB_PNG}

  260. 

  261. 

  262. 

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

  264. {.$DEFINE GLB_DELPHI_JPEG}

  265. 

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

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

  268. {.$DEFINE GLB_LIB_JPEG}

  269. 

  270. 

  271. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

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

  274. // Delphi Versions

  275. {$IFDEF fpc}

  276.   {$MODE Delphi}

  277. 

  278.   {$IFDEF CPUI386}

  279.     {$DEFINE CPU386}

  280.     {$ASMMODE INTEL}

  281.   {$ENDIF}

  282. 

  283.   {$IFNDEF WINDOWS}

  284.     {$linklib c}

  285.   {$ENDIF}

  286. {$ENDIF}

  287. 

  288. // Operation System

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

  290.   {$DEFINE GLB_WIN}

  291. {$ELSEIF DEFINED(LINUX)}

  292.   {$DEFINE GLB_LINUX}

  293. {$IFEND}

  294. 

  295. // native OpenGL Support

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

  297.   {$DEFINE GLB_NATIVE_OGL}

  298. {$IFEND}

  299. 

  300. // checking define combinations

  301. //SDL Image

  302. {$IFDEF GLB_SDL_IMAGE}

  303.   {$IFNDEF GLB_SDL}

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

  305.     {$DEFINE GLB_SDL}

  306.   {$ENDIF}

  307.   {$IFDEF GLB_PNGIMAGE}

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

  309.     {$undef GLB_PNGIMAGE}

  310.   {$ENDIF}

  311.   {$IFDEF GLB_DELPHI_JPEG}

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

  313.     {$undef GLB_DELPHI_JPEG}

  314.   {$ENDIF}

  315.   {$IFDEF GLB_LIB_PNG}

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

  317.     {$undef GLB_LIB_PNG}

  318.   {$ENDIF}

  319.   {$IFDEF GLB_LIB_JPEG}

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

  321.     {$undef GLB_LIB_JPEG}

  322.   {$ENDIF}

  323. 

  324.   {$DEFINE GLB_SUPPORT_PNG_READ}

  325.   {$DEFINE GLB_SUPPORT_JPEG_READ}

  326. {$ENDIF}

  327. 

  328. // PNG Image

  329. {$IFDEF GLB_PNGIMAGE}

  330.   {$IFDEF GLB_LIB_PNG}

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

  332.     {$undef GLB_LIB_PNG}

  333.   {$ENDIF}

  334. 

  335.   {$DEFINE GLB_SUPPORT_PNG_READ}

  336.   {$DEFINE GLB_SUPPORT_PNG_WRITE}

  337. {$ENDIF}

  338. 

  339. // libPNG

  340. {$IFDEF GLB_LIB_PNG}

  341.   {$DEFINE GLB_SUPPORT_PNG_READ}

  342.   {$DEFINE GLB_SUPPORT_PNG_WRITE}

  343. {$ENDIF}

  344. 

  345. // JPEG Image

  346. {$IFDEF GLB_DELPHI_JPEG}

  347.   {$IFDEF GLB_LIB_JPEG}

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

  349.     {$undef GLB_LIB_JPEG}

  350.   {$ENDIF}

  351. 

  352.   {$DEFINE GLB_SUPPORT_JPEG_READ}

  353.   {$DEFINE GLB_SUPPORT_JPEG_WRITE}

  354. {$ENDIF}

  355. 

  356. // libJPEG

  357. {$IFDEF GLB_LIB_JPEG}

  358.   {$DEFINE GLB_SUPPORT_JPEG_READ}

  359.   {$DEFINE GLB_SUPPORT_JPEG_WRITE}

  360. {$ENDIF}

  361. 

  362. // native OpenGL

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

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

  365. {$IFEND}

  366. 

  367. // general options

  368. {$EXTENDEDSYNTAX ON}

  369. {$LONGSTRINGS ON}

  370. {$ALIGN ON}

  371. {$IFNDEF FPC}

  372.   {$OPTIMIZATION ON}

  373. {$ENDIF}

  374. 

  375. interface

  376. 

  377. uses

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

  379.   {$IF DEFINED(GLB_WIN) AND

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

  381. 

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

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

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

  385. 

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

  387. 

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

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

  390. 

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

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

  393. 

  394.   Classes, SysUtils;

  395. 

  396. {$IFDEF GLB_NATIVE_OGL}

  397. const

  398.   GL_TRUE   = 1;

  399.   GL_FALSE  = 0;

  400. 

  401.   GL_VERSION    = $1F02;

  402.   GL_EXTENSIONS = $1F03;

  403. 

  404.   GL_TEXTURE_1D         = $0DE0;

  405.   GL_TEXTURE_2D         = $0DE1;

  406.   GL_TEXTURE_RECTANGLE  = $84F5;

  407. 

  408.   GL_TEXTURE_WIDTH            = $1000;

  409.   GL_TEXTURE_HEIGHT           = $1001;

  410.   GL_TEXTURE_INTERNAL_FORMAT  = $1003;

  411. 

  412.   GL_ALPHA    = $1906;

  413.   GL_ALPHA4   = $803B;

  414.   GL_ALPHA8   = $803C;

  415.   GL_ALPHA12  = $803D;

  416.   GL_ALPHA16  = $803E;

  417. 

  418.   GL_LUMINANCE    = $1909;

  419.   GL_LUMINANCE4   = $803F;

  420.   GL_LUMINANCE8   = $8040;

  421.   GL_LUMINANCE12  = $8041;

  422.   GL_LUMINANCE16  = $8042;

  423. 

  424.   GL_LUMINANCE_ALPHA      = $190A;

  425.   GL_LUMINANCE4_ALPHA4    = $8043;

  426.   GL_LUMINANCE6_ALPHA2    = $8044;

  427.   GL_LUMINANCE8_ALPHA8    = $8045;

  428.   GL_LUMINANCE12_ALPHA4   = $8046;

  429.   GL_LUMINANCE12_ALPHA12  = $8047;

  430.   GL_LUMINANCE16_ALPHA16  = $8048;

  431. 

  432.   GL_RGB      = $1907;

  433.   GL_BGR      = $80E0;

  434.   GL_R3_G3_B2 = $2A10;

  435.   GL_RGB4     = $804F;

  436.   GL_RGB5     = $8050;

  437.   GL_RGB565   = $8D62;

  438.   GL_RGB8     = $8051;

  439.   GL_RGB10    = $8052;

  440.   GL_RGB12    = $8053;

  441.   GL_RGB16    = $8054;

  442. 

  443.   GL_RGBA     = $1908;

  444.   GL_BGRA     = $80E1;

  445.   GL_RGBA2    = $8055;

  446.   GL_RGBA4    = $8056;

  447.   GL_RGB5_A1  = $8057;

  448.   GL_RGBA8    = $8058;

  449.   GL_RGB10_A2 = $8059;

  450.   GL_RGBA12   = $805A;

  451.   GL_RGBA16   = $805B;

  452. 

  453.   GL_DEPTH_COMPONENT    = $1902;

  454.   GL_DEPTH_COMPONENT16  = $81A5;

  455.   GL_DEPTH_COMPONENT24  = $81A6;

  456.   GL_DEPTH_COMPONENT32  = $81A7;

  457. 

  458.   GL_COMPRESSED_RGB                 = $84ED;

  459.   GL_COMPRESSED_RGBA                = $84EE;

  460.   GL_COMPRESSED_RGB_S3TC_DXT1_EXT   = $83F0;

  461.   GL_COMPRESSED_RGBA_S3TC_DXT1_EXT  = $83F1;

  462.   GL_COMPRESSED_RGBA_S3TC_DXT3_EXT  = $83F2;

  463.   GL_COMPRESSED_RGBA_S3TC_DXT5_EXT  = $83F3;

  464. 

  465.   GL_UNSIGNED_BYTE            = $1401;

  466.   GL_UNSIGNED_BYTE_3_3_2      = $8032;

  467.   GL_UNSIGNED_BYTE_2_3_3_REV  = $8362;

  468. 

  469.   GL_UNSIGNED_SHORT             = $1403;

  470.   GL_UNSIGNED_SHORT_5_6_5       = $8363;

  471.   GL_UNSIGNED_SHORT_4_4_4_4     = $8033;

  472.   GL_UNSIGNED_SHORT_5_5_5_1     = $8034;

  473.   GL_UNSIGNED_SHORT_5_6_5_REV   = $8364;

  474.   GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;

  475.   GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;

  476. 

  477.   GL_UNSIGNED_INT                 = $1405;

  478.   GL_UNSIGNED_INT_8_8_8_8         = $8035;

  479.   GL_UNSIGNED_INT_10_10_10_2      = $8036;

  480.   GL_UNSIGNED_INT_8_8_8_8_REV     = $8367;

  481.   GL_UNSIGNED_INT_2_10_10_10_REV  = $8368;

  482. 

  483.   { Texture Filter }

  484.   GL_TEXTURE_MAG_FILTER     = $2800;

  485.   GL_TEXTURE_MIN_FILTER     = $2801;

  486.   GL_NEAREST                = $2600;

  487.   GL_NEAREST_MIPMAP_NEAREST = $2700;

  488.   GL_NEAREST_MIPMAP_LINEAR  = $2702;

  489.   GL_LINEAR                 = $2601;

  490.   GL_LINEAR_MIPMAP_NEAREST  = $2701;

  491.   GL_LINEAR_MIPMAP_LINEAR   = $2703;

  492. 

  493.   { Texture Wrap }

  494.   GL_TEXTURE_WRAP_S   = $2802;

  495.   GL_TEXTURE_WRAP_T   = $2803;

  496.   GL_TEXTURE_WRAP_R   = $8072;

  497.   GL_CLAMP            = $2900;

  498.   GL_REPEAT           = $2901;

  499.   GL_CLAMP_TO_EDGE    = $812F;

  500.   GL_CLAMP_TO_BORDER  = $812D;

  501.   GL_MIRRORED_REPEAT  = $8370;

  502. 

  503.   { Other }

  504.   GL_GENERATE_MIPMAP      = $8191;

  505.   GL_TEXTURE_BORDER_COLOR = $1004;

  506.   GL_MAX_TEXTURE_SIZE     = $0D33;

  507.   GL_PACK_ALIGNMENT       = $0D05;

  508.   GL_UNPACK_ALIGNMENT     = $0CF5;

  509. 

  510.   GL_TEXTURE_MAX_ANISOTROPY_EXT     = $84FE;

  511.   GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;

  512. 

  513. {$IF DEFINED(GLB_WIN)}

  514.   libglu    = 'glu32.dll';

  515.   libopengl = 'opengl32.dll';

  516. {$ELSEIF DEFINED(GLB_LINUX)}

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

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

  519. {$IFEND}

  520. 

  521. type

  522.   GLboolean = BYTEBOOL;

  523.   GLint     = Integer;

  524.   GLsizei   = Integer;

  525.   GLuint    = Cardinal;

  526.   GLfloat   = Single;

  527.   GLenum    = Cardinal;

  528. 

  529.   PGLvoid    = Pointer;

  530.   PGLboolean = ^GLboolean;

  531.   PGLint     = ^GLint;

  532.   PGLuint    = ^GLuint;

  533.   PGLfloat   = ^GLfloat;

  534. 

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

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

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

  538. 

  539. {$IF DEFINED(GLB_WIN)}

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

  541. {$ELSEIF DEFINED(GLB_LINUX)}

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

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

  544. {$IFEND}

  545. 

  546. {$IF DEFINED(GLB_NATIVE_OGL_DYNAMIC)}

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

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

  549. 

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

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

  552. 

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

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

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

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

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

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

  559. 

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

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

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

  563. 

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

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

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

  567. 

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

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

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

  571. 

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

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

  574. 

  575. {$ELSEIF DEFINED(GLB_NATIVE_OGL_STATIC)}

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

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

  578. 

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

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

  581. 

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

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

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

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

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

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

  588. 

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

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

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

  592. 

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

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

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

  596. 

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

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

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

  600. 

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

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

  603. {$IFEND}

  604. 

  605. var

  606.   GL_VERSION_1_2,

  607.   GL_VERSION_1_3,

  608.   GL_VERSION_1_4,

  609.   GL_VERSION_2_0,

  610. 

  611.   GL_SGIS_generate_mipmap,

  612. 

  613.   GL_ARB_texture_border_clamp,

  614.   GL_ARB_texture_mirrored_repeat,

  615.   GL_ARB_texture_rectangle,

  616.   GL_ARB_texture_non_power_of_two,

  617. 

  618.   GL_IBM_texture_mirrored_repeat,

  619. 

  620.   GL_NV_texture_rectangle,

  621. 

  622.   GL_EXT_texture_edge_clamp,

  623.   GL_EXT_texture_rectangle,

  624.   GL_EXT_texture_filter_anisotropic: Boolean;

  625. 

  626.   glCompressedTexImage1D: TglCompressedTexImage1D;

  627.   glCompressedTexImage2D: TglCompressedTexImage2D;

  628.   glGetCompressedTexImage: TglGetCompressedTexImage;

  629. 

  630. {$IF DEFINED(GLB_WIN)}

  631.   wglGetProcAddress: TwglGetProcAddress;

  632. {$ELSEIF DEFINED(GLB_LINUX)}

  633.   glXGetProcAddress: TglXGetProcAddress;

  634.   glXGetProcAddressARB: TglXGetProcAddress;

  635. {$IFEND}

  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. {$ENDIF}

  666. {$ENDIF}

  667. 

  668. type

  669. ////////////////////////////////////////////////////////////////////////////////////////////////////

  670.   TglBitmapFormat = (

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

  672. 

  673.     tfAlpha4,

  674.     tfAlpha8,

  675.     tfAlpha12,

  676.     tfAlpha16,

  677. 

  678.     tfLuminance4,

  679.     tfLuminance8,

  680.     tfLuminance12,

  681.     tfLuminance16,

  682. 

  683.     tfLuminance4Alpha4,

  684.     tfLuminance6Alpha2,

  685.     tfLuminance8Alpha8,

  686.     tfLuminance12Alpha4,

  687.     tfLuminance12Alpha12,

  688.     tfLuminance16Alpha16,

  689. 

  690.     tfR3G3B2,

  691.     tfRGB4,

  692.     tfR5G6B5,

  693.     tfRGB5,

  694.     tfRGB8,

  695.     tfRGB10,

  696.     tfRGB12,

  697.     tfRGB16,

  698. 

  699.     tfRGBA2,

  700.     tfRGBA4,

  701.     tfRGB5A1,

  702.     tfRGBA8,

  703.     tfRGB10A2,

  704.     tfRGBA12,

  705.     tfRGBA16,

  706. 

  707.     tfBGR4,

  708.     tfB5G6R5,

  709.     tfBGR5,

  710.     tfBGR8,

  711.     tfBGR10,

  712.     tfBGR12,

  713.     tfBGR16,

  714. 

  715.     tfBGRA2,

  716.     tfBGRA4,

  717.     tfBGR5A1,

  718.     tfBGRA8,

  719.     tfBGR10A2,

  720.     tfBGRA12,

  721.     tfBGRA16,

  722. 

  723.     tfDepth16,

  724.     tfDepth24,

  725.     tfDepth32,

  726. 

  727.     tfS3tcDtx1RGBA,

  728.     tfS3tcDtx3RGBA,

  729.     tfS3tcDtx5RGBA

  730.   );

  731. 

  732.   TglBitmapFileType = (

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

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

  735.      ftDDS,

  736.      ftTGA,

  737.      ftBMP);

  738.    TglBitmapFileTypes = set of TglBitmapFileType;

  739. 

  740.    TglBitmapMipMap = (

  741.      mmNone,

  742.      mmMipmap,

  743.      mmMipmapGlu);

  744. 

  745.    TglBitmapNormalMapFunc = (

  746.      nm4Samples,

  747.      nmSobel,

  748.      nm3x3,

  749.      nm5x5);

  750. 

  751.  ////////////////////////////////////////////////////////////////////////////////////////////////////

  752.    EglBitmapException               = class(Exception);

  753.    EglBitmapSizeToLargeException    = class(EglBitmapException);

  754.    EglBitmapNonPowerOfTwoException  = class(EglBitmapException);

  755.    EglBitmapUnsupportedFormat       = class(EglBitmapException)

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

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

  758.    end;

  759. 

  760. ////////////////////////////////////////////////////////////////////////////////////////////////////

  761.   TglBitmapColorRec = packed record

  762.   case Integer of

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

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

  765.   end;

  766. 

  767.   TglBitmapPixelData = packed record

  768.     Data, Range: TglBitmapColorRec;

  769.     Format: TglBitmapFormat;

  770.   end;

  771.   PglBitmapPixelData = ^TglBitmapPixelData;

  772. 

  773. ////////////////////////////////////////////////////////////////////////////////////////////////////

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

  775.   TglBitmapPixelPosition = record

  776.     Fields : TglBitmapPixelPositionFields;

  777.     X : Word;

  778.     Y : Word;

  779.   end;

  780. 

  781. ////////////////////////////////////////////////////////////////////////////////////////////////////

  782.   TglBitmap = class;

  783.   TglBitmapFunctionRec = record

  784.     Sender:   TglBitmap;

  785.     Size:     TglBitmapPixelPosition;

  786.     Position: TglBitmapPixelPosition;

  787.     Source:   TglBitmapPixelData;

  788.     Dest:     TglBitmapPixelData;

  789.     Args:     Pointer;

  790.   end;

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

  792. 

  793. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  794.   TglBitmap = class

  795.   protected

  796.     fID: GLuint;

  797.     fTarget: GLuint;

  798.     fAnisotropic: Integer;

  799.     fDeleteTextureOnFree: Boolean;

  800.     fFreeDataAfterGenTexture: Boolean;

  801.     fData: PByte;

  802.     fIsResident: Boolean;

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

  804. 

  805.     fDimension: TglBitmapPixelPosition;

  806.     fMipMap: TglBitmapMipMap;

  807.     fFormat: TglBitmapFormat;

  808. 

  809.     // Mapping

  810.     fPixelSize: Integer;

  811.     fRowSize: Integer;

  812. 

  813.     // Filtering

  814.     fFilterMin: Cardinal;

  815.     fFilterMag: Cardinal;

  816. 

  817.     // TexturWarp

  818.     fWrapS: Cardinal;

  819.     fWrapT: Cardinal;

  820.     fWrapR: Cardinal;

  821. 

  822.     // CustomData

  823.     fFilename: String;

  824.     fCustomName: String;

  825.     fCustomNameW: WideString;

  826.     fCustomData: Pointer;

  827. 

  828.     //Getter

  829.     function GetWidth:  Integer; virtual;

  830.     function GetHeight: Integer; virtual;

  831. 

  832.     function GetFileWidth:  Integer; virtual;

  833.     function GetFileHeight: Integer; virtual;

  834. 

  835.     //Setter

  836.     procedure SetCustomData(const aValue: Pointer);

  837.     procedure SetCustomName(const aValue: String);

  838.     procedure SetCustomNameW(const aValue: WideString);

  839.     procedure SetDeleteTextureOnFree(const aValue: Boolean);

  840.     procedure SetFormat(const aValue: TglBitmapFormat);

  841.     procedure SetFreeDataAfterGenTexture(const aValue: Boolean);

  842.     procedure SetID(const aValue: Cardinal);

  843.     procedure SetMipMap(const aValue: TglBitmapMipMap);

  844.     procedure SetTarget(const aValue: Cardinal);

  845.     procedure SetAnisotropic(const aValue: Integer);

  846. 

  847.     procedure CreateID;

  848.     procedure SetupParameters(out aBuildWithGlu: Boolean);

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

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

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

  852. 

  853.     function FlipHorz: Boolean; virtual;

  854.     function FlipVert: Boolean; virtual;

  855. 

  856.     property Width:  Integer read GetWidth;

  857.     property Height: Integer read GetHeight;

  858. 

  859.     property FileWidth:  Integer read GetFileWidth;

  860.     property FileHeight: Integer read GetFileHeight;

  861.   public

  862.     //Properties

  863.     property ID:           Cardinal        read fID          write SetID;

  864.     property Target:       Cardinal        read fTarget      write SetTarget;

  865.     property Format:       TglBitmapFormat read fFormat      write SetFormat;

  866.     property MipMap:       TglBitmapMipMap read fMipMap      write SetMipMap;

  867.     property Anisotropic:  Integer         read fAnisotropic write SetAnisotropic;

  868. 

  869.     property Filename:    String     read fFilename;

  870.     property CustomName:  String     read fCustomName  write SetCustomName;

  871.     property CustomNameW: WideString read fCustomNameW write SetCustomNameW;

  872.     property CustomData:  Pointer    read fCustomData  write SetCustomData;

  873. 

  874.     property DeleteTextureOnFree:     Boolean read fDeleteTextureOnFree     write SetDeleteTextureOnFree;

  875.     property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;

  876. 

  877.     property Dimension:  TglBitmapPixelPosition  read fDimension;

  878.     property Data:       PByte                   read fData;

  879.     property IsResident: Boolean                 read fIsResident;

  880. 

  881.     procedure AfterConstruction; override;

  882.     procedure BeforeDestruction; override;

  883. 

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

  885. 

  886.     //Load

  887.     procedure LoadFromFile(const aFilename: String);

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

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

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

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

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

  893. 

  894.     //Save

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

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

  897. 

  898.     //Convert

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

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

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

  902.   public

  903.     //Alpha & Co

  904.     {$IFDEF GLB_SDL}

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

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

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

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

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

  910.     {$ENDIF}

  911. 

  912.     {$IFDEF GLB_DELPHI}

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

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

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

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

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

  918.     {$ENDIF}

  919. 

  920.     {$IFDEF GLB_LAZARUS}

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

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

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

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

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

  926.     {$ENDIF}

  927. 

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

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

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

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

  932. 

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

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

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

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

  937. 

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

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

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

  941. 

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

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

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

  945. 

  946.     function RemoveAlpha: Boolean; virtual;

  947.   public

  948.     //Common

  949.     function Clone: TglBitmap;

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

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

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

  953.     procedure FreeData;

  954. 

  955.     //ColorFill

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

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

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

  959. 

  960.     //TexParameters

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

  962.     procedure SetWrap(

  963.       const S: Cardinal = GL_CLAMP_TO_EDGE;

  964.       const T: Cardinal = GL_CLAMP_TO_EDGE;

  965.       const R: Cardinal = GL_CLAMP_TO_EDGE);

  966. 

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

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

  969. 

  970.     //Constructors

  971.     constructor Create; overload;

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

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

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

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

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

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

  978.   private

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

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

  981. 

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

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

  984. 

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

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

  987. 

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

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

  990. 

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

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

  993.   end;

  994. 

  995. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  996.   TglBitmap2D = class(TglBitmap)

  997.   protected

  998.     // Bildeinstellungen

  999.     fLines: array of PByte;

  1000. 

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

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

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

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

  1005.   public

  1006.     property Width;

  1007.     property Height;

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

  1009. 

  1010.     procedure AfterConstruction; override;

  1011. 

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

  1013.     procedure GetDataFromTexture;

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

  1015. 

  1016.     function FlipHorz: Boolean; override;

  1017.     function FlipVert: Boolean; override;

  1018. 

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

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

  1021.   end;

  1022. 

  1023. (* TODO

  1024.   TglBitmapCubeMap = class(TglBitmap2D)

  1025.   protected

  1026.     fGenMode: Integer;

  1027. 

  1028.     // Hide GenTexture

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

  1030.   public

  1031.     procedure AfterConstruction; override;

  1032. 

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

  1034. 

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

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

  1037.   end;

  1038. 

  1039. 

  1040.   TglBitmapNormalMap = class(TglBitmapCubeMap)

  1041.   public

  1042.     procedure AfterConstruction; override;

  1043. 

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

  1045.   end;

  1046. 

  1047. 

  1048.   TglBitmap1D = class(TglBitmap)

  1049.   protected

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

  1051. 

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

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

  1054.   public

  1055.     // propertys

  1056.     property Width;

  1057. 

  1058.     procedure AfterConstruction; override;

  1059. 

  1060.     // Other

  1061.     function FlipHorz: Boolean; override;

  1062. 

  1063.     // Generation

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

  1065.   end;

  1066. *)

  1067. 

  1068. const

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

  1070. 

  1071. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);

  1072. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);

  1073. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);

  1074. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);

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

  1076. procedure glBitmapSetDefaultWrap(

  1077.   const S: Cardinal = GL_CLAMP_TO_EDGE;

  1078.   const T: Cardinal = GL_CLAMP_TO_EDGE;

  1079.   const R: Cardinal = GL_CLAMP_TO_EDGE);

  1080. 

  1081. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;

  1082. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;

  1083. function glBitmapGetDefaultMipmap: TglBitmapMipMap;

  1084. function glBitmapGetDefaultFormat: TglBitmapFormat;

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

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

  1087. 

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

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

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

  1091. 

  1092. var

  1093.   glBitmapDefaultDeleteTextureOnFree: Boolean;

  1094.   glBitmapDefaultFreeDataAfterGenTextures: Boolean;

  1095.   glBitmapDefaultFormat: TglBitmapFormat;

  1096.   glBitmapDefaultMipmap: TglBitmapMipMap;

  1097.   glBitmapDefaultFilterMin: Cardinal;

  1098.   glBitmapDefaultFilterMag: Cardinal;

  1099.   glBitmapDefaultWrapS: Cardinal;

  1100.   glBitmapDefaultWrapT: Cardinal;

  1101.   glBitmapDefaultWrapR: Cardinal;

  1102. 

  1103. {$IFDEF GLB_DELPHI}

  1104. function CreateGrayPalette: HPALETTE;

  1105. {$ENDIF}

  1106. 

  1107. implementation

  1108. 

  1109. uses

  1110.   Math, syncobjs, typinfo;

  1111. 

  1112. type

  1113. {$IFNDEF fpc}

  1114.   QWord   = System.UInt64;

  1115.   PQWord  = ^QWord;

  1116. 

  1117.   PtrInt  = Longint;

  1118.   PtrUInt = DWord;

  1119. {$ENDIF}

  1120. 

  1121. ////////////////////////////////////////////////////////////////////////////////////////////////////

  1122.   TShiftRec = packed record

  1123.   case Integer of

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

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

  1126.   end;

  1127. 

  1128.   TFormatDescriptor = class(TObject)

  1129.   private

  1130.     function GetRedMask: QWord;

  1131.     function GetGreenMask: QWord;

  1132.     function GetBlueMask: QWord;

  1133.     function GetAlphaMask: QWord;

  1134.   protected

  1135.     fFormat: TglBitmapFormat;

  1136.     fWithAlpha: TglBitmapFormat;

  1137.     fWithoutAlpha: TglBitmapFormat;

  1138.     fRGBInverted: TglBitmapFormat;

  1139.     fUncompressed: TglBitmapFormat;

  1140.     fPixelSize: Single;

  1141.     fIsCompressed: Boolean;

  1142. 

  1143.     fRange: TglBitmapColorRec;

  1144.     fShift: TShiftRec;

  1145. 

  1146.     fglFormat:         Cardinal;

  1147.     fglInternalFormat: Cardinal;

  1148.     fglDataFormat:     Cardinal;

  1149. 

  1150.     function GetComponents: Integer; virtual;

  1151.   public

  1152.     property Format:       TglBitmapFormat read fFormat;

  1153.     property WithAlpha:    TglBitmapFormat read fWithAlpha;

  1154.     property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;

  1155.     property RGBInverted:  TglBitmapFormat read fRGBInverted;

  1156.     property Components:   Integer         read GetComponents;

  1157.     property PixelSize:    Single          read fPixelSize;

  1158.     property IsCompressed: Boolean         read fIsCompressed;

  1159. 

  1160.     property glFormat:         Cardinal read fglFormat;

  1161.     property glInternalFormat: Cardinal read fglInternalFormat;

  1162.     property glDataFormat:     Cardinal read fglDataFormat;

  1163. 

  1164.     property Range: TglBitmapColorRec read fRange;

  1165.     property Shift: TShiftRec         read fShift;

  1166. 

  1167.     property RedMask:   QWord read GetRedMask;

  1168.     property GreenMask: QWord read GetGreenMask;

  1169.     property BlueMask:  QWord read GetBlueMask;

  1170.     property AlphaMask: QWord read GetAlphaMask;

  1171. 

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

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

  1174. 

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

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

  1177. 

  1178.     function CreateMappingData: Pointer; virtual;

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

  1180. 

  1181.     function IsEmpty:  Boolean; virtual;

  1182.     function HasAlpha: Boolean; virtual;

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

  1184. 

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

  1186. 

  1187.     constructor Create; virtual;

  1188.   public

  1189.     class procedure Init;

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

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

  1192.     class procedure Clear;

  1193.     class procedure Finalize;

  1194.   end;

  1195.   TFormatDescriptorClass = class of TFormatDescriptor;

  1196. 

  1197.   TfdEmpty = class(TFormatDescriptor);

  1198. 

  1199. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

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

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

  1203.     constructor Create; override;

  1204.   end;

  1205. 

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

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

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

  1209.     constructor Create; override;

  1210.   end;

  1211. 

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

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

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

  1215.     constructor Create; override;

  1216.   end;

  1217. 

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

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

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

  1221.     constructor Create; override;

  1222.   end;

  1223. 

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

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

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

  1227.     constructor Create; override;

  1228.   end;

  1229. 

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

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

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

  1233.     constructor Create; override;

  1234.   end;

  1235. 

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

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

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

  1239.     constructor Create; override;

  1240.   end;

  1241. 

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

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

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

  1245.     constructor Create; override;

  1246.   end;

  1247. 

  1248. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

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

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

  1252.     constructor Create; override;

  1253.   end;

  1254. 

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

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

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

  1258.     constructor Create; override;

  1259.   end;

  1260. 

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

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

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

  1264.     constructor Create; override;

  1265.   end;

  1266. 

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

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

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

  1270.     constructor Create; override;

  1271.   end;

  1272. 

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

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

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

  1276.     constructor Create; override;

  1277.   end;

  1278. 

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

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

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

  1282.     constructor Create; override;

  1283.   end;

  1284. 

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

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

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

  1288.     constructor Create; override;

  1289.   end;

  1290. 

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

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

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

  1294.     constructor Create; override;

  1295.   end;

  1296. 

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

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

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

  1300.     constructor Create; override;

  1301.   end;

  1302. 

  1303. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

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

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

  1307.     constructor Create; override;

  1308.   end;

  1309. 

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

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

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

  1313.     constructor Create; override;

  1314.   end;

  1315. 

  1316. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1317.   TfdAlpha4 = class(TfdAlpha_UB1)

  1318.     constructor Create; override;

  1319.   end;

  1320. 

  1321.   TfdAlpha8 = class(TfdAlpha_UB1)

  1322.     constructor Create; override;

  1323.   end;

  1324. 

  1325.   TfdAlpha12 = class(TfdAlpha_US1)

  1326.     constructor Create; override;

  1327.   end;

  1328. 

  1329.   TfdAlpha16 = class(TfdAlpha_US1)

  1330.     constructor Create; override;

  1331.   end;

  1332. 

  1333.   TfdLuminance4 = class(TfdLuminance_UB1)

  1334.     constructor Create; override;

  1335.   end;

  1336. 

  1337.   TfdLuminance8 = class(TfdLuminance_UB1)

  1338.     constructor Create; override;

  1339.   end;

  1340. 

  1341.   TfdLuminance12 = class(TfdLuminance_US1)

  1342.     constructor Create; override;

  1343.   end;

  1344. 

  1345.   TfdLuminance16 = class(TfdLuminance_US1)

  1346.     constructor Create; override;

  1347.   end;

  1348. 

  1349.   TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)

  1350.     constructor Create; override;

  1351.   end;

  1352. 

  1353.   TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)

  1354.     constructor Create; override;

  1355.   end;

  1356. 

  1357.   TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)

  1358.     constructor Create; override;

  1359.   end;

  1360. 

  1361.   TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)

  1362.     constructor Create; override;

  1363.   end;

  1364. 

  1365.   TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)

  1366.     constructor Create; override;

  1367.   end;

  1368. 

  1369.   TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)

  1370.     constructor Create; override;

  1371.   end;

  1372. 

  1373.   TfdR3G3B2 = class(TfdUniversal_UB1)

  1374.     constructor Create; override;

  1375.   end;

  1376. 

  1377.   TfdRGB4 = class(TfdUniversal_US1)

  1378.     constructor Create; override;

  1379.   end;

  1380. 

  1381.   TfdR5G6B5 = class(TfdUniversal_US1)

  1382.     constructor Create; override;

  1383.   end;

  1384. 

  1385.   TfdRGB5 = class(TfdUniversal_US1)

  1386.     constructor Create; override;

  1387.   end;

  1388. 

  1389.   TfdRGB8 = class(TfdRGB_UB3)

  1390.     constructor Create; override;

  1391.   end;

  1392. 

  1393.   TfdRGB10 = class(TfdUniversal_UI1)

  1394.     constructor Create; override;

  1395.   end;

  1396. 

  1397.   TfdRGB12 = class(TfdRGB_US3)

  1398.     constructor Create; override;

  1399.   end;

  1400. 

  1401.   TfdRGB16 = class(TfdRGB_US3)

  1402.     constructor Create; override;

  1403.   end;

  1404. 

  1405.   TfdRGBA2 = class(TfdRGBA_UB4)

  1406.     constructor Create; override;

  1407.   end;

  1408. 

  1409.   TfdRGBA4 = class(TfdUniversal_US1)

  1410.     constructor Create; override;

  1411.   end;

  1412. 

  1413.   TfdRGB5A1 = class(TfdUniversal_US1)

  1414.     constructor Create; override;

  1415.   end;

  1416. 

  1417.   TfdRGBA8 = class(TfdRGBA_UB4)

  1418.     constructor Create; override;

  1419.   end;

  1420. 

  1421.   TfdRGB10A2 = class(TfdUniversal_UI1)

  1422.     constructor Create; override;

  1423.   end;

  1424. 

  1425.   TfdRGBA12 = class(TfdRGBA_US4)

  1426.     constructor Create; override;

  1427.   end;

  1428. 

  1429.   TfdRGBA16 = class(TfdRGBA_US4)

  1430.     constructor Create; override;

  1431.   end;

  1432. 

  1433.   TfdBGR4 = class(TfdUniversal_US1)

  1434.     constructor Create; override;

  1435.   end;

  1436. 

  1437.   TfdB5G6R5 = class(TfdUniversal_US1)

  1438.     constructor Create; override;

  1439.   end;

  1440. 

  1441.   TfdBGR5 = class(TfdUniversal_US1)

  1442.     constructor Create; override;

  1443.   end;

  1444. 

  1445.   TfdBGR8 = class(TfdBGR_UB3)

  1446.     constructor Create; override;

  1447.   end;

  1448. 

  1449.   TfdBGR10 = class(TfdUniversal_UI1)

  1450.     constructor Create; override;

  1451.   end;

  1452. 

  1453.   TfdBGR12 = class(TfdBGR_US3)

  1454.     constructor Create; override;

  1455.   end;

  1456. 

  1457.   TfdBGR16 = class(TfdBGR_US3)

  1458.     constructor Create; override;

  1459.   end;

  1460. 

  1461.   TfdBGRA2 = class(TfdBGRA_UB4)

  1462.     constructor Create; override;

  1463.   end;

  1464. 

  1465.   TfdBGRA4 = class(TfdUniversal_US1)

  1466.     constructor Create; override;

  1467.   end;

  1468. 

  1469.   TfdBGR5A1 = class(TfdUniversal_US1)

  1470.     constructor Create; override;

  1471.   end;

  1472. 

  1473.   TfdBGRA8 = class(TfdBGRA_UB4)

  1474.     constructor Create; override;

  1475.   end;

  1476. 

  1477.   TfdBGR10A2 = class(TfdUniversal_UI1)

  1478.     constructor Create; override;

  1479.   end;

  1480. 

  1481.   TfdBGRA12 = class(TfdBGRA_US4)

  1482.     constructor Create; override;

  1483.   end;

  1484. 

  1485.   TfdBGRA16 = class(TfdBGRA_US4)

  1486.     constructor Create; override;

  1487.   end;

  1488. 

  1489.   TfdDepth16 = class(TfdDepth_US1)

  1490.     constructor Create; override;

  1491.   end;

  1492. 

  1493.   TfdDepth24 = class(TfdDepth_UI1)

  1494.     constructor Create; override;

  1495.   end;

  1496. 

  1497.   TfdDepth32 = class(TfdDepth_UI1)

  1498.     constructor Create; override;

  1499.   end;

  1500. 

  1501.   TfdS3tcDtx1RGBA = class(TFormatDescriptor)

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

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

  1504.     constructor Create; override;

  1505.   end;

  1506. 

  1507.   TfdS3tcDtx3RGBA = class(TFormatDescriptor)

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

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

  1510.     constructor Create; override;

  1511.   end;

  1512. 

  1513.   TfdS3tcDtx5RGBA = class(TFormatDescriptor)

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

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

  1516.     constructor Create; override;

  1517.   end;

  1518. 

  1519. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1520.   TbmpBitfieldFormat = class(TFormatDescriptor)

  1521.   private

  1522.     procedure SetRedMask  (const aValue: QWord);

  1523.     procedure SetGreenMask(const aValue: QWord);

  1524.     procedure SetBlueMask (const aValue: QWord);

  1525.     procedure SetAlphaMask(const aValue: QWord);

  1526. 

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

  1528.   public

  1529.     property RedMask:   QWord read GetRedMask   write SetRedMask;

  1530.     property GreenMask: QWord read GetGreenMask write SetGreenMask;

  1531.     property BlueMask:  QWord read GetBlueMask  write SetBlueMask;

  1532.     property AlphaMask: QWord read GetAlphaMask write SetAlphaMask;

  1533. 

  1534.     property PixelSize: Single read fPixelSize write fPixelSize;

  1535. 

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

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

  1538.   end;

  1539. 

  1540. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1541.   TbmpColorTableEnty = packed record

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

  1543.   end;

  1544.   TbmpColorTable = array of TbmpColorTableEnty;

  1545.   TbmpColorTableFormat = class(TFormatDescriptor)

  1546.   private

  1547.     fColorTable: TbmpColorTable;

  1548.   public

  1549.     property PixelSize:  Single            read fPixelSize  write fPixelSize;

  1550.     property ColorTable: TbmpColorTable    read fColorTable write fColorTable;

  1551.     property Range:      TglBitmapColorRec read fRange      write fRange;

  1552.     property Shift:      TShiftRec         read fShift      write fShift;

  1553.     property Format:     TglBitmapFormat   read fFormat     write fFormat;

  1554. 

  1555.     procedure CreateColorTable;

  1556. 

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

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

  1559.     destructor Destroy; override;

  1560.   end;

  1561. 

  1562. const

  1563.   LUMINANCE_WEIGHT_R = 0.30;

  1564.   LUMINANCE_WEIGHT_G = 0.59;

  1565.   LUMINANCE_WEIGHT_B = 0.11;

  1566. 

  1567.   ALPHA_WEIGHT_R = 0.30;

  1568.   ALPHA_WEIGHT_G = 0.59;

  1569.   ALPHA_WEIGHT_B = 0.11;

  1570. 

  1571.   DEPTH_WEIGHT_R = 0.333333333;

  1572.   DEPTH_WEIGHT_G = 0.333333333;

  1573.   DEPTH_WEIGHT_B = 0.333333333;

  1574. 

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

  1576. 

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

  1578.     TfdEmpty,

  1579. 

  1580.     TfdAlpha4,

  1581.     TfdAlpha8,

  1582.     TfdAlpha12,

  1583.     TfdAlpha16,

  1584. 

  1585.     TfdLuminance4,

  1586.     TfdLuminance8,

  1587.     TfdLuminance12,

  1588.     TfdLuminance16,

  1589. 

  1590.     TfdLuminance4Alpha4,

  1591.     TfdLuminance6Alpha2,

  1592.     TfdLuminance8Alpha8,

  1593.     TfdLuminance12Alpha4,

  1594.     TfdLuminance12Alpha12,

  1595.     TfdLuminance16Alpha16,

  1596. 

  1597.     TfdR3G3B2,

  1598.     TfdRGB4,

  1599.     TfdR5G6B5,

  1600.     TfdRGB5,

  1601.     TfdRGB8,

  1602.     TfdRGB10,

  1603.     TfdRGB12,

  1604.     TfdRGB16,

  1605. 

  1606.     TfdRGBA2,

  1607.     TfdRGBA4,

  1608.     TfdRGB5A1,

  1609.     TfdRGBA8,

  1610.     TfdRGB10A2,

  1611.     TfdRGBA12,

  1612.     TfdRGBA16,

  1613. 

  1614.     TfdBGR4,

  1615.     TfdB5G6R5,

  1616.     TfdBGR5,

  1617.     TfdBGR8,

  1618.     TfdBGR10,

  1619.     TfdBGR12,

  1620.     TfdBGR16,

  1621. 

  1622.     TfdBGRA2,

  1623.     TfdBGRA4,

  1624.     TfdBGR5A1,

  1625.     TfdBGRA8,

  1626.     TfdBGR10A2,

  1627.     TfdBGRA12,

  1628.     TfdBGRA16,

  1629. 

  1630.     TfdDepth16,

  1631.     TfdDepth24,

  1632.     TfdDepth32,

  1633. 

  1634.     TfdS3tcDtx1RGBA,

  1635.     TfdS3tcDtx3RGBA,

  1636.     TfdS3tcDtx5RGBA

  1637.   );

  1638. 

  1639. var

  1640.   FormatDescriptorCS: TCriticalSection;

  1641.   FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;

  1642. 

  1643. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  1645. begin

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

  1647. end;

  1648. 

  1649. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  1651. begin

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

  1653. end;

  1654. 

  1655. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  1657. begin

  1658.   result.Fields := [];

  1659. 

  1660.   if X >= 0 then

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

  1662.   if Y >= 0 then

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

  1664. 

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

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

  1667. end;

  1668. 

  1669. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  1671. begin

  1672.   result.r := r;

  1673.   result.g := g;

  1674.   result.b := b;

  1675.   result.a := a;

  1676. end;

  1677. 

  1678. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  1680. var

  1681.   i: Integer;

  1682. begin

  1683.   result := false;

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

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

  1686.       exit;

  1687.   result := true;

  1688. end;

  1689. 

  1690. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  1692. begin

  1693.   result.r := r;

  1694.   result.g := g;

  1695.   result.b := b;

  1696.   result.a := a;

  1697. end;

  1698. 

  1699. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  1701. begin

  1702.   result := [];

  1703. 

  1704.   if (aFormat in [

  1705.         //4 bbp

  1706.         tfLuminance4,

  1707. 

  1708.         //8bpp

  1709.         tfR3G3B2, tfLuminance8,

  1710. 

  1711.         //16bpp

  1712.         tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,

  1713.         tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,

  1714. 

  1715.         //24bpp

  1716.         tfBGR8, tfRGB8,

  1717. 

  1718.         //32bpp

  1719.         tfRGB10, tfRGB10A2, tfRGBA8,

  1720.         tfBGR10, tfBGR10A2, tfBGRA8]) then

  1721.     result := result + [ftBMP];

  1722. 

  1723.   if (aFormat in [

  1724.         //8 bpp

  1725.         tfLuminance8, tfAlpha8,

  1726. 

  1727.         //16 bpp

  1728.         tfLuminance16, tfLuminance8Alpha8,

  1729.         tfRGB5, tfRGB5A1, tfRGBA4,

  1730.         tfBGR5, tfBGR5A1, tfBGRA4,

  1731. 

  1732.         //24 bpp

  1733.         tfRGB8, tfBGR8,

  1734. 

  1735.         //32 bpp

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

  1737.     result := result + [ftTGA];

  1738. 

  1739.   if (aFormat in [

  1740.         //8 bpp

  1741.         tfAlpha8, tfLuminance8, tfLuminance4Alpha4, tfLuminance6Alpha2,

  1742.         tfR3G3B2, tfRGBA2, tfBGRA2,

  1743. 

  1744.         //16 bpp

  1745.         tfAlpha16, tfLuminance16, tfLuminance8Alpha8, tfLuminance12Alpha4,

  1746.         tfRGB4, tfR5G6B5, tfRGB5, tfRGBA4, tfRGB5A1,

  1747.         tfBGR4, tfB5G6R5, tfBGR5, tfBGRA4, tfBGR5A1,

  1748. 

  1749.         //24 bpp

  1750.         tfRGB8, tfBGR8,

  1751. 

  1752.         //32 bbp

  1753.         tfLuminance16Alpha16,

  1754.         tfRGBA8, tfRGB10A2,

  1755.         tfBGRA8, tfBGR10A2,

  1756. 

  1757.         //compressed

  1758.         tfS3tcDtx1RGBA, tfS3tcDtx3RGBA, tfS3tcDtx5RGBA]) then

  1759.     result := result + [ftDDS];

  1760. 

  1761.   {$IFDEF GLB_SUPPORT_PNG_WRITE}

  1762.   if aFormat in [

  1763.       tfAlpha8, tfLuminance8, tfLuminance8Alpha8,

  1764.       tfRGB8, tfRGBA8,

  1765.       tfBGR8, tfBGRA8] then

  1766.     result := result + [ftPNG];

  1767.   {$ENDIF}

  1768. 

  1769.   {$IFDEF GLB_SUPPORT_JPEG_WRITE}

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

  1771.     result := result + [ftJPEG];

  1772.   {$ENDIF}

  1773. end;

  1774. 

  1775. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  1777. begin

  1778.   while (aNumber and 1) = 0 do

  1779.     aNumber := aNumber shr 1;

  1780.   result := aNumber = 1;

  1781. end;

  1782. 

  1783. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  1785. begin

  1786.   result := 0;

  1787.   while aBitSet > 0 do begin

  1788.     inc(result);

  1789.     aBitSet := aBitSet shr 1;

  1790.   end;

  1791. end;

  1792. 

  1793. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  1795. begin

  1796.   result := 0;

  1797.   while aBitSet > 0 do begin

  1798.     if (aBitSet and 1) = 1 then

  1799.       inc(result);

  1800.     aBitSet := aBitSet shr 1;

  1801.   end;

  1802. end;

  1803. 

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

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

  1806. begin

  1807.   result := Trunc(

  1808.     LUMINANCE_WEIGHT_R * aPixel.Data.r +

  1809.     LUMINANCE_WEIGHT_G * aPixel.Data.g +

  1810.     LUMINANCE_WEIGHT_B * aPixel.Data.b);

  1811. end;

  1812. 

  1813. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  1815. begin

  1816.   result := Trunc(

  1817.     DEPTH_WEIGHT_R * aPixel.Data.r +

  1818.     DEPTH_WEIGHT_G * aPixel.Data.g +

  1819.     DEPTH_WEIGHT_B * aPixel.Data.b);

  1820. end;

  1821. 

  1822. {$IFDEF GLB_NATIVE_OGL}

  1823. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1824. //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1825. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1826. var

  1827.   GL_LibHandle: Pointer = nil;

  1828. 

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

  1830. begin

  1831.   if not Assigned(aLibHandle) then

  1832.     aLibHandle := GL_LibHandle;

  1833. 

  1834. {$IF DEFINED(GLB_WIN)}

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

  1836.   if Assigned(result) then

  1837.     exit;

  1838. 

  1839.   if Assigned(wglGetProcAddress) then

  1840.     result := wglGetProcAddress(aProcName);

  1841. {$ELSEIF DEFINED(GLB_LINUX)}

  1842.   if Assigned(glXGetProcAddress) then begin

  1843.     result := glXGetProcAddress(aProcName);

  1844.     if Assigned(result) then

  1845.       exit;

  1846.   end;

  1847. 

  1848.   if Assigned(glXGetProcAddressARB) then begin

  1849.     result := glXGetProcAddressARB(aProcName);

  1850.     if Assigned(result) then

  1851.       exit;

  1852.   end;

  1853. 

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

  1855. {$IFEND}

  1856.   if not Assigned(result) then

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

  1858. end;

  1859. 

  1860. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}

  1861. var

  1862.   GLU_LibHandle: Pointer = nil;

  1863.   OpenGLInitialized: Boolean;

  1864.   InitOpenGLCS: TCriticalSection;

  1865. 

  1866. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1867. procedure glbInitOpenGL;

  1868. 

  1869.   ////////////////////////////////////////////////////////////////////////////////

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

  1871.   begin

  1872.     {$IF DEFINED(GLB_WIN)}

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

  1874.     {$ELSEIF DEFINED(GLB_LINUX)}

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

  1876.     {$ELSE}

  1877.     result := nil;

  1878.     {$IFEND}

  1879.   end;

  1880. 

  1881.   ////////////////////////////////////////////////////////////////////////////////

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

  1883.   begin

  1884.     result := false;

  1885.     if not Assigned(aLibHandle) then

  1886.       exit;

  1887. 

  1888.     {$IF DEFINED(GLB_WIN)}

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

  1890.     {$ELSEIF DEFINED(GLB_LINUX)}

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

  1892.     {$IFEND}

  1893.   end;

  1894. 

  1895. begin

  1896.   if Assigned(GL_LibHandle) then

  1897.     glbFreeLibrary(GL_LibHandle);

  1898. 

  1899.   if Assigned(GLU_LibHandle) then

  1900.     glbFreeLibrary(GLU_LibHandle);

  1901. 

  1902.   GL_LibHandle := glbLoadLibrary(libopengl);

  1903.   if not Assigned(GL_LibHandle) then

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

  1905. 

  1906.   GLU_LibHandle := glbLoadLibrary(libglu);

  1907.   if not Assigned(GLU_LibHandle) then

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

  1909. 

  1910.   try

  1911.   {$IF DEFINED(GLB_WIN)}

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

  1913.   {$ELSEIF DEFINED(GLB_LINUX)}

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

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

  1916.   {$IFEND}

  1917. 

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

  1937. 

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

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

  1940.   finally

  1941.     glbFreeLibrary(GL_LibHandle);

  1942.     glbFreeLibrary(GLU_LibHandle);

  1943.   end;

  1944. end;

  1945. {$ENDIF}

  1946. 

  1947. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1948. procedure glbReadOpenGLExtensions;

  1949. var

  1950.   Buffer: AnsiString;

  1951.   MajorVersion, MinorVersion: Integer;

  1952. 

  1953.   ///////////////////////////////////////////////////////////////////////////////////////////

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

  1955.   var

  1956.     Separator: Integer;

  1957.   begin

  1958.     aMinor := 0;

  1959.     aMajor := 0;

  1960. 

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

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

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

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

  1965. 

  1966.       Dec(Separator);

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

  1968.         Dec(Separator);

  1969. 

  1970.       Delete(aBuffer, 1, Separator);

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

  1972. 

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

  1974.         Inc(Separator);

  1975. 

  1976.       Delete(aBuffer, Separator, 255);

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

  1978. 

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

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

  1981.     end;

  1982.   end;

  1983. 

  1984.   ///////////////////////////////////////////////////////////////////////////////////////////

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

  1986.   var

  1987.     ExtPos: Integer;

  1988.   begin

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

  1990.     result := ExtPos > 0;

  1991.     if result then

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

  1993.   end;

  1994. 

  1995. begin

  1996. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}

  1997.   InitOpenGLCS.Enter;

  1998.   try

  1999.     if not OpenGLInitialized then begin

  2000.       glbInitOpenGL;

  2001.       OpenGLInitialized := true;

  2002.     end;

  2003.   finally

  2004.     InitOpenGLCS.Leave;

  2005.   end;

  2006. {$ENDIF}

  2007. 

  2008.   // Version

  2009.   Buffer := glGetString(GL_VERSION);

  2010.   TrimVersionString(Buffer, MajorVersion, MinorVersion);

  2011. 

  2012.   GL_VERSION_1_2 := false;

  2013.   GL_VERSION_1_3 := false;

  2014.   GL_VERSION_1_4 := false;

  2015.   GL_VERSION_2_0 := false;

  2016.   if MajorVersion = 1 then begin

  2017.     if MinorVersion >= 2 then

  2018.       GL_VERSION_1_2 := true;

  2019. 

  2020.     if MinorVersion >= 3 then

  2021.       GL_VERSION_1_3 := true;

  2022. 

  2023.     if MinorVersion >= 4 then

  2024.       GL_VERSION_1_4 := true;

  2025.   end else if MajorVersion >= 2 then begin

  2026.     GL_VERSION_1_2 := true;

  2027.     GL_VERSION_1_3 := true;

  2028.     GL_VERSION_1_4 := true;

  2029.     GL_VERSION_2_0 := true;

  2030.   end;

  2031. 

  2032.   // Extensions

  2033.   Buffer := glGetString(GL_EXTENSIONS);

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

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

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

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

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

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

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

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

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

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

  2044. 

  2045.   if GL_VERSION_1_3 then begin

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

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

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

  2049.   end else begin

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

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

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

  2053.   end;

  2054. end;

  2055. {$ENDIF}

  2056. 

  2057. (* TODO GLB_DELPHI

  2058. {$IFDEF GLB_DELPHI}

  2059. function CreateGrayPalette: HPALETTE;

  2060. var

  2061.   Idx: Integer;

  2062.   Pal: PLogPalette;

  2063. begin

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

  2065. 

  2066.   Pal.palVersion := $300;

  2067.   Pal.palNumEntries := 256;

  2068. 

  2069.   {$IFOPT R+}

  2070.     {$DEFINE GLB_TEMPRANGECHECK}

  2071.     {$R-}

  2072.   {$ENDIF}

  2073. 

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

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

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

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

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

  2079.   end;

  2080. 

  2081.   {$IFDEF GLB_TEMPRANGECHECK}

  2082.     {$UNDEF GLB_TEMPRANGECHECK}

  2083.     {$R+}

  2084.   {$ENDIF}

  2085. 

  2086.   result := CreatePalette(Pal^);

  2087. 

  2088.   FreeMem(Pal);

  2089. end;

  2090. {$ENDIF}

  2091. *)

  2092. 

  2093. {$IFDEF GLB_SDL_IMAGE}

  2094. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2095. // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2096. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2098. begin

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

  2100. end;

  2101. 

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

  2103. begin

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

  2105. end;

  2106. 

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

  2108. begin

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

  2110. end;

  2111. 

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

  2113. begin

  2114.   result := 0;

  2115. end;

  2116. 

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

  2118. begin

  2119.   result := SDL_AllocRW;

  2120. 

  2121.   if result = nil then

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

  2123. 

  2124.   result^.seek := glBitmapRWseek;

  2125.   result^.read := glBitmapRWread;

  2126.   result^.write := glBitmapRWwrite;

  2127.   result^.close := glBitmapRWclose;

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

  2129. end;

  2130. {$ENDIF}

  2131. 

  2132. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2133. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);

  2134. begin

  2135.   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;

  2136. end;

  2137. 

  2138. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2139. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);

  2140. begin

  2141.   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;

  2142. end;

  2143. 

  2144. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2145. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);

  2146. begin

  2147.   glBitmapDefaultMipmap := aValue;

  2148. end;

  2149. 

  2150. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2151. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);

  2152. begin

  2153.   glBitmapDefaultFormat := aFormat;

  2154. end;

  2155. 

  2156. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2158. begin

  2159.   glBitmapDefaultFilterMin := aMin;

  2160.   glBitmapDefaultFilterMag := aMag;

  2161. end;

  2162. 

  2163. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2165. begin

  2166.   glBitmapDefaultWrapS := S;

  2167.   glBitmapDefaultWrapT := T;

  2168.   glBitmapDefaultWrapR := R;

  2169. end;

  2170. 

  2171. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2172. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;

  2173. begin

  2174.   result := glBitmapDefaultDeleteTextureOnFree;

  2175. end;

  2176. 

  2177. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2178. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;

  2179. begin

  2180.   result := glBitmapDefaultFreeDataAfterGenTextures;

  2181. end;

  2182. 

  2183. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2184. function glBitmapGetDefaultMipmap: TglBitmapMipMap;

  2185. begin

  2186.   result := glBitmapDefaultMipmap;

  2187. end;

  2188. 

  2189. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2190. function glBitmapGetDefaultFormat: TglBitmapFormat;

  2191. begin

  2192.   result := glBitmapDefaultFormat;

  2193. end;

  2194. 

  2195. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2197. begin

  2198.   aMin := glBitmapDefaultFilterMin;

  2199.   aMag := glBitmapDefaultFilterMag;

  2200. end;

  2201. 

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

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

  2204. begin

  2205.   S := glBitmapDefaultWrapS;

  2206.   T := glBitmapDefaultWrapT;

  2207.   R := glBitmapDefaultWrapR;

  2208. end;

  2209. 

  2210. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2211. //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2212. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2213. function TFormatDescriptor.GetRedMask: QWord;

  2214. begin

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

  2216. end;

  2217. 

  2218. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2219. function TFormatDescriptor.GetGreenMask: QWord;

  2220. begin

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

  2222. end;

  2223. 

  2224. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2225. function TFormatDescriptor.GetBlueMask: QWord;

  2226. begin

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

  2228. end;

  2229. 

  2230. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2231. function TFormatDescriptor.GetAlphaMask: QWord;

  2232. begin

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

  2234. end;

  2235. 

  2236. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2237. function TFormatDescriptor.GetComponents: Integer;

  2238. var

  2239.   i: Integer;

  2240. begin

  2241.   result := 0;

  2242.   for i := 0 to 3 do

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

  2244.       inc(result);

  2245. end;

  2246. 

  2247. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2249. var

  2250.   w, h: Integer;

  2251. begin

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

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

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

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

  2256.   end else

  2257.     result := 0;

  2258. end;

  2259. 

  2260. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2262. begin

  2263.   result := 0;

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

  2265.     exit;

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

  2267. end;

  2268. 

  2269. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2270. function TFormatDescriptor.CreateMappingData: Pointer;

  2271. begin

  2272.   result := nil;

  2273. end;

  2274. 

  2275. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2277. begin

  2278.   //DUMMY

  2279. end;

  2280. 

  2281. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2282. function TFormatDescriptor.IsEmpty: Boolean;

  2283. begin

  2284.   result := (fFormat = tfEmpty);

  2285. end;

  2286. 

  2287. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2288. function TFormatDescriptor.HasAlpha: Boolean;

  2289. begin

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

  2291. end;

  2292. 

  2293. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2295. begin

  2296.   result := false;

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

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

  2299.   if (aRedMask   <> RedMask) then

  2300.     exit;

  2301.   if (aGreenMask <> GreenMask) then

  2302.     exit;

  2303.   if (aBlueMask  <> BlueMask) then

  2304.     exit;

  2305.   if (aAlphaMask <> AlphaMask) then

  2306.     exit;

  2307.   result := true;

  2308. end;

  2309. 

  2310. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2312. begin

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

  2314.   aPixel.Data   := fRange;

  2315.   aPixel.Range  := fRange;

  2316.   aPixel.Format := fFormat;

  2317. end;

  2318. 

  2319. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2320. constructor TFormatDescriptor.Create;

  2321. begin

  2322.   inherited Create;

  2323. 

  2324.   fFormat       := tfEmpty;

  2325.   fWithAlpha    := tfEmpty;

  2326.   fWithoutAlpha := tfEmpty;

  2327.   fRGBInverted  := tfEmpty;

  2328.   fUncompressed := tfEmpty;

  2329.   fPixelSize    := 0.0;

  2330.   fIsCompressed := false;

  2331. 

  2332.   fglFormat         := 0;

  2333.   fglInternalFormat := 0;

  2334.   fglDataFormat     := 0;

  2335. 

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

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

  2338. end;

  2339. 

  2340. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2341. //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2342. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2344. begin

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

  2346.   inc(aData);

  2347. end;

  2348. 

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

  2350. begin

  2351.   aPixel.Data.r := 0;

  2352.   aPixel.Data.g := 0;

  2353.   aPixel.Data.b := 0;

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

  2355.   inc(aData);

  2356. end;

  2357. 

  2358. constructor TfdAlpha_UB1.Create;

  2359. begin

  2360.   inherited Create;

  2361.   fPixelSize        := 1.0;

  2362.   fRange.a          := $FF;

  2363.   fglFormat         := GL_ALPHA;

  2364.   fglDataFormat     := GL_UNSIGNED_BYTE;

  2365. end;

  2366. 

  2367. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2368. //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2369. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2371. begin

  2372.   aData^ := LuminanceWeight(aPixel);

  2373.   inc(aData);

  2374. end;

  2375. 

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

  2377. begin

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

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

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

  2381.   aPixel.Data.a := 0;

  2382.   inc(aData);

  2383. end;

  2384. 

  2385. constructor TfdLuminance_UB1.Create;

  2386. begin

  2387.   inherited Create;

  2388.   fPixelSize        := 1.0;

  2389.   fRange.r          := $FF;

  2390.   fRange.g          := $FF;

  2391.   fRange.b          := $FF;

  2392.   fglFormat         := GL_LUMINANCE;

  2393.   fglDataFormat     := GL_UNSIGNED_BYTE;

  2394. end;

  2395. 

  2396. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2397. //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

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

  2400. var

  2401.   i: Integer;

  2402. begin

  2403.   aData^ := 0;

  2404.   for i := 0 to 3 do

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

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

  2407.   inc(aData);

  2408. end;

  2409. 

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

  2411. var

  2412.   i: Integer;

  2413. begin

  2414.   for i := 0 to 3 do

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

  2416.   inc(aData);

  2417. end;

  2418. 

  2419. constructor TfdUniversal_UB1.Create;

  2420. begin

  2421.   inherited Create;

  2422.   fPixelSize := 1.0;

  2423. end;

  2424. 

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

  2426. //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

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

  2429. begin

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

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

  2432.   inc(aData);

  2433. end;

  2434. 

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

  2436. begin

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

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

  2439.   inc(aData);

  2440. end;

  2441. 

  2442. constructor TfdLuminanceAlpha_UB2.Create;

  2443. begin

  2444.   inherited Create;

  2445.   fPixelSize        := 2.0;

  2446.   fRange.a          := $FF;

  2447.   fShift.a          :=   8;

  2448.   fglFormat         := GL_LUMINANCE_ALPHA;

  2449.   fglDataFormat     := GL_UNSIGNED_BYTE;

  2450. end;

  2451. 

  2452. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2453. //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

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

  2456. begin

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

  2458.   inc(aData);

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

  2460.   inc(aData);

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

  2462.   inc(aData);

  2463. end;

  2464. 

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

  2466. begin

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

  2468.   inc(aData);

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

  2470.   inc(aData);

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

  2472.   inc(aData);

  2473.   aPixel.Data.a := 0;

  2474. end;

  2475. 

  2476. constructor TfdRGB_UB3.Create;

  2477. begin

  2478.   inherited Create;

  2479.   fPixelSize        := 3.0;

  2480.   fRange.r          := $FF;

  2481.   fRange.g          := $FF;

  2482.   fRange.b          := $FF;

  2483.   fShift.r          :=   0;

  2484.   fShift.g          :=   8;

  2485.   fShift.b          :=  16;

  2486.   fglFormat         := GL_RGB;

  2487.   fglDataFormat     := GL_UNSIGNED_BYTE;

  2488. end;

  2489. 

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

  2491. //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2492. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2494. begin

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

  2496.   inc(aData);

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

  2498.   inc(aData);

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

  2500.   inc(aData);

  2501. end;

  2502. 

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

  2504. begin

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

  2506.   inc(aData);

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

  2508.   inc(aData);

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

  2510.   inc(aData);

  2511.   aPixel.Data.a := 0;

  2512. end;

  2513. 

  2514. constructor TfdBGR_UB3.Create;

  2515. begin

  2516.   fPixelSize        := 3.0;

  2517.   fRange.r          := $FF;

  2518.   fRange.g          := $FF;

  2519.   fRange.b          := $FF;

  2520.   fShift.r          :=  16;

  2521.   fShift.g          :=   8;

  2522.   fShift.b          :=   0;

  2523.   fglFormat         := GL_BGR;

  2524.   fglDataFormat     := GL_UNSIGNED_BYTE;

  2525. end;

  2526. 

  2527. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2528. //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2529. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2531. begin

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

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

  2534.   inc(aData);

  2535. end;

  2536. 

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

  2538. begin

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

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

  2541.   inc(aData);

  2542. end;

  2543. 

  2544. constructor TfdRGBA_UB4.Create;

  2545. begin

  2546.   inherited Create;

  2547.   fPixelSize        := 4.0;

  2548.   fRange.a          := $FF;

  2549.   fShift.a          :=  24;

  2550.   fglFormat         := GL_RGBA;

  2551.   fglDataFormat     := GL_UNSIGNED_BYTE;

  2552. end;

  2553. 

  2554. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2555. //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2556. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2558. begin

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

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

  2561.   inc(aData);

  2562. end;

  2563. 

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

  2565. begin

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

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

  2568.   inc(aData);

  2569. end;

  2570. 

  2571. constructor TfdBGRA_UB4.Create;

  2572. begin

  2573.   inherited Create;

  2574.   fPixelSize        := 4.0;

  2575.   fRange.a          := $FF;

  2576.   fShift.a          :=  24;

  2577.   fglFormat         := GL_BGRA;

  2578.   fglDataFormat     := GL_UNSIGNED_BYTE;

  2579. end;

  2580. 

  2581. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2582. //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2583. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2585. begin

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

  2587.   inc(aData, 2);

  2588. end;

  2589. 

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

  2591. begin

  2592.   aPixel.Data.r := 0;

  2593.   aPixel.Data.g := 0;

  2594.   aPixel.Data.b := 0;

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

  2596.   inc(aData, 2);

  2597. end;

  2598. 

  2599. constructor TfdAlpha_US1.Create;

  2600. begin

  2601.   inherited Create;

  2602.   fPixelSize        := 2.0;

  2603.   fRange.a          := $FFFF;

  2604.   fglFormat         := GL_ALPHA;

  2605.   fglDataFormat     := GL_UNSIGNED_SHORT;

  2606. end;

  2607. 

  2608. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2609. //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2610. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2612. begin

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

  2614.   inc(aData, 2);

  2615. end;

  2616. 

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

  2618. begin

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

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

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

  2622.   aPixel.Data.a := 0;

  2623.   inc(aData, 2);

  2624. end;

  2625. 

  2626. constructor TfdLuminance_US1.Create;

  2627. begin

  2628.   inherited Create;

  2629.   fPixelSize        := 2.0;

  2630.   fRange.r          := $FFFF;

  2631.   fRange.g          := $FFFF;

  2632.   fRange.b          := $FFFF;

  2633.   fglFormat         := GL_LUMINANCE;

  2634.   fglDataFormat     := GL_UNSIGNED_SHORT;

  2635. end;

  2636. 

  2637. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2638. //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

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

  2641. var

  2642.   i: Integer;

  2643. begin

  2644.   PWord(aData)^ := 0;

  2645.   for i := 0 to 3 do

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

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

  2648.   inc(aData, 2);

  2649. end;

  2650. 

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

  2652. var

  2653.   i: Integer;

  2654. begin

  2655.   for i := 0 to 3 do

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

  2657.   inc(aData, 2);

  2658. end;

  2659. 

  2660. constructor TfdUniversal_US1.Create;

  2661. begin

  2662.   inherited Create;

  2663.   fPixelSize := 2.0;

  2664. end;

  2665. 

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

  2667. //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

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

  2670. begin

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

  2672.   inc(aData, 2);

  2673. end;

  2674. 

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

  2676. begin

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

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

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

  2680.   aPixel.Data.a := 0;

  2681.   inc(aData, 2);

  2682. end;

  2683. 

  2684. constructor TfdDepth_US1.Create;

  2685. begin

  2686.   inherited Create;

  2687.   fPixelSize        := 2.0;

  2688.   fRange.r          := $FFFF;

  2689.   fRange.g          := $FFFF;

  2690.   fRange.b          := $FFFF;

  2691.   fglFormat         := GL_DEPTH_COMPONENT;

  2692.   fglDataFormat     := GL_UNSIGNED_SHORT;

  2693. end;

  2694. 

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

  2696. //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

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

  2699. begin

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

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

  2702.   inc(aData, 2);

  2703. end;

  2704. 

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

  2706. begin

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

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

  2709.   inc(aData, 2);

  2710. end;

  2711. 

  2712. constructor TfdLuminanceAlpha_US2.Create;

  2713. begin

  2714.   inherited Create;

  2715.   fPixelSize        :=   4.0;

  2716.   fRange.a          := $FFFF;

  2717.   fShift.a          :=    16;

  2718.   fglFormat         := GL_LUMINANCE_ALPHA;

  2719.   fglDataFormat     := GL_UNSIGNED_SHORT;

  2720. end;

  2721. 

  2722. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2723. //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

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

  2726. begin

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

  2728.   inc(aData, 2);

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

  2730.   inc(aData, 2);

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

  2732.   inc(aData, 2);

  2733. end;

  2734. 

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

  2736. begin

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

  2738.   inc(aData, 2);

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

  2740.   inc(aData, 2);

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

  2742.   inc(aData, 2);

  2743.   aPixel.Data.a := 0;

  2744. end;

  2745. 

  2746. constructor TfdRGB_US3.Create;

  2747. begin

  2748.   inherited Create;

  2749.   fPixelSize        :=   6.0;

  2750.   fRange.r          := $FFFF;

  2751.   fRange.g          := $FFFF;

  2752.   fRange.b          := $FFFF;

  2753.   fShift.r          :=     0;

  2754.   fShift.g          :=    16;

  2755.   fShift.b          :=    32;

  2756.   fglFormat         := GL_RGB;

  2757.   fglDataFormat     := GL_UNSIGNED_SHORT;

  2758. end;

  2759. 

  2760. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2761. //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2762. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2764. begin

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

  2766.   inc(aData, 2);

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

  2768.   inc(aData, 2);

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

  2770.   inc(aData, 2);

  2771. end;

  2772. 

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

  2774. begin

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

  2776.   inc(aData, 2);

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

  2778.   inc(aData, 2);

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

  2780.   inc(aData, 2);

  2781.   aPixel.Data.a := 0;

  2782. end;

  2783. 

  2784. constructor TfdBGR_US3.Create;

  2785. begin

  2786.   inherited Create;

  2787.   fPixelSize        :=   6.0;

  2788.   fRange.r          := $FFFF;

  2789.   fRange.g          := $FFFF;

  2790.   fRange.b          := $FFFF;

  2791.   fShift.r          :=    32;

  2792.   fShift.g          :=    16;

  2793.   fShift.b          :=     0;

  2794.   fglFormat         := GL_BGR;

  2795.   fglDataFormat     := GL_UNSIGNED_SHORT;

  2796. end;

  2797. 

  2798. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2799. //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2800. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2802. begin

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

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

  2805.   inc(aData, 2);

  2806. end;

  2807. 

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

  2809. begin

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

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

  2812.   inc(aData, 2);

  2813. end;

  2814. 

  2815. constructor TfdRGBA_US4.Create;

  2816. begin

  2817.   inherited Create;

  2818.   fPixelSize        :=   8.0;

  2819.   fRange.a          := $FFFF;

  2820.   fShift.a          :=    48;

  2821.   fglFormat         := GL_RGBA;

  2822.   fglDataFormat     := GL_UNSIGNED_SHORT;

  2823. end;

  2824. 

  2825. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2826. //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2827. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2829. begin

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

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

  2832.   inc(aData, 2);

  2833. end;

  2834. 

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

  2836. begin

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

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

  2839.   inc(aData, 2);

  2840. end;

  2841. 

  2842. constructor TfdBGRA_US4.Create;

  2843. begin

  2844.   inherited Create;

  2845.   fPixelSize        :=   8.0;

  2846.   fRange.a          := $FFFF;

  2847.   fShift.a          :=    48;

  2848.   fglFormat         := GL_BGRA;

  2849.   fglDataFormat     := GL_UNSIGNED_SHORT;

  2850. end;

  2851. 

  2852. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2853. //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2854. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2856. var

  2857.   i: Integer;

  2858. begin

  2859.   PCardinal(aData)^ := 0;

  2860.   for i := 0 to 3 do

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

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

  2863.   inc(aData, 4);

  2864. end;

  2865. 

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

  2867. var

  2868.   i: Integer;

  2869. begin

  2870.   for i := 0 to 3 do

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

  2872.   inc(aData, 2);

  2873. end;

  2874. 

  2875. constructor TfdUniversal_UI1.Create;

  2876. begin

  2877.   inherited Create;

  2878.   fPixelSize := 4.0;

  2879. end;

  2880. 

  2881. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2882. //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

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

  2885. begin

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

  2887.   inc(aData, 4);

  2888. end;

  2889. 

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

  2891. begin

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

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

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

  2895.   aPixel.Data.a := 0;

  2896.   inc(aData, 4);

  2897. end;

  2898. 

  2899. constructor TfdDepth_UI1.Create;

  2900. begin

  2901.   inherited Create;

  2902.   fPixelSize        := 4.0;

  2903.   fRange.r          := $FFFFFFFF;

  2904.   fRange.g          := $FFFFFFFF;

  2905.   fRange.b          := $FFFFFFFF;

  2906.   fglFormat         := GL_DEPTH_COMPONENT;

  2907.   fglDataFormat     := GL_UNSIGNED_INT;

  2908. end;

  2909. 

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

  2911. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2913. constructor TfdAlpha4.Create;

  2914. begin

  2915.   inherited Create;

  2916.   fFormat           := tfAlpha4;

  2917.   fWithAlpha        := tfAlpha4;

  2918.   fglInternalFormat := GL_ALPHA4;

  2919. end;

  2920. 

  2921. constructor TfdAlpha8.Create;

  2922. begin

  2923.   inherited Create;

  2924.   fFormat           := tfAlpha8;

  2925.   fWithAlpha        := tfAlpha8;

  2926.   fglInternalFormat := GL_ALPHA8;

  2927. end;

  2928. 

  2929. constructor TfdAlpha12.Create;

  2930. begin

  2931.   inherited Create;

  2932.   fFormat           := tfAlpha12;

  2933.   fWithAlpha        := tfAlpha12;

  2934.   fglInternalFormat := GL_ALPHA12;

  2935. end;

  2936. 

  2937. constructor TfdAlpha16.Create;

  2938. begin

  2939.   inherited Create;

  2940.   fFormat           := tfAlpha16;

  2941.   fWithAlpha        := tfAlpha16;

  2942.   fglInternalFormat := GL_ALPHA16;

  2943. end;

  2944. 

  2945. constructor TfdLuminance4.Create;

  2946. begin

  2947.   inherited Create;

  2948.   fFormat           := tfLuminance4;

  2949.   fWithAlpha        := tfLuminance4Alpha4;

  2950.   fWithoutAlpha     := tfLuminance4;

  2951.   fglInternalFormat := GL_LUMINANCE4;

  2952. end;

  2953. 

  2954. constructor TfdLuminance8.Create;

  2955. begin

  2956.   inherited Create;

  2957.   fFormat           := tfLuminance8;

  2958.   fWithAlpha        := tfLuminance8Alpha8;

  2959.   fWithoutAlpha     := tfLuminance8;

  2960.   fglInternalFormat := GL_LUMINANCE8;

  2961. end;

  2962. 

  2963. constructor TfdLuminance12.Create;

  2964. begin

  2965.   inherited Create;

  2966.   fFormat           := tfLuminance12;

  2967.   fWithAlpha        := tfLuminance12Alpha12;

  2968.   fWithoutAlpha     := tfLuminance12;

  2969.   fglInternalFormat := GL_LUMINANCE12;

  2970. end;

  2971. 

  2972. constructor TfdLuminance16.Create;

  2973. begin

  2974.   inherited Create;

  2975.   fFormat           := tfLuminance16;

  2976.   fWithAlpha        := tfLuminance16Alpha16;

  2977.   fWithoutAlpha     := tfLuminance16;

  2978.   fglInternalFormat := GL_LUMINANCE16;

  2979. end;

  2980. 

  2981. constructor TfdLuminance4Alpha4.Create;

  2982. begin

  2983.   inherited Create;

  2984.   fFormat           := tfLuminance4Alpha4;

  2985.   fWithAlpha        := tfLuminance4Alpha4;

  2986.   fWithoutAlpha     := tfLuminance4;

  2987.   fglInternalFormat := GL_LUMINANCE4_ALPHA4;

  2988. end;

  2989. 

  2990. constructor TfdLuminance6Alpha2.Create;

  2991. begin

  2992.   inherited Create;

  2993.   fFormat           := tfLuminance6Alpha2;

  2994.   fWithAlpha        := tfLuminance6Alpha2;

  2995.   fWithoutAlpha     := tfLuminance8;

  2996.   fglInternalFormat := GL_LUMINANCE6_ALPHA2;

  2997. end;

  2998. 

  2999. constructor TfdLuminance8Alpha8.Create;

  3000. begin

  3001.   inherited Create;

  3002.   fFormat           := tfLuminance8Alpha8;

  3003.   fWithAlpha        := tfLuminance8Alpha8;

  3004.   fWithoutAlpha     := tfLuminance8;

  3005.   fglInternalFormat := GL_LUMINANCE8_ALPHA8;

  3006. end;

  3007. 

  3008. constructor TfdLuminance12Alpha4.Create;

  3009. begin

  3010.   inherited Create;

  3011.   fFormat           := tfLuminance12Alpha4;

  3012.   fWithAlpha        := tfLuminance12Alpha4;

  3013.   fWithoutAlpha     := tfLuminance12;

  3014.   fglInternalFormat := GL_LUMINANCE12_ALPHA4;

  3015. end;

  3016. 

  3017. constructor TfdLuminance12Alpha12.Create;

  3018. begin

  3019.   inherited Create;

  3020.   fFormat           := tfLuminance12Alpha12;

  3021.   fWithAlpha        := tfLuminance12Alpha12;

  3022.   fWithoutAlpha     := tfLuminance12;

  3023.   fglInternalFormat := GL_LUMINANCE12_ALPHA12;

  3024. end;

  3025. 

  3026. constructor TfdLuminance16Alpha16.Create;

  3027. begin

  3028.   inherited Create;

  3029.   fFormat           := tfLuminance16Alpha16;

  3030.   fWithAlpha        := tfLuminance16Alpha16;

  3031.   fWithoutAlpha     := tfLuminance16;

  3032.   fglInternalFormat := GL_LUMINANCE16_ALPHA16;

  3033. end;

  3034. 

  3035. constructor TfdR3G3B2.Create;

  3036. begin

  3037.   inherited Create;

  3038.   fFormat           := tfR3G3B2;

  3039.   fWithAlpha        := tfRGBA2;

  3040.   fWithoutAlpha     := tfR3G3B2;

  3041.   fRange.r          := $7;

  3042.   fRange.g          := $7;

  3043.   fRange.b          := $3;

  3044.   fShift.r          :=  0;

  3045.   fShift.g          :=  3;

  3046.   fShift.b          :=  6;

  3047.   fglFormat         := GL_RGB;

  3048.   fglInternalFormat := GL_R3_G3_B2;

  3049.   fglDataFormat     := GL_UNSIGNED_BYTE_2_3_3_REV;

  3050. end;

  3051. 

  3052. constructor TfdRGB4.Create;

  3053. begin

  3054.   inherited Create;

  3055.   fFormat           := tfRGB4;

  3056.   fWithAlpha        := tfRGBA4;

  3057.   fWithoutAlpha     := tfRGB4;

  3058.   fRGBInverted      := tfBGR4;

  3059.   fRange.r          := $F;

  3060.   fRange.g          := $F;

  3061.   fRange.b          := $F;

  3062.   fShift.r          :=  0;

  3063.   fShift.g          :=  4;

  3064.   fShift.b          :=  8;

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

  3066.   fglInternalFormat := GL_RGB4;

  3067.   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;

  3068. end;

  3069. 

  3070. constructor TfdR5G6B5.Create;

  3071. begin

  3072.   inherited Create;

  3073.   fFormat           := tfR5G6B5;

  3074.   fWithAlpha        := tfRGBA4;

  3075.   fWithoutAlpha     := tfR5G6B5;

  3076.   fRGBInverted      := tfB5G6R5;

  3077.   fRange.r          := $1F;

  3078.   fRange.g          := $3F;

  3079.   fRange.b          := $1F;

  3080.   fShift.r          :=   0;

  3081.   fShift.g          :=   5;

  3082.   fShift.b          :=  11;

  3083.   fglFormat         := GL_RGB;

  3084.   fglInternalFormat := GL_RGB565;

  3085.   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5_REV;

  3086. end;

  3087. 

  3088. constructor TfdRGB5.Create;

  3089. begin

  3090.   inherited Create;

  3091.   fFormat           := tfRGB5;

  3092.   fWithAlpha        := tfRGB5A1;

  3093.   fWithoutAlpha     := tfRGB5;

  3094.   fRGBInverted      := tfBGR5;

  3095.   fRange.r          := $1F;

  3096.   fRange.g          := $1F;

  3097.   fRange.b          := $1F;

  3098.   fShift.r          :=   0;

  3099.   fShift.g          :=   5;

  3100.   fShift.b          :=  10;

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

  3102.   fglInternalFormat := GL_RGB5;

  3103.   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;

  3104. end;

  3105. 

  3106. constructor TfdRGB8.Create;

  3107. begin

  3108.   inherited Create;

  3109.   fFormat           := tfRGB8;

  3110.   fWithAlpha        := tfRGBA8;

  3111.   fWithoutAlpha     := tfRGB8;

  3112.   fRGBInverted      := tfBGR8;

  3113.   fglInternalFormat := GL_RGB8;

  3114. end;

  3115. 

  3116. constructor TfdRGB10.Create;

  3117. begin

  3118.   inherited Create;

  3119.   fFormat           := tfRGB10;

  3120.   fWithAlpha        := tfRGB10A2;

  3121.   fWithoutAlpha     := tfRGB10;

  3122.   fRGBInverted      := tfBGR10;

  3123.   fRange.r          := $3FF;

  3124.   fRange.g          := $3FF;

  3125.   fRange.b          := $3FF;

  3126.   fShift.r          :=    0;

  3127.   fShift.g          :=   10;

  3128.   fShift.b          :=   20;

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

  3130.   fglInternalFormat := GL_RGB10;

  3131.   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;

  3132. end;

  3133. 

  3134. constructor TfdRGB12.Create;

  3135. begin

  3136.   inherited Create;

  3137.   fFormat           := tfRGB12;

  3138.   fWithAlpha        := tfRGBA12;

  3139.   fWithoutAlpha     := tfRGB12;

  3140.   fRGBInverted      := tfBGR12;

  3141.   fglInternalFormat := GL_RGB12;

  3142. end;

  3143. 

  3144. constructor TfdRGB16.Create;

  3145. begin

  3146.   inherited Create;

  3147.   fFormat           := tfRGB16;

  3148.   fWithAlpha        := tfRGBA16;

  3149.   fWithoutAlpha     := tfRGB16;

  3150.   fRGBInverted      := tfBGR16;

  3151.   fglInternalFormat := GL_RGB16;

  3152. end;

  3153. 

  3154. constructor TfdRGBA2.Create;

  3155. begin

  3156.   inherited Create;

  3157.   fFormat           := tfRGBA2;

  3158.   fWithAlpha        := tfRGBA2;

  3159.   fWithoutAlpha     := tfR3G3B2;

  3160.   fRGBInverted      := tfBGRA2;

  3161.   fglInternalFormat := GL_RGBA2;

  3162. end;

  3163. 

  3164. constructor TfdRGBA4.Create;

  3165. begin

  3166.   inherited Create;

  3167.   fFormat           := tfRGBA4;

  3168.   fWithAlpha        := tfRGBA4;

  3169.   fWithoutAlpha     := tfRGB4;

  3170.   fRGBInverted      := tfBGRA4;

  3171.   fRange.r          := $F;

  3172.   fRange.g          := $F;

  3173.   fRange.b          := $F;

  3174.   fRange.a          := $F;

  3175.   fShift.r          :=  0;

  3176.   fShift.g          :=  4;

  3177.   fShift.b          :=  8;

  3178.   fShift.a          := 12;

  3179.   fglFormat         := GL_RGBA;

  3180.   fglInternalFormat := GL_RGBA4;

  3181.   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;

  3182. end;

  3183. 

  3184. constructor TfdRGB5A1.Create;

  3185. begin

  3186.   inherited Create;

  3187.   fFormat           := tfRGB5A1;

  3188.   fWithAlpha        := tfRGB5A1;

  3189.   fWithoutAlpha     := tfRGB5;

  3190.   fRGBInverted      := tfBGR5A1;

  3191.   fRange.r          := $1F;

  3192.   fRange.g          := $1F;

  3193.   fRange.b          := $1F;

  3194.   fRange.a          := $01;

  3195.   fShift.r          :=   0;

  3196.   fShift.g          :=   5;

  3197.   fShift.b          :=  10;

  3198.   fShift.a          :=  15;

  3199.   fglFormat         := GL_RGBA;

  3200.   fglInternalFormat := GL_RGB5_A1;

  3201.   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;

  3202. end;

  3203. 

  3204. constructor TfdRGBA8.Create;

  3205. begin

  3206.   inherited Create;

  3207.   fFormat           := tfRGBA8;

  3208.   fWithAlpha        := tfRGBA8;

  3209.   fWithoutAlpha     := tfRGB8;

  3210.   fRGBInverted      := tfBGRA8;

  3211.   fglInternalFormat := GL_RGBA8;

  3212. end;

  3213. 

  3214. constructor TfdRGB10A2.Create;

  3215. begin

  3216.   inherited Create;

  3217.   fFormat           := tfRGB10A2;

  3218.   fWithAlpha        := tfRGB10A2;

  3219.   fWithoutAlpha     := tfRGB10;

  3220.   fRGBInverted      := tfBGR10A2;

  3221.   fRange.r          := $3FF;

  3222.   fRange.g          := $3FF;

  3223.   fRange.b          := $3FF;

  3224.   fRange.a          := $003;

  3225.   fShift.r          :=    0;

  3226.   fShift.g          :=   10;

  3227.   fShift.b          :=   20;

  3228.   fShift.a          :=   30;

  3229.   fglFormat         := GL_RGBA;

  3230.   fglInternalFormat := GL_RGB10_A2;

  3231.   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;

  3232. end;

  3233. 

  3234. constructor TfdRGBA12.Create;

  3235. begin

  3236.   inherited Create;

  3237.   fFormat           := tfRGBA12;

  3238.   fWithAlpha        := tfRGBA12;

  3239.   fWithoutAlpha     := tfRGB12;

  3240.   fRGBInverted      := tfBGRA12;

  3241.   fglInternalFormat := GL_RGBA12;

  3242. end;

  3243. 

  3244. constructor TfdRGBA16.Create;

  3245. begin

  3246.   inherited Create;

  3247.   fFormat           := tfRGBA16;

  3248.   fWithAlpha        := tfRGBA16;

  3249.   fWithoutAlpha     := tfRGB16;

  3250.   fRGBInverted      := tfBGRA16;

  3251.   fglInternalFormat := GL_RGBA16;

  3252. end;

  3253. 

  3254. constructor TfdBGR4.Create;

  3255. begin

  3256.   inherited Create;

  3257.   fPixelSize        := 2.0;

  3258.   fFormat           := tfBGR4;

  3259.   fWithAlpha        := tfBGRA4;

  3260.   fWithoutAlpha     := tfBGR4;

  3261.   fRGBInverted      := tfRGB4;

  3262.   fRange.r          := $F;

  3263.   fRange.g          := $F;

  3264.   fRange.b          := $F;

  3265.   fRange.a          := $0;

  3266.   fShift.r          :=  8;

  3267.   fShift.g          :=  4;

  3268.   fShift.b          :=  0;

  3269.   fShift.a          :=  0;

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

  3271.   fglInternalFormat := GL_RGB4;

  3272.   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;

  3273. end;

  3274. 

  3275. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3276. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3277. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3278. constructor TfdB5G6R5.Create;

  3279. begin

  3280.   inherited Create;

  3281.   fFormat           := tfB5G6R5;

  3282.   fWithAlpha        := tfBGRA4;

  3283.   fWithoutAlpha     := tfB5G6R5;

  3284.   fRGBInverted      := tfR5G6B5;

  3285.   fRange.r          := $1F;

  3286.   fRange.g          := $3F;

  3287.   fRange.b          := $1F;

  3288.   fShift.r          :=  11;

  3289.   fShift.g          :=   5;

  3290.   fShift.b          :=   0;

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

  3292.   fglInternalFormat := GL_RGB8;

  3293.   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5;

  3294. end;

  3295. 

  3296. constructor TfdBGR5.Create;

  3297. begin

  3298.   inherited Create;

  3299.   fPixelSize        := 2.0;

  3300.   fFormat           := tfBGR5;

  3301.   fWithAlpha        := tfBGR5A1;

  3302.   fWithoutAlpha     := tfBGR5;

  3303.   fRGBInverted      := tfRGB5;

  3304.   fRange.r          := $1F;

  3305.   fRange.g          := $1F;

  3306.   fRange.b          := $1F;

  3307.   fRange.a          := $00;

  3308.   fShift.r          :=  10;

  3309.   fShift.g          :=   5;

  3310.   fShift.b          :=   0;

  3311.   fShift.a          :=   0;

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

  3313.   fglInternalFormat := GL_RGB5;

  3314.   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;

  3315. end;

  3316. 

  3317. constructor TfdBGR8.Create;

  3318. begin

  3319.   inherited Create;

  3320.   fFormat           := tfBGR8;

  3321.   fWithAlpha        := tfBGRA8;

  3322.   fWithoutAlpha     := tfBGR8;

  3323.   fRGBInverted      := tfRGB8;

  3324.   fglInternalFormat := GL_RGB8;

  3325. end;

  3326. 

  3327. constructor TfdBGR10.Create;

  3328. begin

  3329.   inherited Create;

  3330.   fFormat           := tfBGR10;

  3331.   fWithAlpha        := tfBGR10A2;

  3332.   fWithoutAlpha     := tfBGR10;

  3333.   fRGBInverted      := tfRGB10;

  3334.   fRange.r          := $3FF;

  3335.   fRange.g          := $3FF;

  3336.   fRange.b          := $3FF;

  3337.   fRange.a          := $000;

  3338.   fShift.r          :=   20;

  3339.   fShift.g          :=   10;

  3340.   fShift.b          :=    0;

  3341.   fShift.a          :=    0;

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

  3343.   fglInternalFormat := GL_RGB10;

  3344.   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;

  3345. end;

  3346. 

  3347. constructor TfdBGR12.Create;

  3348. begin

  3349.   inherited Create;

  3350.   fFormat           := tfBGR12;

  3351.   fWithAlpha        := tfBGRA12;

  3352.   fWithoutAlpha     := tfBGR12;

  3353.   fRGBInverted      := tfRGB12;

  3354.   fglInternalFormat := GL_RGB12;

  3355. end;

  3356. 

  3357. constructor TfdBGR16.Create;

  3358. begin

  3359.   inherited Create;

  3360.   fFormat           := tfBGR16;

  3361.   fWithAlpha        := tfBGRA16;

  3362.   fWithoutAlpha     := tfBGR16;

  3363.   fRGBInverted      := tfRGB16;

  3364.   fglInternalFormat := GL_RGB16;

  3365. end;

  3366. 

  3367. constructor TfdBGRA2.Create;

  3368. begin

  3369.   inherited Create;

  3370.   fFormat           := tfBGRA2;

  3371.   fWithAlpha        := tfBGRA4;

  3372.   fWithoutAlpha     := tfBGR4;

  3373.   fRGBInverted      := tfRGBA2;

  3374.   fglInternalFormat := GL_RGBA2;

  3375. end;

  3376. 

  3377. constructor TfdBGRA4.Create;

  3378. begin

  3379.   inherited Create;

  3380.   fFormat           := tfBGRA4;

  3381.   fWithAlpha        := tfBGRA4;

  3382.   fWithoutAlpha     := tfBGR4;

  3383.   fRGBInverted      := tfRGBA4;

  3384.   fRange.r          := $F;

  3385.   fRange.g          := $F;

  3386.   fRange.b          := $F;

  3387.   fRange.a          := $F;

  3388.   fShift.r          :=  8;

  3389.   fShift.g          :=  4;

  3390.   fShift.b          :=  0;

  3391.   fShift.a          := 12;

  3392.   fglFormat         := GL_BGRA;

  3393.   fglInternalFormat := GL_RGBA4;

  3394.   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;

  3395. end;

  3396. 

  3397. constructor TfdBGR5A1.Create;

  3398. begin

  3399.   inherited Create;

  3400.   fFormat           := tfBGR5A1;

  3401.   fWithAlpha        := tfBGR5A1;

  3402.   fWithoutAlpha     := tfBGR5;

  3403.   fRGBInverted      := tfRGB5A1;

  3404.   fRange.r          := $1F;

  3405.   fRange.g          := $1F;

  3406.   fRange.b          := $1F;

  3407.   fRange.a          := $01;

  3408.   fShift.r          :=  10;

  3409.   fShift.g          :=   5;

  3410.   fShift.b          :=   0;

  3411.   fShift.a          :=  15;

  3412.   fglFormat         := GL_BGRA;

  3413.   fglInternalFormat := GL_RGB5_A1;

  3414.   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;

  3415. end;

  3416. 

  3417. constructor TfdBGRA8.Create;

  3418. begin

  3419.   inherited Create;

  3420.   fFormat           := tfBGRA8;

  3421.   fWithAlpha        := tfBGRA8;

  3422.   fWithoutAlpha     := tfBGR8;

  3423.   fRGBInverted      := tfRGBA8;

  3424.   fglInternalFormat := GL_RGBA8;

  3425. end;

  3426. 

  3427. constructor TfdBGR10A2.Create;

  3428. begin

  3429.   inherited Create;

  3430.   fFormat           := tfBGR10A2;

  3431.   fWithAlpha        := tfBGR10A2;

  3432.   fWithoutAlpha     := tfBGR10;

  3433.   fRGBInverted      := tfRGB10A2;

  3434.   fRange.r          := $3FF;

  3435.   fRange.g          := $3FF;

  3436.   fRange.b          := $3FF;

  3437.   fRange.a          := $003;

  3438.   fShift.r          :=   20;

  3439.   fShift.g          :=   10;

  3440.   fShift.b          :=    0;

  3441.   fShift.a          :=   30;

  3442.   fglFormat         := GL_BGRA;

  3443.   fglInternalFormat := GL_RGB10_A2;

  3444.   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;

  3445. end;

  3446. 

  3447. constructor TfdBGRA12.Create;

  3448. begin

  3449.   inherited Create;

  3450.   fFormat           := tfBGRA12;

  3451.   fWithAlpha        := tfBGRA12;

  3452.   fWithoutAlpha     := tfBGR12;

  3453.   fRGBInverted      := tfRGBA12;

  3454.   fglInternalFormat := GL_RGBA12;

  3455. end;

  3456. 

  3457. constructor TfdBGRA16.Create;

  3458. begin

  3459.   inherited Create;

  3460.   fFormat           := tfBGRA16;

  3461.   fWithAlpha        := tfBGRA16;

  3462.   fWithoutAlpha     := tfBGR16;

  3463.   fRGBInverted      := tfRGBA16;

  3464.   fglInternalFormat := GL_RGBA16;

  3465. end;

  3466. 

  3467. constructor TfdDepth16.Create;

  3468. begin

  3469.   inherited Create;

  3470.   fFormat           := tfDepth16;

  3471.   fWithAlpha        := tfEmpty;

  3472.   fWithoutAlpha     := tfDepth16;

  3473.   fglInternalFormat := GL_DEPTH_COMPONENT16;

  3474. end;

  3475. 

  3476. constructor TfdDepth24.Create;

  3477. begin

  3478.   inherited Create;

  3479.   fFormat           := tfDepth24;

  3480.   fWithAlpha        := tfEmpty;

  3481.   fWithoutAlpha     := tfDepth24;

  3482.   fglInternalFormat := GL_DEPTH_COMPONENT24;

  3483. end;

  3484. 

  3485. constructor TfdDepth32.Create;

  3486. begin

  3487.   inherited Create;

  3488.   fFormat           := tfDepth32;

  3489.   fWithAlpha        := tfEmpty;

  3490.   fWithoutAlpha     := tfDepth32;

  3491.   fglInternalFormat := GL_DEPTH_COMPONENT32;

  3492. end;

  3493. 

  3494. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3495. //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3496. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  3498. begin

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

  3500. end;

  3501. 

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

  3503. begin

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

  3505. end;

  3506. 

  3507. constructor TfdS3tcDtx1RGBA.Create;

  3508. begin

  3509.   inherited Create;

  3510.   fFormat           := tfS3tcDtx1RGBA;

  3511.   fWithAlpha        := tfS3tcDtx1RGBA;

  3512.   fUncompressed     := tfRGB5A1;

  3513.   fPixelSize        := 0.5;

  3514.   fIsCompressed     := true;

  3515.   fglFormat         := GL_COMPRESSED_RGBA;

  3516.   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;

  3517.   fglDataFormat     := GL_UNSIGNED_BYTE;

  3518. end;

  3519. 

  3520. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3521. //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3522. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  3524. begin

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

  3526. end;

  3527. 

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

  3529. begin

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

  3531. end;

  3532. 

  3533. constructor TfdS3tcDtx3RGBA.Create;

  3534. begin

  3535.   inherited Create;

  3536.   fFormat           := tfS3tcDtx3RGBA;

  3537.   fWithAlpha        := tfS3tcDtx3RGBA;

  3538.   fUncompressed     := tfRGBA8;

  3539.   fPixelSize        := 1.0;

  3540.   fIsCompressed     := true;

  3541.   fglFormat         := GL_COMPRESSED_RGBA;

  3542.   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;

  3543.   fglDataFormat     := GL_UNSIGNED_BYTE;

  3544. end;

  3545. 

  3546. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3547. //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3548. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  3550. begin

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

  3552. end;

  3553. 

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

  3555. begin

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

  3557. end;

  3558. 

  3559. constructor TfdS3tcDtx5RGBA.Create;

  3560. begin

  3561.   inherited Create;

  3562.   fFormat           := tfS3tcDtx3RGBA;

  3563.   fWithAlpha        := tfS3tcDtx3RGBA;

  3564.   fUncompressed     := tfRGBA8;

  3565.   fPixelSize        := 1.0;

  3566.   fIsCompressed     := true;

  3567.   fglFormat         := GL_COMPRESSED_RGBA;

  3568.   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;

  3569.   fglDataFormat     := GL_UNSIGNED_BYTE;

  3570. end;

  3571. 

  3572. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3573. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3574. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3575. class procedure TFormatDescriptor.Init;

  3576. begin

  3577.   if not Assigned(FormatDescriptorCS) then

  3578.     FormatDescriptorCS := TCriticalSection.Create;

  3579. end;

  3580. 

  3581. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  3583. begin

  3584.   FormatDescriptorCS.Enter;

  3585.   try

  3586.     result := FormatDescriptors[aFormat];

  3587.     if not Assigned(result) then begin

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

  3589.       FormatDescriptors[aFormat] := result;

  3590.     end;

  3591.   finally

  3592.     FormatDescriptorCS.Leave;

  3593.   end;

  3594. end;

  3595. 

  3596. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  3598. begin

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

  3600. end;

  3601. 

  3602. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3603. class procedure TFormatDescriptor.Clear;

  3604. var

  3605.   f: TglBitmapFormat;

  3606. begin

  3607.   FormatDescriptorCS.Enter;

  3608.   try

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

  3610.       FreeAndNil(FormatDescriptors[f]);

  3611.   finally

  3612.     FormatDescriptorCS.Leave;

  3613.   end;

  3614. end;

  3615. 

  3616. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3617. class procedure TFormatDescriptor.Finalize;

  3618. begin

  3619.   Clear;

  3620.   FreeAndNil(FormatDescriptorCS);

  3621. end;

  3622. 

  3623. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3624. //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3625. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  3627. begin

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

  3629. end;

  3630. 

  3631. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  3633. begin

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

  3635. end;

  3636. 

  3637. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  3639. begin

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

  3641. end;

  3642. 

  3643. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  3645. begin

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

  3647. end;

  3648. 

  3649. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  3651.   aShift: Byte);

  3652. begin

  3653.   aShift := 0;

  3654.   aRange := 0;

  3655.   if (aMask = 0) then

  3656.     exit;

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

  3658.     inc(aShift);

  3659.     aMask := aMask shr 1;

  3660.   end;

  3661.   aRange := 1;

  3662.   while (aMask > 0) do begin

  3663.     aRange := aRange shl 1;

  3664.     aMask  := aMask  shr 1;

  3665.   end;

  3666.   dec(aRange);

  3667. 

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

  3669. end;

  3670. 

  3671. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  3673. var

  3674.   data: QWord;

  3675.   s: Integer;

  3676. begin

  3677.   data :=

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

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

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

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

  3682.   s := Round(fPixelSize);

  3683.   case s of

  3684.     1:           aData^  := data;

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

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

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

  3688.   else

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

  3690.   end;

  3691.   inc(aData, s);

  3692. end;

  3693. 

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

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

  3696. var

  3697.   data: QWord;

  3698.   s, i: Integer;

  3699. begin

  3700.   s := Round(fPixelSize);

  3701.   case s of

  3702.     1: data :=           aData^;

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

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

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

  3706.   else

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

  3708.   end;

  3709.   for i := 0 to 3 do

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

  3711.   inc(aData, s);

  3712. end;

  3713. 

  3714. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3715. //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3716. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3717. procedure TbmpColorTableFormat.CreateColorTable;

  3718. var

  3719.   i: Integer;

  3720. begin

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

  3722.     raise EglBitmapException.Create(UNSUPPORTED_FORMAT);

  3723. 

  3724.   if (Format = tfLuminance4) then

  3725.     SetLength(fColorTable, 16)

  3726.   else

  3727.     SetLength(fColorTable, 256);

  3728. 

  3729.   case Format of

  3730.     tfLuminance4: begin

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

  3732.         fColorTable[i].r := 16 * i;

  3733.         fColorTable[i].g := 16 * i;

  3734.         fColorTable[i].b := 16 * i;

  3735.         fColorTable[i].a := 0;

  3736.       end;

  3737.     end;

  3738. 

  3739.     tfLuminance8: begin

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

  3741.         fColorTable[i].r := i;

  3742.         fColorTable[i].g := i;

  3743.         fColorTable[i].b := i;

  3744.         fColorTable[i].a := 0;

  3745.       end;

  3746.     end;

  3747. 

  3748.     tfR3G3B2: begin

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

  3750.         fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);

  3751.         fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);

  3752.         fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);

  3753.         fColorTable[i].a := 0;

  3754.       end;

  3755.     end;

  3756.   end;

  3757. end;

  3758. 

  3759. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3760. procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);

  3761. var

  3762.   d: Byte;

  3763. begin

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

  3765.     raise EglBitmapException.Create(UNSUPPORTED_FORMAT);

  3766. 

  3767.   case Format of

  3768.     tfLuminance4: begin

  3769.       if (aMapData = nil) then

  3770.         aData^ := 0;

  3771.       d := LuminanceWeight(aPixel) and Range.r;

  3772.       aData^ := aData^ or (d shl (4 - {%H-}PtrUInt(aMapData)));

  3773.       inc(PByte(aMapData), 4);

  3774.       if ({%H-}PtrUInt(aMapData) >= 8) then begin

  3775.         inc(aData);

  3776.         aMapData := nil;

  3777.       end;

  3778.     end;

  3779. 

  3780.     tfLuminance8: begin

  3781.       aData^ := LuminanceWeight(aPixel) and Range.r;

  3782.       inc(aData);

  3783.     end;

  3784. 

  3785.     tfR3G3B2: begin

  3786.       aData^ := Round(

  3787.         ((aPixel.Data.r and Range.r) shl Shift.r) or

  3788.         ((aPixel.Data.g and Range.g) shl Shift.g) or

  3789.         ((aPixel.Data.b and Range.b) shl Shift.b));

  3790.       inc(aData);

  3791.     end;

  3792.   end;

  3793. end;

  3794. 

  3795. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3796. procedure TbmpColorTableFormat.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);

  3797. var

  3798.   idx: QWord;

  3799.   s: Integer;

  3800.   bits: Byte;

  3801.   f: Single;

  3802. begin

  3803.   s    := Trunc(fPixelSize);

  3804.   f    := fPixelSize - s;

  3805.   bits := Round(8 * f);

  3806.   case s of

  3807.     0: idx :=          (aData^ shr (8 - bits - {%H-}PtrInt(aMapData))) and ((1 shl bits) - 1);

  3808.     1: idx :=           aData^;

  3809.     2: idx :=     PWord(aData)^;

  3810.     4: idx := PCardinal(aData)^;

  3811.     8: idx :=    PQWord(aData)^;

  3812.   else

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

  3814.   end;

  3815.   if (idx >= Length(fColorTable)) then

  3816.     raise EglBitmapException.CreateFmt('invalid color index: %d', [idx]);

  3817.   with fColorTable[idx] do begin

  3818.     aPixel.Data.r := r;

  3819.     aPixel.Data.g := g;

  3820.     aPixel.Data.b := b;

  3821.     aPixel.Data.a := a;

  3822.   end;

  3823.   inc(PByte(aMapData), bits);

  3824.   if ({%H-}PtrUInt(aMapData) >= 8) then begin

  3825.     inc(aData, 1);

  3826.     dec(PByte(aMapData), 8);

  3827.   end;

  3828.   inc(aData, s);

  3829. end;

  3830. 

  3831. destructor TbmpColorTableFormat.Destroy;

  3832. begin

  3833.   SetLength(fColorTable, 0);

  3834.   inherited Destroy;

  3835. end;

  3836. 

  3837. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3838. //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3839. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3840. procedure glBitmapConvertPixel(var aPixel: TglBitmapPixelData; const aSourceFD, aDestFD: TFormatDescriptor);

  3841. var

  3842.   i: Integer;

  3843. begin

  3844.   for i := 0 to 3 do begin

  3845.     if (aSourceFD.Range.arr[i] <> aDestFD.Range.arr[i]) then begin

  3846.       if (aSourceFD.Range.arr[i] > 0) then

  3847.         aPixel.Data.arr[i] := Round(aPixel.Data.arr[i] / aSourceFD.Range.arr[i] * aDestFD.Range.arr[i])

  3848.       else

  3849.         aPixel.Data.arr[i] := aDestFD.Range.arr[i];

  3850.     end;

  3851.   end;

  3852. end;

  3853. 

  3854. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3855. procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);

  3856. begin

  3857.   with aFuncRec do begin

  3858.     if (Source.Range.r   > 0) then

  3859.       Dest.Data.r := Source.Data.r;

  3860.     if (Source.Range.g > 0) then

  3861.       Dest.Data.g := Source.Data.g;

  3862.     if (Source.Range.b  > 0) then

  3863.       Dest.Data.b := Source.Data.b;

  3864.     if (Source.Range.a > 0) then

  3865.       Dest.Data.a := Source.Data.a;

  3866.   end;

  3867. end;

  3868. 

  3869. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3870. procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);

  3871. var

  3872.   i: Integer;

  3873. begin

  3874.   with aFuncRec do begin

  3875.     for i := 0 to 3 do

  3876.       if (Source.Range.arr[i] > 0) then

  3877.         Dest.Data.arr[i] := Round(Dest.Range.arr[i] * Source.Data.arr[i] / Source.Range.arr[i]);

  3878.   end;

  3879. end;

  3880. 

  3881. type

  3882.   TShiftData = packed record

  3883.     case Integer of

  3884.       0: (r, g, b, a: SmallInt);

  3885.       1: (arr: array[0..3] of SmallInt);

  3886.   end;

  3887.   PShiftData = ^TShiftData;

  3888. 

  3889. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3890. procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);

  3891. var

  3892.   i: Integer;

  3893. begin

  3894.   with aFuncRec do

  3895.     for i := 0 to 3 do

  3896.       if (Source.Range.arr[i] > 0) then

  3897.         Dest.Data.arr[i] := Source.Data.arr[i] shr PShiftData(Args)^.arr[i];

  3898. end;

  3899. 

  3900. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3901. procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);

  3902. begin

  3903.   with aFuncRec do begin

  3904.     Dest.Data := Source.Data;

  3905.     if ({%H-}PtrUInt(Args) and $1 > 0) then begin

  3906.       Dest.Data.r := Dest.Data.r xor Dest.Range.r;

  3907.       Dest.Data.g := Dest.Data.g xor Dest.Range.g;

  3908.       Dest.Data.b := Dest.Data.b xor Dest.Range.b;

  3909.     end;

  3910.     if ({%H-}PtrUInt(Args) and $2 > 0) then begin

  3911.       Dest.Data.a := Dest.Data.a xor Dest.Range.a;

  3912.     end;

  3913.   end;

  3914. end;

  3915. 

  3916. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3917. procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);

  3918. var

  3919.   i: Integer;

  3920. begin

  3921.   with aFuncRec do begin

  3922.     for i := 0 to 3 do

  3923.       Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];

  3924.   end;

  3925. end;

  3926. 

  3927. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3928. procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);

  3929. var

  3930.   Temp: Single;

  3931. begin

  3932.   with FuncRec do begin

  3933.     if (FuncRec.Args = nil) then begin //source has no alpha

  3934.       Temp :=

  3935.         Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +

  3936.         Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +

  3937.         Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;

  3938.       Dest.Data.a := Round(Dest.Range.a * Temp);

  3939.     end else

  3940.       Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);

  3941.   end;

  3942. end;

  3943. 

  3944. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3945. procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);

  3946. type

  3947.   PglBitmapPixelData = ^TglBitmapPixelData;

  3948. begin

  3949.   with FuncRec do begin

  3950.     Dest.Data.r := Source.Data.r;

  3951.     Dest.Data.g := Source.Data.g;

  3952.     Dest.Data.b := Source.Data.b;

  3953. 

  3954.     with PglBitmapPixelData(Args)^ do

  3955.       if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and

  3956.           (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and

  3957.           (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then

  3958.         Dest.Data.a := 0

  3959.       else

  3960.         Dest.Data.a := Dest.Range.a;

  3961.   end;

  3962. end;

  3963. 

  3964. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3965. procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);

  3966. begin

  3967.   with FuncRec do begin

  3968.     Dest.Data.r := Source.Data.r;

  3969.     Dest.Data.g := Source.Data.g;

  3970.     Dest.Data.b := Source.Data.b;

  3971.     Dest.Data.a := PCardinal(Args)^;

  3972.   end;

  3973. end;

  3974. 

  3975. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3976. procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);

  3977. type

  3978.   PRGBPix = ^TRGBPix;

  3979.   TRGBPix = array [0..2] of byte;

  3980. var

  3981.   Temp: Byte;

  3982. begin

  3983.   while aWidth > 0 do begin

  3984.     Temp := PRGBPix(aData)^[0];

  3985.     PRGBPix(aData)^[0] := PRGBPix(aData)^[2];

  3986.     PRGBPix(aData)^[2] := Temp;

  3987. 

  3988.     if aHasAlpha then

  3989.       Inc(aData, 4)

  3990.     else

  3991.       Inc(aData, 3);

  3992.     dec(aWidth);

  3993.   end;

  3994. end;

  3995. 

  3996. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3997. //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3998. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3999. function TglBitmap.GetWidth: Integer;

  4000. begin

  4001.   if (ffX in fDimension.Fields) then

  4002.     result := fDimension.X

  4003.   else

  4004.     result := -1;

  4005. end;

  4006. 

  4007. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4008. function TglBitmap.GetHeight: Integer;

  4009. begin

  4010.   if (ffY in fDimension.Fields) then

  4011.     result := fDimension.Y

  4012.   else

  4013.     result := -1;

  4014. end;

  4015. 

  4016. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4017. function TglBitmap.GetFileWidth: Integer;

  4018. begin

  4019.   result := Max(1, Width);

  4020. end;

  4021. 

  4022. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4023. function TglBitmap.GetFileHeight: Integer;

  4024. begin

  4025.   result := Max(1, Height);

  4026. end;

  4027. 

  4028. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4029. procedure TglBitmap.SetCustomData(const aValue: Pointer);

  4030. begin

  4031.   if fCustomData = aValue then

  4032.     exit;

  4033.   fCustomData := aValue;

  4034. end;

  4035. 

  4036. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4037. procedure TglBitmap.SetCustomName(const aValue: String);

  4038. begin

  4039.   if fCustomName = aValue then

  4040.     exit;

  4041.   fCustomName := aValue;

  4042. end;

  4043. 

  4044. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4045. procedure TglBitmap.SetCustomNameW(const aValue: WideString);

  4046. begin

  4047.   if fCustomNameW = aValue then

  4048.     exit;

  4049.   fCustomNameW := aValue;

  4050. end;

  4051. 

  4052. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4053. procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);

  4054. begin

  4055.   if fDeleteTextureOnFree = aValue then

  4056.     exit;

  4057.   fDeleteTextureOnFree := aValue;

  4058. end;

  4059. 

  4060. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4061. procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);

  4062. begin

  4063.   if fFormat = aValue then

  4064.     exit;

  4065.   if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then

  4066.     raise EglBitmapUnsupportedFormat.Create(Format);

  4067.   SetDataPointer(Data, aValue, Width, Height);

  4068. end;

  4069. 

  4070. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4071. procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);

  4072. begin

  4073.   if fFreeDataAfterGenTexture = aValue then

  4074.     exit;

  4075.   fFreeDataAfterGenTexture := aValue;

  4076. end;

  4077. 

  4078. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4079. procedure TglBitmap.SetID(const aValue: Cardinal);

  4080. begin

  4081.   if fID = aValue then

  4082.     exit;

  4083.   fID := aValue;

  4084. end;

  4085. 

  4086. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4087. procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);

  4088. begin

  4089.   if fMipMap = aValue then

  4090.     exit;

  4091.   fMipMap := aValue;

  4092. end;

  4093. 

  4094. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4095. procedure TglBitmap.SetTarget(const aValue: Cardinal);

  4096. begin

  4097.   if fTarget = aValue then

  4098.     exit;

  4099.   fTarget := aValue;

  4100. end;

  4101. 

  4102. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4103. procedure TglBitmap.SetAnisotropic(const aValue: Integer);

  4104. var

  4105.   MaxAnisotropic: Integer;

  4106. begin

  4107.   fAnisotropic := aValue;

  4108.   if (ID > 0) then begin

  4109.     if GL_EXT_texture_filter_anisotropic then begin

  4110.       if fAnisotropic > 0 then begin

  4111.         Bind(false);

  4112.         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);

  4113.         if aValue > MaxAnisotropic then

  4114.           fAnisotropic := MaxAnisotropic;

  4115.         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);

  4116.       end;

  4117.     end else begin

  4118.       fAnisotropic := 0;

  4119.     end;

  4120.   end;

  4121. end;

  4122. 

  4123. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4124. procedure TglBitmap.CreateID;

  4125. begin

  4126.   if (ID <> 0) then

  4127.     glDeleteTextures(1, @fID);

  4128.   glGenTextures(1, @fID);

  4129.   Bind(false);

  4130. end;

  4131. 

  4132. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4133. procedure TglBitmap.SetupParameters(out aBuildWithGlu: Boolean);

  4134. begin

  4135.   // Set Up Parameters

  4136.   SetWrap(fWrapS, fWrapT, fWrapR);

  4137.   SetFilter(fFilterMin, fFilterMag);

  4138.   SetAnisotropic(fAnisotropic);

  4139.   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);

  4140. 

  4141.   // Mip Maps Generation Mode

  4142.   aBuildWithGlu := false;

  4143.   if (MipMap = mmMipmap) then begin

  4144.     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then

  4145.       glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)

  4146.     else

  4147.       aBuildWithGlu := true;

  4148.   end else if (MipMap = mmMipmapGlu) then

  4149.     aBuildWithGlu := true;

  4150. end;

  4151. 

  4152. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4153. procedure TglBitmap.SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;

  4154.   const aWidth: Integer; const aHeight: Integer);

  4155. var

  4156.   s: Single;

  4157. begin

  4158.   if (Data <> aData) then begin

  4159.     if (Assigned(Data)) then

  4160.       FreeMem(Data);

  4161.     fData := aData;

  4162.   end;

  4163. 

  4164.   FillChar(fDimension, SizeOf(fDimension), 0);

  4165.   if not Assigned(fData) then begin

  4166.     fFormat    := tfEmpty;

  4167.     fPixelSize := 0;

  4168.     fRowSize   := 0;

  4169.   end else begin

  4170.     if aWidth <> -1 then begin

  4171.       fDimension.Fields := fDimension.Fields + [ffX];

  4172.       fDimension.X := aWidth;

  4173.     end;

  4174. 

  4175.     if aHeight <> -1 then begin

  4176.       fDimension.Fields := fDimension.Fields + [ffY];

  4177.       fDimension.Y := aHeight;

  4178.     end;

  4179. 

  4180.     s := TFormatDescriptor.Get(aFormat).PixelSize;

  4181.     fFormat    := aFormat;

  4182.     fPixelSize := Ceil(s);

  4183.     fRowSize   := Ceil(s * aWidth);

  4184.   end;

  4185. end;

  4186. 

  4187. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4188. function TglBitmap.FlipHorz: Boolean;

  4189. begin

  4190.   result := false;

  4191. end;

  4192. 

  4193. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4194. function TglBitmap.FlipVert: Boolean;

  4195. begin

  4196.   result := false;

  4197. end;

  4198. 

  4199. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4200. //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4201. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4202. procedure TglBitmap.AfterConstruction;

  4203. begin

  4204.   inherited AfterConstruction;

  4205. 

  4206.   fID         := 0;

  4207.   fTarget     := 0;

  4208.   fIsResident := false;

  4209. 

  4210.   fFormat                  := glBitmapGetDefaultFormat;

  4211.   fMipMap                  := glBitmapDefaultMipmap;

  4212.   fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;

  4213.   fDeleteTextureOnFree     := glBitmapGetDefaultDeleteTextureOnFree;

  4214. 

  4215.   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);

  4216.   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);

  4217. end;

  4218. 

  4219. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4220. procedure TglBitmap.BeforeDestruction;

  4221. begin

  4222.   SetDataPointer(nil, tfEmpty);

  4223.   if (fID > 0) and fDeleteTextureOnFree then

  4224.     glDeleteTextures(1, @fID);

  4225.   inherited BeforeDestruction;

  4226. end;

  4227. 

  4228. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  4230. var

  4231.   TempPos: Integer;

  4232. begin

  4233.   if not Assigned(aResType) then begin

  4234.     TempPos   := Pos('.', aResource);

  4235.     aResType  := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));

  4236.     aResource := UpperCase(Copy(aResource, 0, TempPos -1));

  4237.   end;

  4238. end;

  4239. 

  4240. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4241. procedure TglBitmap.LoadFromFile(const aFilename: String);

  4242. var

  4243.   fs: TFileStream;

  4244. begin

  4245.   if not FileExists(aFilename) then

  4246.     raise EglBitmapException.Create('file does not exist: ' + aFilename);

  4247.   fFilename := aFilename;

  4248.   fs := TFileStream.Create(fFilename, fmOpenRead);

  4249.   try

  4250.     fs.Position := 0;

  4251.     LoadFromStream(fs);

  4252.   finally

  4253.     fs.Free;

  4254.   end;

  4255. end;

  4256. 

  4257. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4258. procedure TglBitmap.LoadFromStream(const aStream: TStream);

  4259. begin

  4260.   {$IFDEF GLB_SUPPORT_PNG_READ}

  4261.   if not LoadPNG(aStream) then

  4262.   {$ENDIF}

  4263.   {$IFDEF GLB_SUPPORT_JPEG_READ}

  4264.   if not LoadJPEG(aStream) then

  4265.   {$ENDIF}

  4266.   if not LoadDDS(aStream) then

  4267.   if not LoadTGA(aStream) then

  4268.   if not LoadBMP(aStream) then

  4269.     raise EglBitmapException.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');

  4270. end;

  4271. 

  4272. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4273. procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;

  4274.   const aFormat: TglBitmapFormat; const aArgs: Pointer);

  4275. var

  4276.   tmpData: PByte;

  4277.   size: Integer;

  4278. begin

  4279.   size := TFormatDescriptor.Get(aFormat).GetSize(aSize);

  4280.   GetMem(tmpData, size);

  4281.   try

  4282.     FillChar(tmpData^, size, #$FF);

  4283.     SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y);

  4284.   except

  4285.     FreeMem(tmpData);

  4286.     raise;

  4287.   end;

  4288.   AddFunc(Self, aFunc, false, Format, aArgs);

  4289. end;

  4290. 

  4291. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4292. procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);

  4293. var

  4294.   rs: TResourceStream;

  4295. begin

  4296.   PrepareResType(aResource, aResType);

  4297.   rs := TResourceStream.Create(aInstance, aResource, aResType);

  4298.   try

  4299.     LoadFromStream(rs);

  4300.   finally

  4301.     rs.Free;

  4302.   end;

  4303. end;

  4304. 

  4305. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  4307. var

  4308.   rs: TResourceStream;

  4309. begin

  4310.   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);

  4311.   try

  4312.     LoadFromStream(rs);

  4313.   finally

  4314.     rs.Free;

  4315.   end;

  4316. end;

  4317. 

  4318. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  4320. var

  4321.   fs: TFileStream;

  4322. begin

  4323.   fs := TFileStream.Create(aFileName, fmCreate);

  4324.   try

  4325.     fs.Position := 0;

  4326.     SaveToStream(fs, aFileType);

  4327.   finally

  4328.     fs.Free;

  4329.   end;

  4330. end;

  4331. 

  4332. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4333. procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);

  4334. begin

  4335.   case aFileType of

  4336.     {$IFDEF GLB_SUPPORT_PNG_WRITE}

  4337.     ftPNG:  SavePNG(aStream);

  4338.     {$ENDIF}

  4339.     {$IFDEF GLB_SUPPORT_JPEG_WRITE}

  4340.     ftJPEG: SaveJPEG(aStream);

  4341.     {$ENDIF}

  4342.     ftDDS:  SaveDDS(aStream);

  4343.     ftTGA:  SaveTGA(aStream);

  4344.     ftBMP:  SaveBMP(aStream);

  4345.   end;

  4346. end;

  4347. 

  4348. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4349. function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;

  4350. begin

  4351.   result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);

  4352. end;

  4353. 

  4354. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  4356.   const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;

  4357. var

  4358.   DestData, TmpData, SourceData: pByte;

  4359.   TempHeight, TempWidth: Integer;

  4360.   SourceFD, DestFD: TFormatDescriptor;

  4361.   SourceMD, DestMD: Pointer;

  4362. 

  4363.   FuncRec: TglBitmapFunctionRec;

  4364. begin

  4365.   Assert(Assigned(Data));

  4366.   Assert(Assigned(aSource));

  4367.   Assert(Assigned(aSource.Data));

  4368. 

  4369.   result := false;

  4370.   if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin

  4371.     SourceFD := TFormatDescriptor.Get(aSource.Format);

  4372.     DestFD   := TFormatDescriptor.Get(aFormat);

  4373. 

  4374.     if (SourceFD.IsCompressed) then

  4375.       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);

  4376.     if (DestFD.IsCompressed) then

  4377.       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);

  4378. 

  4379.     // inkompatible Formats so CreateTemp

  4380.     if (SourceFD.PixelSize <> DestFD.PixelSize) then

  4381.       aCreateTemp := true;

  4382. 

  4383.     // Values

  4384.     TempHeight := Max(1, aSource.Height);

  4385.     TempWidth  := Max(1, aSource.Width);

  4386. 

  4387.     FuncRec.Sender := Self;

  4388.     FuncRec.Args   := aArgs;

  4389. 

  4390.     TmpData := nil;

  4391.     if aCreateTemp then begin

  4392.       GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));

  4393.       DestData := TmpData;

  4394.     end else

  4395.       DestData := Data;

  4396. 

  4397.     try

  4398.       SourceFD.PreparePixel(FuncRec.Source);

  4399.       DestFD.PreparePixel  (FuncRec.Dest);

  4400. 

  4401.       SourceMD := SourceFD.CreateMappingData;

  4402.       DestMD   := DestFD.CreateMappingData;

  4403. 

  4404.       FuncRec.Size            := aSource.Dimension;

  4405.       FuncRec.Position.Fields := FuncRec.Size.Fields;

  4406. 

  4407.       try

  4408.         SourceData := aSource.Data;

  4409.         FuncRec.Position.Y := 0;

  4410.         while FuncRec.Position.Y < TempHeight do begin

  4411.           FuncRec.Position.X := 0;

  4412.           while FuncRec.Position.X < TempWidth do begin

  4413.             SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);

  4414.             aFunc(FuncRec);

  4415.             DestFD.Map(FuncRec.Dest, DestData, DestMD);

  4416.             inc(FuncRec.Position.X);

  4417.           end;

  4418.           inc(FuncRec.Position.Y);

  4419.         end;

  4420. 

  4421.         // Updating Image or InternalFormat

  4422.         if aCreateTemp then

  4423.           SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height)

  4424.         else if (aFormat <> fFormat) then

  4425.           Format := aFormat;

  4426. 

  4427.         result := true;

  4428.       finally

  4429.         SourceFD.FreeMappingData(SourceMD);

  4430.         DestFD.FreeMappingData(DestMD);

  4431.       end;

  4432.     except

  4433.       if aCreateTemp then

  4434.         FreeMem(TmpData);

  4435.       raise;

  4436.     end;

  4437.   end;

  4438. end;

  4439. 

  4440. {$IFDEF GLB_SDL}

  4441. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4442. function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;

  4443. var

  4444.   Row, RowSize: Integer;

  4445.   SourceData, TmpData: PByte;

  4446.   TempDepth: Integer;

  4447.   FormatDesc: TFormatDescriptor;

  4448. 

  4449.   function GetRowPointer(Row: Integer): pByte;

  4450.   begin

  4451.     result := aSurface.pixels;

  4452.     Inc(result, Row * RowSize);

  4453.   end;

  4454. 

  4455. begin

  4456.   result := false;

  4457. 

  4458.   FormatDesc := TFormatDescriptor.Get(Format);

  4459.   if FormatDesc.IsCompressed then

  4460.     raise EglBitmapUnsupportedFormat.Create(Format);

  4461. 

  4462.   if Assigned(Data) then begin

  4463.     case Trunc(FormatDesc.PixelSize) of

  4464.       1: TempDepth :=  8;

  4465.       2: TempDepth := 16;

  4466.       3: TempDepth := 24;

  4467.       4: TempDepth := 32;

  4468.     else

  4469.       raise EglBitmapUnsupportedFormat.Create(Format);

  4470.     end;

  4471. 

  4472.     aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,

  4473.       FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);

  4474.     SourceData := Data;

  4475.     RowSize    := FormatDesc.GetSize(FileWidth, 1);

  4476. 

  4477.     for Row := 0 to FileHeight-1 do begin

  4478.       TmpData := GetRowPointer(Row);

  4479.       if Assigned(TmpData) then begin

  4480.         Move(SourceData^, TmpData^, RowSize);

  4481.         inc(SourceData, RowSize);

  4482.       end;

  4483.     end;

  4484.     result := true;

  4485.   end;

  4486. end;

  4487. 

  4488. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4489. function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;

  4490. var

  4491.   pSource, pData, pTempData: PByte;

  4492.   Row, RowSize, TempWidth, TempHeight: Integer;

  4493.   IntFormat: TglBitmapFormat;

  4494.   FormatDesc: TFormatDescriptor;

  4495. 

  4496.   function GetRowPointer(Row: Integer): pByte;

  4497.   begin

  4498.     result := aSurface^.pixels;

  4499.     Inc(result, Row * RowSize);

  4500.   end;

  4501. 

  4502. begin

  4503.   result := false;

  4504.   if (Assigned(aSurface)) then begin

  4505.     with aSurface^.format^ do begin

  4506.       for IntFormat := High(TglBitmapFormat) to Low(TglBitmapFormat) do begin

  4507.         FormatDesc := TFormatDescriptor.Get(IntFormat);

  4508.         if (FormatDesc.MaskMatch(RMask, GMask, BMask, AMask)) then

  4509.           break;

  4510.       end;

  4511.       if (IntFormat = tfEmpty) then

  4512.         raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');

  4513.     end;

  4514. 

  4515.     TempWidth  := aSurface^.w;

  4516.     TempHeight := aSurface^.h;

  4517.     RowSize := FormatDesc.GetSize(TempWidth, 1);

  4518.     GetMem(pData, TempHeight * RowSize);

  4519.     try

  4520.       pTempData := pData;

  4521.       for Row := 0 to TempHeight -1 do begin

  4522.         pSource := GetRowPointer(Row);

  4523.         if (Assigned(pSource)) then begin

  4524.           Move(pSource^, pTempData^, RowSize);

  4525.           Inc(pTempData, RowSize);

  4526.         end;

  4527.       end;

  4528.       SetDataPointer(pData, IntFormat, TempWidth, TempHeight);

  4529.       result := true;

  4530.     except

  4531.       FreeMem(pData);

  4532.       raise;

  4533.     end;

  4534.   end;

  4535. end;

  4536. 

  4537. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4538. function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;

  4539. var

  4540.   Row, Col, AlphaInterleave: Integer;

  4541.   pSource, pDest: PByte;

  4542. 

  4543.   function GetRowPointer(Row: Integer): pByte;

  4544.   begin

  4545.     result := aSurface.pixels;

  4546.     Inc(result, Row * Width);

  4547.   end;

  4548. 

  4549. begin

  4550.   result := false;

  4551.   if Assigned(Data) then begin

  4552.     if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin

  4553.       aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);

  4554. 

  4555.       AlphaInterleave := 0;

  4556.       case Format of

  4557.         tfLuminance8Alpha8:

  4558.           AlphaInterleave := 1;

  4559.         tfBGRA8, tfRGBA8:

  4560.           AlphaInterleave := 3;

  4561.       end;

  4562. 

  4563.       pSource := Data;

  4564.       for Row := 0 to Height -1 do begin

  4565.         pDest := GetRowPointer(Row);

  4566.         if Assigned(pDest) then begin

  4567.           for Col := 0 to Width -1 do begin

  4568.             Inc(pSource, AlphaInterleave);

  4569.             pDest^ := pSource^;

  4570.             Inc(pDest);

  4571.             Inc(pSource);

  4572.           end;

  4573.         end;

  4574.       end;

  4575.       result := true;

  4576.     end;

  4577.   end;

  4578. end;

  4579. 

  4580. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4581. function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;

  4582. var

  4583.   bmp: TglBitmap2D;

  4584. begin

  4585.   bmp := TglBitmap2D.Create;

  4586.   try

  4587.     bmp.AssignFromSurface(aSurface);

  4588.     result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);

  4589.   finally

  4590.     bmp.Free;

  4591.   end;

  4592. end;

  4593. {$ENDIF}

  4594. 

  4595. {$IFDEF GLB_DELPHI}

  4596. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4597. function CreateGrayPalette: HPALETTE;

  4598. var

  4599.   Idx: Integer;

  4600.   Pal: PLogPalette;

  4601. begin

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

  4603. 

  4604.   Pal.palVersion := $300;

  4605.   Pal.palNumEntries := 256;

  4606. 

  4607.   for Idx := 0 to Pal.palNumEntries - 1 do begin

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

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

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

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

  4612.   end;

  4613.   Result := CreatePalette(Pal^);

  4614.   FreeMem(Pal);

  4615. end;

  4616. 

  4617. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4618. function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;

  4619. var

  4620.   Row: Integer;

  4621.   pSource, pData: PByte;

  4622. begin

  4623.   result := false;

  4624.   if Assigned(Data) then begin

  4625.     if Assigned(aBitmap) then begin

  4626.       aBitmap.Width  := Width;

  4627.       aBitmap.Height := Height;

  4628. 

  4629.       case Format of

  4630.         tfAlpha8, tfLuminance8: begin

  4631.           aBitmap.PixelFormat := pf8bit;

  4632.           aBitmap.Palette     := CreateGrayPalette;

  4633.         end;

  4634.         tfRGB5A1:

  4635.           aBitmap.PixelFormat := pf15bit;

  4636.         tfR5G6B5:

  4637.           aBitmap.PixelFormat := pf16bit;

  4638.         tfRGB8, tfBGR8:

  4639.           aBitmap.PixelFormat := pf24bit;

  4640.         tfRGBA8, tfBGRA8:

  4641.           aBitmap.PixelFormat := pf32bit;

  4642.       else

  4643.         raise EglBitmapException.Create('AssignToBitmap - Invalid Pixelformat.');

  4644.       end;

  4645. 

  4646.       pSource := Data;

  4647.       for Row := 0 to FileHeight -1 do begin

  4648.         pData := aBitmap.Scanline[Row];

  4649.         Move(pSource^, pData^, fRowSize);

  4650.         Inc(pSource, fRowSize);

  4651.         if (Format in [tfRGB8, tfRGBA8]) then        // swap RGB(A) to BGR(A)

  4652.           SwapRGB(pData, FileWidth, Format = tfRGBA8);

  4653.       end;

  4654.       result := true;

  4655.     end;

  4656.   end;

  4657. end;

  4658. 

  4659. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4660. function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;

  4661. var

  4662.   pSource, pData, pTempData: PByte;

  4663.   Row, RowSize, TempWidth, TempHeight: Integer;

  4664.   IntFormat: TglBitmapFormat;

  4665. begin

  4666.   result := false;

  4667. 

  4668.   if (Assigned(aBitmap)) then begin

  4669.     case aBitmap.PixelFormat of

  4670.       pf8bit:

  4671.         IntFormat := tfLuminance8;

  4672.       pf15bit:

  4673.         IntFormat := tfRGB5A1;

  4674.       pf16bit:

  4675.         IntFormat := tfR5G6B5;

  4676.       pf24bit:

  4677.         IntFormat := tfBGR8;

  4678.       pf32bit:

  4679.         IntFormat := tfBGRA8;

  4680.     else

  4681.       raise EglBitmapException.Create('AssignFromBitmap - Invalid Pixelformat.');

  4682.     end;

  4683. 

  4684.     TempWidth  := aBitmap.Width;

  4685.     TempHeight := aBitmap.Height;

  4686.     RowSize    := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);

  4687.     GetMem(pData, TempHeight * RowSize);

  4688.     try

  4689.       pTempData := pData;

  4690.       for Row := 0 to TempHeight -1 do begin

  4691.         pSource := aBitmap.Scanline[Row];

  4692.         if (Assigned(pSource)) then begin

  4693.           Move(pSource^, pTempData^, RowSize);

  4694.           Inc(pTempData, RowSize);

  4695.         end;

  4696.       end;

  4697.       SetDataPointer(pData, IntFormat, TempWidth, TempHeight);

  4698.       result := true;

  4699.     except

  4700.       FreeMem(pData);

  4701.       raise;

  4702.     end;

  4703.   end;

  4704. end;

  4705. 

  4706. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4707. function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;

  4708. var

  4709.   Row, Col, AlphaInterleave: Integer;

  4710.   pSource, pDest: PByte;

  4711. begin

  4712.   result := false;

  4713. 

  4714.   if Assigned(Data) then begin

  4715.     if (Format in [tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8]) then begin

  4716.       if Assigned(aBitmap) then begin

  4717.         aBitmap.PixelFormat := pf8bit;

  4718.         aBitmap.Palette     := CreateGrayPalette;

  4719.         aBitmap.Width       := Width;

  4720.         aBitmap.Height      := Height;

  4721. 

  4722.         case Format of

  4723.           tfLuminance8Alpha8:

  4724.             AlphaInterleave := 1;

  4725.           tfRGBA8, tfBGRA8:

  4726.             AlphaInterleave := 3;

  4727.           else

  4728.             AlphaInterleave := 0;

  4729.         end;

  4730. 

  4731.         // Copy Data

  4732.         pSource := Data;

  4733. 

  4734.         for Row := 0 to Height -1 do begin

  4735.           pDest := aBitmap.Scanline[Row];

  4736.           if Assigned(pDest) then begin

  4737.             for Col := 0 to Width -1 do begin

  4738.               Inc(pSource, AlphaInterleave);

  4739.               pDest^ := pSource^;

  4740.               Inc(pDest);

  4741.               Inc(pSource);

  4742.             end;

  4743.           end;

  4744.         end;   

  4745.         result := true;

  4746.       end;

  4747.     end;

  4748.   end;

  4749. end;

  4750. 

  4751. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4752. function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;

  4753. var

  4754.   tex: TglBitmap2D;

  4755. begin

  4756.   tex := TglBitmap2D.Create;

  4757.   try

  4758.     tex.AssignFromBitmap(ABitmap);

  4759.     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);

  4760.   finally

  4761.     tex.Free;

  4762.   end;

  4763. end;

  4764. {$ENDIF}

  4765. 

  4766. {$IFDEF GLB_LAZARUS}

  4767. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4768. function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;

  4769. var

  4770.   rid: TRawImageDescription;

  4771.   FormatDesc: TFormatDescriptor;

  4772. begin

  4773.   result := false;

  4774.   if not Assigned(aImage) or (Format = tfEmpty) then

  4775.     exit;

  4776.   FormatDesc := TFormatDescriptor.Get(Format);

  4777.   if FormatDesc.IsCompressed then

  4778.     exit;

  4779. 

  4780.   FillChar(rid{%H-}, SizeOf(rid), 0);

  4781.   if (Format in [

  4782.        tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,

  4783.        tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,

  4784.        tfLuminance4Alpha4, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16]) then

  4785.     rid.Format := ricfGray

  4786.   else

  4787.     rid.Format := ricfRGBA;

  4788. 

  4789.   rid.Width        := Width;

  4790.   rid.Height       := Height;

  4791.   rid.Depth        := CountSetBits(FormatDesc.Range.r or FormatDesc.Range.g or FormatDesc.Range.b or FormatDesc.Range.a);

  4792.   rid.BitOrder     := riboBitsInOrder;

  4793.   rid.ByteOrder    := riboLSBFirst;

  4794.   rid.LineOrder    := riloTopToBottom;

  4795.   rid.LineEnd      := rileTight;

  4796.   rid.BitsPerPixel := Round(8 * FormatDesc.PixelSize);

  4797.   rid.RedPrec      := CountSetBits(FormatDesc.Range.r);

  4798.   rid.GreenPrec    := CountSetBits(FormatDesc.Range.g);

  4799.   rid.BluePrec     := CountSetBits(FormatDesc.Range.b);

  4800.   rid.AlphaPrec    := CountSetBits(FormatDesc.Range.a);

  4801.   rid.RedShift     := FormatDesc.Shift.r;

  4802.   rid.GreenShift   := FormatDesc.Shift.g;

  4803.   rid.BlueShift    := FormatDesc.Shift.b;

  4804.   rid.AlphaShift   := FormatDesc.Shift.a;

  4805. 

  4806.   rid.MaskBitsPerPixel  := 0;

  4807.   rid.PaletteColorCount := 0;

  4808. 

  4809.   aImage.DataDescription := rid;

  4810.   aImage.CreateData;

  4811. 

  4812.   Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));

  4813. 

  4814.   result := true;

  4815. end;

  4816. 

  4817. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4818. function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;

  4819. var

  4820.   f: TglBitmapFormat;

  4821.   FormatDesc: TFormatDescriptor;

  4822.   ImageData: PByte;

  4823.   ImageSize: Integer;

  4824. begin

  4825.   result := false;

  4826.   if not Assigned(aImage) then

  4827.     exit;

  4828.   for f := High(f) downto Low(f) do begin

  4829.     FormatDesc := TFormatDescriptor.Get(f);

  4830.     with aImage.DataDescription do

  4831.       if FormatDesc.MaskMatch(

  4832.         (QWord(1 shl RedPrec  )-1) shl RedShift,

  4833.         (QWord(1 shl GreenPrec)-1) shl GreenShift,

  4834.         (QWord(1 shl BluePrec )-1) shl BlueShift,

  4835.         (QWord(1 shl AlphaPrec)-1) shl AlphaShift) then

  4836.         break;

  4837.   end;

  4838. 

  4839.   if (f = tfEmpty) then

  4840.     exit;

  4841. 

  4842.   ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);

  4843.   ImageData := GetMem(ImageSize);

  4844.   try

  4845.     Move(aImage.PixelData^, ImageData^, (aImage.Width * aImage.Height * aImage.DataDescription.BitsPerPixel) shr 3);

  4846.     SetDataPointer(ImageData, f, aImage.Width, aImage.Height);

  4847.   except

  4848.     FreeMem(ImageData);

  4849.     raise;

  4850.   end;

  4851. 

  4852.   result := true;

  4853. end;

  4854. 

  4855. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4856. function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;

  4857. var

  4858.   rid: TRawImageDescription;

  4859.   FormatDesc: TFormatDescriptor;

  4860.   Pixel: TglBitmapPixelData;

  4861.   x, y: Integer;

  4862.   srcMD: Pointer;

  4863.   src, dst: PByte;

  4864. begin

  4865.   result := false;

  4866.   if not Assigned(aImage) or (Format = tfEmpty) then

  4867.     exit;

  4868.   FormatDesc := TFormatDescriptor.Get(Format);

  4869.   if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then

  4870.     exit;

  4871. 

  4872.   FillChar(rid{%H-}, SizeOf(rid), 0);

  4873.   rid.Format       := ricfGray;

  4874.   rid.Width        := Width;

  4875.   rid.Height       := Height;

  4876.   rid.Depth        := CountSetBits(FormatDesc.Range.a);

  4877.   rid.BitOrder     := riboBitsInOrder;

  4878.   rid.ByteOrder    := riboLSBFirst;

  4879.   rid.LineOrder    := riloTopToBottom;

  4880.   rid.LineEnd      := rileTight;

  4881.   rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);

  4882.   rid.RedPrec      := CountSetBits(FormatDesc.Range.a);

  4883.   rid.GreenPrec    := 0;

  4884.   rid.BluePrec     := 0;

  4885.   rid.AlphaPrec    := 0;

  4886.   rid.RedShift     := 0;

  4887.   rid.GreenShift   := 0;

  4888.   rid.BlueShift    := 0;

  4889.   rid.AlphaShift   := 0;

  4890. 

  4891.   rid.MaskBitsPerPixel  := 0;

  4892.   rid.PaletteColorCount := 0;

  4893. 

  4894.   aImage.DataDescription := rid;

  4895.   aImage.CreateData;

  4896. 

  4897.   srcMD := FormatDesc.CreateMappingData;

  4898.   try

  4899.     FormatDesc.PreparePixel(Pixel);

  4900.     src := Data;

  4901.     dst := aImage.PixelData;

  4902.     for y := 0 to Height-1 do

  4903.       for x := 0 to Width-1 do begin

  4904.         FormatDesc.Unmap(src, Pixel, srcMD);

  4905.         case rid.BitsPerPixel of

  4906.            8: begin

  4907.             dst^ := Pixel.Data.a;

  4908.             inc(dst);

  4909.           end;

  4910.           16: begin

  4911.             PWord(dst)^ := Pixel.Data.a;

  4912.             inc(dst, 2);

  4913.           end;

  4914.           24: begin

  4915.             PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];

  4916.             PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];

  4917.             PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];

  4918.             inc(dst, 3);

  4919.           end;

  4920.           32: begin

  4921.             PCardinal(dst)^ := Pixel.Data.a;

  4922.             inc(dst, 4);

  4923.           end;

  4924.         else

  4925.           raise EglBitmapUnsupportedFormat.Create(Format);

  4926.         end;

  4927.       end;

  4928.   finally

  4929.     FormatDesc.FreeMappingData(srcMD);

  4930.   end;

  4931.   result := true;

  4932. end;

  4933. 

  4934. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4935. function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;

  4936. var

  4937.   tex: TglBitmap2D;

  4938. begin

  4939.   tex := TglBitmap2D.Create;

  4940.   try

  4941.     tex.AssignFromLazIntfImage(aImage);

  4942.     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);

  4943.   finally

  4944.     tex.Free;

  4945.   end;

  4946. end;

  4947. {$ENDIF}

  4948. 

  4949. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4950. function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;

  4951.   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;

  4952. var

  4953.   rs: TResourceStream;

  4954. begin

  4955.   PrepareResType(aResource, aResType);

  4956.   rs := TResourceStream.Create(aInstance, aResource, aResType);

  4957.   try

  4958.     result := AddAlphaFromStream(rs, aFunc, aArgs);

  4959.   finally

  4960.     rs.Free;

  4961.   end;

  4962. end;

  4963. 

  4964. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  4966.   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;

  4967. var

  4968.   rs: TResourceStream;

  4969. begin

  4970.   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);

  4971.   try

  4972.     result := AddAlphaFromStream(rs, aFunc, aArgs);

  4973.   finally

  4974.     rs.Free;

  4975.   end;

  4976. end;

  4977. 

  4978. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4979. function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;

  4980. begin

  4981.   if TFormatDescriptor.Get(Format).IsCompressed then

  4982.     raise EglBitmapUnsupportedFormat.Create(Format);

  4983.   result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);

  4984. end;

  4985. 

  4986. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4987. function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;

  4988. var

  4989.   FS: TFileStream;

  4990. begin

  4991.   FS := TFileStream.Create(FileName, fmOpenRead);

  4992.   try

  4993.     result := AddAlphaFromStream(FS, aFunc, aArgs);

  4994.   finally

  4995.     FS.Free;

  4996.   end;

  4997. end;

  4998. 

  4999. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5000. function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;

  5001. var

  5002.   tex: TglBitmap2D;

  5003. begin

  5004.   tex := TglBitmap2D.Create(aStream);

  5005.   try

  5006.     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);

  5007.   finally

  5008.     tex.Free;

  5009.   end;

  5010. end;

  5011. 

  5012. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5013. function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;

  5014. var

  5015.   DestData, DestData2, SourceData: pByte;

  5016.   TempHeight, TempWidth: Integer;

  5017.   SourceFD, DestFD: TFormatDescriptor;

  5018.   SourceMD, DestMD, DestMD2: Pointer;

  5019. 

  5020.   FuncRec: TglBitmapFunctionRec;

  5021. begin

  5022.   result := false;

  5023. 

  5024.   Assert(Assigned(Data));

  5025.   Assert(Assigned(aBitmap));

  5026.   Assert(Assigned(aBitmap.Data));

  5027. 

  5028.   if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin

  5029.     result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);

  5030. 

  5031.     SourceFD := TFormatDescriptor.Get(aBitmap.Format);

  5032.     DestFD   := TFormatDescriptor.Get(Format);

  5033. 

  5034.     if not Assigned(aFunc) then begin

  5035.       aFunc        := glBitmapAlphaFunc;

  5036.       FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);

  5037.     end else

  5038.       FuncRec.Args := aArgs;

  5039. 

  5040.     // Values

  5041.     TempHeight := aBitmap.FileHeight;

  5042.     TempWidth  := aBitmap.FileWidth;

  5043. 

  5044.     FuncRec.Sender          := Self;

  5045.     FuncRec.Size            := Dimension;

  5046.     FuncRec.Position.Fields := FuncRec.Size.Fields;

  5047. 

  5048.     DestData   := Data;

  5049.     DestData2  := Data;

  5050.     SourceData := aBitmap.Data;

  5051. 

  5052.     // Mapping

  5053.     SourceFD.PreparePixel(FuncRec.Source);

  5054.     DestFD.PreparePixel  (FuncRec.Dest);

  5055. 

  5056.     SourceMD := SourceFD.CreateMappingData;

  5057.     DestMD   := DestFD.CreateMappingData;

  5058.     DestMD2  := DestFD.CreateMappingData;

  5059.     try

  5060.       FuncRec.Position.Y := 0;

  5061.       while FuncRec.Position.Y < TempHeight do begin

  5062.         FuncRec.Position.X := 0;

  5063.         while FuncRec.Position.X < TempWidth do begin

  5064.           SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);

  5065.           DestFD.Unmap  (DestData,   FuncRec.Dest,   DestMD);

  5066.           aFunc(FuncRec);

  5067.           DestFD.Map(FuncRec.Dest, DestData2, DestMD2);

  5068.           inc(FuncRec.Position.X);

  5069.         end;

  5070.         inc(FuncRec.Position.Y);

  5071.       end;

  5072.     finally

  5073.       SourceFD.FreeMappingData(SourceMD);

  5074.       DestFD.FreeMappingData(DestMD);

  5075.       DestFD.FreeMappingData(DestMD2);

  5076.     end;

  5077.   end;

  5078. end;

  5079. 

  5080. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5081. function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;

  5082. begin

  5083.   result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);

  5084. end;

  5085. 

  5086. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5087. function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;

  5088. var

  5089.   PixelData: TglBitmapPixelData;

  5090. begin

  5091.   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);

  5092.   result := AddAlphaFromColorKeyFloat(

  5093.     aRed   / PixelData.Range.r,

  5094.     aGreen / PixelData.Range.g,

  5095.     aBlue  / PixelData.Range.b,

  5096.     aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));

  5097. end;

  5098. 

  5099. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5100. function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;

  5101. var

  5102.   values: array[0..2] of Single;

  5103.   tmp: Cardinal;

  5104.   i: Integer;

  5105.   PixelData: TglBitmapPixelData;

  5106. begin

  5107.   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);

  5108.   with PixelData do begin

  5109.     values[0] := aRed;

  5110.     values[1] := aGreen;

  5111.     values[2] := aBlue;

  5112. 

  5113.     for i := 0 to 2 do begin

  5114.       tmp          := Trunc(Range.arr[i] * aDeviation);

  5115.       Data.arr[i]  := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));

  5116.       Range.arr[i] := Max(0,            Trunc(Range.arr[i] * values[i] - tmp));

  5117.     end;

  5118.     Data.a  := 0;

  5119.     Range.a := 0;

  5120.   end;

  5121.   result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);

  5122. end;

  5123. 

  5124. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5125. function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;

  5126. begin

  5127.   result := AddAlphaFromValueFloat(aAlpha / $FF);

  5128. end;

  5129. 

  5130. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5131. function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;

  5132. var

  5133.   PixelData: TglBitmapPixelData;

  5134. begin

  5135.   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);

  5136.   result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);

  5137. end;

  5138. 

  5139. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5140. function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;

  5141. var

  5142.   PixelData: TglBitmapPixelData;

  5143. begin

  5144.   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);

  5145.   with PixelData do

  5146.     Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));

  5147.   result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);

  5148. end;

  5149. 

  5150. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5151. function TglBitmap.RemoveAlpha: Boolean;

  5152. var

  5153.   FormatDesc: TFormatDescriptor;

  5154. begin

  5155.   result := false;

  5156.   FormatDesc := TFormatDescriptor.Get(Format);

  5157.   if Assigned(Data) then begin

  5158.     if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then

  5159.       raise EglBitmapUnsupportedFormat.Create(Format);

  5160.     result := ConvertTo(FormatDesc.WithoutAlpha);

  5161.   end;

  5162. end;

  5163. 

  5164. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5165. function TglBitmap.Clone: TglBitmap;

  5166. var

  5167.   Temp: TglBitmap;

  5168.   TempPtr: PByte;

  5169.   Size: Integer;

  5170. begin

  5171.   result := nil;

  5172.   Temp := (ClassType.Create as TglBitmap);

  5173.   try

  5174.     // copy texture data if assigned

  5175.     if Assigned(Data) then begin

  5176.       Size := TFormatDescriptor.Get(Format).GetSize(fDimension);

  5177.       GetMem(TempPtr, Size);

  5178.       try

  5179.         Move(Data^, TempPtr^, Size);

  5180.         Temp.SetDataPointer(TempPtr, Format, Width, Height);

  5181.       except

  5182.         FreeMem(TempPtr);

  5183.         raise;

  5184.       end;

  5185.     end else

  5186.       Temp.SetDataPointer(nil, Format, Width, Height);

  5187. 

  5188. 	// copy properties

  5189.     Temp.fID                      := ID;

  5190.     Temp.fTarget                  := Target;

  5191.     Temp.fFormat                  := Format;

  5192.     Temp.fMipMap                  := MipMap;

  5193.     Temp.fAnisotropic             := Anisotropic;

  5194.     Temp.fBorderColor             := fBorderColor;

  5195.     Temp.fDeleteTextureOnFree     := DeleteTextureOnFree;

  5196.     Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;

  5197.     Temp.fFilterMin               := fFilterMin;

  5198.     Temp.fFilterMag               := fFilterMag;

  5199.     Temp.fWrapS                   := fWrapS;

  5200.     Temp.fWrapT                   := fWrapT;

  5201.     Temp.fWrapR                   := fWrapR;

  5202.     Temp.fFilename                := fFilename;

  5203.     Temp.fCustomName              := fCustomName;

  5204.     Temp.fCustomNameW             := fCustomNameW;

  5205.     Temp.fCustomData              := fCustomData;

  5206. 

  5207.     result := Temp;

  5208.   except

  5209.     FreeAndNil(Temp);

  5210.     raise;

  5211.   end;

  5212. end;

  5213. 

  5214. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5215. function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;

  5216. var

  5217.   SourceFD, DestFD: TFormatDescriptor;

  5218.   SourcePD, DestPD: TglBitmapPixelData;

  5219.   ShiftData: TShiftData;

  5220. 

  5221.   function CanCopyDirect: Boolean;

  5222.   begin

  5223.     result :=

  5224.       ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and

  5225.       ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and

  5226.       ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and

  5227.       ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));

  5228.   end;

  5229. 

  5230.   function CanShift: Boolean;

  5231.   begin

  5232.     result :=

  5233.       ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and

  5234.       ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and

  5235.       ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and

  5236.       ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));

  5237.   end;

  5238. 

  5239.   function GetShift(aSource, aDest: Cardinal) : ShortInt;

  5240.   begin

  5241.     result := 0;

  5242.     while (aSource > aDest) and (aSource > 0) do begin

  5243.       inc(result);

  5244.       aSource := aSource shr 1;

  5245.     end;

  5246.   end;

  5247. 

  5248. begin

  5249.   if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin

  5250.     SourceFD := TFormatDescriptor.Get(Format);

  5251.     DestFD   := TFormatDescriptor.Get(aFormat);

  5252. 

  5253.     SourceFD.PreparePixel(SourcePD);

  5254.     DestFD.PreparePixel  (DestPD);

  5255. 

  5256.     if CanCopyDirect then

  5257.       result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)

  5258.     else if CanShift then begin

  5259.       ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);

  5260.       ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);

  5261.       ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);

  5262.       ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);

  5263.       result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);

  5264.     end else

  5265.       result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);

  5266.   end else

  5267.     result := true;

  5268. end;

  5269. 

  5270. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5271. procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);

  5272. begin

  5273.   if aUseRGB or aUseAlpha then

  5274.     AddFunc(glBitmapInvertFunc, false, {%H-}Pointer(

  5275.       ((PtrInt(aUseAlpha) and 1) shl 1) or

  5276.        (PtrInt(aUseRGB)   and 1)      ));

  5277. end;

  5278. 

  5279. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  5281. begin

  5282.   fBorderColor[0] := aRed;

  5283.   fBorderColor[1] := aGreen;

  5284.   fBorderColor[2] := aBlue;

  5285.   fBorderColor[3] := aAlpha;

  5286.   if (ID > 0) then begin

  5287.     Bind(false);

  5288.     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);

  5289.   end;

  5290. end;

  5291. 

  5292. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5293. procedure TglBitmap.FreeData;

  5294. begin

  5295.   SetDataPointer(nil, tfEmpty);

  5296. end;

  5297. 

  5298. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5299. procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;

  5300.   const aAlpha: Byte);

  5301. begin

  5302.   FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);

  5303. end;

  5304. 

  5305. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5306. procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);

  5307. var

  5308.   PixelData: TglBitmapPixelData;

  5309. begin

  5310.   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);

  5311.   FillWithColorFloat(

  5312.     aRed   / PixelData.Range.r,

  5313.     aGreen / PixelData.Range.g,

  5314.     aBlue  / PixelData.Range.b,

  5315.     aAlpha / PixelData.Range.a);

  5316. end;

  5317. 

  5318. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5319. procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);

  5320. var

  5321.   PixelData: TglBitmapPixelData;

  5322. begin

  5323.   TFormatDescriptor.Get(Format).PreparePixel(PixelData);

  5324.   with PixelData do begin

  5325.     Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));

  5326.     Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));

  5327.     Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));

  5328.     Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));

  5329.   end;

  5330.   AddFunc(glBitmapFillWithColorFunc, false, @PixelData);

  5331. end;

  5332. 

  5333. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  5335. begin

  5336.   //check MIN filter

  5337.   case aMin of

  5338.     GL_NEAREST:

  5339.       fFilterMin := GL_NEAREST;

  5340.     GL_LINEAR:

  5341.       fFilterMin := GL_LINEAR;

  5342.     GL_NEAREST_MIPMAP_NEAREST:

  5343.       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;

  5344.     GL_LINEAR_MIPMAP_NEAREST:

  5345.       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;

  5346.     GL_NEAREST_MIPMAP_LINEAR:

  5347.       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;

  5348.     GL_LINEAR_MIPMAP_LINEAR:

  5349.       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;

  5350.     else

  5351.       raise EglBitmapException.Create('SetFilter - Unknow MIN filter.');

  5352.   end;

  5353. 

  5354.   //check MAG filter

  5355.   case aMag of

  5356.     GL_NEAREST:

  5357.       fFilterMag := GL_NEAREST;

  5358.     GL_LINEAR:

  5359.       fFilterMag := GL_LINEAR;

  5360.     else

  5361.       raise EglBitmapException.Create('SetFilter - Unknow MAG filter.');

  5362.   end;

  5363. 

  5364.   //apply filter

  5365.   if (ID > 0) then begin

  5366.     Bind(false);

  5367.     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);

  5368. 

  5369.     if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin

  5370.       case fFilterMin of

  5371.         GL_NEAREST, GL_LINEAR:

  5372.           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);

  5373.         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:

  5374.           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);

  5375.         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:

  5376.           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);

  5377.       end;

  5378.     end else

  5379.       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);

  5380.   end;

  5381. end;

  5382. 

  5383. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5384. procedure TglBitmap.SetWrap(const S: Cardinal; const T: Cardinal; const R: Cardinal);

  5385. 

  5386.   procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);

  5387.   begin

  5388.     case aValue of

  5389.       GL_CLAMP:

  5390.         aTarget := GL_CLAMP;

  5391. 

  5392.       GL_REPEAT:

  5393.         aTarget := GL_REPEAT;

  5394. 

  5395.       GL_CLAMP_TO_EDGE: begin

  5396.         if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then

  5397.           aTarget := GL_CLAMP_TO_EDGE

  5398.         else

  5399.           aTarget := GL_CLAMP;

  5400.       end;

  5401. 

  5402.       GL_CLAMP_TO_BORDER: begin

  5403.         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then

  5404.           aTarget := GL_CLAMP_TO_BORDER

  5405.         else

  5406.           aTarget := GL_CLAMP;

  5407.       end;

  5408. 

  5409.       GL_MIRRORED_REPEAT: begin

  5410.         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then

  5411.           aTarget := GL_MIRRORED_REPEAT

  5412.         else

  5413.           raise EglBitmapException.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');

  5414.       end;

  5415.     else

  5416.       raise EglBitmapException.Create('SetWrap - Unknow Texturewrap (S).');

  5417.     end;

  5418.   end;

  5419. 

  5420. begin

  5421.   CheckAndSetWrap(S, fWrapS);

  5422.   CheckAndSetWrap(T, fWrapT);

  5423.   CheckAndSetWrap(R, fWrapR);

  5424. 

  5425.   if (ID > 0) then begin

  5426.     Bind(false);

  5427.     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);

  5428.     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);

  5429.     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);

  5430.   end;

  5431. end;

  5432. 

  5433. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5434. procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);

  5435. begin

  5436.   if aEnableTextureUnit then

  5437.     glEnable(Target);

  5438.   if (ID > 0) then

  5439.     glBindTexture(Target, ID);

  5440. end;

  5441. 

  5442. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5443. procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);

  5444. begin

  5445.   if aDisableTextureUnit then

  5446.     glDisable(Target);

  5447.   glBindTexture(Target, 0);

  5448. end;

  5449. 

  5450. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5451. constructor TglBitmap.Create;

  5452. begin

  5453. {$IFDEF GLB_NATIVE_OGL}

  5454.   glbReadOpenGLExtensions;

  5455. {$ENDIF}

  5456.   if (ClassType = TglBitmap) then

  5457.     raise EglBitmapException.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');

  5458.   inherited Create;

  5459. end;

  5460. 

  5461. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5462. constructor TglBitmap.Create(const aFileName: String);

  5463. begin

  5464.   Create;

  5465.   LoadFromFile(FileName);

  5466. end;

  5467. 

  5468. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5469. constructor TglBitmap.Create(const aStream: TStream);

  5470. begin

  5471.   Create;

  5472.   LoadFromStream(aStream);

  5473. end;

  5474. 

  5475. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5476. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat);

  5477. var

  5478.   Image: PByte;

  5479.   ImageSize: Integer;

  5480. begin

  5481.   Create;

  5482.   ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);

  5483.   GetMem(Image, ImageSize);

  5484.   try

  5485.     FillChar(Image^, ImageSize, #$FF);

  5486.     SetDataPointer(Image, aFormat, aSize.X, aSize.Y);

  5487.   except

  5488.     FreeMem(Image);

  5489.     raise;

  5490.   end;

  5491. end;

  5492. 

  5493. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5494. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat;

  5495.   const aFunc: TglBitmapFunction; const aArgs: Pointer);

  5496. begin

  5497.   Create;

  5498.   LoadFromFunc(aSize, aFunc, aFormat, aArgs);

  5499. end;

  5500. 

  5501. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5502. constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);

  5503. begin

  5504.   Create;

  5505.   LoadFromResource(aInstance, aResource, aResType);

  5506. end;

  5507. 

  5508. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5509. constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);

  5510. begin

  5511.   Create;

  5512.   LoadFromResourceID(aInstance, aResourceID, aResType);

  5513. end;

  5514. 

  5515. {$IFDEF GLB_SUPPORT_PNG_READ}

  5516. {$IF DEFINED(GLB_SDL_IMAGE)}

  5517. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5518. //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5519. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5520. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;

  5521. var

  5522.   Surface: PSDL_Surface;

  5523.   RWops: PSDL_RWops;

  5524. begin

  5525.   result := false;

  5526.   RWops := glBitmapCreateRWops(aStream);

  5527.   try

  5528.     if IMG_isPNG(RWops) > 0 then begin

  5529.       Surface := IMG_LoadPNG_RW(RWops);

  5530.       try

  5531.         AssignFromSurface(Surface);

  5532.         result := true;

  5533.       finally

  5534.         SDL_FreeSurface(Surface);

  5535.       end;

  5536.     end;

  5537.   finally

  5538.     SDL_FreeRW(RWops);

  5539.   end;

  5540. end;

  5541. 

  5542. {$ELSEIF DEFINED(GLB_LIB_PNG)}

  5543. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5544. procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;

  5545. begin

  5546.   TStream(png_get_io_ptr(png)).Read(buffer^, size);

  5547. end;

  5548. 

  5549. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5550. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;

  5551. var

  5552.   StreamPos: Int64;

  5553.   signature: array [0..7] of byte;

  5554.   png: png_structp;

  5555.   png_info: png_infop;

  5556. 

  5557.   TempHeight, TempWidth: Integer;

  5558.   Format: TglBitmapFormat;

  5559. 

  5560.   png_data: pByte;

  5561.   png_rows: array of pByte;

  5562.   Row, LineSize: Integer;

  5563. begin

  5564.   result := false;

  5565. 

  5566.   if not init_libPNG then

  5567.     raise Exception.Create('LoadPNG - unable to initialize libPNG.');

  5568. 

  5569.   try

  5570.     // signature

  5571.     StreamPos := aStream.Position;

  5572.     aStream.Read(signature{%H-}, 8);

  5573.     aStream.Position := StreamPos;

  5574. 

  5575.     if png_check_sig(@signature, 8) <> 0 then begin

  5576.       // png read struct

  5577.       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);

  5578.       if png = nil then

  5579.         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');

  5580. 

  5581.       // png info

  5582.       png_info := png_create_info_struct(png);

  5583.       if png_info = nil then begin

  5584.         png_destroy_read_struct(@png, nil, nil);

  5585.         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');

  5586.       end;

  5587. 

  5588.       // set read callback

  5589.       png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);

  5590. 

  5591.       // read informations

  5592.       png_read_info(png, png_info);

  5593. 

  5594.       // size 

  5595.       TempHeight := png_get_image_height(png, png_info);

  5596.       TempWidth := png_get_image_width(png, png_info);

  5597. 

  5598.       // format

  5599.       case png_get_color_type(png, png_info) of

  5600.         PNG_COLOR_TYPE_GRAY:

  5601.           Format := tfLuminance8;

  5602.         PNG_COLOR_TYPE_GRAY_ALPHA:

  5603.           Format := tfLuminance8Alpha8;

  5604.         PNG_COLOR_TYPE_RGB:

  5605.           Format := tfRGB8;

  5606.         PNG_COLOR_TYPE_RGB_ALPHA:

  5607.           Format := tfRGBA8;

  5608.         else

  5609.           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');

  5610.       end;

  5611. 

  5612.       // cut upper 8 bit from 16 bit formats

  5613.       if png_get_bit_depth(png, png_info) > 8 then

  5614.         png_set_strip_16(png);

  5615. 

  5616.       // expand bitdepth smaller than 8

  5617.       if png_get_bit_depth(png, png_info) < 8 then

  5618.         png_set_expand(png);

  5619. 

  5620.       // allocating mem for scanlines

  5621.       LineSize := png_get_rowbytes(png, png_info);

  5622.       GetMem(png_data, TempHeight * LineSize);

  5623.       try

  5624.         SetLength(png_rows, TempHeight);

  5625.         for Row := Low(png_rows) to High(png_rows) do begin

  5626.           png_rows[Row] := png_data;

  5627.           Inc(png_rows[Row], Row * LineSize);

  5628.         end;

  5629. 

  5630.         // read complete image into scanlines

  5631.         png_read_image(png, @png_rows[0]);

  5632. 

  5633.         // read end

  5634.         png_read_end(png, png_info);

  5635. 

  5636.         // destroy read struct

  5637.         png_destroy_read_struct(@png, @png_info, nil);

  5638. 

  5639.         SetLength(png_rows, 0);

  5640. 

  5641.         // set new data

  5642.         SetDataPointer(png_data, Format, TempWidth, TempHeight);

  5643. 

  5644.         result := true;

  5645.       except

  5646.         FreeMem(png_data);

  5647.         raise;

  5648.       end;

  5649.     end;

  5650.   finally

  5651.     quit_libPNG;

  5652.   end;

  5653. end;

  5654. 

  5655. {$ELSEIF DEFINED(GLB_PNGIMAGE)}

  5656. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5657. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;

  5658. var

  5659.   StreamPos: Int64;

  5660.   Png: TPNGObject;

  5661.   Header: String[8];

  5662.   Row, Col, PixSize, LineSize: Integer;

  5663.   NewImage, pSource, pDest, pAlpha: pByte;

  5664.   PngFormat: TglBitmapFormat;

  5665.   FormatDesc: TFormatDescriptor;

  5666. 

  5667. const

  5668.   PngHeader: String[8] = #137#80#78#71#13#10#26#10;

  5669. 

  5670. begin

  5671.   result := false;

  5672. 

  5673.   StreamPos := aStream.Position;

  5674.   aStream.Read(Header[0], SizeOf(Header));

  5675.   aStream.Position := StreamPos;

  5676. 

  5677.   {Test if the header matches}

  5678.   if Header = PngHeader then begin

  5679.     Png := TPNGObject.Create;

  5680.     try

  5681.       Png.LoadFromStream(aStream);

  5682. 

  5683.       case Png.Header.ColorType of

  5684.         COLOR_GRAYSCALE:

  5685.           PngFormat := tfLuminance8;

  5686.         COLOR_GRAYSCALEALPHA:

  5687.           PngFormat := tfLuminance8Alpha8;

  5688.         COLOR_RGB:

  5689.           PngFormat := tfBGR8;

  5690.         COLOR_RGBALPHA:

  5691.           PngFormat := tfBGRA8;

  5692.         else

  5693.           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');

  5694.       end;

  5695. 

  5696.       FormatDesc := TFormatDescriptor.Get(PngFormat);

  5697.       PixSize    := Round(FormatDesc.PixelSize);

  5698.       LineSize   := FormatDesc.GetSize(Png.Header.Width, 1);

  5699. 

  5700.       GetMem(NewImage, LineSize * Integer(Png.Header.Height));

  5701.       try

  5702.         pDest := NewImage;

  5703. 

  5704.         case Png.Header.ColorType of

  5705.           COLOR_RGB, COLOR_GRAYSCALE:

  5706.             begin

  5707.               for Row := 0 to Png.Height -1 do begin

  5708.                 Move (Png.Scanline[Row]^, pDest^, LineSize);

  5709.                 Inc(pDest, LineSize);

  5710.               end;

  5711.             end;

  5712.           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:

  5713.             begin

  5714.               PixSize := PixSize -1;

  5715. 

  5716.               for Row := 0 to Png.Height -1 do begin

  5717.                 pSource := Png.Scanline[Row];

  5718.                 pAlpha := pByte(Png.AlphaScanline[Row]);

  5719. 

  5720.                 for Col := 0 to Png.Width -1 do begin

  5721.                   Move (pSource^, pDest^, PixSize);

  5722.                   Inc(pSource, PixSize);

  5723.                   Inc(pDest, PixSize);

  5724. 

  5725.                   pDest^ := pAlpha^;

  5726.                   inc(pAlpha);

  5727.                   Inc(pDest);

  5728.                 end;

  5729.               end;

  5730.             end;

  5731.           else

  5732.             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');

  5733.         end;

  5734. 

  5735.         SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height);

  5736. 

  5737.         result := true;

  5738.       except

  5739.         FreeMem(NewImage);

  5740.         raise;

  5741.       end;

  5742.     finally

  5743.       Png.Free;

  5744.     end;

  5745.   end;

  5746. end;

  5747. {$IFEND}

  5748. {$ENDIF}

  5749. 

  5750. {$IFDEF GLB_SUPPORT_PNG_WRITE}

  5751. {$IFDEF GLB_LIB_PNG}

  5752. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5753. procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;

  5754. begin

  5755.   TStream(png_get_io_ptr(png)).Write(buffer^, size);

  5756. end;

  5757. {$ENDIF}

  5758. 

  5759. {$IF DEFINED(GLB_LIB_PNG)}

  5760. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5761. procedure TglBitmap.SavePNG(const aStream: TStream);

  5762. var

  5763.   png: png_structp;

  5764.   png_info: png_infop;

  5765.   png_rows: array of pByte;

  5766.   LineSize: Integer;

  5767.   ColorType: Integer;

  5768.   Row: Integer;

  5769.   FormatDesc: TFormatDescriptor;

  5770. begin

  5771.   if not (ftPNG in FormatGetSupportedFiles(Format)) then

  5772.     raise EglBitmapUnsupportedFormat.Create(Format);

  5773. 

  5774.   if not init_libPNG then

  5775.     raise Exception.Create('unable to initialize libPNG.');

  5776. 

  5777.   try

  5778.     case Format of

  5779.       tfAlpha8, tfLuminance8:

  5780.         ColorType := PNG_COLOR_TYPE_GRAY;

  5781.       tfLuminance8Alpha8:

  5782.         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;

  5783.       tfBGR8, tfRGB8:

  5784.         ColorType := PNG_COLOR_TYPE_RGB;

  5785.       tfBGRA8, tfRGBA8:

  5786.         ColorType := PNG_COLOR_TYPE_RGBA;

  5787.       else

  5788.         raise EglBitmapUnsupportedFormat.Create(Format);

  5789.     end;

  5790. 

  5791.     FormatDesc := TFormatDescriptor.Get(Format);

  5792.     LineSize := FormatDesc.GetSize(Width, 1);

  5793. 

  5794.     // creating array for scanline

  5795.     SetLength(png_rows, Height);

  5796.     try

  5797.       for Row := 0 to Height - 1 do begin

  5798.         png_rows[Row] := Data;

  5799.         Inc(png_rows[Row], Row * LineSize)

  5800.       end;

  5801. 

  5802.       // write struct

  5803.       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);

  5804.       if png = nil then

  5805.         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');

  5806. 

  5807.       // create png info

  5808.       png_info := png_create_info_struct(png);

  5809.       if png_info = nil then begin

  5810.         png_destroy_write_struct(@png, nil);

  5811.         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');

  5812.       end;

  5813. 

  5814.       // set read callback

  5815.       png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);

  5816. 

  5817.       // set compression

  5818.       png_set_compression_level(png, 6);

  5819. 

  5820.       if Format in [tfBGR8, tfBGRA8] then

  5821.         png_set_bgr(png);

  5822. 

  5823.       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);

  5824.       png_write_info(png, png_info);

  5825.       png_write_image(png, @png_rows[0]);

  5826.       png_write_end(png, png_info);

  5827.       png_destroy_write_struct(@png, @png_info);

  5828.     finally

  5829.       SetLength(png_rows, 0);

  5830.     end;

  5831.   finally

  5832.     quit_libPNG;

  5833.   end;

  5834. end;

  5835. 

  5836. {$ELSEIF DEFINED(GLB_PNGIMAGE)}

  5837. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5838. procedure TglBitmap.SavePNG(const aStream: TStream);

  5839. var

  5840.   Png: TPNGObject;

  5841. 

  5842.   pSource, pDest: pByte;

  5843.   X, Y, PixSize: Integer;

  5844.   ColorType: Cardinal;

  5845.   Alpha: Boolean;

  5846. 

  5847.   pTemp: pByte;

  5848.   Temp: Byte;

  5849. begin

  5850.   if not (ftPNG in FormatGetSupportedFiles (Format)) then

  5851.     raise EglBitmapUnsupportedFormat.Create(Format);

  5852. 

  5853.   case Format of

  5854.     tfAlpha8, tfLuminance8: begin

  5855.       ColorType := COLOR_GRAYSCALE;

  5856.       PixSize   := 1;

  5857.       Alpha     := false;

  5858.     end;

  5859.     tfLuminance8Alpha8: begin

  5860.       ColorType := COLOR_GRAYSCALEALPHA;

  5861.       PixSize   := 1;

  5862.       Alpha     := true;

  5863.     end;

  5864.     tfBGR8, tfRGB8: begin

  5865.       ColorType := COLOR_RGB;

  5866.       PixSize   := 3;

  5867.       Alpha     := false;

  5868.     end;

  5869.     tfBGRA8, tfRGBA8: begin

  5870.       ColorType := COLOR_RGBALPHA;

  5871.       PixSize   := 3;

  5872.       Alpha     := true

  5873.     end;

  5874.   else

  5875.     raise EglBitmapUnsupportedFormat.Create(Format);

  5876.   end;

  5877. 

  5878.   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);

  5879.   try

  5880.     // Copy ImageData

  5881.     pSource := Data;

  5882.     for Y := 0 to Height -1 do begin

  5883.       pDest := png.ScanLine[Y];

  5884.       for X := 0 to Width -1 do begin

  5885.         Move(pSource^, pDest^, PixSize);

  5886.         Inc(pDest, PixSize);

  5887.         Inc(pSource, PixSize);

  5888.         if Alpha then begin

  5889.           png.AlphaScanline[Y]^[X] := pSource^;

  5890.           Inc(pSource);

  5891.         end;

  5892.       end;

  5893. 

  5894.       // convert RGB line to BGR

  5895.       if Format in [tfRGB8, tfRGBA8] then begin

  5896.         pTemp := png.ScanLine[Y];

  5897.         for X := 0 to Width -1 do begin

  5898.           Temp := pByteArray(pTemp)^[0];

  5899.           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];

  5900.           pByteArray(pTemp)^[2] := Temp;

  5901.           Inc(pTemp, 3);

  5902.         end;

  5903.       end;

  5904.     end;

  5905. 

  5906.     // Save to Stream

  5907.     Png.CompressionLevel := 6;

  5908.     Png.SaveToStream(aStream);

  5909.   finally

  5910.     FreeAndNil(Png);

  5911.   end;

  5912. end;

  5913. {$IFEND}

  5914. {$ENDIF}

  5915. 

  5916. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5917. //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5918. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5919. {$IFDEF GLB_LIB_JPEG}

  5920. type

  5921.   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;

  5922.   glBitmap_libJPEG_source_mgr = record

  5923.     pub: jpeg_source_mgr;

  5924. 

  5925.     SrcStream: TStream;

  5926.     SrcBuffer: array [1..4096] of byte;

  5927.   end;

  5928. 

  5929.   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;

  5930.   glBitmap_libJPEG_dest_mgr = record

  5931.     pub: jpeg_destination_mgr;

  5932. 

  5933.     DestStream: TStream;

  5934.     DestBuffer: array [1..4096] of byte;

  5935.   end;

  5936. 

  5937. procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;

  5938. begin

  5939.   //DUMMY

  5940. end;

  5941. 

  5942. 

  5943. procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;

  5944. begin

  5945.   //DUMMY

  5946. end;

  5947. 

  5948. 

  5949. procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;

  5950. begin

  5951.   //DUMMY

  5952. end;

  5953. 

  5954. procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;

  5955. begin

  5956.   //DUMMY

  5957. end;

  5958. 

  5959. 

  5960. procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;

  5961. begin

  5962.   //DUMMY

  5963. end;

  5964. 

  5965. 

  5966. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5967. function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;

  5968. var

  5969.   src: glBitmap_libJPEG_source_mgr_ptr;

  5970.   bytes: integer;

  5971. begin

  5972.   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);

  5973. 

  5974.   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);

  5975. 	if (bytes <= 0) then begin

  5976. 		src^.SrcBuffer[1] := $FF;

  5977. 		src^.SrcBuffer[2] := JPEG_EOI;

  5978. 		bytes := 2;

  5979. 	end;

  5980. 

  5981. 	src^.pub.next_input_byte := @(src^.SrcBuffer[1]);

  5982. 	src^.pub.bytes_in_buffer := bytes;

  5983. 

  5984.   result := true;

  5985. end;

  5986. 

  5987. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5988. procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;

  5989. var

  5990.   src: glBitmap_libJPEG_source_mgr_ptr;

  5991. begin

  5992.   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);

  5993. 

  5994.   if num_bytes > 0 then begin

  5995.     // wanted byte isn't in buffer so set stream position and read buffer

  5996.     if num_bytes > src^.pub.bytes_in_buffer then begin

  5997.       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;

  5998.       src^.pub.fill_input_buffer(cinfo);

  5999.     end else begin

  6000.       // wanted byte is in buffer so only skip

  6001.   		inc(src^.pub.next_input_byte, num_bytes);

  6002. 	  	dec(src^.pub.bytes_in_buffer, num_bytes);

  6003.     end;

  6004.   end;

  6005. end;

  6006. 

  6007. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6008. function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;

  6009. var

  6010.   dest: glBitmap_libJPEG_dest_mgr_ptr;

  6011. begin

  6012.   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);

  6013. 

  6014.   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin

  6015.     // write complete buffer

  6016.     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));

  6017. 

  6018.     // reset buffer

  6019.     dest^.pub.next_output_byte := @dest^.DestBuffer[1];

  6020.     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);

  6021.   end;

  6022. 

  6023.   result := true;

  6024. end;

  6025. 

  6026. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6027. procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;

  6028. var

  6029.   Idx: Integer;

  6030.   dest: glBitmap_libJPEG_dest_mgr_ptr;

  6031. begin

  6032.   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);

  6033. 

  6034.   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin

  6035.     // check for endblock

  6036.     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin

  6037.       // write endblock

  6038.       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);

  6039. 

  6040.       // leave

  6041.       break;

  6042.     end else

  6043.       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);

  6044.   end;

  6045. end;

  6046. {$ENDIF}

  6047. 

  6048. {$IFDEF GLB_SUPPORT_JPEG_READ}

  6049. {$IF DEFINED(GLB_SDL_IMAGE)}

  6050. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6051. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;

  6052. var

  6053.   Surface: PSDL_Surface;

  6054.   RWops: PSDL_RWops;

  6055. begin

  6056.   result := false;

  6057. 

  6058.   RWops := glBitmapCreateRWops(aStream);

  6059.   try

  6060.     if IMG_isJPG(RWops) > 0 then begin

  6061.       Surface := IMG_LoadJPG_RW(RWops);

  6062.       try

  6063.         AssignFromSurface(Surface);

  6064.         result := true;

  6065.       finally

  6066.         SDL_FreeSurface(Surface);

  6067.       end;

  6068.     end;

  6069.   finally

  6070.     SDL_FreeRW(RWops);

  6071.   end;

  6072. end;

  6073. 

  6074. {$ELSEIF DEFINED(GLB_LIB_JPEG)}

  6075. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6076. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;

  6077. var

  6078.   StreamPos: Int64;

  6079.   Temp: array[0..1]of Byte;

  6080. 

  6081.   jpeg: jpeg_decompress_struct;

  6082.   jpeg_err: jpeg_error_mgr;

  6083. 

  6084.   IntFormat: TglBitmapFormat;

  6085.   pImage: pByte;

  6086.   TempHeight, TempWidth: Integer;

  6087. 

  6088.   pTemp: pByte;

  6089.   Row: Integer;

  6090. 

  6091.   FormatDesc: TFormatDescriptor;

  6092. begin

  6093.   result := false;

  6094. 

  6095.   if not init_libJPEG then

  6096.     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');

  6097. 

  6098.   try

  6099.     // reading first two bytes to test file and set cursor back to begin

  6100.     StreamPos := aStream.Position;

  6101.     aStream.Read({%H-}Temp[0], 2);

  6102.     aStream.Position := StreamPos;

  6103. 

  6104.     // if Bitmap then read file.

  6105.     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin

  6106.       FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);

  6107.       FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);

  6108. 

  6109.       // error managment

  6110.       jpeg.err := jpeg_std_error(@jpeg_err);

  6111.       jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;

  6112.       jpeg_err.output_message := glBitmap_libJPEG_output_message;

  6113. 

  6114.       // decompression struct

  6115.       jpeg_create_decompress(@jpeg);

  6116. 

  6117.       // allocation space for streaming methods

  6118.       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));

  6119. 

  6120.       // seeting up custom functions

  6121.       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin

  6122.         pub.init_source       := glBitmap_libJPEG_init_source;

  6123.         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;

  6124.         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;

  6125.         pub.resync_to_restart := jpeg_resync_to_restart; // use default method

  6126.         pub.term_source       := glBitmap_libJPEG_term_source;

  6127. 

  6128.         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read

  6129.         pub.next_input_byte := nil;   // until buffer loaded

  6130. 

  6131.         SrcStream := aStream;

  6132.       end;

  6133. 

  6134.       // set global decoding state

  6135.       jpeg.global_state := DSTATE_START;

  6136. 

  6137.       // read header of jpeg

  6138.       jpeg_read_header(@jpeg, false);

  6139. 

  6140.       // setting output parameter

  6141.       case jpeg.jpeg_color_space of

  6142.         JCS_GRAYSCALE:

  6143.           begin

  6144.             jpeg.out_color_space := JCS_GRAYSCALE;

  6145.             IntFormat := tfLuminance8;

  6146.           end;

  6147.         else

  6148.           jpeg.out_color_space := JCS_RGB;

  6149.           IntFormat := tfRGB8;

  6150.       end;

  6151. 

  6152.       // reading image

  6153.       jpeg_start_decompress(@jpeg);

  6154. 

  6155.       TempHeight := jpeg.output_height;

  6156.       TempWidth := jpeg.output_width;

  6157. 

  6158.       FormatDesc := TFormatDescriptor.Get(IntFormat);

  6159. 

  6160.       // creating new image

  6161.       GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));

  6162.       try

  6163.         pTemp := pImage;

  6164. 

  6165.         for Row := 0 to TempHeight -1 do begin

  6166.           jpeg_read_scanlines(@jpeg, @pTemp, 1);

  6167.           Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));

  6168.         end;

  6169. 

  6170.         // finish decompression

  6171.         jpeg_finish_decompress(@jpeg);

  6172. 

  6173.         // destroy decompression

  6174.         jpeg_destroy_decompress(@jpeg);

  6175. 

  6176.         SetDataPointer(pImage, IntFormat, TempWidth, TempHeight);

  6177. 

  6178.         result := true;

  6179.       except

  6180.         FreeMem(pImage);

  6181.         raise;

  6182.       end;

  6183.     end;

  6184.   finally

  6185.     quit_libJPEG;

  6186.   end;

  6187. end;

  6188. 

  6189. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}

  6190. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6191. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;

  6192. var

  6193.   bmp: TBitmap;

  6194.   jpg: TJPEGImage;

  6195.   StreamPos: Int64;

  6196.   Temp: array[0..1]of Byte;

  6197. begin

  6198.   result := false;

  6199. 

  6200.   // reading first two bytes to test file and set cursor back to begin

  6201.   StreamPos := aStream.Position;

  6202.   aStream.Read(Temp[0], 2);

  6203.   aStream.Position := StreamPos;

  6204. 

  6205.   // if Bitmap then read file.

  6206.   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin

  6207.     bmp := TBitmap.Create;

  6208.     try

  6209.       jpg := TJPEGImage.Create;

  6210.       try

  6211.         jpg.LoadFromStream(aStream);

  6212.         bmp.Assign(jpg);

  6213.         result := AssignFromBitmap(bmp);

  6214.       finally

  6215.         jpg.Free;

  6216.       end;

  6217.     finally

  6218.       bmp.Free;

  6219.     end;

  6220.   end;

  6221. end;

  6222. {$IFEND}

  6223. {$ENDIF}

  6224. 

  6225. {$IFDEF GLB_SUPPORT_JPEG_WRITE}

  6226. {$IF DEFINED(GLB_LIB_JPEG)}

  6227. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6228. procedure TglBitmap.SaveJPEG(const aStream: TStream);

  6229. var

  6230.   jpeg: jpeg_compress_struct;

  6231.   jpeg_err: jpeg_error_mgr;

  6232.   Row: Integer;

  6233.   pTemp, pTemp2: pByte;

  6234. 

  6235.   procedure CopyRow(pDest, pSource: pByte);

  6236.   var

  6237.     X: Integer;

  6238.   begin

  6239.     for X := 0 to Width - 1 do begin

  6240.       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];

  6241.       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];

  6242.       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];

  6243.       Inc(pDest, 3);

  6244.       Inc(pSource, 3);

  6245.     end;

  6246.   end;

  6247. 

  6248. begin

  6249.   if not (ftJPEG in FormatGetSupportedFiles(Format)) then

  6250.     raise EglBitmapUnsupportedFormat.Create(Format);

  6251. 

  6252.   if not init_libJPEG then

  6253.     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');

  6254. 

  6255.   try

  6256.     FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);

  6257.     FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);

  6258. 

  6259.     // error managment

  6260.     jpeg.err := jpeg_std_error(@jpeg_err);

  6261.     jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;

  6262.     jpeg_err.output_message := glBitmap_libJPEG_output_message;

  6263. 

  6264.     // compression struct

  6265.     jpeg_create_compress(@jpeg);

  6266. 

  6267.     // allocation space for streaming methods

  6268.     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));

  6269. 

  6270.     // seeting up custom functions

  6271.     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin

  6272.       pub.init_destination    := glBitmap_libJPEG_init_destination;

  6273.       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;

  6274.       pub.term_destination    := glBitmap_libJPEG_term_destination;

  6275. 

  6276.       pub.next_output_byte  := @DestBuffer[1];

  6277.       pub.free_in_buffer    := Length(DestBuffer);

  6278. 

  6279.       DestStream := aStream;

  6280.     end;

  6281. 

  6282.     // very important state

  6283.     jpeg.global_state := CSTATE_START;

  6284.     jpeg.image_width  := Width;

  6285.     jpeg.image_height := Height;

  6286.     case Format of

  6287.       tfAlpha8, tfLuminance8: begin

  6288.         jpeg.input_components := 1;

  6289.         jpeg.in_color_space   := JCS_GRAYSCALE;

  6290.       end;

  6291.       tfRGB8, tfBGR8: begin

  6292.         jpeg.input_components := 3;

  6293.         jpeg.in_color_space   := JCS_RGB;

  6294.       end;

  6295.     end;

  6296. 

  6297.     jpeg_set_defaults(@jpeg);

  6298.     jpeg_set_quality(@jpeg, 95, true);

  6299.     jpeg_start_compress(@jpeg, true);

  6300.     pTemp := Data;

  6301. 

  6302.     if Format = tfBGR8 then

  6303.       GetMem(pTemp2, fRowSize)

  6304.     else

  6305.       pTemp2 := pTemp;

  6306. 

  6307.     try

  6308.       for Row := 0 to jpeg.image_height -1 do begin

  6309.         // prepare row

  6310.         if Format = tfBGR8 then

  6311.           CopyRow(pTemp2, pTemp)

  6312.         else

  6313.           pTemp2 := pTemp;

  6314. 

  6315.         // write row

  6316.         jpeg_write_scanlines(@jpeg, @pTemp2, 1);

  6317.         inc(pTemp, fRowSize);

  6318.       end;

  6319.     finally

  6320.       // free memory

  6321.       if Format = tfBGR8 then

  6322.         FreeMem(pTemp2);

  6323.     end;

  6324.     jpeg_finish_compress(@jpeg);

  6325.     jpeg_destroy_compress(@jpeg);

  6326.   finally

  6327.     quit_libJPEG;

  6328.   end;

  6329. end;

  6330. 

  6331. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}

  6332. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6333. procedure TglBitmap.SaveJPEG(const aStream: TStream);

  6334. var

  6335.   Bmp: TBitmap;

  6336.   Jpg: TJPEGImage;

  6337. begin

  6338.   if not (ftJPEG in FormatGetSupportedFiles(Format)) then

  6339.     raise EglBitmapUnsupportedFormat.Create(Format);

  6340. 

  6341.   Bmp := TBitmap.Create;

  6342.   try

  6343.     Jpg := TJPEGImage.Create;

  6344.     try

  6345.       AssignToBitmap(Bmp);

  6346.       if (Format in [tfAlpha8, tfLuminance8]) then begin

  6347.         Jpg.Grayscale   := true;

  6348.         Jpg.PixelFormat := jf8Bit;

  6349.       end;

  6350.       Jpg.Assign(Bmp);

  6351.       Jpg.SaveToStream(aStream);

  6352.     finally

  6353.       FreeAndNil(Jpg);

  6354.     end;

  6355.   finally

  6356.     FreeAndNil(Bmp);

  6357.   end;

  6358. end;

  6359. {$IFEND}

  6360. {$ENDIF}

  6361. 

  6362. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6363. //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6364. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6365. const

  6366.   BMP_MAGIC          = $4D42;

  6367. 

  6368.   BMP_COMP_RGB       = 0;

  6369.   BMP_COMP_RLE8      = 1;

  6370.   BMP_COMP_RLE4      = 2;

  6371.   BMP_COMP_BITFIELDS = 3;

  6372. 

  6373. type

  6374.   TBMPHeader = packed record

  6375.     bfType: Word;

  6376.     bfSize: Cardinal;

  6377.     bfReserved1: Word;

  6378.     bfReserved2: Word;

  6379.     bfOffBits: Cardinal;

  6380.   end;

  6381. 

  6382.   TBMPInfo = packed record

  6383.     biSize: Cardinal;

  6384.     biWidth: Longint;

  6385.     biHeight: Longint;

  6386.     biPlanes: Word;

  6387.     biBitCount: Word;

  6388.     biCompression: Cardinal;

  6389.     biSizeImage: Cardinal;

  6390.     biXPelsPerMeter: Longint;

  6391.     biYPelsPerMeter: Longint;

  6392.     biClrUsed: Cardinal;

  6393.     biClrImportant: Cardinal;

  6394.   end;

  6395. 

  6396. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6397. function TglBitmap.LoadBMP(const aStream: TStream): Boolean;

  6398. 

  6399.   //////////////////////////////////////////////////////////////////////////////////////////////////

  6400.   function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapColorRec): TglBitmapFormat;

  6401.   begin

  6402.     result := tfEmpty;

  6403.     aStream.Read(aInfo{%H-}, SizeOf(aInfo));

  6404.     FillChar(aMask{%H-}, SizeOf(aMask), 0);

  6405. 

  6406.     //Read Compression

  6407.     case aInfo.biCompression of

  6408.       BMP_COMP_RLE4,

  6409.       BMP_COMP_RLE8: begin

  6410.         raise EglBitmapException.Create('RLE compression is not supported');

  6411.       end;

  6412.       BMP_COMP_BITFIELDS: begin

  6413.         if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin

  6414.           aStream.Read(aMask.r, SizeOf(aMask.r));

  6415.           aStream.Read(aMask.g, SizeOf(aMask.g));

  6416.           aStream.Read(aMask.b, SizeOf(aMask.b));

  6417.           aStream.Read(aMask.a, SizeOf(aMask.a));

  6418.         end else

  6419.           raise EglBitmapException.Create('Bitfields are only supported for 16bit and 32bit formats');

  6420.       end;

  6421.     end;

  6422. 

  6423.     //get suitable format

  6424.     case aInfo.biBitCount of

  6425.        8: result := tfLuminance8;

  6426.       16: result := tfBGR5;

  6427.       24: result := tfBGR8;

  6428.       32: result := tfBGRA8;

  6429.     end;

  6430.   end;

  6431. 

  6432.   function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;

  6433.   var

  6434.     i, c: Integer;

  6435.     ColorTable: TbmpColorTable;

  6436.   begin

  6437.     result := nil;

  6438.     if (aInfo.biBitCount >= 16) then

  6439.       exit;

  6440.     aFormat := tfLuminance8;

  6441.     c := aInfo.biClrUsed;

  6442.     if (c = 0) then

  6443.       c := 1 shl aInfo.biBitCount;

  6444.     SetLength(ColorTable, c);

  6445.     for i := 0 to c-1 do begin

  6446.       aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));

  6447.       if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then

  6448.         aFormat := tfRGB8;

  6449.     end;

  6450. 

  6451.     result := TbmpColorTableFormat.Create;

  6452.     result.PixelSize  := aInfo.biBitCount / 8;

  6453.     result.ColorTable := ColorTable;

  6454.     result.Range      := glBitmapColorRec($FF, $FF, $FF, $00);

  6455.   end;

  6456. 

  6457.   //////////////////////////////////////////////////////////////////////////////////////////////////

  6458.   function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;

  6459.     const aInfo: TBMPInfo): TbmpBitfieldFormat;

  6460.   var

  6461.     TmpFormat: TglBitmapFormat;

  6462.     FormatDesc: TFormatDescriptor;

  6463.   begin

  6464.     result := nil;

  6465.     if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin

  6466.       for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin

  6467.         FormatDesc := TFormatDescriptor.Get(TmpFormat);

  6468.         if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin

  6469.           aFormat := FormatDesc.Format;

  6470.           exit;

  6471.         end;

  6472.       end;

  6473. 

  6474.       if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then

  6475.         aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;

  6476.       if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then

  6477.         aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;

  6478. 

  6479.       result := TbmpBitfieldFormat.Create;

  6480.       result.PixelSize := aInfo.biBitCount / 8;

  6481.       result.RedMask   := aMask.r;

  6482.       result.GreenMask := aMask.g;

  6483.       result.BlueMask  := aMask.b;

  6484.       result.AlphaMask := aMask.a;

  6485.     end;

  6486.   end;

  6487. 

  6488. var

  6489.   //simple types

  6490.   StartPos: Int64;

  6491.   ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;

  6492.   PaddingBuff: Cardinal;

  6493.   LineBuf, ImageData, TmpData: PByte;

  6494.   SourceMD, DestMD: Pointer;

  6495.   BmpFormat: TglBitmapFormat;

  6496. 

  6497.   //records

  6498.   Mask: TglBitmapColorRec;

  6499.   Header: TBMPHeader;

  6500.   Info: TBMPInfo;

  6501. 

  6502.   //classes

  6503.   SpecialFormat: TFormatDescriptor;

  6504.   FormatDesc: TFormatDescriptor;

  6505. 

  6506.   //////////////////////////////////////////////////////////////////////////////////////////////////

  6507.   procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);

  6508.   var

  6509.     i: Integer;

  6510.     Pixel: TglBitmapPixelData;

  6511.   begin

  6512.     aStream.Read(aLineBuf^, rbLineSize);

  6513.     SpecialFormat.PreparePixel(Pixel);

  6514.     for i := 0 to Info.biWidth-1 do begin

  6515.       SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);

  6516.       glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);

  6517.       FormatDesc.Map(Pixel, aData, DestMD);

  6518.     end;

  6519.   end;

  6520. 

  6521. begin

  6522.   result        := false;

  6523.   BmpFormat     := tfEmpty;

  6524.   SpecialFormat := nil;

  6525.   LineBuf       := nil;

  6526.   SourceMD      := nil;

  6527.   DestMD        := nil;

  6528. 

  6529.   // Header

  6530.   StartPos := aStream.Position;

  6531.   aStream.Read(Header{%H-}, SizeOf(Header));

  6532. 

  6533.   if Header.bfType = BMP_MAGIC then begin

  6534.     try try

  6535.       BmpFormat        := ReadInfo(Info, Mask);

  6536.       SpecialFormat    := ReadColorTable(BmpFormat, Info);

  6537.       if not Assigned(SpecialFormat) then

  6538.         SpecialFormat  := CheckBitfields(BmpFormat, Mask, Info);

  6539.       aStream.Position := StartPos + Header.bfOffBits;

  6540. 

  6541.       if (BmpFormat <> tfEmpty) then begin

  6542.         FormatDesc := TFormatDescriptor.Get(BmpFormat);

  6543.         rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize

  6544.         wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);

  6545.         Padding    := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;

  6546. 

  6547.         //get Memory

  6548.         DestMD    := FormatDesc.CreateMappingData;

  6549.         ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));

  6550.         GetMem(ImageData, ImageSize);

  6551.         if Assigned(SpecialFormat) then begin

  6552.           GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields

  6553.           SourceMD := SpecialFormat.CreateMappingData;

  6554.         end;

  6555. 

  6556.         //read Data

  6557.         try try

  6558.           FillChar(ImageData^, ImageSize, $FF);

  6559.           TmpData := ImageData;

  6560.           if (Info.biHeight > 0) then

  6561.             Inc(TmpData, wbLineSize * (Info.biHeight-1));

  6562.           for i := 0 to Abs(Info.biHeight)-1 do begin

  6563.             if Assigned(SpecialFormat) then

  6564.               SpecialFormatReadLine(TmpData, LineBuf)  //if is special format read and convert data

  6565.             else

  6566.               aStream.Read(TmpData^, wbLineSize);   //else only read data

  6567.             if (Info.biHeight > 0) then

  6568.               dec(TmpData, wbLineSize)

  6569.             else

  6570.               inc(TmpData, wbLineSize);

  6571.             aStream.Read(PaddingBuff{%H-}, Padding);

  6572.           end;

  6573.           SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight));

  6574.           result := true;

  6575.         finally

  6576.           if Assigned(LineBuf) then

  6577.             FreeMem(LineBuf);

  6578.           if Assigned(SourceMD) then

  6579.             SpecialFormat.FreeMappingData(SourceMD);

  6580.           FormatDesc.FreeMappingData(DestMD);

  6581.         end;

  6582.         except

  6583.           FreeMem(ImageData);

  6584.           raise;

  6585.         end;

  6586.       end else

  6587.         raise EglBitmapException.Create('LoadBMP - No suitable format found');

  6588.     except

  6589.       aStream.Position := StartPos;

  6590.       raise;

  6591.     end;

  6592.     finally

  6593.       FreeAndNil(SpecialFormat);

  6594.     end;

  6595.   end

  6596.     else aStream.Position := StartPos;

  6597. end;

  6598. 

  6599. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6600. procedure TglBitmap.SaveBMP(const aStream: TStream);

  6601. var

  6602.   Header: TBMPHeader;

  6603.   Info: TBMPInfo;

  6604.   Converter: TbmpColorTableFormat;

  6605.   FormatDesc: TFormatDescriptor;

  6606.   SourceFD, DestFD: Pointer;

  6607.   pData, srcData, dstData, ConvertBuffer: pByte;

  6608. 

  6609.   Pixel: TglBitmapPixelData;

  6610.   ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;

  6611.   RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;

  6612. 

  6613.   PaddingBuff: Cardinal;

  6614. 

  6615.   function GetLineWidth : Integer;

  6616.   begin

  6617.     result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;

  6618.   end;

  6619. 

  6620. begin

  6621.   if not (ftBMP in FormatGetSupportedFiles(Format)) then

  6622.     raise EglBitmapUnsupportedFormat.Create(Format);

  6623. 

  6624.   Converter  := nil;

  6625.   FormatDesc := TFormatDescriptor.Get(Format);

  6626.   ImageSize  := FormatDesc.GetSize(Dimension);

  6627. 

  6628.   FillChar(Header{%H-}, SizeOf(Header), 0);

  6629.   Header.bfType      := BMP_MAGIC;

  6630.   Header.bfSize      := SizeOf(Header) + SizeOf(Info) + ImageSize;

  6631.   Header.bfReserved1 := 0;

  6632.   Header.bfReserved2 := 0;

  6633.   Header.bfOffBits   := SizeOf(Header) + SizeOf(Info);

  6634. 

  6635.   FillChar(Info{%H-}, SizeOf(Info), 0);

  6636.   Info.biSize        := SizeOf(Info);

  6637.   Info.biWidth       := Width;

  6638.   Info.biHeight      := Height;

  6639.   Info.biPlanes      := 1;

  6640.   Info.biCompression := BMP_COMP_RGB;

  6641.   Info.biSizeImage   := ImageSize;

  6642. 

  6643.   try

  6644.     case Format of

  6645.       tfLuminance4: begin

  6646.         Info.biBitCount  := 4;

  6647.         Header.bfSize    := Header.bfSize    + 16 * SizeOf(Cardinal);

  6648.         Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries

  6649.         Converter           := TbmpColorTableFormat.Create;

  6650.         Converter.PixelSize := 0.5;

  6651.         Converter.Format    := Format;

  6652.         Converter.Range     := glBitmapColorRec($F, $F, $F, $0);

  6653.         Converter.CreateColorTable;

  6654.       end;

  6655. 

  6656.       tfR3G3B2, tfLuminance8: begin

  6657.         Info.biBitCount  :=  8;

  6658.         Header.bfSize    := Header.bfSize    + 256 * SizeOf(Cardinal);

  6659.         Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries

  6660.         Converter           := TbmpColorTableFormat.Create;

  6661.         Converter.PixelSize := 1;

  6662.         Converter.Format    := Format;

  6663.         if (Format = tfR3G3B2) then begin

  6664.           Converter.Range := glBitmapColorRec($7, $7, $3, $0);

  6665.           Converter.Shift := glBitmapShiftRec(0, 3, 6, 0);

  6666.         end else

  6667.           Converter.Range := glBitmapColorRec($FF, $FF, $FF, $0);

  6668.         Converter.CreateColorTable;

  6669.       end;

  6670. 

  6671.       tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,

  6672.       tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin

  6673.         Info.biBitCount    := 16;

  6674.         Info.biCompression := BMP_COMP_BITFIELDS;

  6675.       end;

  6676. 

  6677.       tfBGR8, tfRGB8: begin

  6678.         Info.biBitCount := 24;

  6679.       end;

  6680. 

  6681.       tfRGB10, tfRGB10A2, tfRGBA8,

  6682.       tfBGR10, tfBGR10A2, tfBGRA8: begin

  6683.         Info.biBitCount    := 32;

  6684.         Info.biCompression := BMP_COMP_BITFIELDS;

  6685.       end;

  6686.     else

  6687.       raise EglBitmapUnsupportedFormat.Create(Format);

  6688.     end;

  6689.     Info.biXPelsPerMeter := 2835;

  6690.     Info.biYPelsPerMeter := 2835;

  6691. 

  6692.     // prepare bitmasks

  6693.     if Info.biCompression = BMP_COMP_BITFIELDS then begin

  6694.       Header.bfSize    := Header.bfSize    + 4 * SizeOf(Cardinal);

  6695.       Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);

  6696. 

  6697.       RedMask    := FormatDesc.RedMask;

  6698.       GreenMask  := FormatDesc.GreenMask;

  6699.       BlueMask   := FormatDesc.BlueMask;

  6700.       AlphaMask  := FormatDesc.AlphaMask;

  6701.     end;

  6702. 

  6703.     // headers

  6704.     aStream.Write(Header, SizeOf(Header));

  6705.     aStream.Write(Info, SizeOf(Info));

  6706. 

  6707.     // colortable

  6708.     if Assigned(Converter) then

  6709.       aStream.Write(Converter.ColorTable[0].b,

  6710.         SizeOf(TbmpColorTableEnty) * Length(Converter.ColorTable));

  6711. 

  6712.     // bitmasks

  6713.     if Info.biCompression = BMP_COMP_BITFIELDS then begin

  6714.       aStream.Write(RedMask,   SizeOf(Cardinal));

  6715.       aStream.Write(GreenMask, SizeOf(Cardinal));

  6716.       aStream.Write(BlueMask,  SizeOf(Cardinal));

  6717.       aStream.Write(AlphaMask, SizeOf(Cardinal));

  6718.     end;

  6719. 

  6720.     // image data

  6721.     rbLineSize  := Round(Info.biWidth * FormatDesc.PixelSize);

  6722.     wbLineSize  := Round(Info.biWidth * Info.biBitCount / 8);

  6723.     Padding     := GetLineWidth - wbLineSize;

  6724.     PaddingBuff := 0;

  6725. 

  6726.     pData := Data;

  6727.     inc(pData, (Height-1) * rbLineSize);

  6728. 

  6729.     // prepare row buffer. But only for RGB because RGBA supports color masks

  6730.     // so it's possible to change color within the image.

  6731.     if Assigned(Converter) then begin

  6732.       FormatDesc.PreparePixel(Pixel);

  6733.       GetMem(ConvertBuffer, wbLineSize);

  6734.       SourceFD := FormatDesc.CreateMappingData;

  6735.       DestFD   := Converter.CreateMappingData;

  6736.     end else

  6737.       ConvertBuffer := nil;

  6738. 

  6739.     try

  6740.       for LineIdx := 0 to Height - 1 do begin

  6741.         // preparing row

  6742.         if Assigned(Converter) then begin

  6743.           srcData := pData;

  6744.           dstData := ConvertBuffer;

  6745.           for PixelIdx := 0 to Info.biWidth-1 do begin

  6746.             FormatDesc.Unmap(srcData, Pixel, SourceFD);

  6747.             glBitmapConvertPixel(Pixel, FormatDesc, Converter);

  6748.             Converter.Map(Pixel, dstData, DestFD);

  6749.           end;

  6750.           aStream.Write(ConvertBuffer^, wbLineSize);

  6751.         end else begin

  6752.           aStream.Write(pData^, rbLineSize);

  6753.         end;

  6754.         dec(pData, rbLineSize);

  6755.         if (Padding > 0) then

  6756.           aStream.Write(PaddingBuff, Padding);

  6757.       end;

  6758.     finally

  6759.       // destroy row buffer

  6760.       if Assigned(ConvertBuffer) then begin

  6761.         FormatDesc.FreeMappingData(SourceFD);

  6762.         Converter.FreeMappingData(DestFD);

  6763.         FreeMem(ConvertBuffer);

  6764.       end;

  6765.     end;

  6766.   finally

  6767.     if Assigned(Converter) then

  6768.       Converter.Free;

  6769.   end;

  6770. end;

  6771. 

  6772. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6773. //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6774. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6775. type

  6776.   TTGAHeader = packed record

  6777.     ImageID: Byte;

  6778.     ColorMapType: Byte;

  6779.     ImageType: Byte;

  6780.     //ColorMapSpec: Array[0..4] of Byte;

  6781.     ColorMapStart: Word;

  6782.     ColorMapLength: Word;

  6783.     ColorMapEntrySize: Byte;

  6784.     OrigX: Word;

  6785.     OrigY: Word;

  6786.     Width: Word;

  6787.     Height: Word;

  6788.     Bpp: Byte;

  6789.     ImageDesc: Byte;

  6790.   end;

  6791. 

  6792. const

  6793.   TGA_UNCOMPRESSED_RGB  =  2;

  6794.   TGA_UNCOMPRESSED_GRAY =  3;

  6795.   TGA_COMPRESSED_RGB    = 10;

  6796.   TGA_COMPRESSED_GRAY   = 11;

  6797. 

  6798.   TGA_NONE_COLOR_TABLE  = 0;

  6799. 

  6800. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6801. function TglBitmap.LoadTGA(const aStream: TStream): Boolean;

  6802. var

  6803.   Header: TTGAHeader;

  6804.   ImageData: System.PByte;

  6805.   StartPosition: Int64;

  6806.   PixelSize, LineSize: Integer;

  6807.   tgaFormat: TglBitmapFormat;

  6808.   FormatDesc: TFormatDescriptor;

  6809.   Counter: packed record

  6810.     X, Y: packed record

  6811.       low, high, dir: Integer;

  6812.     end;

  6813.   end;

  6814. 

  6815. const

  6816.   CACHE_SIZE = $4000;

  6817. 

  6818.   ////////////////////////////////////////////////////////////////////////////////////////

  6819.   procedure ReadUncompressed;

  6820.   var

  6821.     i, j: Integer;

  6822.     buf, tmp1, tmp2: System.PByte;

  6823.   begin

  6824.     buf := nil;

  6825.     if (Counter.X.dir < 0) then

  6826.       GetMem(buf, LineSize);

  6827.     try

  6828.       while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin

  6829.         tmp1 := ImageData;

  6830.         inc(tmp1, (Counter.Y.low * LineSize));          //pointer to LineStart

  6831.         if (Counter.X.dir < 0) then begin               //flip X

  6832.           aStream.Read(buf^, LineSize);

  6833.           tmp2 := buf;

  6834.           inc(tmp2, LineSize - PixelSize);              //pointer to last pixel in line

  6835.           for i := 0 to Header.Width-1 do begin         //for all pixels in line

  6836.             for j := 0 to PixelSize-1 do begin          //for all bytes in pixel

  6837.               tmp1^ := tmp2^;

  6838.               inc(tmp1);

  6839.               inc(tmp2);

  6840.             end;

  6841.             dec(tmp2, 2*PixelSize);                     //move 2 backwards, because j-loop moved 1 forward

  6842.           end;

  6843.         end else

  6844.           aStream.Read(tmp1^, LineSize);

  6845.         inc(Counter.Y.low, Counter.Y.dir);              //move to next line index

  6846.       end;

  6847.     finally

  6848.       if Assigned(buf) then

  6849.         FreeMem(buf);

  6850.     end;

  6851.   end;

  6852. 

  6853.   ////////////////////////////////////////////////////////////////////////////////////////

  6854.   procedure ReadCompressed;

  6855. 

  6856.     /////////////////////////////////////////////////////////////////

  6857.     var

  6858.       TmpData: System.PByte;

  6859.       LinePixelsRead: Integer;

  6860.     procedure CheckLine;

  6861.     begin

  6862.       if (LinePixelsRead >= Header.Width) then begin

  6863.         LinePixelsRead := 0;

  6864.         inc(Counter.Y.low, Counter.Y.dir);                //next line index

  6865.         TmpData := ImageData;

  6866.         inc(TmpData, Counter.Y.low * LineSize);           //set line

  6867.         if (Counter.X.dir < 0) then                       //if x flipped then

  6868.           inc(TmpData, LineSize - PixelSize);             //set last pixel

  6869.       end;

  6870.     end;

  6871. 

  6872.     /////////////////////////////////////////////////////////////////

  6873.     var

  6874.       Cache: PByte;

  6875.       CacheSize, CachePos: Integer;

  6876.     procedure CachedRead(out Buffer; Count: Integer);

  6877.     var

  6878.       BytesRead: Integer;

  6879.     begin

  6880.       if (CachePos + Count > CacheSize) then begin

  6881.         //if buffer overflow save non read bytes

  6882.         BytesRead := 0;

  6883.         if (CacheSize - CachePos > 0) then begin

  6884.           BytesRead := CacheSize - CachePos;

  6885.           Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);

  6886.           inc(CachePos, BytesRead);

  6887.         end;

  6888. 

  6889.         //load cache from file

  6890.         CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);

  6891.         aStream.Read(Cache^, CacheSize);

  6892.         CachePos := 0;

  6893. 

  6894.         //read rest of requested bytes

  6895.         if (Count - BytesRead > 0) then begin

  6896.           Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);

  6897.           inc(CachePos, Count - BytesRead);

  6898.         end;

  6899.       end else begin

  6900.         //if no buffer overflow just read the data

  6901.         Move(PByteArray(Cache)^[CachePos], Buffer, Count);

  6902.         inc(CachePos, Count);

  6903.       end;

  6904.     end;

  6905. 

  6906.     procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);

  6907.     begin

  6908.       case PixelSize of

  6909.         1: begin

  6910.           aBuffer^ := aData^;

  6911.           inc(aBuffer, Counter.X.dir);

  6912.         end;

  6913.         2: begin

  6914.           PWord(aBuffer)^ := PWord(aData)^;

  6915.           inc(aBuffer, 2 * Counter.X.dir);

  6916.         end;

  6917.         3: begin

  6918.           PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];

  6919.           PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];

  6920.           PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];

  6921.           inc(aBuffer, 3 * Counter.X.dir);

  6922.         end;

  6923.         4: begin

  6924.           PCardinal(aBuffer)^ := PCardinal(aData)^;

  6925.           inc(aBuffer, 4 * Counter.X.dir);

  6926.         end;

  6927.       end;

  6928.     end;

  6929. 

  6930.   var

  6931.     TotalPixelsToRead, TotalPixelsRead: Integer;

  6932.     Temp: Byte;

  6933.     buf: array [0..3] of Byte; //1 pixel is max 32bit long

  6934.     PixelRepeat: Boolean;

  6935.     PixelsToRead, PixelCount: Integer;

  6936.   begin

  6937.     CacheSize := 0;

  6938.     CachePos  := 0;

  6939. 

  6940.     TotalPixelsToRead := Header.Width * Header.Height;

  6941.     TotalPixelsRead   := 0;

  6942.     LinePixelsRead    := 0;

  6943. 

  6944.     GetMem(Cache, CACHE_SIZE);

  6945.     try

  6946.       TmpData := ImageData;

  6947.       inc(TmpData, Counter.Y.low * LineSize);           //set line

  6948.       if (Counter.X.dir < 0) then                       //if x flipped then

  6949.         inc(TmpData, LineSize - PixelSize);             //set last pixel

  6950. 

  6951.       repeat

  6952.         //read CommandByte

  6953.         CachedRead(Temp, 1);

  6954.         PixelRepeat  := (Temp and $80) > 0;

  6955.         PixelsToRead := (Temp and $7F) + 1;

  6956.         inc(TotalPixelsRead, PixelsToRead);

  6957. 

  6958.         if PixelRepeat then

  6959.           CachedRead(buf[0], PixelSize);

  6960.         while (PixelsToRead > 0) do begin

  6961.           CheckLine;

  6962.           PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF

  6963.           while (PixelCount > 0) do begin

  6964.             if not PixelRepeat then

  6965.               CachedRead(buf[0], PixelSize);

  6966.             PixelToBuffer(@buf[0], TmpData);

  6967.             inc(LinePixelsRead);

  6968.             dec(PixelsToRead);

  6969.             dec(PixelCount);

  6970.           end;

  6971.         end;

  6972.       until (TotalPixelsRead >= TotalPixelsToRead);

  6973.     finally

  6974.       FreeMem(Cache);

  6975.     end;

  6976.   end;

  6977. 

  6978.   function IsGrayFormat: Boolean;

  6979.   begin

  6980.     result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];

  6981.   end;

  6982. 

  6983. begin

  6984.   result := false;

  6985. 

  6986.   // reading header to test file and set cursor back to begin

  6987.   StartPosition := aStream.Position;

  6988.   aStream.Read(Header{%H-}, SizeOf(Header));

  6989. 

  6990.   // no colormapped files

  6991.   if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [

  6992.     TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then

  6993.   begin

  6994.     try

  6995.       if Header.ImageID <> 0 then       // skip image ID

  6996.         aStream.Position := aStream.Position + Header.ImageID;

  6997. 

  6998.       tgaFormat := tfEmpty;        

  6999.       case Header.Bpp of

  7000.          8: if IsGrayFormat then case (Header.ImageDesc and $F) of

  7001.                0: tgaFormat := tfLuminance8;

  7002.                8: tgaFormat := tfAlpha8;

  7003.             end;

  7004. 

  7005.         16: if IsGrayFormat then case (Header.ImageDesc and $F) of

  7006.                0: tgaFormat := tfLuminance16;

  7007.                8: tgaFormat := tfLuminance8Alpha8;

  7008.             end else case (Header.ImageDesc and $F) of

  7009.                0: tgaFormat := tfBGR5;

  7010.                1: tgaFormat := tfBGR5A1;

  7011.                4: tgaFormat := tfBGRA4;

  7012.             end;

  7013. 

  7014.         24: if not IsGrayFormat then case (Header.ImageDesc and $F) of

  7015.                0: tgaFormat := tfBGR8;

  7016.             end;

  7017. 

  7018.         32: if not IsGrayFormat then case (Header.ImageDesc and $F) of

  7019.                2: tgaFormat := tfBGR10A2;

  7020.                8: tgaFormat := tfBGRA8;

  7021.             end;

  7022.       end;

  7023. 

  7024.       if (tgaFormat = tfEmpty) then

  7025.         raise EglBitmapException.Create('LoadTga - unsupported format');

  7026. 

  7027.       FormatDesc := TFormatDescriptor.Get(tgaFormat);

  7028.       PixelSize  := FormatDesc.GetSize(1, 1);

  7029.       LineSize   := FormatDesc.GetSize(Header.Width, 1);

  7030. 

  7031.       GetMem(ImageData, LineSize * Header.Height);

  7032.       try

  7033.         //column direction

  7034.         if ((Header.ImageDesc and (1 shl 4)) > 0) then begin

  7035.           Counter.X.low  := Header.Height-1;;

  7036.           Counter.X.high := 0;

  7037.           Counter.X.dir  := -1;

  7038.         end else begin

  7039.           Counter.X.low  := 0;

  7040.           Counter.X.high := Header.Height-1;

  7041.           Counter.X.dir  := 1;

  7042.         end;

  7043. 

  7044.         // Row direction

  7045.         if ((Header.ImageDesc and (1 shl 5)) > 0) then begin

  7046.           Counter.Y.low  := 0;

  7047.           Counter.Y.high := Header.Height-1;

  7048.           Counter.Y.dir  := 1;

  7049.         end else begin

  7050.           Counter.Y.low  := Header.Height-1;;

  7051.           Counter.Y.high := 0;

  7052.           Counter.Y.dir  := -1;

  7053.         end;

  7054. 

  7055.         // Read Image

  7056.         case Header.ImageType of

  7057.           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:

  7058.             ReadUncompressed;

  7059.           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:

  7060.             ReadCompressed;

  7061.         end;

  7062. 

  7063.         SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height);

  7064.         result := true;

  7065.       except

  7066.         FreeMem(ImageData);

  7067.         raise;

  7068.       end;

  7069.     finally

  7070.       aStream.Position := StartPosition;

  7071.     end;

  7072.   end

  7073.     else aStream.Position := StartPosition;

  7074. end;

  7075. 

  7076. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7077. procedure TglBitmap.SaveTGA(const aStream: TStream);

  7078. var

  7079.   Header: TTGAHeader;

  7080.   LineSize, Size, x, y: Integer;

  7081.   Pixel: TglBitmapPixelData;

  7082.   LineBuf, SourceData, DestData: PByte;

  7083.   SourceMD, DestMD: Pointer;

  7084.   FormatDesc: TFormatDescriptor;

  7085.   Converter: TFormatDescriptor;

  7086. begin

  7087.   if not (ftTGA in FormatGetSupportedFiles(Format)) then

  7088.     raise EglBitmapUnsupportedFormat.Create(Format);

  7089. 

  7090.   //prepare header

  7091.   FillChar(Header{%H-}, SizeOf(Header), 0);

  7092. 

  7093.   //set ImageType

  7094.   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8,

  7095.                  tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8]) then

  7096.     Header.ImageType := TGA_UNCOMPRESSED_GRAY

  7097.   else

  7098.     Header.ImageType := TGA_UNCOMPRESSED_RGB;

  7099. 

  7100.   //set BitsPerPixel

  7101.   if (Format in [tfLuminance8, tfLuminance6Alpha2, tfLuminance4Alpha4, tfAlpha8]) then

  7102.     Header.Bpp := 8

  7103.   else if (Format in [tfLuminance16, tfLuminance12Alpha4, tfLuminance8Alpha8,

  7104.                       tfRGB5, tfBGR5, tfRGB5A1, tfBGR5A1, tfRGBA4, tfBGRA4]) then

  7105.     Header.Bpp := 16

  7106.   else if (Format in [tfBGR8, tfRGB8]) then

  7107.     Header.Bpp := 24

  7108.   else

  7109.     Header.Bpp := 32;

  7110. 

  7111.   //set AlphaBitCount

  7112.   case Format of

  7113.     tfRGB5A1, tfBGR5A1:

  7114.       Header.ImageDesc := 1 and $F;

  7115.     tfRGB10A2, tfBGR10A2:

  7116.       Header.ImageDesc := 2 and $F;

  7117.     tfRGBA4, tfBGRA4:

  7118.       Header.ImageDesc := 4 and $F;

  7119.     tfAlpha8, tfLuminance8Alpha8, tfRGBA8, tfBGRA8:

  7120.       Header.ImageDesc := 8 and $F;

  7121.   end;

  7122. 

  7123.   Header.Width     := Width;

  7124.   Header.Height    := Height;

  7125.   Header.ImageDesc := Header.ImageDesc or $20; //flip y

  7126.   aStream.Write(Header, SizeOf(Header));

  7127. 

  7128.   // convert RGB(A) to BGR(A)

  7129.   Converter  := nil;

  7130.   FormatDesc := TFormatDescriptor.Get(Format);

  7131.   Size       := FormatDesc.GetSize(Dimension);

  7132.   if Format in [tfRGB5, tfRGB5A1, tfRGBA4, tfRGB8, tfRGB10A2, tfRGBA8] then begin

  7133.     if (FormatDesc.RGBInverted = tfEmpty) then

  7134.       raise EglBitmapException.Create('inverted RGB format is empty');

  7135.     Converter := TFormatDescriptor.Get(FormatDesc.RGBInverted);

  7136.     if not glBitmapColorRecCmp(Converter.Range, FormatDesc.Range) or

  7137.        (Converter.PixelSize <> FormatDesc.PixelSize) then

  7138.       raise EglBitmapException.Create('invalid inverted RGB format');

  7139.   end;

  7140. 

  7141.   if Assigned(Converter) then begin

  7142.     LineSize := FormatDesc.GetSize(Width, 1);

  7143.     GetMem(LineBuf, LineSize);

  7144.     SourceMD := FormatDesc.CreateMappingData;

  7145.     DestMD   := Converter.CreateMappingData;

  7146.     try

  7147.       SourceData := Data;

  7148.       for y := 0 to Height-1 do begin

  7149.         DestData := LineBuf;

  7150.         for x := 0 to Width-1 do begin

  7151.           FormatDesc.Unmap(SourceData, Pixel, SourceMD);

  7152.           Converter.Map(Pixel, DestData, DestMD);

  7153.         end;

  7154.         aStream.Write(LineBuf^, LineSize);

  7155.       end;

  7156.     finally

  7157.       FreeMem(LineBuf);

  7158.       FormatDesc.FreeMappingData(SourceMD);

  7159.       FormatDesc.FreeMappingData(DestMD);

  7160.     end;

  7161.   end else

  7162.     aStream.Write(Data^, Size);

  7163. end;

  7164. 

  7165. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7166. //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7167. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7168. const

  7169.   DDS_MAGIC: Cardinal         = $20534444;

  7170. 

  7171.   // DDS_header.dwFlags

  7172.   DDSD_CAPS                   = $00000001;

  7173.   DDSD_HEIGHT                 = $00000002;

  7174.   DDSD_WIDTH                  = $00000004;

  7175.   DDSD_PIXELFORMAT            = $00001000;

  7176. 

  7177.   // DDS_header.sPixelFormat.dwFlags

  7178.   DDPF_ALPHAPIXELS            = $00000001;

  7179.   DDPF_ALPHA                  = $00000002;

  7180.   DDPF_FOURCC                 = $00000004;

  7181.   DDPF_RGB                    = $00000040;

  7182.   DDPF_LUMINANCE              = $00020000;

  7183. 

  7184.   // DDS_header.sCaps.dwCaps1

  7185.   DDSCAPS_TEXTURE             = $00001000;

  7186. 

  7187.   // DDS_header.sCaps.dwCaps2

  7188.   DDSCAPS2_CUBEMAP            = $00000200;

  7189. 

  7190.   D3DFMT_DXT1                 = $31545844;

  7191.   D3DFMT_DXT3                 = $33545844;

  7192.   D3DFMT_DXT5                 = $35545844;

  7193. 

  7194. type

  7195.   TDDSPixelFormat = packed record

  7196.     dwSize: Cardinal;

  7197.     dwFlags: Cardinal;

  7198.     dwFourCC: Cardinal;

  7199.     dwRGBBitCount: Cardinal;

  7200.     dwRBitMask: Cardinal;

  7201.     dwGBitMask: Cardinal;

  7202.     dwBBitMask: Cardinal;

  7203.     dwABitMask: Cardinal;

  7204.   end;

  7205. 

  7206.   TDDSCaps = packed record

  7207.     dwCaps1: Cardinal;

  7208.     dwCaps2: Cardinal;

  7209.     dwDDSX: Cardinal;

  7210.     dwReserved: Cardinal;

  7211.   end;

  7212. 

  7213.   TDDSHeader = packed record

  7214.     dwSize: Cardinal;

  7215.     dwFlags: Cardinal;

  7216.     dwHeight: Cardinal;

  7217.     dwWidth: Cardinal;

  7218.     dwPitchOrLinearSize: Cardinal;

  7219.     dwDepth: Cardinal;

  7220.     dwMipMapCount: Cardinal;

  7221.     dwReserved: array[0..10] of Cardinal;

  7222.     PixelFormat: TDDSPixelFormat;

  7223.     Caps: TDDSCaps;

  7224.     dwReserved2: Cardinal;

  7225.   end;

  7226. 

  7227. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7228. function TglBitmap.LoadDDS(const aStream: TStream): Boolean;

  7229. var

  7230.   Header: TDDSHeader;

  7231.   Converter: TbmpBitfieldFormat;

  7232. 

  7233.   function GetDDSFormat: TglBitmapFormat;

  7234.   var

  7235.     fd: TFormatDescriptor;

  7236.     i: Integer;

  7237.     Range: TglBitmapColorRec;

  7238.     match: Boolean;

  7239.   begin

  7240.     result := tfEmpty;

  7241.     with Header.PixelFormat do begin

  7242.       // Compresses

  7243.       if ((dwFlags and DDPF_FOURCC) > 0) then begin

  7244.         case Header.PixelFormat.dwFourCC of

  7245.           D3DFMT_DXT1: result := tfS3tcDtx1RGBA;

  7246.           D3DFMT_DXT3: result := tfS3tcDtx3RGBA;

  7247.           D3DFMT_DXT5: result := tfS3tcDtx5RGBA;

  7248.         end;

  7249.       end else if ((Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0) then begin

  7250. 

  7251.         //find matching format

  7252.         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin

  7253.           fd := TFormatDescriptor.Get(result);

  7254.           if fd.MaskMatch(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask) and

  7255.              (8 * fd.PixelSize = dwRGBBitCount) then

  7256.             exit;

  7257.         end;

  7258. 

  7259.         //find format with same Range

  7260.         Range.r := dwRBitMask;

  7261.         Range.g := dwGBitMask;

  7262.         Range.b := dwBBitMask;

  7263.         Range.a := dwABitMask;

  7264.         for i := 0 to 3 do begin

  7265.           while ((Range.arr[i] and 1) = 0) and (Range.arr[i] > 0) do

  7266.             Range.arr[i] := Range.arr[i] shr 1;

  7267.         end;

  7268.         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin

  7269.           fd := TFormatDescriptor.Get(result);

  7270.           match := true;

  7271.           for i := 0 to 3 do

  7272.             if (fd.Range.arr[i] <> Range.arr[i]) then begin

  7273.               match := false;

  7274.               break;

  7275.             end;

  7276.           if match then

  7277.             break;

  7278.         end;

  7279. 

  7280.         //no format with same range found -> use default

  7281.         if (result = tfEmpty) then begin

  7282.           if (dwABitMask > 0) then

  7283.             result := tfBGRA8

  7284.           else

  7285.             result := tfBGR8;

  7286.         end;

  7287. 

  7288.         Converter := TbmpBitfieldFormat.Create;

  7289.         Converter.RedMask   := dwRBitMask;

  7290.         Converter.GreenMask := dwGBitMask;

  7291.         Converter.BlueMask  := dwBBitMask;

  7292.         Converter.AlphaMask := dwABitMask;

  7293.         Converter.PixelSize := dwRGBBitCount / 8;

  7294.       end;

  7295.     end;

  7296.   end;

  7297. 

  7298. var

  7299.   StreamPos: Int64;

  7300.   x, y, LineSize, RowSize, Magic: Cardinal;

  7301.   NewImage, TmpData, RowData, SrcData: System.PByte;

  7302.   SourceMD, DestMD: Pointer;

  7303.   Pixel: TglBitmapPixelData;

  7304.   ddsFormat: TglBitmapFormat;

  7305.   FormatDesc: TFormatDescriptor;

  7306. 

  7307. begin

  7308.   result    := false;

  7309.   Converter := nil;

  7310.   StreamPos := aStream.Position;

  7311. 

  7312.   // Magic

  7313.   aStream.Read(Magic{%H-}, sizeof(Magic));

  7314.   if (Magic <> DDS_MAGIC) then begin

  7315.     aStream.Position := StreamPos;

  7316.     exit;

  7317.   end;

  7318. 

  7319.   //Header

  7320.   aStream.Read(Header{%H-}, sizeof(Header));

  7321.   if (Header.dwSize <> SizeOf(Header)) or

  7322.      ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>

  7323.         (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then

  7324.   begin

  7325.     aStream.Position := StreamPos;

  7326.     exit;

  7327.   end;

  7328. 

  7329.   if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then

  7330.     raise EglBitmapException.Create('LoadDDS - CubeMaps are not supported');

  7331. 

  7332.   ddsFormat := GetDDSFormat;

  7333.   try

  7334.     if (ddsFormat = tfEmpty) then

  7335.       raise EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');

  7336. 

  7337.     FormatDesc := TFormatDescriptor.Get(ddsFormat);

  7338.     LineSize   := Trunc(Header.dwWidth * FormatDesc.PixelSize);

  7339.     GetMem(NewImage, Header.dwHeight * LineSize);

  7340.     try

  7341.       TmpData := NewImage;

  7342. 

  7343.       //Converter needed

  7344.       if Assigned(Converter) then begin

  7345.         RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);

  7346.         GetMem(RowData, RowSize);

  7347.         SourceMD := Converter.CreateMappingData;

  7348.         DestMD   := FormatDesc.CreateMappingData;

  7349.         try

  7350.           for y := 0 to Header.dwHeight-1 do begin

  7351.             TmpData := NewImage;

  7352.             inc(TmpData, y * LineSize);

  7353.             SrcData := RowData;

  7354.             aStream.Read(SrcData^, RowSize);

  7355.             for x := 0 to Header.dwWidth-1 do begin

  7356.               Converter.Unmap(SrcData, Pixel, SourceMD);

  7357.               glBitmapConvertPixel(Pixel, Converter, FormatDesc);

  7358.               FormatDesc.Map(Pixel, TmpData, DestMD);

  7359.             end;

  7360.           end;

  7361.         finally

  7362.           Converter.FreeMappingData(SourceMD);

  7363.           FormatDesc.FreeMappingData(DestMD);

  7364.           FreeMem(RowData);

  7365.         end;

  7366.       end else

  7367. 

  7368.       // Compressed

  7369.       if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin

  7370.         RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;

  7371.         for Y := 0 to Header.dwHeight-1 do begin

  7372.           aStream.Read(TmpData^, RowSize);

  7373.           Inc(TmpData, LineSize);

  7374.         end;

  7375.       end else

  7376. 

  7377.       // Uncompressed

  7378.       if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin

  7379.         RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;

  7380.         for Y := 0 to Header.dwHeight-1 do begin

  7381.           aStream.Read(TmpData^, RowSize);

  7382.           Inc(TmpData, LineSize);

  7383.         end;

  7384.       end else

  7385.         raise EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');

  7386. 

  7387.       SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight);

  7388.       result := true;

  7389.     except

  7390.       FreeMem(NewImage);

  7391.       raise;

  7392.     end;

  7393.   finally

  7394.     FreeAndNil(Converter);

  7395.   end;

  7396. end;

  7397. 

  7398. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7399. procedure TglBitmap.SaveDDS(const aStream: TStream);

  7400. var

  7401.   Header: TDDSHeader;

  7402.   FormatDesc: TFormatDescriptor;

  7403. begin

  7404.   if not (ftDDS in FormatGetSupportedFiles(Format)) then

  7405.     raise EglBitmapUnsupportedFormat.Create(Format);

  7406. 

  7407.   FormatDesc := TFormatDescriptor.Get(Format);

  7408. 

  7409.   // Generell

  7410.   FillChar(Header{%H-}, SizeOf(Header), 0);

  7411.   Header.dwSize  := SizeOf(Header);

  7412.   Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;

  7413. 

  7414.   Header.dwWidth  := Max(1, Width);

  7415.   Header.dwHeight := Max(1, Height);

  7416. 

  7417.   // Caps

  7418.   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;

  7419. 

  7420.   // Pixelformat

  7421.   Header.PixelFormat.dwSize := sizeof(Header);

  7422.   if (FormatDesc.IsCompressed) then begin

  7423.     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;

  7424.     case Format of

  7425.       tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;

  7426.       tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;

  7427.       tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;

  7428.     end;

  7429.   end else if (Format in [tfAlpha8, tfAlpha16]) then begin

  7430.     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_ALPHA;

  7431.     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);

  7432.     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;

  7433.   end else if (FormatDesc.RedMask = FormatDesc.GreenMask) and (FormatDesc.GreenMask = FormatDesc.BlueMask) then begin

  7434.     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;

  7435.     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);

  7436.     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;

  7437.     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;

  7438.   end else begin

  7439.     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;

  7440.     Header.PixelFormat.dwRGBBitCount := Round(FormatDesc.PixelSize * 8);

  7441.     Header.PixelFormat.dwRBitMask    := FormatDesc.RedMask;

  7442.     Header.PixelFormat.dwGBitMask    := FormatDesc.GreenMask;

  7443.     Header.PixelFormat.dwBBitMask    := FormatDesc.BlueMask;

  7444.     Header.PixelFormat.dwABitMask    := FormatDesc.AlphaMask;

  7445.   end;

  7446. 

  7447.   if (FormatDesc.HasAlpha) then

  7448.     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;

  7449. 

  7450.   aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));

  7451.   aStream.Write(Header, SizeOf(Header));

  7452.   aStream.Write(Data^, FormatDesc.GetSize(Dimension));

  7453. end;

  7454. 

  7455. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7456. //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7457. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7458. function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;

  7459. begin

  7460.   if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then

  7461.     result := fLines[aIndex]

  7462.   else

  7463.     result := nil;

  7464. end;

  7465. 

  7466. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7467. procedure TglBitmap2D.SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;

  7468.   const aWidth: Integer; const aHeight: Integer);

  7469. var

  7470.   Idx, LineWidth: Integer;

  7471. begin

  7472.   inherited SetDataPointer(aData, aFormat, aWidth, aHeight);

  7473. 

  7474.   if not TFormatDescriptor.Get(aFormat).IsCompressed then begin

  7475.     // Assigning Data

  7476.     if Assigned(Data) then begin

  7477.       SetLength(fLines, GetHeight);

  7478.       LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);

  7479. 

  7480.       for Idx := 0 to GetHeight-1 do begin

  7481.         fLines[Idx] := Data;

  7482.         Inc(fLines[Idx], Idx * LineWidth);

  7483.       end;

  7484.     end

  7485.       else SetLength(fLines, 0);

  7486.   end else begin

  7487.     SetLength(fLines, 0);

  7488.   end;

  7489. end;

  7490. 

  7491. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  7493. var

  7494.   FormatDesc: TFormatDescriptor;

  7495. begin

  7496.   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);

  7497. 

  7498.   FormatDesc := TFormatDescriptor.Get(Format);

  7499.   if FormatDesc.IsCompressed then begin

  7500.     glCompressedTexImage2D(Target, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)

  7501.   end else if aBuildWithGlu then begin

  7502.     gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,

  7503.       FormatDesc.glFormat, FormatDesc.glDataFormat, Data)

  7504.   end else begin

  7505.     glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,

  7506.       FormatDesc.glFormat, FormatDesc.glDataFormat, Data);

  7507.   end;

  7508. 

  7509.   // Freigeben

  7510.   if (FreeDataAfterGenTexture) then

  7511.     FreeData;

  7512. end;

  7513. 

  7514. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7515. procedure TglBitmap2D.AfterConstruction;

  7516. begin

  7517.   inherited;

  7518.   Target := GL_TEXTURE_2D;

  7519. end;

  7520. 

  7521. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  7523. var

  7524.   Temp: pByte;

  7525.   Size, w, h: Integer;

  7526.   FormatDesc: TFormatDescriptor;

  7527. begin

  7528.   FormatDesc := TFormatDescriptor.Get(Format);

  7529.   if FormatDesc.IsCompressed then

  7530.     raise EglBitmapUnsupportedFormat.Create(Format);

  7531. 

  7532.   w    := aRight  - aLeft;

  7533.   h    := aBottom - aTop;

  7534.   Size := FormatDesc.GetSize(w, h);

  7535.   GetMem(Temp, Size);

  7536.   try

  7537.     glPixelStorei(GL_PACK_ALIGNMENT, 1);

  7538.     glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);

  7539.     SetDataPointer(Temp, Format, w, h);

  7540.     FlipVert;

  7541.   except

  7542.     FreeMem(Temp);

  7543.     raise;

  7544.   end;

  7545. end;

  7546. 

  7547. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7548. procedure TglBitmap2D.GetDataFromTexture;

  7549. var

  7550.   Temp: PByte;

  7551.   TempWidth, TempHeight: Integer;

  7552.   TempIntFormat: Cardinal;

  7553.   IntFormat, f: TglBitmapFormat;

  7554.   FormatDesc: TFormatDescriptor;

  7555. begin

  7556.   Bind;

  7557. 

  7558.   // Request Data

  7559.   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH,           @TempWidth);

  7560.   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT,          @TempHeight);

  7561.   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);

  7562. 

  7563.   IntFormat := tfEmpty;

  7564.   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin

  7565.     FormatDesc := TFormatDescriptor.Get(f);

  7566.     if (FormatDesc.glInternalFormat = TempIntFormat) then begin

  7567.       IntFormat := FormatDesc.Format;

  7568.       break;

  7569.     end;

  7570.   end;

  7571. 

  7572.   // Getting data from OpenGL

  7573.   FormatDesc := TFormatDescriptor.Get(IntFormat);

  7574.   GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));

  7575.   try

  7576.     if FormatDesc.IsCompressed then

  7577.       glGetCompressedTexImage(Target, 0, Temp)

  7578.     else

  7579.      glGetTexImage(Target, 0, FormatDesc.glInternalFormat, FormatDesc.glDataFormat, Temp);

  7580.     SetDataPointer(Temp, IntFormat, TempWidth, TempHeight);

  7581.   except

  7582.     FreeMem(Temp);

  7583.     raise;

  7584.   end;

  7585. end;

  7586. 

  7587. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7588. procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);

  7589. var

  7590.   BuildWithGlu, PotTex, TexRec: Boolean;

  7591.   TexSize: Integer;

  7592. begin

  7593.   if Assigned(Data) then begin

  7594.     // Check Texture Size

  7595.     if (aTestTextureSize) then begin

  7596.       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);

  7597. 

  7598.       if ((Height > TexSize) or (Width > TexSize)) then

  7599.         raise EglBitmapSizeToLargeException.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');

  7600. 

  7601.       PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);

  7602.       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);

  7603. 

  7604.       if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then

  7605.         raise EglBitmapNonPowerOfTwoException.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');

  7606.     end;

  7607. 

  7608.     CreateId;

  7609.     SetupParameters(BuildWithGlu);

  7610.     UploadData(Target, BuildWithGlu);

  7611.     glAreTexturesResident(1, @fID, @fIsResident);

  7612.   end;

  7613. end;

  7614. 

  7615. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7616. function TglBitmap2D.FlipHorz: Boolean;

  7617. var

  7618.   Col, Row: Integer;

  7619.   TempDestData, DestData, SourceData: PByte;

  7620.   ImgSize: Integer;

  7621. begin

  7622.   result := inherited FlipHorz;

  7623.   if Assigned(Data) then begin

  7624.     SourceData := Data;

  7625.     ImgSize := Height * fRowSize;

  7626.     GetMem(DestData, ImgSize);

  7627.     try

  7628.       TempDestData := DestData;

  7629.       Dec(TempDestData, fRowSize + fPixelSize);

  7630.       for Row := 0 to Height -1 do begin

  7631.         Inc(TempDestData, fRowSize * 2);

  7632.         for Col := 0 to Width -1 do begin

  7633.           Move(SourceData^, TempDestData^, fPixelSize);

  7634.           Inc(SourceData, fPixelSize);

  7635.           Dec(TempDestData, fPixelSize);

  7636.         end;

  7637.       end;

  7638.       SetDataPointer(DestData, Format);

  7639.       result := true;

  7640.     except

  7641.       FreeMem(DestData);

  7642.       raise;

  7643.     end;

  7644.   end;

  7645. end;

  7646. 

  7647. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7648. function TglBitmap2D.FlipVert: Boolean;

  7649. var

  7650.   Row: Integer;

  7651.   TempDestData, DestData, SourceData: PByte;

  7652. begin

  7653.   result := inherited FlipVert;

  7654.   if Assigned(Data) then begin

  7655.     SourceData := Data;

  7656.     GetMem(DestData, Height * fRowSize);

  7657.     try

  7658.       TempDestData := DestData;

  7659.       Inc(TempDestData, Width * (Height -1) * fPixelSize);

  7660.       for Row := 0 to Height -1 do begin

  7661.         Move(SourceData^, TempDestData^, fRowSize);

  7662.         Dec(TempDestData, fRowSize);

  7663.         Inc(SourceData, fRowSize);

  7664.       end;

  7665.       SetDataPointer(DestData, Format);

  7666.       result := true;

  7667.     except

  7668.       FreeMem(DestData);

  7669.       raise;

  7670.     end;

  7671.   end;

  7672. end;

  7673. 

  7674. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7675. //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7676. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7677. type

  7678.   TMatrixItem = record

  7679.     X, Y: Integer;

  7680.     W: Single;

  7681.   end;

  7682. 

  7683.   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;

  7684.   TglBitmapToNormalMapRec = Record

  7685.     Scale: Single;

  7686.     Heights: array of Single;

  7687.     MatrixU : array of TMatrixItem;

  7688.     MatrixV : array of TMatrixItem;

  7689.   end;

  7690. 

  7691. const

  7692.   ONE_OVER_255 = 1 / 255;

  7693. 

  7694.   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7695. procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);

  7696. var

  7697.   Val: Single;

  7698. begin

  7699.   with FuncRec do begin

  7700.     Val :=

  7701.       Source.Data.r * LUMINANCE_WEIGHT_R +

  7702.       Source.Data.g * LUMINANCE_WEIGHT_G +

  7703.       Source.Data.b * LUMINANCE_WEIGHT_B;

  7704.     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;

  7705.   end;

  7706. end;

  7707. 

  7708. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7709. procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);

  7710. begin

  7711.   with FuncRec do

  7712.     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;

  7713. end;

  7714. 

  7715. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7716. procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);

  7717. type

  7718.   TVec = Array[0..2] of Single;

  7719. var

  7720.   Idx: Integer;

  7721.   du, dv: Double;

  7722.   Len: Single;

  7723.   Vec: TVec;

  7724. 

  7725.   function GetHeight(X, Y: Integer): Single;

  7726.   begin

  7727.     with FuncRec do begin

  7728.       X := Max(0, Min(Size.X -1, X));

  7729.       Y := Max(0, Min(Size.Y -1, Y));

  7730.       result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];

  7731.     end;

  7732.   end;

  7733. 

  7734. begin

  7735.   with FuncRec do begin

  7736.     with PglBitmapToNormalMapRec(Args)^ do begin

  7737.       du := 0;

  7738.       for Idx := Low(MatrixU) to High(MatrixU) do

  7739.         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;

  7740. 

  7741.       dv := 0;

  7742.       for Idx := Low(MatrixU) to High(MatrixU) do

  7743.         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;

  7744. 

  7745.       Vec[0] := -du * Scale;

  7746.       Vec[1] := -dv * Scale;

  7747.       Vec[2] := 1;

  7748.     end;

  7749. 

  7750.     // Normalize

  7751.     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));

  7752.     if Len <> 0 then begin

  7753.       Vec[0] := Vec[0] * Len;

  7754.       Vec[1] := Vec[1] * Len;

  7755.       Vec[2] := Vec[2] * Len;

  7756.     end;

  7757. 

  7758.     // Farbe zuweisem

  7759.     Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);

  7760.     Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);

  7761.     Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);

  7762.   end;

  7763. end;

  7764. 

  7765. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7766. procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);

  7767. var

  7768.   Rec: TglBitmapToNormalMapRec;

  7769. 

  7770.   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);

  7771.   begin

  7772.     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin

  7773.       Matrix[Index].X := X;

  7774.       Matrix[Index].Y := Y;

  7775.       Matrix[Index].W := W;

  7776.     end;

  7777.   end;

  7778. 

  7779. begin

  7780.   if TFormatDescriptor.Get(Format).IsCompressed then

  7781.     raise EglBitmapUnsupportedFormat.Create(Format);

  7782. 

  7783.   if aScale > 100 then

  7784.     Rec.Scale := 100

  7785.   else if aScale < -100 then

  7786.     Rec.Scale := -100

  7787.   else

  7788.     Rec.Scale := aScale;

  7789. 

  7790.   SetLength(Rec.Heights, Width * Height);

  7791.   try

  7792.     case aFunc of

  7793.       nm4Samples: begin

  7794.         SetLength(Rec.MatrixU, 2);

  7795.         SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);

  7796.         SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);

  7797. 

  7798.         SetLength(Rec.MatrixV, 2);

  7799.         SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);

  7800.         SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);

  7801.       end;

  7802. 

  7803.       nmSobel: begin

  7804.         SetLength(Rec.MatrixU, 6);

  7805.         SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);

  7806.         SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);

  7807.         SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);

  7808.         SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);

  7809.         SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);

  7810.         SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);

  7811. 

  7812.         SetLength(Rec.MatrixV, 6);

  7813.         SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);

  7814.         SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);

  7815.         SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);

  7816.         SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);

  7817.         SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);

  7818.         SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);

  7819.       end;

  7820. 

  7821.       nm3x3: begin

  7822.         SetLength(Rec.MatrixU, 6);

  7823.         SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);

  7824.         SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);

  7825.         SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);

  7826.         SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);

  7827.         SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);

  7828.         SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);

  7829. 

  7830.         SetLength(Rec.MatrixV, 6);

  7831.         SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);

  7832.         SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);

  7833.         SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);

  7834.         SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);

  7835.         SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);

  7836.         SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);

  7837.       end;

  7838. 

  7839.       nm5x5: begin

  7840.         SetLength(Rec.MatrixU, 20);

  7841.         SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);

  7842.         SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);

  7843.         SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);

  7844.         SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);

  7845.         SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);

  7846.         SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);

  7847.         SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);

  7848.         SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);

  7849.         SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);

  7850.         SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);

  7851.         SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);

  7852.         SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);

  7853.         SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);

  7854.         SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);

  7855.         SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);

  7856.         SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);

  7857.         SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);

  7858.         SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);

  7859.         SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);

  7860.         SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);

  7861. 

  7862.         SetLength(Rec.MatrixV, 20);

  7863.         SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);

  7864.         SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);

  7865.         SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);

  7866.         SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);

  7867.         SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);

  7868.         SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);

  7869.         SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);

  7870.         SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);

  7871.         SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);

  7872.         SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);

  7873.         SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);

  7874.         SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);

  7875.         SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);

  7876.         SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);

  7877.         SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);

  7878.         SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);

  7879.         SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);

  7880.         SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);

  7881.         SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);

  7882.         SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);

  7883.       end;

  7884.     end;

  7885. 

  7886.     // Daten Sammeln

  7887.     if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then

  7888.       AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)

  7889.     else

  7890.       AddFunc(glBitmapToNormalMapPrepareFunc, false, @Rec);

  7891.     AddFunc(glBitmapToNormalMapFunc, false, @Rec);

  7892.   finally

  7893.     SetLength(Rec.Heights, 0);

  7894.   end;

  7895. end;

  7896. 

  7897. 

  7898. 

  7899. 

  7900. 

  7901. 

  7902. 

  7903. 

  7904. 

  7905. (*

  7906. procedure TglBitmap1D.SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width, Height: Integer);

  7907. var

  7908.   pTemp: pByte;

  7909.   Size: Integer;

  7910. begin

  7911.   if Height > 1 then begin

  7912.     // extract first line of the data

  7913.     Size := FormatGetImageSize(glBitmapPosition(Width), Format);

  7914.     GetMem(pTemp, Size);

  7915. 

  7916.     Move(Data^, pTemp^, Size);

  7917. 

  7918.     FreeMem(Data);

  7919.   end else

  7920.     pTemp := Data;

  7921. 

  7922.   // set data pointer

  7923.   inherited SetDataPointer(pTemp, Format, Width);

  7924. 

  7925.   if FormatIsUncompressed(Format) then begin

  7926.     fUnmapFunc := FormatGetUnMapFunc(Format);

  7927.     fGetPixelFunc := GetPixel1DUnmap;

  7928.   end;

  7929. end;

  7930. 

  7931. 

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

  7933. var

  7934.   pTemp: pByte;

  7935. begin

  7936.   pTemp := Data;

  7937.   Inc(pTemp, Pos.X * fPixelSize);

  7938. 

  7939.   fUnmapFunc(pTemp, Pixel);

  7940. end;

  7941. 

  7942. 

  7943. function TglBitmap1D.FlipHorz: Boolean;

  7944. var

  7945.   Col: Integer;

  7946.   pTempDest, pDest, pSource: pByte;

  7947. begin

  7948.   result := inherited FlipHorz;

  7949. 

  7950.   if Assigned(Data) and FormatIsUncompressed(InternalFormat) then begin

  7951.     pSource := Data;

  7952. 

  7953.     GetMem(pDest, fRowSize);

  7954.     try

  7955.       pTempDest := pDest;

  7956. 

  7957.       Inc(pTempDest, fRowSize);

  7958.       for Col := 0 to Width -1 do begin

  7959.         Move(pSource^, pTempDest^, fPixelSize);

  7960. 

  7961.         Inc(pSource, fPixelSize);

  7962.         Dec(pTempDest, fPixelSize);

  7963.       end;

  7964. 

  7965.       SetDataPointer(pDest, InternalFormat);

  7966. 

  7967.       result := true;

  7968.     finally

  7969.       FreeMem(pDest);

  7970.     end;

  7971.   end;

  7972. end;

  7973. 

  7974. 

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

  7976. begin

  7977.   // Upload data

  7978.   if Self.InternalFormat in [ifDXT1, ifDXT3, ifDXT5] then

  7979.     glCompressedTexImage1D(Target, 0, InternalFormat, Width, 0, Trunc(Width * FormatGetSize(Self.InternalFormat)), Data)

  7980.   else

  7981. 

  7982.   // Upload data

  7983.   if BuildWithGlu then

  7984.     gluBuild1DMipmaps(Target, InternalFormat, Width, Format, Typ, Data)

  7985.   else

  7986.     glTexImage1D(Target, 0, InternalFormat, Width, 0, Format, Typ, Data);

  7987. 

  7988.   // Freigeben

  7989.   if (FreeDataAfterGenTexture) then

  7990.     FreeData;

  7991. end;

  7992. 

  7993. 

  7994. procedure TglBitmap1D.GenTexture(TestTextureSize: Boolean);

  7995. var

  7996.   BuildWithGlu, TexRec: Boolean;

  7997.   glFormat, glInternalFormat, glType: Cardinal;

  7998.   TexSize: Integer;

  7999. begin

  8000.   if Assigned(Data) then begin

  8001.     // Check Texture Size

  8002.     if (TestTextureSize) then begin

  8003.       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);

  8004. 

  8005.       if (Width > TexSize) then

  8006.         raise EglBitmapSizeToLargeException.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');

  8007. 

  8008.       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and

  8009.                 (Target = GL_TEXTURE_RECTANGLE_ARB);

  8010. 

  8011.       if not (IsPowerOfTwo (Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then

  8012.         raise EglBitmapNonPowerOfTwoException.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');

  8013.     end;

  8014. 

  8015.     CreateId;

  8016. 

  8017.     SetupParameters(BuildWithGlu);

  8018.     SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);

  8019. 

  8020.     UploadData(Target, glFormat, glInternalFormat, glType, BuildWithGlu);

  8021. 

  8022.     // Infos sammeln

  8023.     glAreTexturesResident(1, @fID, @fIsResident);

  8024.   end;

  8025. end;

  8026. 

  8027. 

  8028. procedure TglBitmap1D.AfterConstruction;

  8029. begin

  8030.   inherited;

  8031. 

  8032.   Target := GL_TEXTURE_1D;

  8033. end;

  8034. 

  8035. 

  8036. { TglBitmapCubeMap }

  8037. 

  8038. procedure TglBitmapCubeMap.AfterConstruction;

  8039. begin

  8040.   inherited;

  8041. 

  8042.   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then

  8043.     raise EglBitmapException.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');

  8044. 

  8045.   SetWrap; // set all to GL_CLAMP_TO_EDGE

  8046.   Target := GL_TEXTURE_CUBE_MAP;

  8047.   fGenMode := GL_REFLECTION_MAP;

  8048. end;

  8049. 

  8050. 

  8051. procedure TglBitmapCubeMap.Bind(EnableTexCoordsGen, EnableTextureUnit: Boolean);

  8052. begin

  8053.   inherited Bind (EnableTextureUnit);

  8054. 

  8055.   if EnableTexCoordsGen then begin

  8056.     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);

  8057.     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);

  8058.     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);

  8059.     glEnable(GL_TEXTURE_GEN_S);

  8060.     glEnable(GL_TEXTURE_GEN_T);

  8061.     glEnable(GL_TEXTURE_GEN_R);

  8062.   end;

  8063. end;

  8064. 

  8065. 

  8066. procedure TglBitmapCubeMap.GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean);

  8067. var

  8068.   glFormat, glInternalFormat, glType: Cardinal;

  8069.   BuildWithGlu: Boolean;

  8070.   TexSize: Integer;

  8071. begin

  8072.   // Check Texture Size

  8073.   if (TestTextureSize) then begin

  8074.     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);

  8075. 

  8076.     if ((Height > TexSize) or (Width > TexSize)) then

  8077.       raise EglBitmapSizeToLargeException.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');

  8078. 

  8079.     if not ((IsPowerOfTwo (Height) and IsPowerOfTwo (Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then

  8080.       raise EglBitmapNonPowerOfTwoException.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');

  8081.   end;

  8082. 

  8083.   // create Texture

  8084.   if ID = 0 then begin

  8085.     CreateID;

  8086.     SetupParameters(BuildWithGlu);

  8087.   end;

  8088. 

  8089.   SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);

  8090. 

  8091.   UploadData (CubeTarget, glFormat, glInternalFormat, glType, BuildWithGlu);

  8092. end;

  8093. 

  8094. 

  8095. procedure TglBitmapCubeMap.GenTexture(TestTextureSize: Boolean);

  8096. begin

  8097.   Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');

  8098. end;

  8099. 

  8100. 

  8101. procedure TglBitmapCubeMap.Unbind(DisableTexCoordsGen,

  8102.   DisableTextureUnit: Boolean);

  8103. begin

  8104.   inherited Unbind (DisableTextureUnit);

  8105. 

  8106.   if DisableTexCoordsGen then begin

  8107.     glDisable(GL_TEXTURE_GEN_S);

  8108.     glDisable(GL_TEXTURE_GEN_T);

  8109.     glDisable(GL_TEXTURE_GEN_R);

  8110.   end;

  8111. end;

  8112. 

  8113. 

  8114. { TglBitmapNormalMap }

  8115. 

  8116. type

  8117.   TVec = Array[0..2] of Single;

  8118.   TglBitmapNormalMapGetVectorFunc = procedure (var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);

  8119. 

  8120.   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;

  8121.   TglBitmapNormalMapRec = record

  8122.     HalfSize : Integer;

  8123.     Func: TglBitmapNormalMapGetVectorFunc;

  8124.   end;

  8125. 

  8126. 

  8127. procedure glBitmapNormalMapPosX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);

  8128. begin

  8129.   Vec[0] := HalfSize;

  8130.   Vec[1] := - (Position.Y + 0.5 - HalfSize);

  8131.   Vec[2] := - (Position.X + 0.5 - HalfSize);

  8132. end;

  8133. 

  8134. 

  8135. procedure glBitmapNormalMapNegX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);

  8136. begin

  8137.   Vec[0] := - HalfSize;

  8138.   Vec[1] := - (Position.Y + 0.5 - HalfSize);

  8139.   Vec[2] := Position.X + 0.5 - HalfSize;

  8140. end;

  8141. 

  8142. 

  8143. procedure glBitmapNormalMapPosY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);

  8144. begin

  8145.   Vec[0] := Position.X + 0.5 - HalfSize;

  8146.   Vec[1] := HalfSize;

  8147.   Vec[2] := Position.Y + 0.5 - HalfSize;

  8148. end;

  8149. 

  8150. 

  8151. procedure glBitmapNormalMapNegY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);

  8152. begin

  8153.   Vec[0] := Position.X + 0.5 - HalfSize;

  8154.   Vec[1] := - HalfSize;

  8155.   Vec[2] := - (Position.Y + 0.5 - HalfSize);

  8156. end;

  8157. 

  8158. 

  8159. procedure glBitmapNormalMapPosZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);

  8160. begin

  8161.   Vec[0] := Position.X + 0.5 - HalfSize;

  8162.   Vec[1] := - (Position.Y + 0.5 - HalfSize);

  8163.   Vec[2] := HalfSize;

  8164. end;

  8165. 

  8166. 

  8167. procedure glBitmapNormalMapNegZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);

  8168. begin

  8169.   Vec[0] := - (Position.X + 0.5 - HalfSize);

  8170.   Vec[1] := - (Position.Y + 0.5 - HalfSize);

  8171.   Vec[2] := - HalfSize;

  8172. end;

  8173. 

  8174. 

  8175. procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);

  8176. var

  8177.   Vec : TVec;

  8178.   Len: Single;

  8179. begin

  8180.   with FuncRec do begin

  8181.     with PglBitmapNormalMapRec (CustomData)^ do begin

  8182.       Func(Vec, Position, HalfSize);

  8183. 

  8184.       // Normalize

  8185.       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));

  8186.       if Len <> 0 then begin

  8187.         Vec[0] := Vec[0] * Len;

  8188.         Vec[1] := Vec[1] * Len;

  8189.         Vec[2] := Vec[2] * Len;

  8190.       end;

  8191. 

  8192.       // Scale Vector and AddVectro

  8193.       Vec[0] := Vec[0] * 0.5 + 0.5;

  8194.       Vec[1] := Vec[1] * 0.5 + 0.5;

  8195.       Vec[2] := Vec[2] * 0.5 + 0.5;

  8196.     end;

  8197. 

  8198.     // Set Color

  8199.     Dest.Red   := Round(Vec[0] * 255);

  8200.     Dest.Green := Round(Vec[1] * 255);

  8201.     Dest.Blue  := Round(Vec[2] * 255);

  8202.   end;

  8203. end;

  8204. 

  8205. 

  8206. procedure TglBitmapNormalMap.AfterConstruction;

  8207. begin

  8208.   inherited;

  8209. 

  8210.   fGenMode := GL_NORMAL_MAP;

  8211. end;

  8212. 

  8213. 

  8214. procedure TglBitmapNormalMap.GenerateNormalMap(Size: Integer;

  8215.   TestTextureSize: Boolean);

  8216. var

  8217.   Rec: TglBitmapNormalMapRec;

  8218.   SizeRec: TglBitmapPixelPosition;

  8219. begin

  8220.   Rec.HalfSize := Size div 2;

  8221. 

  8222.   FreeDataAfterGenTexture := false;

  8223. 

  8224.   SizeRec.Fields := [ffX, ffY];

  8225.   SizeRec.X := Size;

  8226.   SizeRec.Y := Size;

  8227. 

  8228.   // Positive X

  8229.   Rec.Func := glBitmapNormalMapPosX;

  8230.   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);

  8231.   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, TestTextureSize);

  8232. 

  8233.   // Negative X

  8234.   Rec.Func := glBitmapNormalMapNegX;

  8235.   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);

  8236.   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, TestTextureSize);

  8237. 

  8238.   // Positive Y

  8239.   Rec.Func := glBitmapNormalMapPosY;

  8240.   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);

  8241.   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, TestTextureSize);

  8242. 

  8243.   // Negative Y

  8244.   Rec.Func := glBitmapNormalMapNegY;

  8245.   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);

  8246.   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, TestTextureSize);

  8247. 

  8248.   // Positive Z

  8249.   Rec.Func := glBitmapNormalMapPosZ;

  8250.   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);

  8251.   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, TestTextureSize);

  8252. 

  8253.   // Negative Z

  8254.   Rec.Func := glBitmapNormalMapNegZ;

  8255.   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);

  8256.   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, TestTextureSize);

  8257. end;

  8258. *)

  8259. 

  8260. initialization

  8261.   glBitmapSetDefaultFormat(tfEmpty);

  8262.   glBitmapSetDefaultMipmap(mmMipmap);

  8263.   glBitmapSetDefaultFilter(GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);

  8264.   glBitmapSetDefaultWrap  (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);

  8265. 

  8266.   glBitmapSetDefaultFreeDataAfterGenTexture(true);

  8267.   glBitmapSetDefaultDeleteTextureOnFree    (true);

  8268. 

  8269.   TFormatDescriptor.Init;

  8270. 

  8271. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}

  8272.   OpenGLInitialized := false;

  8273.   InitOpenGLCS := TCriticalSection.Create;

  8274. {$ENDIF}

  8275. 

  8276. finalization

  8277.   TFormatDescriptor.Finalize;

  8278. 

  8279. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}

  8280.   FreeAndNil(InitOpenGLCS);

  8281. {$ENDIF}

  8282. 

  8283. end.