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

7705 líneas
251 KiB
Original Blame Histórico 

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

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

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

  4. ------------------------------------------------------------

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

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

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

  8. obtain a copy of the License at

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

  10. ------------------------------------------------------------

  11. Version 2.0.3

  12. ------------------------------------------------------------

  13. History

  14. 21-03-2010

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

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

  17.   with newer versions of Delphi.

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

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

  20. 10-08-2008

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

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

  23. 24-07-2008

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

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

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

  27.   - CustomName  (free for use string)

  28.   - CustomNameW (free for use widestring)

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

  30. 27-05-2008

  31. - RLE TGAs loaded much faster

  32. 26-05-2008

  33. - fixed some problem with reading RLE TGAs.

  34. 21-05-2008

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

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

  37. 01-05-2008

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

  39. - define GLB_NO_NATIVE_GL deactivated by default

  40. 27-04-2008

  41. - Now supports the following libraries

  42.   - SDL and SDL_image

  43.   - libPNG

  44.   - libJPEG

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

  46. - BMPs now loaded manuel

  47. - Large restructuring

  48. - Property DataPtr now has the name Data

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

  50. - Unused Depth removed

  51. - Function FreeData to freeing image data added 

  52. 24-10-2007

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

  54. 15-11-2006

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

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

  57. - Function ReadOpenGLExtension is now only intern

  58. 29-06-2006

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

  60. 26-06-2006

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

  62. 22-06-2006

  63. - Fixed some Problem with Delphi 5

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

  65. 22-03-2006

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

  67. 09-03-2006

  68. - Internal Format ifDepth8 added

  69. - function GrabScreen now supports all uncompressed formats

  70. 31-01-2006

  71. - AddAlphaFromglBitmap implemented

  72. 29-12-2005

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

  74. 28-12-2005

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

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

  77. 11-12-2005

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

  79. 19-10-2005

  80. - Added function GrabScreen to class TglBitmap2D

  81. 18-10-2005

  82. - Added support to Save images

  83. - Added function Clone to Clone Instance

  84. 11-10-2005

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

  86.   Usefull for Future

  87. - Several speed optimizations

  88. 09-10-2005

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

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

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

  92. - Some Funtions moved to Baseclass TglBitmap

  93. 06-10-2005

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

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

  96. 05-10-2005

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

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

  99. - Added Support to decompress DXT1 compressed Images.

  100. - SwapColors replaced by ConvertTo

  101. 04-10-2005

  102. - Added Support for compressed DDSs

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

  104. 29-09-2005

  105. - Parameter Components renamed to InternalFormat

  106. 23-09-2005

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

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

  109. 22-09-2005

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

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

  112. 07-09-2005

  113. - Added support for Grayscale textures

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

  115. 10-07-2005

  116. - Added support for GL_VERSION_2_0

  117. - Added support for GL_EXT_texture_filter_anisotropic

  118. 04-07-2005

  119. - Function FillWithColor fills the Image with one Color

  120. - Function LoadNormalMap added

  121. 30-06-2005

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

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

  124. 29-06-2005

  125. - support for RLE Compressed RGB TGAs added

  126. 28-06-2005

  127. - Class TglBitmapNormalMap added to support Normalmap generation

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

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

  130. 16-06-2005

  131. - Method LoadCubeMapClass removed

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

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

  134. 12-06-2005

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

  136. 10-06-2005

  137. - little enhancement for IsPowerOfTwo

  138. - TglBitmap1D.GenTexture now tests NPOT Textures

  139. 06-06-2005

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

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

  142. 03-06-2005

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

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

  145. 02-06-2005

  146. - added support for GL_ARB_texture_rectangle, GL_EXT_texture_rectangle and GL_NV_texture_rectangle

  147. 25-04-2005

  148. - Function Unbind added

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

  150. 21-04-2005

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

  152. 29-03-2005

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

  154.   To Enable png's use the define pngimage

  155. 22-03-2005

  156. - New Functioninterface added

  157. - Function GetPixel added

  158. 27-11-2004

  159. - Property BuildMipMaps renamed to MipMap

  160. 21-11-2004

  161. - property Name removed.

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

  163. 22-05-2004

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

  165. 26-11-2003

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

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

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

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

  170. 29-09-2003

  171. - property BuildMipsMaps added (default = true)

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

  173. - property FreeDataAfterGenTexture added (default = true)

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

  175. - parameter DisableOtherTextureUnits of Bind removed

  176. - parameter FreeDataAfterGeneration of GenTextures removed

  177. 12-09-2003

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

  179. 09-09-2003

  180. - Bind now enables TextureUnits (by params)

  181. - GenTextures can leave data (by param)

  182. - LoadTextures now optimal

  183. 03-09-2003

  184. - Performance optimization in AddFunc

  185. - procedure Bind moved to subclasses

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

  187. 19-08-2003

  188. - Texturefilter and texturewrap now also as defaults

  189.   Minfilter = GL_LINEAR_MIPMAP_LINEAR

  190.   Magfilter = GL_LINEAR

  191.   Wrap(str) = GL_CLAMP_TO_EDGE

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

  193. - propertys IsCompressed, TextureSize and IsResident added

  194.   IsCompressed and TextureSize only contains data from level 0

  195. 18-08-2003

  196. - Added function AddFunc to add PerPixelEffects to Image

  197. - LoadFromFunc now based on AddFunc

  198. - Invert now based on AddFunc

  199. - SwapColors now based on AddFunc

  200. 16-08-2003

  201. - Added function FlipHorz

  202. 15-08-2003

  203. - Added function LaodFromFunc to create images with function

  204. - Added function FlipVert

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

  206. 29-07-2003

  207. - Added Alphafunctions to calculate alpha per function

  208. - Added Alpha from ColorKey using alphafunctions

  209. 28-07-2003

  210. - First full functionally Version of glBitmap

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

  212. 25-07-2003

  213. - begin of programming

  214. ***********************************************************}

  215. unit glBitmap;

  216. 

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

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

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

  220. 

  221. // ###### Start of preferences ################################################

  222. 

  223. {$DEFINE GLB_NO_NATIVE_GL}

  224. // To enable the dglOpenGL.pas Header

  225. // With native GL then bindings are staticlly declared to support other headers

  226. // or use the glBitmap inside of DLLs (minimize codesize).

  227. 

  228. 

  229. {.$DEFINE GLB_SDL}

  230. // To enable the support for SDL_surfaces

  231. 

  232. {.$DEFINE GLB_DELPHI}

  233. // To enable the support for TBitmap from Delphi (not lazarus)

  234. 

  235. 

  236. // *** image libs ***

  237. 

  238. {.$DEFINE GLB_SDL_IMAGE}

  239. // To enable the support of SDL_image to load files. (READ ONLY)

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

  241. 

  242. 

  243. {.$DEFINE GLB_PNGIMAGE}

  244. // to enable png support with the unit pngimage. You can download it from http://pngdelphi.sourceforge.net/

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

  246. 

  247. {.$DEFINE GLB_LIB_PNG}

  248. // to use the libPNG http://www.libpng.org/

  249. // You will need an aditional header.

  250. // http://www.opengl24.de/index.php?cat=header&file=libpng

  251. 

  252. {.$DEFINE GLB_DELPHI_JPEG}

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

  254. 

  255. {.$DEFINE GLB_LIB_JPEG}

  256. // to use the libJPEG http://www.ijg.org/

  257. // You will need an aditional header.

  258. // http://www.opengl24.de/index.php?cat=header&file=libjpeg

  259. 

  260. // ###### End of preferences ##################################################

  261. 

  262. 

  263. // ###### PRIVATE. Do not change anything. ####################################

  264. // *** old defines for compatibility ***

  265. {$IFDEF NO_NATIVE_GL}

  266.   {$DEFINE GLB_NO_NATIVE_GL}

  267. {$ENDIF}

  268. {$IFDEF pngimage}

  269.   {$definde GLB_PNGIMAGE}

  270. {$ENDIF}

  271. 

  272. // *** Delphi Versions ***

  273. {$IFDEF fpc}

  274.   {$MODE Delphi}

  275. 

  276.   {$IFDEF CPUI386}

  277.     {$DEFINE CPU386}

  278.     {$ASMMODE INTEL}

  279.   {$ENDIF}

  280. 

  281.   {$IFNDEF WINDOWS}

  282.     {$linklib c}

  283.   {$ENDIF}

  284. {$ENDIF}

  285. 

  286. // *** checking define combinations ***

  287. {$IFDEF GLB_SDL_IMAGE}

  288.   {$IFNDEF GLB_SDL}

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

  290.     {$DEFINE GLB_SDL}

  291.   {$ENDIF}

  292.   {$IFDEF GLB_PNGIMAGE}

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

  294.     {$undef GLB_PNGIMAGE}

  295.   {$ENDIF}

  296.   {$IFDEF GLB_DELPHI_JPEG}

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

  298.     {$undef GLB_DELPHI_JPEG}

  299.   {$ENDIF}

  300.   {$IFDEF GLB_LIB_PNG}

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

  302.     {$undef GLB_LIB_PNG}

  303.   {$ENDIF}

  304.   {$IFDEF GLB_LIB_JPEG}

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

  306.     {$undef GLB_LIB_JPEG}

  307.   {$ENDIF}

  308. 

  309.   {$DEFINE GLB_SUPPORT_PNG_READ}

  310.   {$DEFINE GLB_SUPPORT_JPEG_READ}

  311. {$ENDIF}

  312. 

  313. {$IFDEF GLB_PNGIMAGE}

  314.   {$IFDEF GLB_LIB_PNG}

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

  316.     {$undef GLB_LIB_PNG}

  317.   {$ENDIF}

  318. 

  319.   {$DEFINE GLB_SUPPORT_PNG_READ}

  320.   {$DEFINE GLB_SUPPORT_PNG_WRITE}

  321. {$ENDIF}

  322. 

  323. {$IFDEF GLB_LIB_PNG}

  324.   {$DEFINE GLB_SUPPORT_PNG_READ}

  325.   {$DEFINE GLB_SUPPORT_PNG_WRITE}

  326. {$ENDIF}

  327. 

  328. {$IFDEF GLB_DELPHI_JPEG}

  329.   {$IFDEF GLB_LIB_JPEG}

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

  331.     {$undef GLB_LIB_JPEG}

  332.   {$ENDIF}

  333. 

  334.   {$DEFINE GLB_SUPPORT_JPEG_READ}

  335.   {$DEFINE GLB_SUPPORT_JPEG_WRITE}

  336. {$ENDIF}

  337. 

  338. {$IFDEF GLB_LIB_JPEG}

  339.   {$DEFINE GLB_SUPPORT_JPEG_READ}

  340.   {$DEFINE GLB_SUPPORT_JPEG_WRITE}

  341. {$ENDIF}

  342. 

  343. // *** general options ***

  344. {$EXTENDEDSYNTAX ON}

  345. {$LONGSTRINGS ON}

  346. {$ALIGN ON}

  347. {$IFNDEF FPC}

  348.   {$OPTIMIZATION ON}

  349. {$ENDIF}

  350. 

  351. interface

  352. 

  353. uses

  354.   {$IFDEF GLB_NO_NATIVE_GL} dglOpenGL,                            {$ENDIF}

  355. 

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

  357.   {$IFDEF GLB_DELPHI}       Dialogs, Windows, Graphics,           {$ENDIF}

  358. 

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

  360. 

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

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

  363. 

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

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

  366.   Classes, SysUtils;

  367. 

  368. {$IFNDEF GLB_DELPHI}

  369. type

  370.   HGLRC = Cardinal;

  371.   DWORD = Cardinal;

  372.   PDWORD = ^DWORD;

  373. 

  374.   TRGBQuad = packed record

  375.     rgbBlue: Byte;

  376.     rgbGreen: Byte;

  377.     rgbRed: Byte;

  378.     rgbReserved: Byte;

  379.   end;

  380. {$ENDIF}

  381. 

  382. (* TODO dglOpenGL

  383. {$IFNDEF GLB_NO_NATIVE_GL}

  384. // Native OpenGL Implementation

  385. type

  386.   PByteBool = ^ByteBool;

  387. 

  388. {$IFDEF GLB_DELPHI}

  389. var

  390.   gLastContext: HGLRC;

  391. {$ENDIF}

  392. 

  393. const

  394.   // Generell

  395.   GL_VERSION = $1F02;

  396.   GL_EXTENSIONS = $1F03;

  397. 

  398.   GL_TRUE = 1;

  399.   GL_FALSE = 0;

  400. 

  401.   GL_TEXTURE_1D = $0DE0;

  402.   GL_TEXTURE_2D = $0DE1;

  403. 

  404.   GL_MAX_TEXTURE_SIZE = $0D33;

  405.   GL_PACK_ALIGNMENT = $0D05;

  406.   GL_UNPACK_ALIGNMENT = $0CF5;

  407. 

  408.   // Textureformats

  409.   GL_RGB = $1907;

  410.   GL_RGB4 = $804F;

  411.   GL_RGB8 = $8051;

  412.   GL_RGBA = $1908;

  413.   GL_RGBA4 = $8056;

  414.   GL_RGBA8 = $8058;

  415.   GL_BGR = $80E0;

  416.   GL_BGRA = $80E1;

  417.   GL_ALPHA4 = $803B;

  418.   GL_ALPHA8 = $803C;

  419.   GL_LUMINANCE4 = $803F;

  420.   GL_LUMINANCE8 = $8040;

  421.   GL_LUMINANCE4_ALPHA4 = $8043;

  422.   GL_LUMINANCE8_ALPHA8 = $8045;

  423.   GL_DEPTH_COMPONENT = $1902;

  424. 

  425.   GL_UNSIGNED_BYTE = $1401;

  426.   GL_ALPHA = $1906;

  427.   GL_LUMINANCE = $1909;

  428.   GL_LUMINANCE_ALPHA = $190A;

  429. 

  430.   GL_TEXTURE_WIDTH = $1000;

  431.   GL_TEXTURE_HEIGHT = $1001;

  432.   GL_TEXTURE_INTERNAL_FORMAT = $1003;

  433.   GL_TEXTURE_RED_SIZE = $805C;

  434.   GL_TEXTURE_GREEN_SIZE = $805D;

  435.   GL_TEXTURE_BLUE_SIZE = $805E;

  436.   GL_TEXTURE_ALPHA_SIZE = $805F;

  437.   GL_TEXTURE_LUMINANCE_SIZE = $8060;

  438. 

  439.   // Dataformats

  440.   GL_UNSIGNED_SHORT_5_6_5 = $8363;

  441.   GL_UNSIGNED_SHORT_5_6_5_REV = $8364;

  442.   GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;

  443.   GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;

  444.   GL_UNSIGNED_INT_2_10_10_10_REV = $8368;

  445. 

  446.   // Filter

  447.   GL_NEAREST = $2600;

  448.   GL_LINEAR = $2601;

  449.   GL_NEAREST_MIPMAP_NEAREST = $2700;

  450.   GL_LINEAR_MIPMAP_NEAREST = $2701;

  451.   GL_NEAREST_MIPMAP_LINEAR = $2702;

  452.   GL_LINEAR_MIPMAP_LINEAR = $2703;

  453.   GL_TEXTURE_MAG_FILTER = $2800;

  454.   GL_TEXTURE_MIN_FILTER = $2801;

  455. 

  456.   // Wrapmodes

  457.   GL_TEXTURE_WRAP_S = $2802;

  458.   GL_TEXTURE_WRAP_T = $2803;

  459.   GL_CLAMP = $2900;

  460.   GL_REPEAT = $2901;

  461.   GL_CLAMP_TO_EDGE = $812F;

  462.   GL_CLAMP_TO_BORDER = $812D;

  463.   GL_TEXTURE_WRAP_R = $8072;

  464. 

  465.   GL_MIRRORED_REPEAT = $8370;

  466. 

  467.   // Border Color

  468.   GL_TEXTURE_BORDER_COLOR = $1004;

  469. 

  470.   // Texgen

  471.   GL_NORMAL_MAP = $8511;

  472.   GL_REFLECTION_MAP = $8512;

  473.   GL_S = $2000;

  474.   GL_T = $2001;

  475.   GL_R = $2002;

  476.   GL_TEXTURE_GEN_MODE = $2500;

  477.   GL_TEXTURE_GEN_S = $0C60;

  478.   GL_TEXTURE_GEN_T = $0C61;

  479.   GL_TEXTURE_GEN_R = $0C62;

  480. 

  481.   // Cubemaps

  482.   GL_MAX_CUBE_MAP_TEXTURE_SIZE = $851C;

  483.   GL_TEXTURE_CUBE_MAP = $8513;

  484.   GL_TEXTURE_BINDING_CUBE_MAP = $8514;

  485.   GL_TEXTURE_CUBE_MAP_POSITIVE_X = $8515;

  486.   GL_TEXTURE_CUBE_MAP_NEGATIVE_X = $8516;

  487.   GL_TEXTURE_CUBE_MAP_POSITIVE_Y = $8517;

  488.   GL_TEXTURE_CUBE_MAP_NEGATIVE_Y = $8518;

  489.   GL_TEXTURE_CUBE_MAP_POSITIVE_Z = $8519;

  490.   GL_TEXTURE_CUBE_MAP_NEGATIVE_Z = $851A;

  491. 

  492.   GL_TEXTURE_RECTANGLE_ARB = $84F5;

  493. 

  494.   // GL_SGIS_generate_mipmap

  495.   GL_GENERATE_MIPMAP = $8191;

  496. 

  497.   // GL_EXT_texture_compression_s3tc

  498.   GL_COMPRESSED_RGB_S3TC_DXT1_EXT = $83F0;

  499.   GL_COMPRESSED_RGBA_S3TC_DXT1_EXT = $83F1;

  500.   GL_COMPRESSED_RGBA_S3TC_DXT3_EXT = $83F2;

  501.   GL_COMPRESSED_RGBA_S3TC_DXT5_EXT = $83F3;

  502. 

  503.   // GL_EXT_texture_filter_anisotropic

  504.   GL_TEXTURE_MAX_ANISOTROPY_EXT = $84FE;

  505.   GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;

  506. 

  507.   // GL_ARB_texture_compression

  508.   GL_COMPRESSED_RGB = $84ED;

  509.   GL_COMPRESSED_RGBA = $84EE;

  510.   GL_COMPRESSED_ALPHA = $84E9;

  511.   GL_COMPRESSED_LUMINANCE = $84EA;

  512.   GL_COMPRESSED_LUMINANCE_ALPHA = $84EB;

  513. 

  514.   // Extensions

  515. var

  516.   GL_VERSION_1_2,

  517.   GL_VERSION_1_3,

  518.   GL_VERSION_1_4,

  519.   GL_VERSION_2_0,

  520. 

  521.   GL_ARB_texture_border_clamp,

  522.   GL_ARB_texture_cube_map,

  523.   GL_ARB_texture_compression,

  524.   GL_ARB_texture_non_power_of_two,

  525.   GL_ARB_texture_rectangle,

  526.   GL_ARB_texture_mirrored_repeat,

  527.   GL_EXT_bgra,

  528.   GL_EXT_texture_edge_clamp,

  529.   GL_EXT_texture_cube_map,

  530.   GL_EXT_texture_compression_s3tc,

  531.   GL_EXT_texture_filter_anisotropic,

  532.   GL_EXT_texture_rectangle,

  533.   GL_NV_texture_rectangle,

  534.   GL_IBM_texture_mirrored_repeat,

  535.   GL_SGIS_generate_mipmap: Boolean;

  536. 

  537. const

  538. {$IFDEF LINUX}

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

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

  541. {$else}

  542.   libglu = 'glu32.dll';

  543.   libopengl = 'opengl32.dll';

  544. {$ENDIF}

  545. 

  546. {$IFDEF LINUX}

  547.   function glXGetProcAddress(ProcName: PAnsiChar): Pointer; cdecl; external libopengl;

  548. {$else}

  549.   function wglGetProcAddress(ProcName: PAnsiChar): Pointer; stdcall; external libopengl;

  550. {$ENDIF}

  551. 

  552.   function glGetString(name: Cardinal): PAnsiChar; {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;

  553. 

  554.   procedure glEnable(cap: Cardinal); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;

  555.   procedure glDisable(cap: Cardinal); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;

  556.   procedure glGetIntegerv(pname: Cardinal; params: PInteger); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;

  557. 

  558.   procedure glTexImage1D(target: Cardinal; level, internalformat, width, border: Integer; format, atype: Cardinal; const pixels: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;

  559.   procedure glTexImage2D(target: Cardinal; level, internalformat, width, height, border: Integer; format, atype: Cardinal; const pixels: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;

  560. 

  561.   procedure glGenTextures(n: Integer; Textures: PCardinal); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;

  562.   procedure glBindTexture(target: Cardinal; Texture: Cardinal); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;

  563.   procedure glDeleteTextures(n: Integer; const textures: PCardinal); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;

  564. 

  565.   procedure glReadPixels(x, y: Integer; width, height: Integer; format, atype: Cardinal; pixels: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;

  566.   procedure glPixelStorei(pname: Cardinal; param: Integer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;

  567.   procedure glGetTexImage(target: Cardinal; level: Integer; format: Cardinal; _type: Cardinal; pixels: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;

  568. 

  569.   function glAreTexturesResident(n: Integer; const Textures: PCardinal; residences: PByteBool): ByteBool;  {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;

  570.   procedure glTexParameteri(target: Cardinal; pname: Cardinal; param: Integer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;

  571.   procedure glTexParameterfv(target: Cardinal; pname: Cardinal; const params: PSingle); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;

  572.   procedure glGetTexLevelParameteriv(target: Cardinal; level: Integer; pname: Cardinal; params: PInteger); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;

  573.   procedure glTexGeni(coord, pname: Cardinal; param: Integer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libopengl;

  574. 

  575.   function gluBuild1DMipmaps(Target: Cardinal; Components, Width: Integer; Format, atype: Cardinal; Data: Pointer): Integer; {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libglu;

  576.   function gluBuild2DMipmaps(Target: Cardinal; Components, Width, Height: Integer; Format, aType: Cardinal; Data: Pointer): Integer; {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF} external libglu;

  577. 

  578. var

  579.   glCompressedTexImage2D : procedure(target: Cardinal; level: Integer; internalformat: Cardinal; width, height: Integer; border: Integer; imageSize: Integer; const data: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF}

  580.   glCompressedTexImage1D : procedure(target: Cardinal; level: Integer; internalformat: Cardinal; width: Integer; border: Integer; imageSize: Integer; const data: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF}

  581.   glGetCompressedTexImage : procedure(target: Cardinal; level: Integer; img: Pointer); {$IFDEF WINDOWS}stdcall; {$else}cdecl; {$ENDIF}

  582. {$ENDIF}

  583. *)

  584. 

  585. type

  586. ////////////////////////////////////////////////////////////////////////////////////////////////////

  587.   EglBitmapException               = class(Exception);

  588.   EglBitmapSizeToLargeException    = class(EglBitmapException);

  589.   EglBitmapNonPowerOfTwoException  = class(EglBitmapException);

  590.   EglBitmapUnsupportedFormatFormat = class(EglBitmapException);

  591. 

  592. ////////////////////////////////////////////////////////////////////////////////////////////////////

  593.   TglBitmapFormat = (

  594.     tfEmpty = 0,

  595. 

  596.     tfAlpha4,

  597.     tfAlpha8,

  598.     tfAlpha12,

  599.     tfAlpha16,

  600. 

  601.     tfLuminance4,

  602.     tfLuminance8,

  603.     tfLuminance12,

  604.     tfLuminance16,

  605. 

  606.     tfLuminance4Alpha4,

  607.     tfLuminance6Alpha2,

  608.     tfLuminance8Alpha8,

  609.     tfLuminance12Alpha4,

  610.     tfLuminance12Alpha12,

  611.     tfLuminance16Alpha16,

  612. 

  613.     tfR3G3B2,

  614.     tfRGB4,

  615.     tfR5G6B5,

  616.     tfRGB5,

  617.     tfRGB8,

  618.     tfRGB10,

  619.     tfRGB12,

  620.     tfRGB16,

  621. 

  622.     tfRGBA2,

  623.     tfRGBA4,

  624.     tfRGB5A1,

  625.     tfRGBA8,

  626.     tfRGB10A2,

  627.     tfRGBA12,

  628.     tfRGBA16,

  629. 

  630.     tfBGR4,

  631.     tfB5G6R5,

  632.     tfBGR5,

  633.     tfBGR8,

  634.     tfBGR10,

  635.     tfBGR12,

  636.     tfBGR16,

  637. 

  638.     tfBGRA2,

  639.     tfBGRA4,

  640.     tfBGR5A1,

  641.     tfBGRA8,

  642.     tfBGR10A2,

  643.     tfBGRA12,

  644.     tfBGRA16,

  645. 

  646.     tfDepth16,

  647.     tfDepth24,

  648.     tfDepth32

  649.   );

  650. 

  651.   TglBitmapFileType = (

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

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

  654.      ftDDS,

  655.      ftTGA,

  656.      ftBMP);

  657.    TglBitmapFileTypes = set of TglBitmapFileType;

  658. 

  659.    TglBitmapMipMap = (

  660.      mmNone,

  661.      mmMipmap,

  662.      mmMipmapGlu);

  663. 

  664.    TglBitmapNormalMapFunc = (

  665.      nm4Samples,

  666.      nmSobel,

  667.      nm3x3,

  668.      nm5x5);

  669. 

  670. ////////////////////////////////////////////////////////////////////////////////////////////////////

  671.   TglBitmapColorRec = packed record

  672.   case Integer of

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

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

  675.   end;

  676. 

  677.   TglBitmapPixelData = packed record

  678.     Data, Range: TglBitmapColorRec;

  679.     Format: TglBitmapFormat;

  680.   end;

  681.   PglBitmapPixelData = ^TglBitmapPixelData;

  682. 

  683. ////////////////////////////////////////////////////////////////////////////////////////////////////

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

  685.   TglBitmapPixelPosition = record

  686.     Fields : TglBitmapPixelPositionFields;

  687.     X : Word;

  688.     Y : Word;

  689.   end;

  690. 

  691. ////////////////////////////////////////////////////////////////////////////////////////////////////

  692.   TglBitmap = class;

  693.   TglBitmapFunctionRec = record

  694.     Sender:   TglBitmap;

  695.     Size:     TglBitmapPixelPosition;

  696.     Position: TglBitmapPixelPosition;

  697.     Source:   TglBitmapPixelData;

  698.     Dest:     TglBitmapPixelData;

  699.     Args:     PtrInt;

  700.   end;

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

  702. 

  703. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  704.   TglBitmap = class

  705.   protected

  706.     fID: GLuint;

  707.     fTarget: GLuint;

  708.     fAnisotropic: Integer;

  709.     fDeleteTextureOnFree: Boolean;

  710.     fFreeDataAfterGenTexture: Boolean;

  711.     fData: PByte;

  712.     fIsResident: Boolean;

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

  714. 

  715.     fDimension: TglBitmapPixelPosition;

  716.     fMipMap: TglBitmapMipMap;

  717.     fFormat: TglBitmapFormat;

  718. 

  719.     // Mapping

  720.     fPixelSize: Integer;

  721.     fRowSize: Integer;

  722. 

  723.     // Filtering

  724.     fFilterMin: Cardinal;

  725.     fFilterMag: Cardinal;

  726. 

  727.     // TexturWarp

  728.     fWrapS: Cardinal;

  729.     fWrapT: Cardinal;

  730.     fWrapR: Cardinal;

  731. 

  732.     // CustomData

  733.     fFilename: String;

  734.     fCustomName: String;

  735.     fCustomNameW: WideString;

  736.     fCustomData: Pointer;

  737. 

  738.     //Getter

  739.     function GetWidth:  Integer; virtual;

  740.     function GetHeight: Integer; virtual;

  741. 

  742.     function GetFileWidth:  Integer; virtual;

  743.     function GetFileHeight: Integer; virtual;

  744. 

  745.     //Setter

  746.     procedure SetCustomData(const aValue: Pointer);

  747.     procedure SetCustomName(const aValue: String);

  748.     procedure SetCustomNameW(const aValue: WideString);

  749.     procedure SetDeleteTextureOnFree(const aValue: Boolean);

  750.     procedure SetFormat(const aValue: TglBitmapFormat);

  751.     procedure SetFreeDataAfterGenTexture(const aValue: Boolean);

  752.     procedure SetID(const aValue: Cardinal);

  753.     procedure SetMipMap(const aValue: TglBitmapMipMap);

  754.     procedure SetTarget(const aValue: Cardinal);

  755.     procedure SetAnisotropic(const aValue: Integer);

  756. 

  757.     procedure CreateID;

  758.     procedure SetupParameters(var aBuildWithGlu: Boolean);

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

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

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

  762. 

  763.     function FlipHorz: Boolean; virtual;

  764.     function FlipVert: Boolean; virtual;

  765. 

  766.     property Width:  Integer read GetWidth;

  767.     property Height: Integer read GetHeight;

  768. 

  769.     property FileWidth:  Integer read GetFileWidth;

  770.     property FileHeight: Integer read GetFileHeight;

  771.   public

  772.     //Properties

  773.     property ID:           Cardinal        read fID          write SetID;

  774.     property Target:       Cardinal        read fTarget      write SetTarget;

  775.     property Format:       TglBitmapFormat read fFormat      write SetFormat;

  776.     property MipMap:       TglBitmapMipMap read fMipMap      write SetMipMap;

  777.     property Anisotropic:  Integer         read fAnisotropic write SetAnisotropic;

  778. 

  779.     property Filename:    String     read fFilename;

  780.     property CustomName:  String     read fCustomName  write SetCustomName;

  781.     property CustomNameW: WideString read fCustomNameW write SetCustomNameW;

  782.     property CustomData:  Pointer    read fCustomData  write SetCustomData;

  783. 

  784.     property DeleteTextureOnFree:     Boolean read fDeleteTextureOnFree     write SetDeleteTextureOnFree;

  785.     property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture;

  786. 

  787.     property Dimension:  TglBitmapPixelPosition  read fDimension;

  788.     property Data:       PByte                   read fData;

  789.     property IsResident: Boolean                 read fIsResident;

  790. 

  791.     procedure AfterConstruction; override;

  792.     procedure BeforeDestruction; override;

  793. 

  794.     //Load

  795.     procedure LoadFromFile(const aFilename: String);

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

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

  798.       const aFormat: TglBitmapFormat; const aArgs: PtrInt = 0);

  799.     {$IFDEF GLB_DELPHI}

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

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

  802.     {$ENDIF}

  803. 

  804.     //Save

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

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

  807. 

  808.     //Convert

  809.     function AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: PtrInt = 0): Boolean; overload;

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

  811.       const aFormat: TglBitmapFormat; const aArgs: PtrInt = 0): Boolean; overload;

  812.   public

  813.     //Alpha & Co

  814.     {$IFDEF GLB_SDL}

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

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

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

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

  819.       const aArgs: PtrInt = 0): Boolean;

  820.     {$ENDIF}

  821. 

  822.     {$IFDEF GLB_DELPHI}

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

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

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

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

  827.       const aArgs: PtrInt = 0): Boolean;

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

  829.       const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;

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

  831.       const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;

  832.     {$ENDIF}

  833. 

  834.     function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: PtrInt = 0): Boolean; virtual;

  835.     function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;

  836.     function AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;

  837.     function AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction = nil; const aArgs: PtrInt = 0): Boolean;

  838. 

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

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

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

  842. 

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

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

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

  846. 

  847.     function RemoveAlpha: Boolean; virtual;

  848.   public

  849.     //Common

  850.     function Clone: TglBitmap;

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

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

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

  854.     procedure FreeData;

  855. 

  856.     //ColorFill

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

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

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

  860. 

  861.     //TexParameters

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

  863.     procedure SetWrap(

  864.       const S: Cardinal = GL_CLAMP_TO_EDGE;

  865.       const T: Cardinal = GL_CLAMP_TO_EDGE;

  866.       const R: Cardinal = GL_CLAMP_TO_EDGE);

  867. 

  868.     procedure GetPixel(const aPos: TglBitmapPixelPosition; var aPixel: TglBitmapPixelData);   virtual;

  869.     procedure SetPixel(const aPos: TglBitmapPixelPosition; const aPixel: TglBitmapPixelData); virtual;

  870. 

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

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

  873. 

  874.     //Constructors

  875.     constructor Create; overload;

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

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

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

  879.     constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: PtrInt = 0); overload;

  880.     {$IFDEF GLB_DELPHI}

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

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

  883.     {$ENDIF}

  884.   private

  885.     {$IFDEF GLB_SUPPORT_PNG_READ}

  886.     function LoadPNG(const aStream: TStream): Boolean; virtual;

  887.     procedure SavePNG(const aStream: TStream); virtual;

  888.     {$ENDIF}

  889.     {$IFDEF GLB_SUPPORT_JPEG_READ}

  890.     function LoadJPEG(const aStream: TStream): Boolean; virtual;

  891.     procedure SaveJPEG(const aStream: TStream); virtual;

  892.     {$ENDIF}

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

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

  895. 

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

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

  898. 

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

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

  901.   end;

  902. 

  903. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  904.   TglBitmap2D = class(TglBitmap)

  905.   protected

  906.     // Bildeinstellungen

  907.     fLines: array of PByte;

  908. 

  909.     (* TODO

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

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

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

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

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

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

  916.     *)

  917. 

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

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

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

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

  922.   public

  923.     property Width;

  924.     property Height;

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

  926. 

  927.     procedure AfterConstruction; override;

  928. 

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

  930.     procedure GetDataFromTexture;

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

  932. 

  933.     function FlipHorz: Boolean; override;

  934.     function FlipVert: Boolean; override;

  935. 

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

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

  938.   end;

  939. 

  940. (* TODO

  941.   TglBitmapCubeMap = class(TglBitmap2D)

  942.   protected

  943.     fGenMode: Integer;

  944. 

  945.     // Hide GenTexture

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

  947.   public

  948.     procedure AfterConstruction; override;

  949. 

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

  951. 

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

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

  954.   end;

  955. 

  956. 

  957.   TglBitmapNormalMap = class(TglBitmapCubeMap)

  958.   public

  959.     procedure AfterConstruction; override;

  960. 

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

  962.   end;

  963. 

  964. 

  965.   TglBitmap1D = class(TglBitmap)

  966.   protected

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

  968. 

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

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

  971.   public

  972.     // propertys

  973.     property Width;

  974. 

  975.     procedure AfterConstruction; override;

  976. 

  977.     // Other

  978.     function FlipHorz: Boolean; override;

  979. 

  980.     // Generation

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

  982.   end;

  983. *)

  984. 

  985. const

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

  987. 

  988. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);

  989. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);

  990. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);

  991. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);

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

  993. procedure glBitmapSetDefaultWrap(

  994.   const S: Cardinal = GL_CLAMP_TO_EDGE;

  995.   const T: Cardinal = GL_CLAMP_TO_EDGE;

  996.   const R: Cardinal = GL_CLAMP_TO_EDGE);

  997. 

  998. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;

  999. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;

  1000. function glBitmapGetDefaultMipmap: TglBitmapMipMap;

  1001. function glBitmapGetDefaultFormat: TglBitmapFormat;

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

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

  1004. 

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

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

  1007. 

  1008. var

  1009.   glBitmapDefaultDeleteTextureOnFree: Boolean;

  1010.   glBitmapDefaultFreeDataAfterGenTextures: Boolean;

  1011.   glBitmapDefaultFormat: TglBitmapFormat;

  1012.   glBitmapDefaultMipmap: TglBitmapMipMap;

  1013.   glBitmapDefaultFilterMin: Cardinal;

  1014.   glBitmapDefaultFilterMag: Cardinal;

  1015.   glBitmapDefaultWrapS: Cardinal;

  1016.   glBitmapDefaultWrapT: Cardinal;

  1017.   glBitmapDefaultWrapR: Cardinal;

  1018. 

  1019. {$IFDEF GLB_DELPHI}

  1020. function CreateGrayPalette: HPALETTE;

  1021. {$ENDIF}

  1022. 

  1023. implementation

  1024. 

  1025. 

  1026.     (* TODO

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

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

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

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

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

  1032.     *)

  1033. 

  1034. uses

  1035.   Math, syncobjs;

  1036. 

  1037. type

  1038. ////////////////////////////////////////////////////////////////////////////////////////////////////

  1039.   TShiftRec = packed record

  1040.   case Integer of

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

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

  1043.   end;

  1044. 

  1045.   TFormatDescriptor = class(TObject)

  1046.   private

  1047.     function GetRedMask: UInt64;

  1048.     function GetGreenMask: UInt64;

  1049.     function GetBlueMask: UInt64;

  1050.     function GetAlphaMask: UInt64;

  1051.   protected

  1052.     fFormat: TglBitmapFormat;

  1053.     fWithAlpha: TglBitmapFormat;

  1054.     fWithoutAlpha: TglBitmapFormat;

  1055.     fPixelSize: Single;

  1056. 

  1057.     fRange: TglBitmapColorRec;

  1058.     fShift: TShiftRec;

  1059. 

  1060.     fglFormat:         Cardinal;

  1061.     fglInternalFormat: Cardinal;

  1062.     fglDataFormat:     Cardinal;

  1063. 

  1064.     function GetComponents: Integer; virtual;

  1065.   public

  1066.     property Format:       TglBitmapFormat read fFormat;

  1067.     property WithAlpha:    TglBitmapFormat read fWithAlpha;

  1068.     property WithoutAlpha: TglBitmapFormat read fWithoutAlpha;

  1069.     property Components:   Integer         read GetComponents;

  1070.     property PixelSize:    Single          read fPixelSize;

  1071. 

  1072.     property glFormat:         Cardinal read fglFormat;

  1073.     property glInternalFormat: Cardinal read fglInternalFormat;

  1074.     property glDataFormat:     Cardinal read fglDataFormat;

  1075. 

  1076.     property Range: TglBitmapColorRec read fRange;

  1077.     property Shift: TShiftRec         read fShift;

  1078. 

  1079.     property RedMask:   UInt64 read GetRedMask;

  1080.     property GreenMask: UInt64 read GetGreenMask;

  1081.     property BlueMask:  UInt64 read GetBlueMask;

  1082.     property AlphaMask: UInt64 read GetAlphaMask;

  1083. 

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

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

  1086. 

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

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

  1089. 

  1090.     function CreateMappingData: Pointer; virtual;

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

  1092. 

  1093.     function IsEmpty:  Boolean; virtual;

  1094.     function HasAlpha: Boolean; virtual;

  1095.     function MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: UInt64): Boolean; virtual;

  1096. 

  1097.     procedure PreparePixel(var aPixel: TglBitmapPixelData); virtual;

  1098. 

  1099.     constructor Create; virtual;

  1100.   public

  1101.     class procedure Init;

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

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

  1104.     class procedure Clear;

  1105.     class procedure Finalize;

  1106.   end;

  1107.   TFormatDescriptorClass = class of TFormatDescriptor;

  1108. 

  1109.   TfdEmpty = class(TFormatDescriptor);

  1110. 

  1111. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

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

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

  1115.     constructor Create; override;

  1116.   end;

  1117. 

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

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

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

  1121.     constructor Create; override;

  1122.   end;

  1123. 

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

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

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

  1127.     constructor Create; override;

  1128.   end;

  1129. 

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

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

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

  1133.     constructor Create; override;

  1134.   end;

  1135. 

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

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

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

  1139.     constructor Create; override;

  1140.   end;

  1141. 

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

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

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

  1145.     constructor Create; override;

  1146.   end;

  1147. 

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

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

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

  1151.     constructor Create; override;

  1152.   end;

  1153. 

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

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

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

  1157.     constructor Create; override;

  1158.   end;

  1159. 

  1160. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

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

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

  1164.     constructor Create; override;

  1165.   end;

  1166. 

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

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

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

  1170.     constructor Create; override;

  1171.   end;

  1172. 

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

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

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

  1176.     constructor Create; override;

  1177.   end;

  1178. 

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

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

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

  1182.     constructor Create; override;

  1183.   end;

  1184. 

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

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

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

  1188.     constructor Create; override;

  1189.   end;

  1190. 

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

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

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

  1194.     constructor Create; override;

  1195.   end;

  1196. 

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

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

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

  1200.     constructor Create; override;

  1201.   end;

  1202. 

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

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

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

  1206.     constructor Create; override;

  1207.   end;

  1208. 

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

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

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

  1212.     constructor Create; override;

  1213.   end;

  1214. 

  1215. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

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

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

  1219.     constructor Create; override;

  1220.   end;

  1221. 

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

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

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

  1225.     constructor Create; override;

  1226.   end;

  1227. 

  1228. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1229.   TfdAlpha4 = class(TfdAlpha_UB1)

  1230.     constructor Create; override;

  1231.   end;

  1232. 

  1233.   TfdAlpha8 = class(TfdAlpha_UB1)

  1234.     constructor Create; override;

  1235.   end;

  1236. 

  1237.   TfdAlpha12 = class(TfdAlpha_US1)

  1238.     constructor Create; override;

  1239.   end;

  1240. 

  1241.   TfdAlpha16 = class(TfdAlpha_US1)

  1242.     constructor Create; override;

  1243.   end;

  1244. 

  1245.   TfdLuminance4 = class(TfdLuminance_UB1)

  1246.     constructor Create; override;

  1247.   end;

  1248. 

  1249.   TfdLuminance8 = class(TfdLuminance_UB1)

  1250.     constructor Create; override;

  1251.   end;

  1252. 

  1253.   TfdLuminance12 = class(TfdLuminance_US1)

  1254.     constructor Create; override;

  1255.   end;

  1256. 

  1257.   TfdLuminance16 = class(TfdLuminance_US1)

  1258.     constructor Create; override;

  1259.   end;

  1260. 

  1261.   TfdLuminance4Alpha4 = class(TfdLuminanceAlpha_UB2)

  1262.     constructor Create; override;

  1263.   end;

  1264. 

  1265.   TfdLuminance6Alpha2 = class(TfdLuminanceAlpha_UB2)

  1266.     constructor Create; override;

  1267.   end;

  1268. 

  1269.   TfdLuminance8Alpha8 = class(TfdLuminanceAlpha_UB2)

  1270.     constructor Create; override;

  1271.   end;

  1272. 

  1273.   TfdLuminance12Alpha4 = class(TfdLuminanceAlpha_US2)

  1274.     constructor Create; override;

  1275.   end;

  1276. 

  1277.   TfdLuminance12Alpha12 = class(TfdLuminanceAlpha_US2)

  1278.     constructor Create; override;

  1279.   end;

  1280. 

  1281.   TfdLuminance16Alpha16 = class(TfdLuminanceAlpha_US2)

  1282.     constructor Create; override;

  1283.   end;

  1284. 

  1285.   TfdR3G3B2 = class(TfdUniversal_UB1)

  1286.     constructor Create; override;

  1287.   end;

  1288. 

  1289.   TfdRGB4 = class(TfdUniversal_US1)

  1290.     constructor Create; override;

  1291.   end;

  1292. 

  1293.   TfdR5G6B5 = class(TfdUniversal_US1)

  1294.     constructor Create; override;

  1295.   end;

  1296. 

  1297.   TfdRGB5 = class(TfdUniversal_US1)

  1298.     constructor Create; override;

  1299.   end;

  1300. 

  1301.   TfdRGB8 = class(TfdRGB_UB3)

  1302.     constructor Create; override;

  1303.   end;

  1304. 

  1305.   TfdRGB10 = class(TfdUniversal_UI1)

  1306.     constructor Create; override;

  1307.   end;

  1308. 

  1309.   TfdRGB12 = class(TfdRGB_US3)

  1310.     constructor Create; override;

  1311.   end;

  1312. 

  1313.   TfdRGB16 = class(TfdRGB_US3)

  1314.     constructor Create; override;

  1315.   end;

  1316. 

  1317.   TfdRGBA2 = class(TfdRGBA_UB4)

  1318.     constructor Create; override;

  1319.   end;

  1320. 

  1321.   TfdRGBA4 = class(TfdUniversal_US1)

  1322.     constructor Create; override;

  1323.   end;

  1324. 

  1325.   TfdRGB5A1 = class(TfdUniversal_US1)

  1326.     constructor Create; override;

  1327.   end;

  1328. 

  1329.   TfdRGBA8 = class(TfdRGBA_UB4)

  1330.     constructor Create; override;

  1331.   end;

  1332. 

  1333.   TfdRGB10A2 = class(TfdUniversal_UI1)

  1334.     constructor Create; override;

  1335.   end;

  1336. 

  1337.   TfdRGBA12 = class(TfdRGBA_US4)

  1338.     constructor Create; override;

  1339.   end;

  1340. 

  1341.   TfdRGBA16 = class(TfdRGBA_US4)

  1342.     constructor Create; override;

  1343.   end;

  1344. 

  1345.   TfdBGR4 = class(TfdUniversal_US1)

  1346.     constructor Create; override;

  1347.   end;

  1348. 

  1349.   TfdB5G6R5 = class(TfdUniversal_US1)

  1350.     constructor Create; override;

  1351.   end;

  1352. 

  1353.   TfdBGR5 = class(TfdUniversal_US1)

  1354.     constructor Create; override;

  1355.   end;

  1356. 

  1357.   TfdBGR8 = class(TfdBGR_UB3)

  1358.     constructor Create; override;

  1359.   end;

  1360. 

  1361.   TfdBGR10 = class(TfdUniversal_UI1)

  1362.     constructor Create; override;

  1363.   end;

  1364. 

  1365.   TfdBGR12 = class(TfdBGR_US3)

  1366.     constructor Create; override;

  1367.   end;

  1368. 

  1369.   TfdBGR16 = class(TfdBGR_US3)

  1370.     constructor Create; override;

  1371.   end;

  1372. 

  1373.   TfdBGRA2 = class(TfdBGRA_UB4)

  1374.     constructor Create; override;

  1375.   end;

  1376. 

  1377.   TfdBGRA4 = class(TfdUniversal_US1)

  1378.     constructor Create; override;

  1379.   end;

  1380. 

  1381.   TfdBGR5A1 = class(TfdUniversal_US1)

  1382.     constructor Create; override;

  1383.   end;

  1384. 

  1385.   TfdBGRA8 = class(TfdBGRA_UB4)

  1386.     constructor Create; override;

  1387.   end;

  1388. 

  1389.   TfdBGR10A2 = class(TfdUniversal_UI1)

  1390.     constructor Create; override;

  1391.   end;

  1392. 

  1393.   TfdBGRA12 = class(TfdBGRA_US4)

  1394.     constructor Create; override;

  1395.   end;

  1396. 

  1397.   TfdBGRA16 = class(TfdBGRA_US4)

  1398.     constructor Create; override;

  1399.   end;

  1400. 

  1401.   TfdDepth16 = class(TfdDepth_US1)

  1402.     constructor Create; override;

  1403.   end;

  1404. 

  1405.   TfdDepth24 = class(TfdDepth_UI1)

  1406.     constructor Create; override;

  1407.   end;

  1408. 

  1409.   TfdDepth32 = class(TfdDepth_UI1)

  1410.     constructor Create; override;

  1411.   end;

  1412. 

  1413. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1414.   TBitfieldFormat = class(TFormatDescriptor)

  1415.   private

  1416.     procedure SetRedMask  (const aValue: UInt64);

  1417.     procedure SetGreenMask(const aValue: UInt64);

  1418.     procedure SetBlueMask (const aValue: UInt64);

  1419.     procedure SetAlphaMask(const aValue: UInt64);

  1420. 

  1421.     procedure Update(aMask: UInt64; out aRange: Cardinal; out aShift: Byte);

  1422.   public

  1423.     property RedMask:   UInt64 read GetRedMask   write SetRedMask;

  1424.     property GreenMask: UInt64 read GetGreenMask write SetGreenMask;

  1425.     property BlueMask:  UInt64 read GetBlueMask  write SetBlueMask;

  1426.     property AlphaMask: UInt64 read GetAlphaMask write SetAlphaMask;

  1427. 

  1428.     property PixelSize: Single read fPixelSize write fPixelSize;

  1429. 

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

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

  1432.   end;

  1433. 

  1434. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1435.   TColorTableEnty = packed record

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

  1437.   end;

  1438.   TColorTable = array of TColorTableEnty;

  1439.   TColorTableFormat = class(TFormatDescriptor)

  1440.   private

  1441.     fColorTable: TColorTable;

  1442.   public

  1443.     property PixelSize:  Single            read fPixelSize  write fPixelSize;

  1444.     property ColorTable: TColorTable       read fColorTable write fColorTable;

  1445.     property Range:      TglBitmapColorRec read fRange      write fRange;

  1446. 

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

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

  1449.     destructor Destroy; override;

  1450.   end;

  1451. 

  1452. const

  1453.   LUMINANCE_WEIGHT_R = 0.30;

  1454.   LUMINANCE_WEIGHT_G = 0.59;

  1455.   LUMINANCE_WEIGHT_B = 0.11;

  1456. 

  1457.   ALPHA_WEIGHT_R = 0.30;

  1458.   ALPHA_WEIGHT_G = 0.59;

  1459.   ALPHA_WEIGHT_B = 0.11;

  1460. 

  1461.   DEPTH_WEIGHT_R = 0.333333333;

  1462.   DEPTH_WEIGHT_G = 0.333333333;

  1463.   DEPTH_WEIGHT_B = 0.333333333;

  1464. 

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

  1466. 

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

  1468.     TfdEmpty,

  1469. 

  1470.     TfdAlpha4,

  1471.     TfdAlpha8,

  1472.     TfdAlpha12,

  1473.     TfdAlpha16,

  1474. 

  1475.     TfdLuminance4,

  1476.     TfdLuminance8,

  1477.     TfdLuminance12,

  1478.     TfdLuminance16,

  1479. 

  1480.     TfdLuminance4Alpha4,

  1481.     TfdLuminance6Alpha2,

  1482.     TfdLuminance8Alpha8,

  1483.     TfdLuminance12Alpha4,

  1484.     TfdLuminance12Alpha12,

  1485.     TfdLuminance16Alpha16,

  1486. 

  1487.     TfdR3G3B2,

  1488.     TfdRGB4,

  1489.     TfdR5G6B5,

  1490.     TfdRGB5,

  1491.     TfdRGB8,

  1492.     TfdRGB10,

  1493.     TfdRGB12,

  1494.     TfdRGB16,

  1495. 

  1496.     TfdRGBA2,

  1497.     TfdRGBA4,

  1498.     TfdRGB5A1,

  1499.     TfdRGBA8,

  1500.     TfdRGB10A2,

  1501.     TfdRGBA12,

  1502.     TfdRGBA16,

  1503. 

  1504.     TfdBGR4,

  1505.     TfdB5G6R5,

  1506.     TfdBGR5,

  1507.     TfdBGR8,

  1508.     TfdBGR10,

  1509.     TfdBGR12,

  1510.     TfdBGR16,

  1511. 

  1512.     TfdBGRA2,

  1513.     TfdBGRA4,

  1514.     TfdBGR5A1,

  1515.     TfdBGRA8,

  1516.     TfdBGR10A2,

  1517.     TfdBGRA12,

  1518.     TfdBGRA16,

  1519. 

  1520.     TfdDepth16,

  1521.     TfdDepth24,

  1522.     TfdDepth32

  1523.   );

  1524. 

  1525. var

  1526.   FormatDescriptorCS: TCriticalSection;

  1527.   FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;

  1528. 

  1529. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  1531. begin

  1532.   result.Fields := [];

  1533. 

  1534.   if X >= 0 then

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

  1536.   if Y >= 0 then

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

  1538. 

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

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

  1541. end;

  1542. 

  1543. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  1545. begin

  1546.   result.r := r;

  1547.   result.g := g;

  1548.   result.b := b;

  1549.   result.a := a;

  1550. end;

  1551. 

  1552. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  1554. begin

  1555.   //TODO Supported File Formats!

  1556.   result := [ftDDS, ftTGA, ftBMP];

  1557.   (*

  1558.   {$IFDEF GLB_SUPPORT_PNG_WRITE}

  1559.   if aFormat in [

  1560.     tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,

  1561.     tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,

  1562.     tfuminance4Alpha4, tfLuminance6Alpha2, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16,

  1563.     tfR3G3B2, tfRGB4, tfRGB5, tfRGB8, tfRGB10, tfRGB12, tfRGB16,

  1564.     tfRGBA2, tfRGBA4, tfRGB5A1, tfRGBA8, tfRGB10A2, tfRGBA12, tfRGBA16,

  1565.     tfDepth16, tfDepth24, tfDepth32]

  1566.   then

  1567.     result := result + [ftPNG];

  1568.   {$ENDIF}

  1569. 

  1570.   {$IFDEF GLB_SUPPORT_JPEG_WRITE}

  1571.   if Format in [

  1572.     tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,

  1573.     tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,

  1574.     tfR3G3B2, tfRGB4, tfRGB5, tfRGB8, tfRGB10, tfRGB12, tfRGB16,

  1575.     tfDepth16, tfDepth24, tfDepth32]

  1576.   then

  1577.     result := result + [ftJPEG];

  1578.   {$ENDIF}

  1579. 

  1580.   if aFormat in [

  1581.     tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,

  1582.     tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,

  1583.     tfuminance4Alpha4, tfLuminance6Alpha2, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16,

  1584.     tfR3G3B2, tfRGB4, tfRGB5, tfRGB8, tfRGB10, tfRGB12, tfRGB16,

  1585.     tfRGBA2, tfRGBA4, tfRGB5A1, tfRGBA8, tfRGB10A2, tfRGBA12, tfRGBA16,

  1586.     tfDepth16, tfDepth24, tfDepth32]

  1587.   then

  1588.     result := result + [ftDDS, ftTGA, ftBMP];

  1589.   *)

  1590. end;

  1591. 

  1592. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  1594. begin

  1595.   while (aNumber and 1) = 0 do

  1596.     aNumber := aNumber shr 1;

  1597.   result := aNumber = 1;

  1598. end;

  1599. 

  1600. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1601. function GetTopMostBit(aBitSet: UInt64): Integer;

  1602. begin

  1603.   result := 0;

  1604.   while aBitSet > 0 do begin

  1605.     inc(result);

  1606.     aBitSet := aBitSet shr 1;

  1607.   end;

  1608. end;

  1609. 

  1610. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1611. function CountSetBits(aBitSet: UInt64): Integer;

  1612. begin

  1613.   result := 0;

  1614.   while aBitSet > 0 do begin

  1615.     if (aBitSet and 1) = 1 then

  1616.       inc(result);

  1617.     aBitSet := aBitSet shr 1;

  1618.   end;

  1619. end;

  1620. 

  1621. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  1623. begin

  1624.   result := Trunc(

  1625.     LUMINANCE_WEIGHT_R * aPixel.Data.r +

  1626.     LUMINANCE_WEIGHT_G * aPixel.Data.g +

  1627.     LUMINANCE_WEIGHT_B * aPixel.Data.b);

  1628. end;

  1629. 

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

  1631. begin

  1632.   result := Trunc(

  1633.     DEPTH_WEIGHT_R * aPixel.Data.r +

  1634.     DEPTH_WEIGHT_G * aPixel.Data.g +

  1635.     DEPTH_WEIGHT_B * aPixel.Data.b);

  1636. end;

  1637. 

  1638. //TODO check _ARB functions and constants

  1639. 

  1640. (* GLB_NO_NATIVE_GL

  1641. {$IFNDEF GLB_NO_NATIVE_GL}

  1642. procedure ReadOpenGLExtensions;

  1643. var

  1644.   {$IFDEF GLB_DELPHI}

  1645.   Context: HGLRC;

  1646.   {$ENDIF}

  1647.   Buffer: AnsiString;

  1648.   MajorVersion, MinorVersion: Integer;

  1649. 

  1650. 

  1651.   procedure TrimVersionString(Buffer: AnsiString; var Major, Minor: Integer);

  1652.   var

  1653.     Separator: Integer;

  1654.   begin

  1655.     Minor := 0;

  1656.     Major := 0;

  1657. 

  1658.     Separator := Pos(AnsiString('.'), Buffer);

  1659. 

  1660.     if (Separator > 1) and (Separator < Length(Buffer)) and

  1661.        (Buffer[Separator - 1] in ['0'..'9']) and

  1662.        (Buffer[Separator + 1] in ['0'..'9']) then begin

  1663. 

  1664.       Dec(Separator);

  1665.       while (Separator > 0) and (Buffer[Separator] in ['0'..'9']) do

  1666.         Dec(Separator);

  1667. 

  1668.       Delete(Buffer, 1, Separator);

  1669.       Separator := Pos(AnsiString('.'), Buffer) + 1;

  1670. 

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

  1672.         Inc(Separator);

  1673. 

  1674.       Delete(Buffer, Separator, 255);

  1675.       Separator := Pos(AnsiString('.'), Buffer);

  1676. 

  1677.       Major := StrToInt(Copy(String(Buffer), 1, Separator - 1));

  1678.       Minor := StrToInt(Copy(String(Buffer), Separator + 1, 1));

  1679.     end;

  1680.   end;

  1681. 

  1682. 

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

  1684.   var

  1685.     ExtPos: Integer;

  1686.   begin

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

  1688.     result := ExtPos > 0;

  1689. 

  1690.     if result then

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

  1692.   end;

  1693. 

  1694. 

  1695.   function glLoad (aFunc: pAnsiChar): pointer;

  1696.   begin

  1697.     {$IFDEF LINUX}

  1698.       result := glXGetProcAddress(aFunc);

  1699.     {$else}

  1700.       result := wglGetProcAddress(aFunc);

  1701.     {$ENDIF}

  1702.   end;

  1703. 

  1704. 

  1705. begin

  1706.   {$IFDEF GLB_DELPHI}

  1707.   Context := wglGetCurrentContext;

  1708. 

  1709.   if Context <> gLastContext then begin

  1710.     gLastContext := Context;

  1711.   {$ENDIF}

  1712. 

  1713.     // Version

  1714.     Buffer := glGetString(GL_VERSION);

  1715.     TrimVersionString(Buffer, MajorVersion, MinorVersion);

  1716. 

  1717.     GL_VERSION_1_2 := false;

  1718.     GL_VERSION_1_3 := false;

  1719.     GL_VERSION_1_4 := false;

  1720.     GL_VERSION_2_0 := false;

  1721. 

  1722.     if MajorVersion = 1 then begin

  1723.       if MinorVersion >= 1 then begin

  1724.         if MinorVersion >= 2 then

  1725.           GL_VERSION_1_2 := true;

  1726. 

  1727.         if MinorVersion >= 3 then

  1728.           GL_VERSION_1_3 := true;

  1729. 

  1730.         if MinorVersion >= 4 then

  1731.           GL_VERSION_1_4 := true;

  1732.       end;

  1733.     end;

  1734. 

  1735.     if MajorVersion >= 2 then begin

  1736.       GL_VERSION_1_2 := true;

  1737.       GL_VERSION_1_3 := true;

  1738.       GL_VERSION_1_4 := true;

  1739.       GL_VERSION_2_0 := true;

  1740.     end;

  1741. 

  1742.     // Extensions

  1743.     Buffer := glGetString(GL_EXTENSIONS);

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

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

  1746.     GL_ARB_texture_compression        := CheckExtension('GL_ARB_texture_compression');

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

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

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

  1750.     GL_EXT_bgra                       := CheckExtension('GL_EXT_bgra');

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

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

  1753.     GL_EXT_texture_compression_s3tc   := CheckExtension('GL_EXT_texture_compression_s3tc');

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

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

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

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

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

  1759. 

  1760.     // Funtions

  1761.     if GL_VERSION_1_3 then begin

  1762.       // Loading Core

  1763.       glCompressedTexImage1D := glLoad('glCompressedTexImage1D');

  1764.       glCompressedTexImage2D := glLoad('glCompressedTexImage2D');

  1765.       glGetCompressedTexImage := glLoad('glGetCompressedTexImage');

  1766.     end else

  1767. 

  1768.     begin

  1769.       // Try loading Extension

  1770.       glCompressedTexImage1D := glLoad('glCompressedTexImage1DARB');

  1771.       glCompressedTexImage2D := glLoad('glCompressedTexImage2DARB');

  1772.       glGetCompressedTexImage := glLoad('glGetCompressedTexImageARB');

  1773.     end;

  1774.   {$IFDEF GLB_DELPHI}

  1775.   end;

  1776.   {$ENDIF}

  1777. end;

  1778. {$ENDIF}

  1779. *)

  1780. 

  1781. (* TODO GLB_DELPHI

  1782. {$IFDEF GLB_DELPHI}

  1783. function CreateGrayPalette: HPALETTE;

  1784. var

  1785.   Idx: Integer;

  1786.   Pal: PLogPalette;

  1787. begin

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

  1789. 

  1790.   Pal.palVersion := $300;

  1791.   Pal.palNumEntries := 256;

  1792. 

  1793.   {$IFOPT R+}

  1794.     {$DEFINE GLB_TEMPRANGECHECK}

  1795.     {$R-}

  1796.   {$ENDIF}

  1797. 

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

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

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

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

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

  1803.   end;

  1804. 

  1805.   {$IFDEF GLB_TEMPRANGECHECK}

  1806.     {$UNDEF GLB_TEMPRANGECHECK}

  1807.     {$R+}

  1808.   {$ENDIF}

  1809. 

  1810.   result := CreatePalette(Pal^);

  1811. 

  1812.   FreeMem(Pal);

  1813. end;

  1814. {$ENDIF}

  1815. *)

  1816. 

  1817. (* TODO GLB_SDL_IMAGE

  1818. {$IFDEF GLB_SDL_IMAGE}

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

  1820. begin

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

  1822. end;

  1823. 

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

  1825. begin

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

  1827. end;

  1828. 

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

  1830. begin

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

  1832. end;

  1833. 

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

  1835. begin

  1836.   result := 0;

  1837. end;

  1838. 

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

  1840. begin

  1841.   result := SDL_AllocRW;

  1842. 

  1843.   if result = nil then

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

  1845. 

  1846.   result^.seek := glBitmapRWseek;

  1847.   result^.read := glBitmapRWread;

  1848.   result^.write := glBitmapRWwrite;

  1849.   result^.close := glBitmapRWclose;

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

  1851. end;

  1852. {$ENDIF}

  1853. *)

  1854. 

  1855. (* TODO LoadFuncs

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

  1857. var

  1858.   glBitmap: TglBitmap2D;

  1859. begin

  1860.   result := false;

  1861.   Texture := 0;

  1862. 

  1863.   {$IFDEF GLB_DELPHI}

  1864.   if Instance = 0 then

  1865.     Instance := HInstance;

  1866. 

  1867.   if (LoadFromRes) then

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

  1869.   else

  1870.   {$ENDIF}

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

  1872. 

  1873.   try

  1874.     glBitmap.DeleteTextureOnFree := false;

  1875.     glBitmap.FreeDataAfterGenTexture := false;

  1876.     glBitmap.GenTexture(true);

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

  1878.       Texture := glBitmap.ID;

  1879.       result := true;

  1880.     end;

  1881.   finally

  1882.     glBitmap.Free;

  1883.   end;

  1884. end;

  1885. 

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

  1887. var

  1888.   CM: TglBitmapCubeMap;

  1889. begin

  1890.   Texture := 0;

  1891. 

  1892.   {$IFDEF GLB_DELPHI}

  1893.   if Instance = 0 then

  1894.     Instance := HInstance;

  1895.   {$ENDIF}

  1896. 

  1897.   CM := TglBitmapCubeMap.Create;

  1898.   try

  1899.     CM.DeleteTextureOnFree := false;

  1900. 

  1901.     // Maps

  1902.     {$IFDEF GLB_DELPHI}

  1903.     if (LoadFromRes) then

  1904.       CM.LoadFromResource(Instance, PositiveX)

  1905.     else

  1906.     {$ENDIF}

  1907.       CM.LoadFromFile(PositiveX);

  1908.     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X);

  1909. 

  1910.     {$IFDEF GLB_DELPHI}

  1911.     if (LoadFromRes) then

  1912.       CM.LoadFromResource(Instance, NegativeX)

  1913.     else

  1914.     {$ENDIF}

  1915.       CM.LoadFromFile(NegativeX);

  1916.     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X);

  1917. 

  1918.     {$IFDEF GLB_DELPHI}

  1919.     if (LoadFromRes) then

  1920.       CM.LoadFromResource(Instance, PositiveY)

  1921.     else

  1922.     {$ENDIF}

  1923.       CM.LoadFromFile(PositiveY);

  1924.     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y);

  1925. 

  1926.     {$IFDEF GLB_DELPHI}

  1927.     if (LoadFromRes) then

  1928.       CM.LoadFromResource(Instance, NegativeY)

  1929.     else

  1930.     {$ENDIF}

  1931.       CM.LoadFromFile(NegativeY);

  1932.     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y);

  1933. 

  1934.     {$IFDEF GLB_DELPHI}

  1935.     if (LoadFromRes) then

  1936.       CM.LoadFromResource(Instance, PositiveZ)

  1937.     else

  1938.     {$ENDIF}

  1939.       CM.LoadFromFile(PositiveZ);

  1940.     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z);

  1941. 

  1942.     {$IFDEF GLB_DELPHI}

  1943.     if (LoadFromRes) then

  1944.       CM.LoadFromResource(Instance, NegativeZ)

  1945.     else

  1946.     {$ENDIF}

  1947.       CM.LoadFromFile(NegativeZ);

  1948.     CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z);

  1949. 

  1950.     Texture := CM.ID;

  1951.     result := true;

  1952.   finally

  1953.     CM.Free;

  1954.   end;

  1955. end;

  1956. 

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

  1958. var

  1959.   NM: TglBitmapNormalMap;

  1960. begin

  1961.   Texture := 0;

  1962. 

  1963.   NM := TglBitmapNormalMap.Create;

  1964.   try

  1965.     NM.DeleteTextureOnFree := false;

  1966.     NM.GenerateNormalMap(Size);

  1967. 

  1968.     Texture := NM.ID;

  1969.     result := true;

  1970.   finally

  1971.     NM.Free;

  1972.   end;

  1973. end;

  1974. *)

  1975. 

  1976. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1977. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);

  1978. begin

  1979.   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;

  1980. end;

  1981. 

  1982. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1983. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);

  1984. begin

  1985.   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;

  1986. end;

  1987. 

  1988. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1989. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);

  1990. begin

  1991.   glBitmapDefaultMipmap := aValue;

  1992. end;

  1993. 

  1994. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1995. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);

  1996. begin

  1997.   glBitmapDefaultFormat := aFormat;

  1998. end;

  1999. 

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

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

  2002. begin

  2003.   glBitmapDefaultFilterMin := aMin;

  2004.   glBitmapDefaultFilterMag := aMag;

  2005. end;

  2006. 

  2007. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2009. begin

  2010.   glBitmapDefaultWrapS := S;

  2011.   glBitmapDefaultWrapT := T;

  2012.   glBitmapDefaultWrapR := R;

  2013. end;

  2014. 

  2015. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2016. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;

  2017. begin

  2018.   result := glBitmapDefaultDeleteTextureOnFree;

  2019. end;

  2020. 

  2021. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2022. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;

  2023. begin

  2024.   result := glBitmapDefaultFreeDataAfterGenTextures;

  2025. end;

  2026. 

  2027. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2028. function glBitmapGetDefaultMipmap: TglBitmapMipMap;

  2029. begin

  2030.   result := glBitmapDefaultMipmap;

  2031. end;

  2032. 

  2033. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2034. function glBitmapGetDefaultFormat: TglBitmapFormat;

  2035. begin

  2036.   result := glBitmapDefaultFormat;

  2037. end;

  2038. 

  2039. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2041. begin

  2042.   aMin := glBitmapDefaultFilterMin;

  2043.   aMag := glBitmapDefaultFilterMag;

  2044. end;

  2045. 

  2046. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2048. begin

  2049.   S := glBitmapDefaultWrapS;

  2050.   T := glBitmapDefaultWrapT;

  2051.   R := glBitmapDefaultWrapR;

  2052. end;

  2053. 

  2054. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2055. //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2056. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2057. function TFormatDescriptor.GetRedMask: UInt64;

  2058. begin

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

  2060. end;

  2061. 

  2062. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2063. function TFormatDescriptor.GetGreenMask: UInt64;

  2064. begin

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

  2066. end;

  2067. 

  2068. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2069. function TFormatDescriptor.GetBlueMask: UInt64;

  2070. begin

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

  2072. end;

  2073. 

  2074. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2075. function TFormatDescriptor.GetAlphaMask: UInt64;

  2076. begin

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

  2078. end;

  2079. 

  2080. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2081. function TFormatDescriptor.GetComponents: Integer;

  2082. var

  2083.   i: Integer;

  2084. begin

  2085.   result := 0;

  2086.   for i := 0 to 3 do

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

  2088.       inc(result);

  2089. end;

  2090. 

  2091. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2093. var

  2094.   w, h: Integer;

  2095. begin

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

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

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

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

  2100.   end else

  2101.     result := 0;

  2102. end;

  2103. 

  2104. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2106. begin

  2107.   result := 0;

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

  2109.     exit;

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

  2111. end;

  2112. 

  2113. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2114. function TFormatDescriptor.CreateMappingData: Pointer;

  2115. begin

  2116.   result := nil;

  2117. end;

  2118. 

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

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

  2121. begin

  2122.   //DUMMY

  2123. end;

  2124. 

  2125. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2126. function TFormatDescriptor.IsEmpty: Boolean;

  2127. begin

  2128.   result := (fFormat = tfEmpty);

  2129. end;

  2130. 

  2131. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2132. function TFormatDescriptor.HasAlpha: Boolean;

  2133. begin

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

  2135. end;

  2136. 

  2137. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2138. function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: UInt64): Boolean;

  2139. begin

  2140.   result := false;

  2141. 

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

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

  2144. 

  2145.   if (aRedMask   <> RedMask) then

  2146.     exit;

  2147.   if (aGreenMask <> GreenMask) then

  2148.     exit;

  2149.   if (aBlueMask  <> BlueMask) then

  2150.     exit;

  2151.   if (aAlphaMask <> AlphaMask) then

  2152.     exit;

  2153.   result := true;

  2154. end;

  2155. 

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

  2157. procedure TFormatDescriptor.PreparePixel(var aPixel: TglBitmapPixelData);

  2158. begin

  2159.   FillChar(aPixel, SizeOf(aPixel), 0);

  2160.   aPixel.Data   := fRange;

  2161.   aPixel.Range  := fRange;

  2162.   aPixel.Format := fFormat;

  2163. end;

  2164. 

  2165. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2166. constructor TFormatDescriptor.Create;

  2167. begin

  2168.   inherited Create;

  2169. 

  2170.   fFormat       := tfEmpty;

  2171.   fWithAlpha    := tfEmpty;

  2172.   fWithoutAlpha := tfEmpty;

  2173.   fPixelSize    := 0.0;

  2174. 

  2175.   fglFormat         := 0;

  2176.   fglInternalFormat := 0;

  2177.   fglDataFormat     := 0;

  2178. 

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

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

  2181. end;

  2182. 

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

  2184. //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2185. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2187. begin

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

  2189.   inc(aData);

  2190. end;

  2191. 

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

  2193. begin

  2194.   aPixel.Data.r := 0;

  2195.   aPixel.Data.g := 0;

  2196.   aPixel.Data.b := 0;

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

  2198.   inc(aData^);

  2199. end;

  2200. 

  2201. constructor TfdAlpha_UB1.Create;

  2202. begin

  2203.   inherited Create;

  2204.   fPixelSize        := 1.0;

  2205.   fRange.a          := $FF;

  2206.   fglFormat         := GL_ALPHA;

  2207.   fglDataFormat     := GL_UNSIGNED_BYTE;

  2208. end;

  2209. 

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

  2211. //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

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

  2214. begin

  2215.   aData^ := LuminanceWeight(aPixel);

  2216.   inc(aData);

  2217. end;

  2218. 

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

  2220. begin

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

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

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

  2224.   aPixel.Data.a := 0;

  2225.   inc(aData);

  2226. end;

  2227. 

  2228. constructor TfdLuminance_UB1.Create;

  2229. begin

  2230.   inherited Create;

  2231.   fPixelSize        := 1.0;

  2232.   fRange.r          := $FF;

  2233.   fRange.g          := $FF;

  2234.   fRange.b          := $FF;

  2235.   fglFormat         := GL_LUMINANCE;

  2236.   fglDataFormat     := GL_UNSIGNED_BYTE;

  2237. end;

  2238. 

  2239. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2240. //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2241. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2243. var

  2244.   i: Integer;

  2245. begin

  2246.   aData^ := 0;

  2247.   for i := 0 to 3 do

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

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

  2250.   inc(aData);

  2251. end;

  2252. 

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

  2254. var

  2255.   i: Integer;

  2256. begin

  2257.   for i := 0 to 3 do

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

  2259.   inc(aData);

  2260. end;

  2261. 

  2262. constructor TfdUniversal_UB1.Create;

  2263. begin

  2264.   inherited Create;

  2265.   fPixelSize := 1.0;

  2266. end;

  2267. 

  2268. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2269. //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

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

  2272. begin

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

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

  2275.   inc(aData);

  2276. end;

  2277. 

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

  2279. begin

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

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

  2282.   inc(aData);

  2283. end;

  2284. 

  2285. constructor TfdLuminanceAlpha_UB2.Create;

  2286. begin

  2287.   inherited Create;

  2288.   fPixelSize        := 2.0;

  2289.   fRange.a          := $FF;

  2290.   fShift.a          :=   8;

  2291.   fglFormat         := GL_LUMINANCE_ALPHA;

  2292.   fglDataFormat     := GL_UNSIGNED_BYTE;

  2293. end;

  2294. 

  2295. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2296. //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2297. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2299. begin

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

  2301.   inc(aData);

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

  2303.   inc(aData);

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

  2305.   inc(aData);

  2306. end;

  2307. 

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

  2309. begin

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

  2311.   inc(aData);

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

  2313.   inc(aData);

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

  2315.   inc(aData);

  2316.   aPixel.Data.a := 0;

  2317. end;

  2318. 

  2319. constructor TfdRGB_UB3.Create;

  2320. begin

  2321.   inherited Create;

  2322.   fPixelSize        := 3.0;

  2323.   fRange.r          := $FF;

  2324.   fRange.g          := $FF;

  2325.   fRange.b          := $FF;

  2326.   fShift.r          :=   0;

  2327.   fShift.g          :=   8;

  2328.   fShift.b          :=  16;

  2329.   fglFormat         := GL_RGB;

  2330.   fglDataFormat     := GL_UNSIGNED_BYTE;

  2331. end;

  2332. 

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

  2334. //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

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

  2337. begin

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

  2339.   inc(aData);

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

  2341.   inc(aData);

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

  2343.   inc(aData);

  2344. end;

  2345. 

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

  2347. begin

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

  2349.   inc(aData);

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

  2351.   inc(aData);

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

  2353.   inc(aData);

  2354.   aPixel.Data.a := 0;

  2355. end;

  2356. 

  2357. constructor TfdBGR_UB3.Create;

  2358. begin

  2359.   fPixelSize        := 3.0;

  2360.   fRange.r          := $FF;

  2361.   fRange.g          := $FF;

  2362.   fRange.b          := $FF;

  2363.   fShift.r          :=  16;

  2364.   fShift.g          :=   8;

  2365.   fShift.b          :=   0;

  2366.   fglFormat         := GL_BGR;

  2367.   fglDataFormat     := GL_UNSIGNED_BYTE;

  2368. end;

  2369. 

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

  2371. //TdfRGBA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2372. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2374. begin

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

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

  2377.   inc(aData);

  2378. end;

  2379. 

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

  2381. begin

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

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

  2384.   inc(aData);

  2385. end;

  2386. 

  2387. constructor TfdRGBA_UB4.Create;

  2388. begin

  2389.   inherited Create;

  2390.   fPixelSize        := 4.0;

  2391.   fRange.a          := $FF;

  2392.   fShift.a          :=  24;

  2393.   fglFormat         := GL_RGBA;

  2394.   fglDataFormat     := GL_UNSIGNED_BYTE;

  2395. end;

  2396. 

  2397. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2398. //TfdBGRA_UB4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2399. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2401. begin

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

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

  2404.   inc(aData);

  2405. end;

  2406. 

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

  2408. begin

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

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

  2411.   inc(aData);

  2412. end;

  2413. 

  2414. constructor TfdBGRA_UB4.Create;

  2415. begin

  2416.   inherited Create;

  2417.   fPixelSize        := 4.0;

  2418.   fRange.a          := $FF;

  2419.   fShift.a          :=  24;

  2420.   fglFormat         := GL_BGRA;

  2421.   fglDataFormat     := GL_UNSIGNED_BYTE;

  2422. end;

  2423. 

  2424. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2425. //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2426. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2428. begin

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

  2430.   inc(aData, 2);

  2431. end;

  2432. 

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

  2434. begin

  2435.   aPixel.Data.r := 0;

  2436.   aPixel.Data.g := 0;

  2437.   aPixel.Data.b := 0;

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

  2439.   inc(aData, 2);

  2440. end;

  2441. 

  2442. constructor TfdAlpha_US1.Create;

  2443. begin

  2444.   inherited Create;

  2445.   fPixelSize        := 2.0;

  2446.   fRange.a          := $FFFF;

  2447.   fglFormat         := GL_ALPHA;

  2448.   fglDataFormat     := GL_UNSIGNED_SHORT;

  2449. end;

  2450. 

  2451. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2452. //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2453. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2455. begin

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

  2457.   inc(aData, 2);

  2458. end;

  2459. 

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

  2461. begin

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

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

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

  2465.   aPixel.Data.a := 0;

  2466.   inc(aData, 2);

  2467. end;

  2468. 

  2469. constructor TfdLuminance_US1.Create;

  2470. begin

  2471.   inherited Create;

  2472.   fPixelSize        := 2.0;

  2473.   fRange.r          := $FFFF;

  2474.   fRange.g          := $FFFF;

  2475.   fRange.b          := $FFFF;

  2476.   fglFormat         := GL_LUMINANCE;

  2477.   fglDataFormat     := GL_UNSIGNED_SHORT;

  2478. end;

  2479. 

  2480. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2481. //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2482. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2484. var

  2485.   i: Integer;

  2486. begin

  2487.   PWord(aData)^ := 0;

  2488.   for i := 0 to 3 do

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

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

  2491.   inc(aData, 2);

  2492. end;

  2493. 

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

  2495. var

  2496.   i: Integer;

  2497. begin

  2498.   for i := 0 to 3 do

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

  2500.   inc(aData, 2);

  2501. end;

  2502. 

  2503. constructor TfdUniversal_US1.Create;

  2504. begin

  2505.   inherited Create;

  2506.   fPixelSize := 2.0;

  2507. end;

  2508. 

  2509. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2510. //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2511. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2513. begin

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

  2515.   inc(aData, 2);

  2516. end;

  2517. 

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

  2519. begin

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

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

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

  2523.   aPixel.Data.a := 0;

  2524.   inc(aData, 2);

  2525. end;

  2526. 

  2527. constructor TfdDepth_US1.Create;

  2528. begin

  2529.   inherited Create;

  2530.   fPixelSize        := 2.0;

  2531.   fRange.r          := $FFFF;

  2532.   fRange.g          := $FFFF;

  2533.   fRange.b          := $FFFF;

  2534.   fglFormat         := GL_DEPTH_COMPONENT;

  2535.   fglDataFormat     := GL_UNSIGNED_SHORT;

  2536. end;

  2537. 

  2538. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2539. //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2540. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2542. begin

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

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

  2545.   inc(aData, 2);

  2546. end;

  2547. 

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

  2549. begin

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

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

  2552.   inc(aData, 2);

  2553. end;

  2554. 

  2555. constructor TfdLuminanceAlpha_US2.Create;

  2556. begin

  2557.   inherited Create;

  2558.   fPixelSize        :=   4.0;

  2559.   fRange.a          := $FFFF;

  2560.   fShift.a          :=    16;

  2561.   fglFormat         := GL_LUMINANCE_ALPHA;

  2562.   fglDataFormat     := GL_UNSIGNED_SHORT;

  2563. end;

  2564. 

  2565. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2566. //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2567. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2569. begin

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

  2571.   inc(aData, 2);

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

  2573.   inc(aData, 2);

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

  2575.   inc(aData, 2);

  2576. end;

  2577. 

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

  2579. begin

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

  2581.   inc(aData, 2);

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

  2583.   inc(aData, 2);

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

  2585.   inc(aData, 2);

  2586.   aPixel.Data.a := 0;

  2587. end;

  2588. 

  2589. constructor TfdRGB_US3.Create;

  2590. begin

  2591.   inherited Create;

  2592.   fPixelSize        :=   6.0;

  2593.   fRange.r          := $FFFF;

  2594.   fRange.g          := $FFFF;

  2595.   fRange.b          := $FFFF;

  2596.   fShift.r          :=     0;

  2597.   fShift.g          :=    16;

  2598.   fShift.b          :=    32;

  2599.   fglFormat         := GL_RGB;

  2600.   fglDataFormat     := GL_UNSIGNED_SHORT;

  2601. end;

  2602. 

  2603. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2604. //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2605. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2607. begin

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

  2609.   inc(aData, 2);

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

  2611.   inc(aData, 2);

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

  2613.   inc(aData, 2);

  2614. end;

  2615. 

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

  2617. begin

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

  2619.   inc(aData, 2);

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

  2621.   inc(aData, 2);

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

  2623.   inc(aData, 2);

  2624.   aPixel.Data.a := 0;

  2625. end;

  2626. 

  2627. constructor TfdBGR_US3.Create;

  2628. begin

  2629.   inherited Create;

  2630.   fPixelSize        :=   6.0;

  2631.   fRange.r          := $FFFF;

  2632.   fRange.g          := $FFFF;

  2633.   fRange.b          := $FFFF;

  2634.   fShift.r          :=    32;

  2635.   fShift.g          :=    16;

  2636.   fShift.b          :=     0;

  2637.   fglFormat         := GL_BGR;

  2638.   fglDataFormat     := GL_UNSIGNED_SHORT;

  2639. end;

  2640. 

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

  2642. //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2643. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2645. begin

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

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

  2648.   inc(aData, 2);

  2649. end;

  2650. 

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

  2652. begin

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

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

  2655.   inc(aData, 2);

  2656. end;

  2657. 

  2658. constructor TfdRGBA_US4.Create;

  2659. begin

  2660.   inherited Create;

  2661.   fPixelSize        :=   8.0;

  2662.   fRange.a          := $FFFF;

  2663.   fShift.a          :=    48;

  2664.   fglFormat         := GL_RGBA;

  2665.   fglDataFormat     := GL_UNSIGNED_SHORT;

  2666. end;

  2667. 

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

  2669. //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2670. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2672. begin

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

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

  2675.   inc(aData, 2);

  2676. end;

  2677. 

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

  2679. begin

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

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

  2682.   inc(aData, 2);

  2683. end;

  2684. 

  2685. constructor TfdBGRA_US4.Create;

  2686. begin

  2687.   inherited Create;

  2688.   fPixelSize        :=   8.0;

  2689.   fRange.a          := $FFFF;

  2690.   fShift.a          :=    48;

  2691.   fglFormat         := GL_BGRA;

  2692.   fglDataFormat     := GL_UNSIGNED_SHORT;

  2693. end;

  2694. 

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

  2696. //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

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

  2699. var

  2700.   i: Integer;

  2701. begin

  2702.   PCardinal(aData)^ := 0;

  2703.   for i := 0 to 3 do

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

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

  2706.   inc(aData, 4);

  2707. end;

  2708. 

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

  2710. var

  2711.   i: Integer;

  2712. begin

  2713.   for i := 0 to 3 do

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

  2715.   inc(aData, 2);

  2716. end;

  2717. 

  2718. constructor TfdUniversal_UI1.Create;

  2719. begin

  2720.   inherited Create;

  2721.   fPixelSize := 4.0;

  2722. end;

  2723. 

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

  2725. //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

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

  2728. begin

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

  2730.   inc(aData, 4);

  2731. end;

  2732. 

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

  2734. begin

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

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

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

  2738.   aPixel.Data.a := 0;

  2739.   inc(aData, 4);

  2740. end;

  2741. 

  2742. constructor TfdDepth_UI1.Create;

  2743. begin

  2744.   inherited Create;

  2745.   fPixelSize        := 4.0;

  2746.   fRange.r          := $FFFFFFFF;

  2747.   fRange.g          := $FFFFFFFF;

  2748.   fRange.b          := $FFFFFFFF;

  2749.   fglFormat         := GL_DEPTH_COMPONENT;

  2750.   fglDataFormat     := GL_UNSIGNED_INT;

  2751. end;

  2752. 

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

  2754. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2756. constructor TfdAlpha4.Create;

  2757. begin

  2758.   inherited Create;

  2759.   fFormat           := tfAlpha4;

  2760.   fWithAlpha        := tfAlpha4;

  2761.   fglInternalFormat := GL_ALPHA4;

  2762. end;

  2763. 

  2764. constructor TfdAlpha8.Create;

  2765. begin

  2766.   inherited Create;

  2767.   fFormat           := tfAlpha8;

  2768.   fWithAlpha        := tfAlpha8;

  2769.   fglInternalFormat := GL_ALPHA8;

  2770. end;

  2771. 

  2772. constructor TfdAlpha12.Create;

  2773. begin

  2774.   inherited Create;

  2775.   fFormat           := tfAlpha12;

  2776.   fWithAlpha        := tfAlpha12;

  2777.   fglInternalFormat := GL_ALPHA12;

  2778. end;

  2779. 

  2780. constructor TfdAlpha16.Create;

  2781. begin

  2782.   inherited Create;

  2783.   fFormat           := tfAlpha16;

  2784.   fWithAlpha        := tfAlpha16;

  2785.   fglInternalFormat := GL_ALPHA16;

  2786. end;

  2787. 

  2788. constructor TfdLuminance4.Create;

  2789. begin

  2790.   inherited Create;

  2791.   fFormat           := tfLuminance4;

  2792.   fWithAlpha        := tfLuminance4Alpha4;

  2793.   fWithoutAlpha     := tfLuminance4;

  2794.   fglInternalFormat := GL_LUMINANCE4;

  2795. end;

  2796. 

  2797. constructor TfdLuminance8.Create;

  2798. begin

  2799.   inherited Create;

  2800.   fFormat           := tfLuminance8;

  2801.   fWithAlpha        := tfLuminance8Alpha8;

  2802.   fWithoutAlpha     := tfLuminance8;

  2803.   fglInternalFormat := GL_LUMINANCE8;

  2804. end;

  2805. 

  2806. constructor TfdLuminance12.Create;

  2807. begin

  2808.   inherited Create;

  2809.   fFormat           := tfLuminance12;

  2810.   fWithAlpha        := tfLuminance12Alpha12;

  2811.   fWithoutAlpha     := tfLuminance12;

  2812.   fglInternalFormat := GL_LUMINANCE12;

  2813. end;

  2814. 

  2815. constructor TfdLuminance16.Create;

  2816. begin

  2817.   inherited Create;

  2818.   fFormat           := tfLuminance16;

  2819.   fWithAlpha        := tfLuminance16Alpha16;

  2820.   fWithoutAlpha     := tfLuminance16;

  2821.   fglInternalFormat := GL_LUMINANCE16;

  2822. end;

  2823. 

  2824. constructor TfdLuminance4Alpha4.Create;

  2825. begin

  2826.   inherited Create;

  2827.   fFormat           := tfLuminance4Alpha4;

  2828.   fWithAlpha        := tfLuminance4Alpha4;

  2829.   fWithoutAlpha     := tfLuminance4;

  2830.   fglInternalFormat := GL_LUMINANCE4_ALPHA4;

  2831. end;

  2832. 

  2833. constructor TfdLuminance6Alpha2.Create;

  2834. begin

  2835.   inherited Create;

  2836.   fFormat           := tfLuminance6Alpha2;

  2837.   fWithAlpha        := tfLuminance6Alpha2;

  2838.   fWithoutAlpha     := tfLuminance8;

  2839.   fglInternalFormat := GL_LUMINANCE6_ALPHA2;

  2840. end;

  2841. 

  2842. constructor TfdLuminance8Alpha8.Create;

  2843. begin

  2844.   inherited Create;

  2845.   fFormat           := tfLuminance8Alpha8;

  2846.   fWithAlpha        := tfLuminance8Alpha8;

  2847.   fWithoutAlpha     := tfLuminance8;

  2848.   fglInternalFormat := GL_LUMINANCE8_ALPHA8;

  2849. end;

  2850. 

  2851. constructor TfdLuminance12Alpha4.Create;

  2852. begin

  2853.   inherited Create;

  2854.   fFormat           := tfLuminance12Alpha4;

  2855.   fWithAlpha        := tfLuminance12Alpha4;

  2856.   fWithoutAlpha     := tfLuminance12;

  2857.   fglInternalFormat := GL_LUMINANCE12_ALPHA4;

  2858. end;

  2859. 

  2860. constructor TfdLuminance12Alpha12.Create;

  2861. begin

  2862.   inherited Create;

  2863.   fFormat           := tfLuminance12Alpha12;

  2864.   fWithAlpha        := tfLuminance12Alpha12;

  2865.   fWithoutAlpha     := tfLuminance12;

  2866.   fglInternalFormat := GL_LUMINANCE12_ALPHA12;

  2867. end;

  2868. 

  2869. constructor TfdLuminance16Alpha16.Create;

  2870. begin

  2871.   inherited Create;

  2872.   fFormat           := tfLuminance16Alpha16;

  2873.   fWithAlpha        := tfLuminance16Alpha16;

  2874.   fWithoutAlpha     := tfLuminance16;

  2875.   fglInternalFormat := GL_LUMINANCE16_ALPHA16;

  2876. end;

  2877. 

  2878. constructor TfdR3G3B2.Create;

  2879. begin

  2880.   inherited Create;

  2881.   fFormat           := tfR3G3B2;

  2882.   fWithAlpha        := tfRGBA2;

  2883.   fWithoutAlpha     := tfR3G3B2;

  2884.   fRange.r          := $7;

  2885.   fRange.g          := $7;

  2886.   fRange.b          := $3;

  2887.   fShift.r          :=  0;

  2888.   fShift.g          :=  3;

  2889.   fShift.b          :=  6;

  2890.   fglFormat         := GL_RGB;

  2891.   fglInternalFormat := GL_R3_G3_B2;

  2892.   fglDataFormat     := GL_UNSIGNED_BYTE_2_3_3_REV;

  2893. end;

  2894. 

  2895. constructor TfdRGB4.Create;

  2896. begin

  2897.   inherited Create;

  2898.   fFormat           := tfRGB4;

  2899.   fWithAlpha        := tfRGBA4;

  2900.   fWithoutAlpha     := tfRGB4;

  2901.   fRange.r          := $F;

  2902.   fRange.g          := $F;

  2903.   fRange.b          := $F;

  2904.   fShift.r          :=  0;

  2905.   fShift.g          :=  4;

  2906.   fShift.b          :=  8;

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

  2908.   fglInternalFormat := GL_RGB4;

  2909.   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;

  2910. end;

  2911. 

  2912. constructor TfdR5G6B5.Create;

  2913. begin

  2914.   inherited Create;

  2915.   fFormat           := tfR5G6B5;

  2916.   fWithAlpha        := tfRGBA4;

  2917.   fWithoutAlpha     := tfR5G6B5;

  2918.   fRange.r          := $1F;

  2919.   fRange.g          := $3F;

  2920.   fRange.b          := $1F;

  2921.   fShift.r          :=   0;

  2922.   fShift.g          :=   5;

  2923.   fShift.b          :=  11;

  2924.   fglFormat         := GL_RGB;

  2925.   fglInternalFormat := GL_RGB565;

  2926.   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5_REV;

  2927. end;

  2928. 

  2929. constructor TfdRGB5.Create;

  2930. begin

  2931.   inherited Create;

  2932.   fFormat           := tfRGB5;

  2933.   fWithAlpha        := tfRGB5A1;

  2934.   fWithoutAlpha     := tfRGB5;

  2935.   fRange.r          := $1F;

  2936.   fRange.g          := $1F;

  2937.   fRange.b          := $1F;

  2938.   fShift.r          :=   0;

  2939.   fShift.g          :=   5;

  2940.   fShift.b          :=  10;

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

  2942.   fglInternalFormat := GL_RGB5;

  2943.   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;

  2944. end;

  2945. 

  2946. constructor TfdRGB8.Create;

  2947. begin

  2948.   inherited Create;

  2949.   fFormat           := tfRGB8;

  2950.   fWithAlpha        := tfRGBA8;

  2951.   fWithoutAlpha     := tfRGB8;

  2952.   fglInternalFormat := GL_RGB8;

  2953. end;

  2954. 

  2955. constructor TfdRGB10.Create;

  2956. begin

  2957.   inherited Create;

  2958.   fFormat           := tfRGB10;

  2959.   fWithAlpha        := tfRGB10A2;

  2960.   fWithoutAlpha     := tfRGB10;

  2961.   fRange.r          := $3FF;

  2962.   fRange.g          := $3FF;

  2963.   fRange.b          := $3FF;

  2964.   fShift.r          :=    0;

  2965.   fShift.g          :=   10;

  2966.   fShift.b          :=   20;

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

  2968.   fglInternalFormat := GL_RGB10;

  2969.   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;

  2970. end;

  2971. 

  2972. constructor TfdRGB12.Create;

  2973. begin

  2974.   inherited Create;

  2975.   fFormat           := tfRGB12;

  2976.   fWithAlpha        := tfRGBA12;

  2977.   fWithoutAlpha     := tfRGB12;

  2978.   fglInternalFormat := GL_RGB12;

  2979. end;

  2980. 

  2981. constructor TfdRGB16.Create;

  2982. begin

  2983.   inherited Create;

  2984.   fFormat           := tfRGB16;

  2985.   fWithAlpha        := tfRGBA16;

  2986.   fWithoutAlpha     := tfRGB16;

  2987.   fglInternalFormat := GL_RGB16;

  2988. end;

  2989. 

  2990. constructor TfdRGBA2.Create;

  2991. begin

  2992.   inherited Create;

  2993.   fFormat           := tfRGBA2;

  2994.   fWithAlpha        := tfRGBA2;

  2995.   fWithoutAlpha     := tfR3G3B2;

  2996.   fglInternalFormat := GL_RGBA2;

  2997. end;

  2998. 

  2999. constructor TfdRGBA4.Create;

  3000. begin

  3001.   inherited Create;

  3002.   fFormat           := tfRGBA4;

  3003.   fWithAlpha        := tfRGBA4;

  3004.   fWithoutAlpha     := tfRGB4;

  3005.   fRange.r          := $F;

  3006.   fRange.g          := $F;

  3007.   fRange.b          := $F;

  3008.   fRange.a          := $F;

  3009.   fShift.r          :=  0;

  3010.   fShift.g          :=  4;

  3011.   fShift.b          :=  8;

  3012.   fShift.a          := 12;

  3013.   fglFormat         := GL_RGBA;

  3014.   fglInternalFormat := GL_RGBA4;

  3015.   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;

  3016. end;

  3017. 

  3018. constructor TfdRGB5A1.Create;

  3019. begin

  3020.   inherited Create;

  3021.   fFormat           := tfRGB5A1;

  3022.   fWithAlpha        := tfRGB5A1;

  3023.   fWithoutAlpha     := tfRGB5;

  3024.   fRange.r          := $1F;

  3025.   fRange.g          := $1F;

  3026.   fRange.b          := $1F;

  3027.   fRange.a          := $01;

  3028.   fShift.r          :=   0;

  3029.   fShift.g          :=   5;

  3030.   fShift.b          :=  10;

  3031.   fShift.a          :=  15;

  3032.   fglFormat         := GL_RGBA;

  3033.   fglInternalFormat := GL_RGB5_A1;

  3034.   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;

  3035. end;

  3036. 

  3037. constructor TfdRGBA8.Create;

  3038. begin

  3039.   inherited Create;

  3040.   fFormat           := tfRGBA8;

  3041.   fWithAlpha        := tfRGBA8;

  3042.   fWithoutAlpha     := tfRGB8;

  3043.   fglInternalFormat := GL_RGBA8;

  3044. end;

  3045. 

  3046. constructor TfdRGB10A2.Create;

  3047. begin

  3048.   inherited Create;

  3049.   fFormat           := tfRGB10A2;

  3050.   fWithAlpha        := tfRGB10A2;

  3051.   fWithoutAlpha     := tfRGB10;

  3052.   fRange.r          := $3FF;

  3053.   fRange.g          := $3FF;

  3054.   fRange.b          := $3FF;

  3055.   fRange.a          := $003;

  3056.   fShift.r          :=    0;

  3057.   fShift.g          :=   10;

  3058.   fShift.b          :=   20;

  3059.   fShift.a          :=   30;

  3060.   fglFormat         := GL_RGBA;

  3061.   fglInternalFormat := GL_RGB10_A2;

  3062.   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;

  3063. end;

  3064. 

  3065. constructor TfdRGBA12.Create;

  3066. begin

  3067.   inherited Create;

  3068.   fFormat           := tfRGBA12;

  3069.   fWithAlpha        := tfRGBA12;

  3070.   fWithoutAlpha     := tfRGB12;

  3071.   fglInternalFormat := GL_RGBA12;

  3072. end;

  3073. 

  3074. constructor TfdRGBA16.Create;

  3075. begin

  3076.   inherited Create;

  3077.   fFormat           := tfRGBA16;

  3078.   fWithAlpha        := tfRGBA16;

  3079.   fWithoutAlpha     := tfRGB16;

  3080.   fglInternalFormat := GL_RGBA16;

  3081. end;

  3082. 

  3083. constructor TfdBGR4.Create;

  3084. begin

  3085.   inherited Create;

  3086.   fPixelSize        := 2.0;

  3087.   fFormat           := tfBGR4;

  3088.   fWithAlpha        := tfBGRA4;

  3089.   fWithoutAlpha     := tfBGR4;

  3090.   fRange.r          := $F;

  3091.   fRange.g          := $F;

  3092.   fRange.b          := $F;

  3093.   fRange.a          := $0;

  3094.   fShift.r          :=  8;

  3095.   fShift.g          :=  4;

  3096.   fShift.b          :=  0;

  3097.   fShift.a          :=  0;

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

  3099.   fglInternalFormat := GL_RGB4;

  3100.   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;

  3101. end;

  3102. 

  3103. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3104. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3105. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3106. constructor TfdB5G6R5.Create;

  3107. begin

  3108.   inherited Create;

  3109.   fFormat           := tfB5G6R5;

  3110.   fWithAlpha        := tfBGRA4;

  3111.   fWithoutAlpha     := tfB5G6R5;

  3112.   fRange.r          := $1F;

  3113.   fRange.g          := $3F;

  3114.   fRange.b          := $1F;

  3115.   fShift.r          :=  11;

  3116.   fShift.g          :=   5;

  3117.   fShift.b          :=   0;

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

  3119.   fglInternalFormat := GL_RGB8;

  3120.   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5;

  3121. end;

  3122. 

  3123. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3124. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3125. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3126. constructor TfdBGR5.Create;

  3127. begin

  3128.   inherited Create;

  3129.   fPixelSize        := 2.0;

  3130.   fFormat           := tfBGR5;

  3131.   fWithAlpha        := tfBGR5A1;

  3132.   fWithoutAlpha     := tfBGR5;

  3133.   fRange.r          := $1F;

  3134.   fRange.g          := $1F;

  3135.   fRange.b          := $1F;

  3136.   fRange.a          := $00;

  3137.   fShift.r          :=  10;

  3138.   fShift.g          :=   5;

  3139.   fShift.b          :=   0;

  3140.   fShift.a          :=   0;

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

  3142.   fglInternalFormat := GL_RGB5;

  3143.   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;

  3144. end;

  3145. 

  3146. constructor TfdBGR8.Create;

  3147. begin

  3148.   inherited Create;

  3149.   fFormat           := tfBGR8;

  3150.   fWithAlpha        := tfBGRA8;

  3151.   fWithoutAlpha     := tfBGR8;

  3152.   fglInternalFormat := GL_RGB8;

  3153. end;

  3154. 

  3155. constructor TfdBGR10.Create;

  3156. begin

  3157.   inherited Create;

  3158.   fFormat           := tfBGR10;

  3159.   fWithAlpha        := tfBGR10A2;

  3160.   fWithoutAlpha     := tfBGR10;

  3161.   fRange.r          := $3FF;

  3162.   fRange.g          := $3FF;

  3163.   fRange.b          := $3FF;

  3164.   fRange.a          := $000;

  3165.   fShift.r          :=   20;

  3166.   fShift.g          :=   10;

  3167.   fShift.b          :=    0;

  3168.   fShift.a          :=    0;

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

  3170.   fglInternalFormat := GL_RGB10;

  3171.   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;

  3172. end;

  3173. 

  3174. constructor TfdBGR12.Create;

  3175. begin

  3176.   inherited Create;

  3177.   fFormat           := tfBGR12;

  3178.   fWithAlpha        := tfBGRA12;

  3179.   fWithoutAlpha     := tfBGR12;

  3180.   fglInternalFormat := GL_RGB12;

  3181. end;

  3182. 

  3183. constructor TfdBGR16.Create;

  3184. begin

  3185.   inherited Create;

  3186.   fFormat           := tfBGR16;

  3187.   fWithAlpha        := tfBGRA16;

  3188.   fWithoutAlpha     := tfBGR16;

  3189.   fglInternalFormat := GL_RGB16;

  3190. end;

  3191. 

  3192. constructor TfdBGRA2.Create;

  3193. begin

  3194.   inherited Create;

  3195.   fFormat           := tfBGRA2;

  3196.   fWithAlpha        := tfBGRA4;

  3197.   fWithoutAlpha     := tfBGR4;

  3198.   fglInternalFormat := GL_RGBA2;

  3199. end;

  3200. 

  3201. constructor TfdBGRA4.Create;

  3202. begin

  3203.   inherited Create;

  3204.   fFormat           := tfBGRA4;

  3205.   fWithAlpha        := tfBGRA4;

  3206.   fWithoutAlpha     := tfBGR4;

  3207.   fRange.r          := $F;

  3208.   fRange.g          := $F;

  3209.   fRange.b          := $F;

  3210.   fRange.a          := $F;

  3211.   fShift.r          :=  8;

  3212.   fShift.g          :=  4;

  3213.   fShift.b          :=  0;

  3214.   fShift.a          := 12;

  3215.   fglFormat         := GL_BGRA;

  3216.   fglInternalFormat := GL_RGBA4;

  3217.   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;

  3218. end;

  3219. 

  3220. constructor TfdBGR5A1.Create;

  3221. begin

  3222.   inherited Create;

  3223.   fFormat           := tfBGR5A1;

  3224.   fWithAlpha        := tfBGR5A1;

  3225.   fWithoutAlpha     := tfBGR5;

  3226.   fRange.r          := $1F;

  3227.   fRange.g          := $1F;

  3228.   fRange.b          := $1F;

  3229.   fRange.a          := $01;

  3230.   fShift.r          :=  10;

  3231.   fShift.g          :=   5;

  3232.   fShift.b          :=   0;

  3233.   fShift.a          :=  15;

  3234.   fglFormat         := GL_BGRA;

  3235.   fglInternalFormat := GL_RGB5_A1;

  3236.   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;

  3237. end;

  3238. 

  3239. constructor TfdBGRA8.Create;

  3240. begin

  3241.   inherited Create;

  3242.   fFormat           := tfBGRA8;

  3243.   fWithAlpha        := tfBGRA8;

  3244.   fWithoutAlpha     := tfBGR8;

  3245.   fglInternalFormat := GL_RGBA8;

  3246. end;

  3247. 

  3248. constructor TfdBGR10A2.Create;

  3249. begin

  3250.   inherited Create;

  3251.   fFormat           := tfBGR10A2;

  3252.   fWithAlpha        := tfBGR10A2;

  3253.   fWithoutAlpha     := tfBGR10;

  3254.   fRange.r          := $3FF;

  3255.   fRange.g          := $3FF;

  3256.   fRange.b          := $3FF;

  3257.   fRange.a          := $003;

  3258.   fShift.r          :=   20;

  3259.   fShift.g          :=   10;

  3260.   fShift.b          :=    0;

  3261.   fShift.a          :=   30;

  3262.   fglFormat         := GL_BGRA;

  3263.   fglInternalFormat := GL_RGB10_A2;

  3264.   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;

  3265. end;

  3266. 

  3267. constructor TfdBGRA12.Create;

  3268. begin

  3269.   inherited Create;

  3270.   fFormat           := tfBGRA12;

  3271.   fWithAlpha        := tfBGRA12;

  3272.   fWithoutAlpha     := tfBGR12;

  3273.   fglInternalFormat := GL_RGBA12;

  3274. end;

  3275. 

  3276. constructor TfdBGRA16.Create;

  3277. begin

  3278.   inherited Create;

  3279.   fFormat           := tfBGRA16;

  3280.   fWithAlpha        := tfBGRA16;

  3281.   fWithoutAlpha     := tfBGR16;

  3282.   fglInternalFormat := GL_RGBA16;

  3283. end;

  3284. 

  3285. constructor TfdDepth16.Create;

  3286. begin

  3287.   inherited Create;

  3288.   fFormat           := tfDepth16;

  3289.   fWithAlpha        := tfEmpty;

  3290.   fWithoutAlpha     := tfDepth16;

  3291.   fglInternalFormat := GL_DEPTH_COMPONENT16;

  3292. end;

  3293. 

  3294. constructor TfdDepth24.Create;

  3295. begin

  3296.   inherited Create;

  3297.   fFormat           := tfDepth24;

  3298.   fWithAlpha        := tfEmpty;

  3299.   fWithoutAlpha     := tfDepth24;

  3300.   fglInternalFormat := GL_DEPTH_COMPONENT24;

  3301. end;

  3302. 

  3303. constructor TfdDepth32.Create;

  3304. begin

  3305.   inherited Create;

  3306.   fFormat           := tfDepth32;

  3307.   fWithAlpha        := tfEmpty;

  3308.   fWithoutAlpha     := tfDepth32;

  3309.   fglInternalFormat := GL_DEPTH_COMPONENT32;

  3310. end;

  3311. 

  3312. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3313. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3314. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3315. class procedure TFormatDescriptor.Init;

  3316. begin

  3317.   if not Assigned(FormatDescriptorCS) then

  3318.     FormatDescriptorCS := TCriticalSection.Create;

  3319. end;

  3320. 

  3321. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  3323. begin

  3324.   FormatDescriptorCS.Enter;

  3325.   try

  3326.     result := FormatDescriptors[aFormat];

  3327.     if not Assigned(result) then begin

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

  3329.       FormatDescriptors[aFormat] := result;

  3330.     end;

  3331.   finally

  3332.     FormatDescriptorCS.Leave;

  3333.   end;

  3334. end;

  3335. 

  3336. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  3338. begin

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

  3340. end;

  3341. 

  3342. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3343. class procedure TFormatDescriptor.Clear;

  3344. var

  3345.   f: TglBitmapFormat;

  3346. begin

  3347.   FormatDescriptorCS.Enter;

  3348.   try

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

  3350.       FreeAndNil(FormatDescriptors[f]);

  3351.   finally

  3352.     FormatDescriptorCS.Leave;

  3353.   end;

  3354. end;

  3355. 

  3356. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3357. class procedure TFormatDescriptor.Finalize;

  3358. begin

  3359.   Clear;

  3360.   FreeAndNil(FormatDescriptorCS);

  3361. end;

  3362. 

  3363. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3364. //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3365. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3366. procedure TBitfieldFormat.SetRedMask(const aValue: UInt64);

  3367. begin

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

  3369. end;

  3370. 

  3371. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3372. procedure TBitfieldFormat.SetGreenMask(const aValue: UInt64);

  3373. begin

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

  3375. end;

  3376. 

  3377. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3378. procedure TBitfieldFormat.SetBlueMask(const aValue: UInt64);

  3379. begin

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

  3381. end;

  3382. 

  3383. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3384. procedure TBitfieldFormat.SetAlphaMask(const aValue: UInt64);

  3385. begin

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

  3387. end;

  3388. 

  3389. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3390. procedure TBitfieldFormat.Update(aMask: UInt64; out aRange: Cardinal; out

  3391.   aShift: Byte);

  3392. begin

  3393.   aShift := 0;

  3394.   aRange := 0;

  3395.   if (aMask = 0) then

  3396.     exit;

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

  3398.     inc(aShift);

  3399.     aMask := aMask shr 1;

  3400.   end;

  3401.   aRange := 1;

  3402.   while (aMask > 0) do begin

  3403.     aRange := aRange shl 1;

  3404.     aMask  := aMask  shr 1;

  3405.   end;

  3406.   dec(aRange);

  3407. 

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

  3409. end;

  3410. 

  3411. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3412. procedure TBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);

  3413. var

  3414.   data: UInt64;

  3415.   s: Integer;

  3416. type

  3417.   PUInt64 = ^UInt64;

  3418. begin

  3419.   data :=

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

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

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

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

  3424.   s := Round(fPixelSize);

  3425.   case s of

  3426.     1:           aData^  := data;

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

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

  3429.     8:   PUInt64(aData)^ := data;

  3430.   else

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

  3432.   end;

  3433.   inc(aData, s);

  3434. end;

  3435. 

  3436. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3437. procedure TBitfieldFormat.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);

  3438. var

  3439.   data: UInt64;

  3440.   s, i: Integer;

  3441. type

  3442.   PUInt64 = ^UInt64;

  3443. begin

  3444.   s := Round(fPixelSize);

  3445.   case s of

  3446.     1: data :=           aData^;

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

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

  3449.     8: data :=   PUInt64(aData)^;

  3450.   else

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

  3452.   end;

  3453.   for i := 0 to 3 do

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

  3455.   inc(aData, s);

  3456. end;

  3457. 

  3458. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3459. //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3460. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3461. procedure TColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);

  3462. begin

  3463.   raise EglBitmapException.Create('mapping of color table formats is not supported');

  3464. end;

  3465. 

  3466. procedure TColorTableFormat.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);

  3467. type

  3468.   PUInt64 = ^UInt64;

  3469. var

  3470.   idx: UInt64;

  3471.   s: Integer;

  3472.   bits: Byte;

  3473.   f: Single;

  3474. begin

  3475.   s    := Trunc(fPixelSize);

  3476.   f    := fPixelSize - s;

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

  3478.   case s of

  3479.     0: idx :=          (aData^ shr (8 - bits - PtrInt(aMapData))) and ((1 shl bits) - 1);

  3480.     1: idx :=           aData^;

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

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

  3483.     8: idx :=   PUInt64(aData)^;

  3484.   else

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

  3486.   end;

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

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

  3489.   with fColorTable[idx] do begin

  3490.     aPixel.Data.r := r;

  3491.     aPixel.Data.g := g;

  3492.     aPixel.Data.b := b;

  3493.     aPixel.Data.a := a;

  3494.   end;

  3495.   inc(aMapData, bits);

  3496.   if (PtrInt(aMapData) >= 8) then begin

  3497.     inc(aData, 1);

  3498.     dec(aMapData, 8);

  3499.   end;

  3500.   inc(aData, s);

  3501. end;

  3502. 

  3503. destructor TColorTableFormat.Destroy;

  3504. begin

  3505.   SetLength(fColorTable, 0);

  3506.   inherited Destroy;

  3507. end;

  3508. 

  3509. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3510. //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3511. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3512. procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);

  3513. begin

  3514.   with aFuncRec do begin

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

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

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

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

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

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

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

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

  3523.   end;

  3524. end;

  3525. 

  3526. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3527. procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);

  3528. var

  3529.   i: Integer;

  3530. begin

  3531.   with aFuncRec do begin

  3532.     for i := 0 to 3 do

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

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

  3535.   end;

  3536. end;

  3537. 

  3538. type

  3539.   TShiftData = packed record

  3540.     case Integer of

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

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

  3543.   end;

  3544.   PShiftData = ^TShiftData;

  3545. 

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

  3547. procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);

  3548. var

  3549.   i: Integer;

  3550. begin

  3551.   with aFuncRec do

  3552.     for i := 0 to 3 do

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

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

  3555. end;

  3556. 

  3557. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3558. procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);

  3559. begin

  3560.   with aFuncRec do begin

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

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

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

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

  3565.     if (Args and $1 > 0) then begin

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

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

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

  3569.     end;

  3570.     if (Args and $2 > 0) then begin

  3571.       Dest.Data.a := Dest.Data.a xor Dest.Range.a;

  3572.     end;

  3573.   end;

  3574. end;

  3575. 

  3576. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3577. procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);

  3578. var

  3579.   i: Integer;

  3580. begin

  3581.   with aFuncRec do begin

  3582.     for i := 0 to 3 do

  3583.       Dest.Data.arr[i] := PglBitmapPixelData(Args)^.Data.arr[i];

  3584.   end;

  3585. end;

  3586. 

  3587. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3588. procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);

  3589. var

  3590.   Temp: Single;

  3591. begin

  3592.   with FuncRec do begin

  3593.     if (FuncRec.Args = 0) then begin //source has no alpha

  3594.       Temp :=

  3595.         Source.Data.r / Source.Range.r * ALPHA_WEIGHT_R +

  3596.         Source.Data.g / Source.Range.g * ALPHA_WEIGHT_G +

  3597.         Source.Data.b / Source.Range.b * ALPHA_WEIGHT_B;

  3598.       Dest.Data.a := Round(Dest.Range.a * Temp);

  3599.     end else

  3600.       Dest.Data.a := Round(Source.Data.a / Source.Range.a * Dest.Range.a);

  3601.   end;

  3602. end;

  3603. 

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

  3605. procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);

  3606. type

  3607.   PglBitmapPixelData = ^TglBitmapPixelData;

  3608. begin

  3609.   with FuncRec do begin

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

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

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

  3613. 

  3614.     with PglBitmapPixelData(Args)^ do

  3615.       if ((Dest.Data.r <= Data.r) and (Dest.Data.r >= Range.r) and

  3616.           (Dest.Data.g <= Data.g) and (Dest.Data.g >= Range.g) and

  3617.           (Dest.Data.b <= Data.b) and (Dest.Data.b >= Range.b)) then

  3618.         Dest.Data.a := 0

  3619.       else

  3620.         Dest.Data.a := Dest.Range.a;

  3621.   end;

  3622. end;

  3623. 

  3624. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3625. procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);

  3626. type

  3627.   PglBitmapPixelData = ^TglBitmapPixelData;

  3628. begin

  3629.   with FuncRec do begin

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

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

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

  3633.     Dest.Data.a := PCardinal(Args)^;

  3634.   end;

  3635. end;

  3636. 

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

  3638. procedure SwapRGB(aData: PByte; aWidth: Integer; const aHasAlpha: Boolean);

  3639. type

  3640.   PRGBPix = ^TRGBPix;

  3641.   TRGBPix = array [0..2] of byte;

  3642. var

  3643.   Temp: Byte;

  3644. begin

  3645.   while aWidth > 0 do begin

  3646.     Temp := PRGBPix(aData)^[0];

  3647.     PRGBPix(aData)^[0] := PRGBPix(aData)^[2];

  3648.     PRGBPix(aData)^[2] := Temp;

  3649. 

  3650.     if aHasAlpha then

  3651.       Inc(aData, 4)

  3652.     else

  3653.       Inc(aData, 3);

  3654.     dec(aWidth);

  3655.   end;

  3656. end;

  3657. 

  3658. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3659. //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  3661. function TglBitmap.GetWidth: Integer;

  3662. begin

  3663.   if (ffX in fDimension.Fields) then

  3664.     result := fDimension.X

  3665.   else

  3666.     result := -1;

  3667. end;

  3668. 

  3669. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3670. function TglBitmap.GetHeight: Integer;

  3671. begin

  3672.   if (ffY in fDimension.Fields) then

  3673.     result := fDimension.Y

  3674.   else

  3675.     result := -1;

  3676. end;

  3677. 

  3678. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3679. function TglBitmap.GetFileWidth: Integer;

  3680. begin

  3681.   result := Max(1, Width);

  3682. end;

  3683. 

  3684. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3685. function TglBitmap.GetFileHeight: Integer;

  3686. begin

  3687.   result := Max(1, Height);

  3688. end;

  3689. 

  3690. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3691. procedure TglBitmap.SetCustomData(const aValue: Pointer);

  3692. begin

  3693.   if fCustomData = aValue then

  3694.     exit;

  3695.   fCustomData := aValue;

  3696. end;

  3697. 

  3698. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3699. procedure TglBitmap.SetCustomName(const aValue: String);

  3700. begin

  3701.   if fCustomName = aValue then

  3702.     exit;

  3703.   fCustomName := aValue;

  3704. end;

  3705. 

  3706. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3707. procedure TglBitmap.SetCustomNameW(const aValue: WideString);

  3708. begin

  3709.   if fCustomNameW = aValue then

  3710.     exit;

  3711.   fCustomNameW := aValue;

  3712. end;

  3713. 

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

  3715. procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);

  3716. begin

  3717.   if fDeleteTextureOnFree = aValue then

  3718.     exit;

  3719.   fDeleteTextureOnFree := aValue;

  3720. end;

  3721. 

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

  3723. procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);

  3724. begin

  3725.   if fFormat = aValue then

  3726.     exit;

  3727.   if TFormatDescriptor.Get(Format).PixelSize <> TFormatDescriptor.Get(aValue).PixelSize then

  3728.     raise EglBitmapUnsupportedFormatFormat.Create('SetInternalFormat - ' + UNSUPPORTED_FORMAT);

  3729.   SetDataPointer(Data, aValue, Width, Height);

  3730. end;

  3731. 

  3732. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3733. procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);

  3734. begin

  3735.   if fFreeDataAfterGenTexture = aValue then

  3736.     exit;

  3737.   fFreeDataAfterGenTexture := aValue;

  3738. end;

  3739. 

  3740. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3741. procedure TglBitmap.SetID(const aValue: Cardinal);

  3742. begin

  3743.   if fID = aValue then

  3744.     exit;

  3745.   fID := aValue;

  3746. end;

  3747. 

  3748. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3749. procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);

  3750. begin

  3751.   if fMipMap = aValue then

  3752.     exit;

  3753.   fMipMap := aValue;

  3754. end;

  3755. 

  3756. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3757. procedure TglBitmap.SetTarget(const aValue: Cardinal);

  3758. begin

  3759.   if fTarget = aValue then

  3760.     exit;

  3761.   fTarget := aValue;

  3762. end;

  3763. 

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

  3765. procedure TglBitmap.SetAnisotropic(const aValue: Integer);

  3766. var

  3767.   MaxAnisotropic: Integer;

  3768. begin

  3769.   fAnisotropic := aValue;

  3770.   if (ID > 0) then begin

  3771.     if GL_EXT_texture_filter_anisotropic then begin

  3772.       if fAnisotropic > 0 then begin

  3773.         Bind(false);

  3774.         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);

  3775.         if aValue > MaxAnisotropic then

  3776.           fAnisotropic := MaxAnisotropic;

  3777.         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);

  3778.       end;

  3779.     end else begin

  3780.       fAnisotropic := 0;

  3781.     end;

  3782.   end;

  3783. end;

  3784. 

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

  3786. procedure TglBitmap.CreateID;

  3787. begin

  3788.   if (ID <> 0) then

  3789.     glDeleteTextures(1, @fID);

  3790.   glGenTextures(1, @fID);

  3791.   Bind(false);

  3792. end;

  3793. 

  3794. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3795. procedure TglBitmap.SetupParameters(var aBuildWithGlu: Boolean);

  3796. begin

  3797.   // Set Up Parameters

  3798.   SetWrap(fWrapS, fWrapT, fWrapR);

  3799.   SetFilter(fFilterMin, fFilterMag);

  3800.   SetAnisotropic(fAnisotropic);

  3801.   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);

  3802. 

  3803.   // Mip Maps Generation Mode

  3804.   aBuildWithGlu := false;

  3805.   if (MipMap = mmMipmap) then begin

  3806.     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then

  3807.       glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)

  3808.     else

  3809.       aBuildWithGlu := true;

  3810.   end else if (MipMap = mmMipmapGlu) then

  3811.     aBuildWithGlu := true;

  3812. end;

  3813. 

  3814. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3815. procedure TglBitmap.SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;

  3816.   const aWidth: Integer; const aHeight: Integer);

  3817. var

  3818.   s: Single;

  3819. begin

  3820.   if (Data <> aData) then begin

  3821.     if (Assigned(Data)) then

  3822.       FreeMem(Data);

  3823.     fData := aData;

  3824.   end;

  3825. 

  3826.   FillChar(fDimension, SizeOf(fDimension), 0);

  3827.   if not Assigned(fData) then begin

  3828.     fFormat    := tfEmpty;

  3829.     fPixelSize := 0;

  3830.     fRowSize   := 0;

  3831.   end else begin

  3832.     if aWidth <> -1 then begin

  3833.       fDimension.Fields := fDimension.Fields + [ffX];

  3834.       fDimension.X := aWidth;

  3835.     end;

  3836. 

  3837.     if aHeight <> -1 then begin

  3838.       fDimension.Fields := fDimension.Fields + [ffY];

  3839.       fDimension.Y := aHeight;

  3840.     end;

  3841. 

  3842.     s := TFormatDescriptor.Get(aFormat).PixelSize;

  3843.     fFormat    := aFormat;

  3844.     fPixelSize := Ceil(s);

  3845.     fRowSize   := Ceil(s * aWidth);

  3846.   end;

  3847. end;

  3848. 

  3849. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3850. function TglBitmap.FlipHorz: Boolean;

  3851. begin

  3852.   result := false;

  3853. end;

  3854. 

  3855. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3856. function TglBitmap.FlipVert: Boolean;

  3857. begin

  3858.   result := false;

  3859. end;

  3860. 

  3861. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3862. //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3863. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3864. procedure TglBitmap.AfterConstruction;

  3865. begin

  3866.   inherited AfterConstruction;

  3867. 

  3868.   fID         := 0;

  3869.   fTarget     := 0;

  3870.   fIsResident := false;

  3871. 

  3872.   fFormat                  := glBitmapGetDefaultFormat;

  3873.   fMipMap                  := glBitmapDefaultMipmap;

  3874.   fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;

  3875.   fDeleteTextureOnFree     := glBitmapGetDefaultDeleteTextureOnFree;

  3876. 

  3877.   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);

  3878.   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);

  3879. end;

  3880. 

  3881. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3882. procedure TglBitmap.BeforeDestruction;

  3883. begin

  3884.   SetDataPointer(nil, tfEmpty);

  3885.   if (fID > 0) and fDeleteTextureOnFree then

  3886.     glDeleteTextures(1, @fID);

  3887.   inherited BeforeDestruction;

  3888. end;

  3889. 

  3890. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3891. procedure TglBitmap.LoadFromFile(const aFilename: String);

  3892. var

  3893.   fs: TFileStream;

  3894. begin

  3895.   fFilename := aFilename;

  3896.   fs := TFileStream.Create(fFilename, fmOpenRead);

  3897.   try

  3898.     fs.Position := 0;

  3899.     LoadFromStream(fs);

  3900.   finally

  3901.     fs.Free;

  3902.   end;

  3903. end;

  3904. 

  3905. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3906. procedure TglBitmap.LoadFromStream(const aStream: TStream);

  3907. begin

  3908.   {$IFDEF GLB_SUPPORT_PNG_READ}

  3909.   if not LoadPNG(aStream) then

  3910.   {$ENDIF}

  3911.   {$IFDEF GLB_SUPPORT_JPEG_READ}

  3912.   if not LoadJPEG(aStream) then

  3913.   {$ENDIF}

  3914.   if not LoadDDS(aStream) then

  3915.   if not LoadTGA(aStream) then

  3916.   if not LoadBMP(aStream) then

  3917.     raise EglBitmapException.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');

  3918. end;

  3919. 

  3920. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3921. procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;

  3922.   const aFormat: TglBitmapFormat; const aArgs: PtrInt);

  3923. var

  3924.   tmpData: PByte;

  3925.   size: Integer;

  3926. begin

  3927.   size := TFormatDescriptor.Get(aFormat).GetSize(aSize);

  3928.   GetMem(tmpData, size);

  3929.   try

  3930.     FillChar(tmpData^, size, #$FF);

  3931.     SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y);

  3932.   except

  3933.     FreeMem(tmpData);

  3934.     raise;

  3935.   end;

  3936.   AddFunc(Self, aFunc, false, Format, aArgs);

  3937. end;

  3938. 

  3939. {$IFDEF GLB_DELPHI}

  3940. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  3942. var

  3943.   rs: TResourceStream;

  3944.   TempPos: Integer;

  3945.   ResTypeStr: String;

  3946.   TempResType: PChar;

  3947. begin

  3948.   if not Assigned(ResType) then begin

  3949.     TempPos     := Pos('.', Resource);

  3950.     ResTypeStr  := UpperCase(Copy(Resource, TempPos + 1, Length(Resource) - TempPos));

  3951.     Resource    := UpperCase(Copy(Resource, 0, TempPos -1));

  3952.     TempResType := PChar(ResTypeStr);

  3953.   end else

  3954.     TempResType := ResType

  3955. 

  3956.   rs := TResourceStream.Create(Instance, Resource, TempResType);

  3957.   try

  3958.     LoadFromStream(rs);

  3959.   finally

  3960.     rs.Free;

  3961.   end;

  3962. end;

  3963. 

  3964. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  3966. var

  3967.   rs: TResourceStream;

  3968. begin

  3969.   rs := TResourceStream.CreateFromID(Instance, ResourceID, ResType);

  3970.   try

  3971.     LoadFromStream(rs);

  3972.   finally

  3973.     rs.Free;

  3974.   end;

  3975. end;

  3976. {$ENDIF}

  3977. 

  3978. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  3980. var

  3981.   fs: TFileStream;

  3982. begin

  3983.   fs := TFileStream.Create(aFileName, fmCreate);

  3984.   try

  3985.     fs.Position := 0;

  3986.     SaveToStream(fs, aFileType);

  3987.   finally

  3988.     fs.Free;

  3989.   end;

  3990. end;

  3991. 

  3992. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3993. procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);

  3994. begin

  3995.   case aFileType of

  3996.     {$IFDEF GLB_SUPPORT_PNG_WRITE}

  3997.     ftPNG:  SavePng(aStream);

  3998.     {$ENDIF}

  3999.     {$IFDEF GLB_SUPPORT_JPEG_WRITE}

  4000.     ftJPEG: SaveJPEG(aStream);

  4001.     {$ENDIF}

  4002.     ftDDS:  SaveDDS(aStream);

  4003.     ftTGA:  SaveTGA(aStream);

  4004.     ftBMP:  SaveBMP(aStream);

  4005.   end;

  4006. end;

  4007. 

  4008. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4009. function TglBitmap.AddFunc(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: PtrInt): Boolean;

  4010. begin

  4011.   result := AddFunc(Self, aFunc, aCreateTemp, Format, aArgs);

  4012. end;

  4013. 

  4014. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  4016.   const aFormat: TglBitmapFormat; const aArgs: PtrInt): Boolean;

  4017. var

  4018.   DestData, TmpData, SourceData: pByte;

  4019.   TempHeight, TempWidth: Integer;

  4020.   SourceFD, DestFD: TFormatDescriptor;

  4021.   SourceMD, DestMD: Pointer;

  4022. 

  4023.   FuncRec: TglBitmapFunctionRec;

  4024. begin

  4025.   Assert(Assigned(Data));

  4026.   Assert(Assigned(aSource));

  4027.   Assert(Assigned(aSource.Data));

  4028. 

  4029.   result := false;

  4030.   if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin

  4031.     SourceFD := TFormatDescriptor.Get(aSource.Format);

  4032.     DestFD   := TFormatDescriptor.Get(aFormat);

  4033. 

  4034.     // inkompatible Formats so CreateTemp

  4035.     if (SourceFD.PixelSize <> DestFD.PixelSize) then

  4036.       aCreateTemp := true;

  4037. 

  4038.     // Values

  4039.     TempHeight := Max(1, aSource.Height);

  4040.     TempWidth  := Max(1, aSource.Width);

  4041. 

  4042.     FuncRec.Sender := Self;

  4043.     FuncRec.Args   := aArgs;

  4044. 

  4045.     TmpData := nil;

  4046.     if aCreateTemp then begin

  4047.       GetMem(TmpData, TFormatDescriptor.Get(aFormat).GetSize(TempWidth, TempHeight));

  4048.       DestData := TmpData;

  4049.     end else

  4050.       DestData := Data;

  4051. 

  4052.     try

  4053.       SourceFD.PreparePixel(FuncRec.Source);

  4054.       DestFD.PreparePixel  (FuncRec.Dest);

  4055. 

  4056.       SourceMD := SourceFD.CreateMappingData;

  4057.       DestMD   := DestFD.CreateMappingData;

  4058. 

  4059.       FuncRec.Size            := aSource.Dimension;

  4060.       FuncRec.Position.Fields := FuncRec.Size.Fields;

  4061. 

  4062.       try

  4063.         SourceData := aSource.Data;

  4064.         FuncRec.Position.Y := 0;

  4065.         while FuncRec.Position.Y < TempHeight do begin

  4066.           FuncRec.Position.X := 0;

  4067.           while FuncRec.Position.X < TempWidth do begin

  4068.             SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);

  4069.             aFunc(FuncRec);

  4070.             DestFD.Map(FuncRec.Dest, DestData, DestMD);

  4071.             inc(FuncRec.Position.X);

  4072.           end;

  4073.           inc(FuncRec.Position.Y);

  4074.         end;

  4075. 

  4076.         // Updating Image or InternalFormat

  4077.         if aCreateTemp then

  4078.           SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height)

  4079.         else if (aFormat <> fFormat) then

  4080.           Format := aFormat;

  4081. 

  4082.         result := true;

  4083.       finally

  4084.         SourceFD.FreeMappingData(SourceMD);

  4085.         DestFD.FreeMappingData(DestMD);

  4086.       end;

  4087.     except

  4088.       if aCreateTemp then

  4089.         FreeMem(TmpData);

  4090.       raise;

  4091.     end;

  4092.   end;

  4093. end;

  4094. 

  4095. {$IFDEF GLB_SDL}

  4096. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4097. function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;

  4098. var

  4099.   Row, RowSize: Integer;

  4100.   SourceData, TmpData: PByte;

  4101.   TempDepth: Integer;

  4102.   Pix: TglBitmapPixelData;

  4103.   FormatDesc: TglBitmapFormatDescriptor;

  4104. 

  4105.   function GetRowPointer(Row: Integer): pByte;

  4106.   begin

  4107.     result := Surface.pixels;

  4108.     Inc(result, Row * RowSize);

  4109.   end;

  4110. 

  4111. begin

  4112.   result := false;

  4113. 

  4114.   (* TODO

  4115.   if not FormatIsUncompressed(InternalFormat) then

  4116.     raise EglBitmapUnsupportedInternalFormat.Create('AssignToSurface - ' + UNSUPPORTED_INTERNAL_FORMAT);

  4117.   *)

  4118. 

  4119.   FormatDesc := FORMAT_DESCRIPTORS[Format];

  4120.   if Assigned(Data) then begin

  4121.     case Trunc(FormatDesc.GetSize) of

  4122.       1: TempDepth :=  8;

  4123.       2: TempDepth := 16;

  4124.       3: TempDepth := 24;

  4125.       4: TempDepth := 32;

  4126.     else

  4127.       raise EglBitmapException.Create('AssignToSurface - ' + UNSUPPORTED_INTERNAL_FORMAT);

  4128.     end;

  4129.     FormatDesc.PreparePixel(Pix);

  4130.     with Pix.PixelDesc do

  4131.       Surface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,

  4132.         RedRange shl RedShift, GreenRange shl GreenShift, BlueRange shl BlueShift, AlphaRange shl AlphaShift);

  4133. 

  4134.     SourceData := Data;

  4135.     RowSize    := Ceil(FileWidth * FormatDesc.GetSize);

  4136. 

  4137.     for Row := 0 to FileHeight -1 do begin

  4138.       TmpData := GetRowPointer(Row);

  4139.       if Assigned(TmpData) then begin

  4140.         Move(SourceData^, TmpData^, RowSize);

  4141.         inc(SourceData, RowSize);

  4142.       end;

  4143.     end;

  4144.     result := true;

  4145.   end;

  4146. end;

  4147. 

  4148. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4149. function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;

  4150. var

  4151.   pSource, pData, pTempData: PByte;

  4152.   Row, RowSize, TempWidth, TempHeight: Integer;

  4153.   IntFormat, f: TglBitmapInternalFormat;

  4154.   FormatDesc: TglBitmapFormatDescriptor;

  4155. 

  4156.   function GetRowPointer(Row: Integer): pByte;

  4157.   begin

  4158.     result := Surface^.pixels;

  4159.     Inc(result, Row * RowSize);

  4160.   end;

  4161. 

  4162. begin

  4163.   result := false;

  4164.   if (Assigned(Surface)) then begin

  4165.     with Surface^.format^ do begin

  4166.       IntFormat := tfEmpty;

  4167.       for f := Low(f) to High(f) do begin

  4168.         if FORMAT_DESCRIPTORS[f].MaskMatch(RMask, GMask, BMask, AMask) then begin

  4169.           IntFormat := f;

  4170.           break;

  4171.         end;

  4172.       end;

  4173.       if (IntFormat = tfEmpty) then

  4174.         raise EglBitmapException.Create('AssignFromSurface - Invalid Pixelformat.');

  4175.     end;

  4176. 

  4177.     FormatDesc := FORMAT_DESCRIPTORS[IntFormat];

  4178.     TempWidth  := Surface^.w;

  4179.     TempHeight := Surface^.h;

  4180.     RowSize := Trunc(TempWidth * FormatDesc.GetSize);

  4181.     GetMem(pData, TempHeight * RowSize);

  4182.     try

  4183.       pTempData := pData;

  4184.       for Row := 0 to TempHeight -1 do begin

  4185.         pSource := GetRowPointer(Row);

  4186.         if (Assigned(pSource)) then begin

  4187.           Move(pSource^, pTempData^, RowSize);

  4188.           Inc(pTempData, RowSize);

  4189.         end;

  4190.       end;

  4191.       SetDataPointer(pData, IntFormat, TempWidth, TempHeight);

  4192.       result := true;

  4193.     except

  4194.       FreeMem(pData);

  4195.       raise;

  4196.     end;

  4197.   end;

  4198. end;

  4199. 

  4200. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4201. function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;

  4202. var

  4203.   Row, Col, AlphaInterleave: Integer;

  4204.   pSource, pDest: PByte;

  4205. 

  4206.   function GetRowPointer(Row: Integer): pByte;

  4207.   begin

  4208.     result := aSurface.pixels;

  4209.     Inc(result, Row * Width);

  4210.   end;

  4211. 

  4212. begin

  4213.   result := false;

  4214.   if Assigned(Data) then begin

  4215.     if Format in [tfAlpha8, tfLuminance8Alpha8, tfBGRA8, tfRGBA8] then begin

  4216.       aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);

  4217. 

  4218.       AlphaInterleave := 0;

  4219.       case Format of

  4220.         ifLuminance8Alpha8:

  4221.           AlphaInterleave := 1;

  4222.         ifBGRA8, ifRGBA8:

  4223.           AlphaInterleave := 3;

  4224.       end;

  4225. 

  4226.       pSource := Data;

  4227.       for Row := 0 to Height -1 do begin

  4228.         pDest := GetRowPointer(Row);

  4229.         if Assigned(pDest) then begin

  4230.           for Col := 0 to Width -1 do begin

  4231.             Inc(pSource, AlphaInterleave);

  4232.             pDest^ := pSource^;

  4233.             Inc(pDest);

  4234.             Inc(pSource);

  4235.           end;

  4236.         end;

  4237.       end;

  4238.       result := true;

  4239.     end;

  4240.   end;

  4241. end;

  4242. 

  4243. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4244. function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;

  4245. var

  4246.   bmp: TglBitmap2D;

  4247. begin

  4248.   bmp := TglBitmap2D.Create;

  4249.   try

  4250.     bmp.AssignFromSurface(Surface);

  4251.     result := AddAlphaFromGlBitmap(bmp, Func, CustomData);

  4252.   finally

  4253.     bmp.Free;

  4254.   end;

  4255. end;

  4256. {$ENDIF}

  4257. 

  4258. {$IFDEF GLB_DELPHI}

  4259. //TODO rework & test

  4260. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4261. function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;

  4262. var

  4263.   Row: Integer;

  4264.   pSource, pData: PByte;

  4265. begin

  4266.   result := false;

  4267.   if Assigned(Data) then begin

  4268.     if Assigned(aBitmap) then begin

  4269.       aBitmap.Width  := Width;

  4270.       aBitmap.Height := Height;

  4271. 

  4272.       case Format of

  4273.         tfAlpha8, ifLuminance, ifDepth8:

  4274.           begin

  4275.             Bitmap.PixelFormat := pf8bit;

  4276.             Bitmap.Palette := CreateGrayPalette;

  4277.           end;

  4278.         ifRGB5A1:

  4279.           Bitmap.PixelFormat := pf15bit;

  4280.         ifR5G6B5:

  4281.           Bitmap.PixelFormat := pf16bit;

  4282.         ifRGB8, ifBGR8:

  4283.           Bitmap.PixelFormat := pf24bit;

  4284.         ifRGBA8, ifBGRA8:

  4285.           Bitmap.PixelFormat := pf32bit;

  4286.         else

  4287.           raise EglBitmapException.Create('AssignToBitmap - Invalid Pixelformat.');

  4288.       end;

  4289. 

  4290.       pSource := Data;

  4291.       for Row := 0 to FileHeight -1 do begin

  4292.         pData := Bitmap.Scanline[Row];

  4293. 

  4294.         Move(pSource^, pData^, fRowSize);

  4295.         Inc(pSource, fRowSize);

  4296. 

  4297.         // swap RGB(A) to BGR(A)

  4298.         if InternalFormat in [ifRGB8, ifRGBA8] then

  4299.           SwapRGB(pData, FileWidth, InternalFormat = ifRGBA8);

  4300.       end;

  4301. 

  4302.       result := true;

  4303.     end;

  4304.   end;

  4305. end;

  4306. 

  4307. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4308. function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;

  4309. var

  4310.   pSource, pData, pTempData: PByte;

  4311.   Row, RowSize, TempWidth, TempHeight: Integer;

  4312.   IntFormat: TglBitmapInternalFormat;

  4313. begin

  4314.   result := false;

  4315. 

  4316.   if (Assigned(Bitmap)) then begin

  4317.     case Bitmap.PixelFormat of

  4318.       pf8bit:

  4319.         IntFormat := ifLuminance;

  4320.       pf15bit:

  4321.         IntFormat := ifRGB5A1;

  4322.       pf16bit:

  4323.         IntFormat := ifR5G6B5;

  4324.       pf24bit:

  4325.         IntFormat := ifBGR8;

  4326.       pf32bit:

  4327.         IntFormat := ifBGRA8;

  4328.       else

  4329.         raise EglBitmapException.Create('AssignFromBitmap - Invalid Pixelformat.');

  4330.     end;

  4331. 

  4332.     TempWidth := Bitmap.Width;

  4333.     TempHeight := Bitmap.Height;

  4334. 

  4335.     RowSize := Trunc(TempWidth * FormatGetSize(IntFormat));

  4336. 

  4337.     GetMem(pData, TempHeight * RowSize);

  4338.     try

  4339.       pTempData := pData;

  4340. 

  4341.       for Row := 0 to TempHeight -1 do begin

  4342.         pSource := Bitmap.Scanline[Row];

  4343. 

  4344.         if (Assigned(pSource)) then begin

  4345.           Move(pSource^, pTempData^, RowSize);

  4346.           Inc(pTempData, RowSize);

  4347.         end;

  4348.       end;

  4349. 

  4350.       SetDataPointer(pData, IntFormat, TempWidth, TempHeight);

  4351. 

  4352.       result := true;

  4353.     except

  4354.       FreeMem(pData);

  4355.       raise;

  4356.     end;

  4357.   end;

  4358. end;

  4359. 

  4360. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4361. function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;

  4362. var

  4363.   Row, Col, AlphaInterleave: Integer;

  4364.   pSource, pDest: PByte;

  4365. begin

  4366.   result := false;

  4367. 

  4368.   if Assigned(Data) then begin

  4369.     if InternalFormat in [ifAlpha, ifLuminanceAlpha, ifRGBA8, ifBGRA8] then begin

  4370.       if Assigned(Bitmap) then begin

  4371.         Bitmap.PixelFormat := pf8bit;

  4372.         Bitmap.Palette := CreateGrayPalette;

  4373.         Bitmap.Width := Width;

  4374.         Bitmap.Height := Height;

  4375. 

  4376.         case InternalFormat of

  4377.           ifLuminanceAlpha:

  4378.             AlphaInterleave := 1;

  4379.           ifRGBA8, ifBGRA8:

  4380.             AlphaInterleave := 3;

  4381.           else

  4382.             AlphaInterleave := 0;

  4383.         end;

  4384. 

  4385.         // Copy Data

  4386.         pSource := Data;

  4387. 

  4388.         for Row := 0 to Height -1 do begin

  4389.           pDest := Bitmap.Scanline[Row];

  4390. 

  4391.           if Assigned(pDest) then begin

  4392.             for Col := 0 to Width -1 do begin

  4393.               Inc(pSource, AlphaInterleave);

  4394.               pDest^ := pSource^;

  4395.               Inc(pDest);

  4396.               Inc(pSource);

  4397.             end;

  4398.           end;

  4399.         end;

  4400. 

  4401.         result := true;

  4402.       end;

  4403.     end;

  4404.   end;

  4405. end;

  4406. 

  4407. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4408. function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;

  4409. var

  4410.   tex: TglBitmap2D;

  4411. begin

  4412.   tex := TglBitmap2D.Create;

  4413.   try

  4414.     tex.AssignFromBitmap(Bitmap);

  4415.     result := AddAlphaFromglBitmap(tex, Func, CustomData);

  4416.   finally

  4417.     tex.Free;

  4418.   end;

  4419. end;

  4420. 

  4421. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4422. function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar;

  4423.   const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;

  4424. var

  4425.   RS: TResourceStream;

  4426.   TempPos: Integer;

  4427.   ResTypeStr: String;

  4428.   TempResType: PChar;

  4429. begin

  4430.   if Assigned(ResType) then

  4431.     TempResType := ResType

  4432.   else

  4433.     begin

  4434.       TempPos := Pos('.', Resource);

  4435.       ResTypeStr := UpperCase(Copy(Resource, TempPos + 1, Length(Resource) - TempPos));

  4436.       Resource   := UpperCase(Copy(Resource, 0, TempPos -1));

  4437.       TempResType := PChar(ResTypeStr);

  4438.     end;

  4439. 

  4440.   RS := TResourceStream.Create(Instance, Resource, TempResType);

  4441.   try

  4442.     result := AddAlphaFromStream(RS, Func, CustomData);

  4443.   finally

  4444.     RS.Free;

  4445.   end;

  4446. end;

  4447. 

  4448. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  4450.   const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;

  4451. var

  4452.   RS: TResourceStream;

  4453. begin

  4454.   RS := TResourceStream.CreateFromID(Instance, ResourceID, ResType);

  4455.   try

  4456.     result := AddAlphaFromStream(RS, Func, CustomData);

  4457.   finally

  4458.     RS.Free;

  4459.   end;

  4460. end;

  4461. {$ENDIF}

  4462. 

  4463. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4464. function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;

  4465. begin

  4466.   (* TODO

  4467.   if not FormatIsUncompressed(InternalFormat) then

  4468.     raise EglBitmapUnsupportedFormatFormat.Create('AddAlphaFromFunc - ' + UNSUPPORTED_FORMAT);

  4469.   *)

  4470.   result := AddFunc(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);

  4471. end;

  4472. 

  4473. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4474. function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;

  4475. var

  4476.   FS: TFileStream;

  4477. begin

  4478.   FS := TFileStream.Create(FileName, fmOpenRead);

  4479.   try

  4480.     result := AddAlphaFromStream(FS, aFunc, aArgs);

  4481.   finally

  4482.     FS.Free;

  4483.   end;

  4484. end;

  4485. 

  4486. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4487. function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;

  4488. var

  4489.   tex: TglBitmap2D;

  4490. begin

  4491.   tex := TglBitmap2D.Create(aStream);

  4492.   try

  4493.     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);

  4494.   finally

  4495.     tex.Free;

  4496.   end;

  4497. end;

  4498. 

  4499. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4500. function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;

  4501. var

  4502.   DestData, DestData2, SourceData: pByte;

  4503.   TempHeight, TempWidth: Integer;

  4504.   SourceFD, DestFD: TFormatDescriptor;

  4505.   SourceMD, DestMD, DestMD2: Pointer;

  4506. 

  4507.   FuncRec: TglBitmapFunctionRec;

  4508. begin

  4509.   result := false;

  4510. 

  4511.   Assert(Assigned(Data));

  4512.   Assert(Assigned(aBitmap));

  4513.   Assert(Assigned(aBitmap.Data));

  4514. 

  4515.   if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin

  4516.     result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);

  4517.     if not Assigned(aFunc) then

  4518.       aFunc := glBitmapAlphaFunc;

  4519. 

  4520.     SourceFD := TFormatDescriptor.Get(aBitmap.Format);

  4521.     DestFD   := TFormatDescriptor.Get(Format);

  4522. 

  4523.     // Values

  4524.     TempHeight := aBitmap.FileHeight;

  4525.     TempWidth  := aBitmap.FileWidth;

  4526. 

  4527.     FuncRec.Sender          := Self;

  4528.     FuncRec.Args            := aArgs;

  4529.     FuncRec.Size            := Dimension;

  4530.     FuncRec.Position.Fields := FuncRec.Size.Fields;

  4531.     FuncRec.Args            := PtrInt(SourceFD.HasAlpha) and 1;

  4532. 

  4533.     DestData   := Data;

  4534.     DestData2  := Data;

  4535.     SourceData := aBitmap.Data;

  4536. 

  4537.     // Mapping

  4538.     SourceFD.PreparePixel(FuncRec.Source);

  4539.     DestFD.PreparePixel  (FuncRec.Dest);

  4540. 

  4541.     SourceMD := SourceFD.CreateMappingData;

  4542.     DestMD   := DestFD.CreateMappingData;

  4543.     DestMD2  := DestFD.CreateMappingData;

  4544.     try

  4545.       FuncRec.Position.Y := 0;

  4546.       while FuncRec.Position.Y < TempHeight do begin

  4547.         FuncRec.Position.X := 0;

  4548.         while FuncRec.Position.X < TempWidth do begin

  4549.           SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);

  4550.           DestFD.Unmap  (DestData,   FuncRec.Dest,   DestMD);

  4551.           aFunc(FuncRec);

  4552.           DestFD.Map(FuncRec.Dest, DestData2, DestMD2);

  4553.           inc(FuncRec.Position.X);

  4554.         end;

  4555.         inc(FuncRec.Position.Y);

  4556.       end;

  4557.     finally

  4558.       SourceFD.FreeMappingData(SourceMD);

  4559.       DestFD.FreeMappingData(DestMD);

  4560.       DestFD.FreeMappingData(DestMD2);

  4561.     end;

  4562.   end;

  4563. end;

  4564. 

  4565. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4566. function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;

  4567. begin

  4568.   result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);

  4569. end;

  4570. 

  4571. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4572. function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;

  4573. var

  4574.   PixelData: TglBitmapPixelData;

  4575. begin

  4576.   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);

  4577.   result := AddAlphaFromColorKeyFloat(

  4578.     aRed   / PixelData.Range.r,

  4579.     aGreen / PixelData.Range.g,

  4580.     aBlue  / PixelData.Range.b,

  4581.     aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));

  4582. end;

  4583. 

  4584. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4585. function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;

  4586. var

  4587.   values: array[0..2] of Single;

  4588.   tmp: Cardinal;

  4589.   i: Integer;

  4590.   PixelData: TglBitmapPixelData;

  4591. begin

  4592.   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);

  4593.   with PixelData do begin

  4594.     values[0] := aRed;

  4595.     values[1] := aGreen;

  4596.     values[2] := aBlue;

  4597. 

  4598.     for i := 0 to 2 do begin

  4599.       tmp          := Trunc(Range.arr[i] * aDeviation);

  4600.       Data.arr[i]  := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));

  4601.       Range.arr[i] := Max(0,            Trunc(Range.arr[i] * values[i] - tmp));

  4602.     end;

  4603.     Data.a  := 0;

  4604.     Range.a := 0;

  4605.   end;

  4606.   result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, PtrInt(@PixelData));

  4607. end;

  4608. 

  4609. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4610. function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;

  4611. begin

  4612.   result := AddAlphaFromValueFloat(aAlpha / $FF);

  4613. end;

  4614. 

  4615. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4616. function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;

  4617. var

  4618.   PixelData: TglBitmapPixelData;

  4619. begin

  4620.   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);

  4621.   result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);

  4622. end;

  4623. 

  4624. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4625. function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;

  4626. var

  4627.   PixelData: TglBitmapPixelData;

  4628. begin

  4629.   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);

  4630.   with PixelData do

  4631.     Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));

  4632.   result := AddAlphaFromFunc(glBitmapValueAlphaFunc, PtrInt(@PixelData.Data.a));

  4633. end;

  4634. 

  4635. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4636. function TglBitmap.RemoveAlpha: Boolean;

  4637. var

  4638.   FormatDesc: TFormatDescriptor;

  4639. begin

  4640.   result := false;

  4641.   FormatDesc := TFormatDescriptor.Get(Format);

  4642.   if Assigned(Data) then begin

  4643.     if not ({FormatDesc.IsUncompressed or }FormatDesc.HasAlpha) then

  4644.       raise EglBitmapUnsupportedFormatFormat.Create('RemoveAlpha - ' + UNSUPPORTED_FORMAT);

  4645.     result := ConvertTo(FormatDesc.WithoutAlpha);

  4646.   end;

  4647. end;

  4648. 

  4649. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4650. function TglBitmap.Clone: TglBitmap;

  4651. var

  4652.   Temp: TglBitmap;

  4653.   TempPtr: PByte;

  4654.   Size: Integer;

  4655. begin

  4656.   result := nil;

  4657.   Temp := (ClassType.Create as TglBitmap);

  4658.   try

  4659.     // copy texture data if assigned

  4660.     if Assigned(Data) then begin

  4661.       Size := TFormatDescriptor.Get(Format).GetSize(fDimension);

  4662.       GetMem(TempPtr, Size);

  4663.       try

  4664.         Move(Data^, TempPtr^, Size);

  4665.         Temp.SetDataPointer(TempPtr, Format, Width, Height);

  4666.       except

  4667.         FreeMem(TempPtr);

  4668.         raise;

  4669.       end;

  4670.     end else

  4671.       Temp.SetDataPointer(nil, Format, Width, Height);

  4672. 

  4673. 	// copy properties

  4674.     Temp.fID                      := ID;

  4675.     Temp.fTarget                  := Target;

  4676.     Temp.fFormat                  := Format;

  4677.     Temp.fMipMap                  := MipMap;

  4678.     Temp.fAnisotropic             := Anisotropic;

  4679.     Temp.fBorderColor             := fBorderColor;

  4680.     Temp.fDeleteTextureOnFree     := DeleteTextureOnFree;

  4681.     Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;

  4682.     Temp.fFilterMin               := fFilterMin;

  4683.     Temp.fFilterMag               := fFilterMag;

  4684.     Temp.fWrapS                   := fWrapS;

  4685.     Temp.fWrapT                   := fWrapT;

  4686.     Temp.fWrapR                   := fWrapR;

  4687.     Temp.fFilename                := fFilename;

  4688.     Temp.fCustomName              := fCustomName;

  4689.     Temp.fCustomNameW             := fCustomNameW;

  4690.     Temp.fCustomData              := fCustomData;

  4691. 

  4692.     result := Temp;

  4693.   except

  4694.     FreeAndNil(Temp);

  4695.     raise;

  4696.   end;

  4697. end;

  4698. 

  4699. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4700. function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;

  4701. var

  4702.   SourceFD, DestFD: TFormatDescriptor;

  4703.   SourcePD, DestPD: TglBitmapPixelData;

  4704.   ShiftData: TShiftData;

  4705. 

  4706.   function CanCopyDirect: Boolean;

  4707.   begin

  4708.     result :=

  4709.       ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and

  4710.       ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and

  4711.       ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and

  4712.       ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));

  4713.   end;

  4714. 

  4715.   function CanShift: Boolean;

  4716.   begin

  4717.     result :=

  4718.       ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and

  4719.       ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and

  4720.       ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and

  4721.       ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));

  4722.   end;

  4723. 

  4724.   function GetShift(aSource, aDest: Cardinal) : ShortInt;

  4725.   begin

  4726.     result := 0;

  4727.     while (aSource > aDest) and (aSource > 0) do begin

  4728.       inc(result);

  4729.       aSource := aSource shr 1;

  4730.     end;

  4731.   end;

  4732. 

  4733. begin

  4734.   if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin

  4735.     SourceFD := TFormatDescriptor.Get(Format);

  4736.     DestFD   := TFormatDescriptor.Get(aFormat);

  4737. 

  4738.     SourceFD.PreparePixel(SourcePD);

  4739.     DestFD.PreparePixel  (DestPD);

  4740. 

  4741.     if CanCopyDirect then

  4742.       result := AddFunc(Self, glBitmapConvertCopyFunc, false, aFormat)

  4743.     else if CanShift then begin

  4744.       ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);

  4745.       ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);

  4746.       ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);

  4747.       ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);

  4748.       result := AddFunc(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, PtrInt(@ShiftData));

  4749.     end else

  4750.       result := AddFunc(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);

  4751.   end else

  4752.     result := true;

  4753. end;

  4754. 

  4755. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4756. procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);

  4757. begin

  4758.   if aUseRGB or aUseAlpha then

  4759.     AddFunc(glBitmapInvertFunc, false, ((PtrInt(aUseAlpha) and 1) shl 1) or (PtrInt(aUseRGB) and 1));

  4760. end;

  4761. 

  4762. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  4764. begin

  4765.   fBorderColor[0] := aRed;

  4766.   fBorderColor[1] := aGreen;

  4767.   fBorderColor[2] := aBlue;

  4768.   fBorderColor[3] := aAlpha;

  4769.   if (ID > 0) then begin

  4770.     Bind(false);

  4771.     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);

  4772.   end;

  4773. end;

  4774. 

  4775. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4776. procedure TglBitmap.FreeData;

  4777. begin

  4778.   SetDataPointer(nil, tfEmpty);

  4779. end;

  4780. 

  4781. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4782. procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;

  4783.   const aAlpha: Byte);

  4784. begin

  4785.   FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);

  4786. end;

  4787. 

  4788. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4789. procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);

  4790. var

  4791.   PixelData: TglBitmapPixelData;

  4792. begin

  4793.   TFormatDescriptor.GetWithAlpha(Format).PreparePixel(PixelData);

  4794.   FillWithColorFloat(

  4795.     aRed   / PixelData.Range.r,

  4796.     aGreen / PixelData.Range.g,

  4797.     aBlue  / PixelData.Range.b,

  4798.     aAlpha / PixelData.Range.a);

  4799. end;

  4800. 

  4801. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4802. procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);

  4803. var

  4804.   PixelData: TglBitmapPixelData;

  4805. begin

  4806.   TFormatDescriptor.Get(Format).PreparePixel(PixelData);

  4807.   with PixelData do begin

  4808.     Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));

  4809.     Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));

  4810.     Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));

  4811.     Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));

  4812.   end;

  4813.   AddFunc(glBitmapFillWithColorFunc, false, PtrInt(@PixelData));

  4814. end;

  4815. 

  4816. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  4818. begin

  4819.   //check MIN filter

  4820.   case aMin of

  4821.     GL_NEAREST:

  4822.       fFilterMin := GL_NEAREST;

  4823.     GL_LINEAR:

  4824.       fFilterMin := GL_LINEAR;

  4825.     GL_NEAREST_MIPMAP_NEAREST:

  4826.       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;

  4827.     GL_LINEAR_MIPMAP_NEAREST:

  4828.       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;

  4829.     GL_NEAREST_MIPMAP_LINEAR:

  4830.       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;

  4831.     GL_LINEAR_MIPMAP_LINEAR:

  4832.       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;

  4833.     else

  4834.       raise EglBitmapException.Create('SetFilter - Unknow MIN filter.');

  4835.   end;

  4836. 

  4837.   //check MAG filter

  4838.   case aMag of

  4839.     GL_NEAREST:

  4840.       fFilterMag := GL_NEAREST;

  4841.     GL_LINEAR:

  4842.       fFilterMag := GL_LINEAR;

  4843.     else

  4844.       raise EglBitmapException.Create('SetFilter - Unknow MAG filter.');

  4845.   end;

  4846. 

  4847.   //apply filter

  4848.   if (ID > 0) then begin

  4849.     Bind(false);

  4850.     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);

  4851. 

  4852.     if (MipMap = mmNone) or (Target = GL_TEXTURE_RECTANGLE) then begin

  4853.       case fFilterMin of

  4854.         GL_NEAREST, GL_LINEAR:

  4855.           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);

  4856.         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:

  4857.           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);

  4858.         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:

  4859.           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);

  4860.       end;

  4861.     end else

  4862.       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);

  4863.   end;

  4864. end;

  4865. 

  4866. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4867. procedure TglBitmap.SetWrap(const S: Cardinal; const T: Cardinal; const R: Cardinal);

  4868. 

  4869.   procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);

  4870.   begin

  4871.     case aValue of

  4872.       GL_CLAMP:

  4873.         aTarget := GL_CLAMP;

  4874. 

  4875.       GL_REPEAT:

  4876.         aTarget := GL_REPEAT;

  4877. 

  4878.       GL_CLAMP_TO_EDGE: begin

  4879.         if GL_VERSION_1_2 or GL_EXT_texture_edge_clamp then

  4880.           aTarget := GL_CLAMP_TO_EDGE

  4881.         else

  4882.           aTarget := GL_CLAMP;

  4883.       end;

  4884. 

  4885.       GL_CLAMP_TO_BORDER: begin

  4886.         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then

  4887.           aTarget := GL_CLAMP_TO_BORDER

  4888.         else

  4889.           aTarget := GL_CLAMP;

  4890.       end;

  4891. 

  4892.       GL_MIRRORED_REPEAT: begin

  4893.         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then

  4894.           aTarget := GL_MIRRORED_REPEAT

  4895.         else

  4896.           raise EglBitmapException.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');

  4897.       end;

  4898.     else

  4899.       raise EglBitmapException.Create('SetWrap - Unknow Texturewrap (S).');

  4900.     end;

  4901.   end;

  4902. 

  4903. begin

  4904.   CheckAndSetWrap(S, fWrapS);

  4905.   CheckAndSetWrap(T, fWrapT);

  4906.   CheckAndSetWrap(R, fWrapR);

  4907. 

  4908.   if (ID > 0) then begin

  4909.     Bind(false);

  4910.     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);

  4911.     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);

  4912.     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);

  4913.   end;

  4914. end;

  4915. 

  4916. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4917. procedure TglBitmap.GetPixel(const aPos: TglBitmapPixelPosition; var aPixel: TglBitmapPixelData);

  4918. begin

  4919.   { TODO delete?

  4920.   if Assigned (fGetPixelFunc) then

  4921.     fGetPixelFunc(aPos, aPixel);

  4922.     }

  4923. end;

  4924. 

  4925. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4926. procedure TglBitmap.SetPixel(const aPos: TglBitmapPixelPosition; const aPixel: TglBitmapPixelData);

  4927. begin

  4928.   {TODO delete?

  4929.   if Assigned (fSetPixelFunc) then

  4930.     fSetPixelFuc(aPos, aPixel);

  4931.     }

  4932. end;

  4933. 

  4934. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4935. procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);

  4936. begin

  4937.   if aEnableTextureUnit then

  4938.     glEnable(Target);

  4939.   if (ID > 0) then

  4940.     glBindTexture(Target, ID);

  4941. end;

  4942. 

  4943. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4944. procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);

  4945. begin

  4946.   if aDisableTextureUnit then

  4947.     glDisable(Target);

  4948.   glBindTexture(Target, 0);

  4949. end;

  4950. 

  4951. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4952. constructor TglBitmap.Create;

  4953. begin

  4954. {$IFNDEF GLB_NO_NATIVE_GL}

  4955.   ReadOpenGLExtensions;

  4956. {$ENDIF}

  4957.   if (ClassType = TglBitmap) then

  4958.     raise EglBitmapException.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');

  4959.   inherited Create;

  4960. end;

  4961. 

  4962. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4963. constructor TglBitmap.Create(const aFileName: String);

  4964. begin

  4965.   Create;

  4966.   LoadFromFile(FileName);

  4967. end;

  4968. 

  4969. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4970. constructor TglBitmap.Create(const aStream: TStream);

  4971. begin

  4972.   Create;

  4973.   LoadFromStream(aStream);

  4974. end;

  4975. 

  4976. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4977. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat);

  4978. var

  4979.   Image: PByte;

  4980.   ImageSize: Integer;

  4981. begin

  4982.   Create;

  4983.   TFormatDescriptor.Get(aFormat).GetSize(aSize);

  4984.   GetMem(Image, ImageSize);

  4985.   try

  4986.     FillChar(Image^, ImageSize, #$FF);

  4987.     SetDataPointer(Image, aFormat, aSize.X, aSize.Y);

  4988.   except

  4989.     FreeMem(Image);

  4990.     raise;

  4991.   end;

  4992. end;

  4993. 

  4994. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4995. constructor TglBitmap.Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat;

  4996.   const aFunc: TglBitmapFunction; const aArgs: PtrInt);

  4997. begin

  4998.   Create;

  4999.   LoadFromFunc(aSize, aFunc, aFormat, aArgs);

  5000. end;

  5001. 

  5002. {$IFDEF GLB_DELPHI}

  5003. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5004. constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);

  5005. begin

  5006.   Create;

  5007.   LoadFromResource(aInstance, aResource, aResType);

  5008. end;

  5009. 

  5010. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5011. constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);

  5012. begin

  5013.   Create;

  5014.   LoadFromResourceID(aInstance, aResourceID, aResType);

  5015. end;

  5016. {$ENDIF}

  5017. 

  5018. {$IFDEF GLB_SUPPORT_PNG_READ}

  5019. {$IF DEFINED(GLB_SDL_IMAGE)}

  5020. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5021. //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5022. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5023. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;

  5024. var

  5025.   Surface: PSDL_Surface;

  5026.   RWops: PSDL_RWops;

  5027. begin

  5028.   result := false;

  5029.   RWops := glBitmapCreateRWops(aStream);

  5030.   try

  5031.     if IMG_isPNG(RWops) > 0 then begin

  5032.       Surface := IMG_LoadPNG_RW(RWops);

  5033.       try

  5034.         AssignFromSurface(Surface);

  5035.         Rresult := true;

  5036.       finally

  5037.         SDL_FreeSurface(Surface);

  5038.       end;

  5039.     end;

  5040.   finally

  5041.     SDL_FreeRW(RWops);

  5042.   end;

  5043. end;

  5044. 

  5045. {$ELSEIF DEFINED(GLB_LIB_PNG)}

  5046. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5047. procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;

  5048. begin

  5049.   TStream(png_get_io_ptr(png)).Read(buffer^, size);

  5050. end;

  5051. 

  5052. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5053. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;

  5054. var

  5055.   StreamPos: Int64;

  5056.   signature: array [0..7] of byte;

  5057.   png: png_structp;

  5058.   png_info: png_infop;

  5059. 

  5060.   TempHeight, TempWidth: Integer;

  5061.   Format: TglBitmapInternalFormat;

  5062. 

  5063.   png_data: pByte;

  5064.   png_rows: array of pByte;

  5065.   Row, LineSize: Integer;

  5066. begin

  5067.   result := false;

  5068. 

  5069.   if not init_libPNG then

  5070.     raise Exception.Create('LoadPNG - unable to initialize libPNG.');

  5071. 

  5072.   try

  5073.     // signature

  5074.     StreamPos := Stream.Position;

  5075.     Stream.Read(signature, 8);

  5076.     Stream.Position := StreamPos;

  5077. 

  5078.     if png_check_sig(@signature, 8) <> 0 then begin

  5079.       // png read struct

  5080.       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);

  5081.       if png = nil then

  5082.         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');

  5083. 

  5084.       // png info

  5085.       png_info := png_create_info_struct(png);

  5086.       if png_info = nil then begin

  5087.         png_destroy_read_struct(@png, nil, nil);

  5088.         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');

  5089.       end;

  5090. 

  5091.       // set read callback

  5092.       png_set_read_fn(png, stream, glBitmap_libPNG_read_func);

  5093. 

  5094.       // read informations

  5095.       png_read_info(png, png_info);

  5096. 

  5097.       // size 

  5098.       TempHeight := png_get_image_height(png, png_info);

  5099.       TempWidth := png_get_image_width(png, png_info);

  5100. 

  5101.       // format

  5102.       case png_get_color_type(png, png_info) of

  5103.         PNG_COLOR_TYPE_GRAY:

  5104.           Format := tfLuminance8;

  5105.         PNG_COLOR_TYPE_GRAY_ALPHA:

  5106.           Format := tfLuminance8Alpha8;

  5107.         PNG_COLOR_TYPE_RGB:

  5108.           Format := tfRGB8;

  5109.         PNG_COLOR_TYPE_RGB_ALPHA:

  5110.           Format := tfRGBA8;

  5111.         else

  5112.           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');

  5113.       end;

  5114. 

  5115.       // cut upper 8 bit from 16 bit formats

  5116.       if png_get_bit_depth(png, png_info) > 8 then

  5117.         png_set_strip_16(png);

  5118. 

  5119.       // expand bitdepth smaller than 8

  5120.       if png_get_bit_depth(png, png_info) < 8 then

  5121.         png_set_expand(png);

  5122. 

  5123.       // allocating mem for scanlines

  5124.       LineSize := png_get_rowbytes(png, png_info);

  5125.       GetMem(png_data, TempHeight * LineSize);

  5126.       try

  5127.         SetLength(png_rows, TempHeight);

  5128.         for Row := Low(png_rows) to High(png_rows) do begin

  5129.           png_rows[Row] := png_data;

  5130.           Inc(png_rows[Row], Row * LineSize);

  5131.         end;

  5132. 

  5133.         // read complete image into scanlines

  5134.         png_read_image(png, @png_rows[0]);

  5135. 

  5136.         // read end

  5137.         png_read_end(png, png_info);

  5138. 

  5139.         // destroy read struct

  5140.         png_destroy_read_struct(@png, @png_info, nil);

  5141. 

  5142.         SetLength(png_rows, 0);

  5143. 

  5144.         // set new data

  5145.         SetDataPointer(png_data, Format, TempWidth, TempHeight);

  5146. 

  5147.         result := true;

  5148.       except

  5149.         FreeMem(png_data);

  5150.         raise;

  5151.       end;

  5152.     end;

  5153.   finally

  5154.     quit_libPNG;

  5155.   end;

  5156. end;

  5157. 

  5158. {$ELSEIF DEFINED(GLB_PNGIMAGE)}

  5159. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5160. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;

  5161. var

  5162.   StreamPos: Int64;

  5163.   Png: TPNGObject;

  5164.   Header: Array[0..7] of Byte;

  5165.   Row, Col, PixSize, LineSize: Integer;

  5166.   NewImage, pSource, pDest, pAlpha: pByte;

  5167.   Format: TglBitmapInternalFormat;

  5168. 

  5169. const

  5170.   PngHeader: Array[0..7] of Byte = (#137, #80, #78, #71, #13, #10, #26, #10);

  5171. 

  5172. begin

  5173.   result := false;

  5174. 

  5175.   StreamPos := Stream.Position;

  5176.   Stream.Read(Header[0], SizeOf(Header));

  5177.   Stream.Position := StreamPos;

  5178. 

  5179.   {Test if the header matches}

  5180.   if Header = PngHeader then begin

  5181.     Png := TPNGObject.Create;

  5182.     try

  5183.       Png.LoadFromStream(Stream);

  5184. 

  5185.       case Png.Header.ColorType of

  5186.         COLOR_GRAYSCALE:

  5187.           Format := ifLuminance;

  5188.         COLOR_GRAYSCALEALPHA:

  5189.           Format := ifLuminanceAlpha;

  5190.         COLOR_RGB:

  5191.           Format := ifBGR8;

  5192.         COLOR_RGBALPHA:

  5193.           Format := ifBGRA8;

  5194.         else

  5195.           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');

  5196.       end;

  5197. 

  5198.       PixSize := Trunc(FormatGetSize(Format));

  5199.       LineSize := Integer(Png.Header.Width) * PixSize;

  5200. 

  5201.       GetMem(NewImage, LineSize * Integer(Png.Header.Height));

  5202.       try

  5203.         pDest := NewImage;

  5204. 

  5205.         case Png.Header.ColorType of

  5206.           COLOR_RGB, COLOR_GRAYSCALE:

  5207.             begin

  5208.               for Row := 0 to Png.Height -1 do begin

  5209.                 Move (Png.Scanline[Row]^, pDest^, LineSize);

  5210.                 Inc(pDest, LineSize);

  5211.               end;

  5212.             end;

  5213.           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:

  5214.             begin

  5215.               PixSize := PixSize -1;

  5216. 

  5217.               for Row := 0 to Png.Height -1 do begin

  5218.                 pSource := Png.Scanline[Row];

  5219.                 pAlpha := pByte(Png.AlphaScanline[Row]);

  5220. 

  5221.                 for Col := 0 to Png.Width -1 do begin

  5222.                   Move (pSource^, pDest^, PixSize);

  5223.                   Inc(pSource, PixSize);

  5224.                   Inc(pDest, PixSize);

  5225. 

  5226.                   pDest^ := pAlpha^;

  5227.                   inc(pAlpha);

  5228.                   Inc(pDest);

  5229.                 end;

  5230.               end;

  5231.             end;

  5232.           else

  5233.             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');

  5234.         end;

  5235. 

  5236.         SetDataPointer(NewImage, Format, Png.Header.Width, Png.Header.Height);

  5237. 

  5238.         result := true;

  5239.       except

  5240.         FreeMem(NewImage);

  5241.         raise;

  5242.       end;

  5243.     finally

  5244.       Png.Free;

  5245.     end;

  5246.   end;

  5247. end;

  5248. {$IFEND}

  5249. {$ENDIF}

  5250. 

  5251. {$IFDEF GLB_SUPPORT_PNG_WRITE}

  5252. {$IFDEF GLB_LIB_PNG}

  5253. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5254. procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;

  5255. begin

  5256.   TStream(png_get_io_ptr(png)).Write(buffer^, size);

  5257. end;

  5258. {$ENDIF}

  5259. 

  5260. {$IF DEFINED(GLB_LIB_PNG)}

  5261. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5262. procedure TglBitmap.SavePNG(const aStream: TStream);

  5263. var

  5264.   png: png_structp;

  5265.   png_info: png_infop;

  5266.   png_rows: array of pByte;

  5267.   LineSize: Integer;

  5268.   ColorType: Integer;

  5269.   Row: Integer;

  5270. begin

  5271.   if not (ftPNG in FormatGetSupportedFiles (InternalFormat)) then

  5272.     raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);

  5273. 

  5274.   if not init_libPNG then

  5275.     raise Exception.Create('SavePNG - unable to initialize libPNG.');

  5276. 

  5277.   try

  5278.     case FInternalFormat of

  5279.       ifAlpha, ifLuminance, ifDepth8:

  5280.         ColorType := PNG_COLOR_TYPE_GRAY;

  5281.       ifLuminanceAlpha:

  5282.         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;

  5283.       ifBGR8, ifRGB8:

  5284.         ColorType := PNG_COLOR_TYPE_RGB;

  5285.       ifBGRA8, ifRGBA8:

  5286.         ColorType := PNG_COLOR_TYPE_RGBA;

  5287.       else

  5288.         raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);

  5289.     end;

  5290.     LineSize := Trunc(FormatGetSize(FInternalFormat) * Width);

  5291. 

  5292.     // creating array for scanline

  5293.     SetLength(png_rows, Height);

  5294.     try

  5295.       for Row := 0 to Height - 1 do begin

  5296.         png_rows[Row] := Data;

  5297.         Inc(png_rows[Row], Row * LineSize)

  5298.       end;

  5299. 

  5300.       // write struct

  5301.       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);

  5302.       if png = nil then

  5303.         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');

  5304. 

  5305.       // create png info

  5306.       png_info := png_create_info_struct(png);

  5307.       if png_info = nil then begin

  5308.         png_destroy_write_struct(@png, nil);

  5309.         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');

  5310.       end;

  5311. 

  5312.       // set read callback

  5313.       png_set_write_fn(png, stream, glBitmap_libPNG_write_func, nil);

  5314. 

  5315.       // set compression

  5316.       png_set_compression_level(png, 6);

  5317. 

  5318.       if InternalFormat in [ifBGR8, ifBGRA8] then

  5319.         png_set_bgr(png);

  5320. 

  5321.       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);

  5322.       png_write_info(png, png_info);

  5323.       png_write_image(png, @png_rows[0]);

  5324.       png_write_end(png, png_info);

  5325.       png_destroy_write_struct(@png, @png_info);

  5326.     finally

  5327.       SetLength(png_rows, 0);

  5328.     end;

  5329.   finally

  5330.     quit_libPNG;

  5331.   end;

  5332. end;

  5333. 

  5334. {$ELSEIF DEFINED(GLB_PNGIMAGE)}

  5335. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5336. procedure TglBitmap.SavePNG(const aStream: TStream);

  5337. var

  5338.   Png: TPNGObject;

  5339. 

  5340.   pSource, pDest: pByte;

  5341.   X, Y, PixSize: Integer;

  5342.   ColorType: Cardinal;

  5343.   Alpha: Boolean;

  5344. 

  5345.   pTemp: pByte;

  5346.   Temp: Byte;

  5347. begin

  5348.   if not (ftPNG in FormatGetSupportedFiles (InternalFormat)) then

  5349.     raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);

  5350. 

  5351.   case FInternalFormat of

  5352.     ifAlpha, ifLuminance, ifDepth8: begin

  5353.       ColorType := COLOR_GRAYSCALE;

  5354.       PixSize := 1;

  5355.       Alpha := false;

  5356.     end;

  5357.     ifLuminanceAlpha: begin

  5358.       ColorType := COLOR_GRAYSCALEALPHA;

  5359.       PixSize := 1;

  5360.       Alpha := true;

  5361.     end;

  5362.     ifBGR8, ifRGB8: begin

  5363.       ColorType := COLOR_RGB;

  5364.       PixSize := 3;

  5365.       Alpha := false;

  5366.     end;

  5367.     ifBGRA8, ifRGBA8: begin

  5368.       ColorType := COLOR_RGBALPHA;

  5369.       PixSize := 3;

  5370.       Alpha := true

  5371.     end;

  5372.   else

  5373.     raise EglBitmapUnsupportedInternalFormat.Create('SavePng - ' + UNSUPPORTED_INTERNAL_FORMAT);

  5374.   end;

  5375. 

  5376.   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);

  5377.   try

  5378.     // Copy ImageData

  5379.     pSource := Data;

  5380.     for Y := 0 to Height -1 do begin

  5381.       pDest := png.ScanLine[Y];

  5382.       for X := 0 to Width -1 do begin

  5383.         Move(pSource^, pDest^, PixSize);

  5384.         Inc(pDest, PixSize);

  5385.         Inc(pSource, PixSize);

  5386.         if Alpha then begin

  5387.           png.AlphaScanline[Y]^[X] := pSource^;

  5388.           Inc(pSource);

  5389.         end;

  5390.       end;

  5391. 

  5392.       // convert RGB line to BGR

  5393.       if InternalFormat in [ifRGB8, ifRGBA8] then begin

  5394.         pTemp := png.ScanLine[Y];

  5395.         for X := 0 to Width -1 do begin

  5396.           Temp := pByteArray(pTemp)^[0];

  5397.           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];

  5398.           pByteArray(pTemp)^[2] := Temp;

  5399.           Inc(pTemp, 3);

  5400.         end;

  5401.       end;

  5402.     end;

  5403. 

  5404.     // Save to Stream

  5405.     Png.CompressionLevel := 6;

  5406.     Png.SaveToStream(Stream);

  5407.   finally

  5408.     FreeAndNil(Png);

  5409.   end;

  5410. end;

  5411. {$IFEND}

  5412. {$ENDIF}

  5413. 

  5414. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5415. //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5416. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5417. {$IFDEF GLB_LIB_JPEG}

  5418. type

  5419.   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;

  5420.   glBitmap_libJPEG_source_mgr = record

  5421.     pub: jpeg_source_mgr;

  5422. 

  5423.     SrcStream: TStream;

  5424.     SrcBuffer: array [1..4096] of byte;

  5425.   end;

  5426. 

  5427.   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;

  5428.   glBitmap_libJPEG_dest_mgr = record

  5429.     pub: jpeg_destination_mgr;

  5430. 

  5431.     DestStream: TStream;

  5432.     DestBuffer: array [1..4096] of byte;

  5433.   end;

  5434. 

  5435. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5436. {

  5437. procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;

  5438. var

  5439.   Msg: String;

  5440. begin

  5441.   SetLength(Msg, 256);

  5442.   cinfo^.err^.format_message(cinfo, pChar(Msg));

  5443.   Writeln('ERROR [' + IntToStr(cinfo^.err^.msg_code) + '] ' + Msg);

  5444.   cinfo^.global_state := 0;

  5445.   jpeg_abort(cinfo);

  5446. end;

  5447. }

  5448. 

  5449. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5450. {

  5451. procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;

  5452. var

  5453.   Msg: String;

  5454. begin

  5455.   SetLength(Msg, 256);

  5456.   cinfo^.err^.format_message(cinfo, pChar(Msg));

  5457.   Writeln('OUTPUT [' + IntToStr(cinfo^.err^.msg_code) + '] ' + Msg);

  5458.   cinfo^.global_state := 0;

  5459. end;

  5460. }

  5461. 

  5462. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5463. {

  5464. procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;

  5465. begin

  5466. end;

  5467. }

  5468. 

  5469. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5470. function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;

  5471. var

  5472.   src: glBitmap_libJPEG_source_mgr_ptr;

  5473.   bytes: integer;

  5474. begin

  5475.   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);

  5476. 

  5477.   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);

  5478. 	if (bytes <= 0) then begin

  5479. 		src^.SrcBuffer[1] := $FF;

  5480. 		src^.SrcBuffer[2] := JPEG_EOI;

  5481. 		bytes := 2;

  5482. 	end;

  5483. 

  5484. 	src^.pub.next_input_byte := @(src^.SrcBuffer[1]);

  5485. 	src^.pub.bytes_in_buffer := bytes;

  5486. 

  5487.   result := true;

  5488. end;

  5489. 

  5490. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5491. procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;

  5492. var

  5493.   src: glBitmap_libJPEG_source_mgr_ptr;

  5494. begin

  5495.   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);

  5496. 

  5497.   if num_bytes > 0 then begin

  5498.     // wanted byte isn't in buffer so set stream position and read buffer

  5499.     if num_bytes > src^.pub.bytes_in_buffer then begin

  5500.       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;

  5501.       src^.pub.fill_input_buffer(cinfo);

  5502.     end else begin

  5503.       // wanted byte is in buffer so only skip

  5504.   		inc(src^.pub.next_input_byte, num_bytes);

  5505. 	  	dec(src^.pub.bytes_in_buffer, num_bytes);

  5506.     end;

  5507.   end;

  5508. end;

  5509. 

  5510. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5511. {

  5512. procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;

  5513. begin

  5514. end;

  5515. }

  5516. 

  5517. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5518. {

  5519. procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;

  5520. begin

  5521. end;

  5522. }

  5523. 

  5524. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5525. function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;

  5526. var

  5527.   dest: glBitmap_libJPEG_dest_mgr_ptr;

  5528. begin

  5529.   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);

  5530. 

  5531.   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin

  5532.     // write complete buffer

  5533.     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));

  5534. 

  5535.     // reset buffer

  5536.     dest^.pub.next_output_byte := @dest^.DestBuffer[1];

  5537.     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);

  5538.   end;

  5539. 

  5540.   result := true;

  5541. end;

  5542. 

  5543. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5544. procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;

  5545. var

  5546.   Idx: Integer;

  5547.   dest: glBitmap_libJPEG_dest_mgr_ptr;

  5548. begin

  5549.   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);

  5550. 

  5551.   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin

  5552.     // check for endblock

  5553.     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin

  5554.       // write endblock

  5555.       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);

  5556. 

  5557.       // leave

  5558.       break;

  5559.     end else

  5560.       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);

  5561.   end;

  5562. end;

  5563. {$ENDIF}

  5564. 

  5565. {$IFDEF GLB_SUPPORT_JPEG_READ}

  5566. {$IF DEFINED(GLB_SDL_IMAGE)}

  5567. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5568. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;

  5569. var

  5570.   Surface: PSDL_Surface;

  5571.   RWops: PSDL_RWops;

  5572. begin

  5573.   result := false;

  5574. 

  5575.   RWops := glBitmapCreateRWops(Stream);

  5576.   try

  5577.     if IMG_isJPG(RWops) > 0 then begin

  5578.       Surface := IMG_LoadJPG_RW(RWops);

  5579.       try

  5580.         AssignFromSurface(Surface);

  5581.         result := true;

  5582.       finally

  5583.         SDL_FreeSurface(Surface);

  5584.       end;

  5585.     end;

  5586.   finally

  5587.     SDL_FreeRW(RWops);

  5588.   end;

  5589. end;

  5590. 

  5591. {$ELSEIF DEFINED(GLB_LIB_JPEG)}

  5592. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5593. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;

  5594. var

  5595.   StreamPos: Int64;

  5596.   Temp: array[0..1]of Byte;

  5597. 

  5598.   jpeg: jpeg_decompress_struct;

  5599.   jpeg_err: jpeg_error_mgr;

  5600. 

  5601.   IntFormat: TglBitmapInternalFormat;

  5602.   pImage: pByte;

  5603.   TempHeight, TempWidth: Integer;

  5604. 

  5605.   pTemp: pByte;

  5606.   Row: Integer;

  5607. begin

  5608.   result := false;

  5609. 

  5610.   if not init_libJPEG then

  5611.     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');

  5612. 

  5613.   try

  5614.     // reading first two bytes to test file and set cursor back to begin

  5615.     StreamPos := Stream.Position;

  5616.     Stream.Read(Temp[0], 2);

  5617.     Stream.Position := StreamPos;

  5618. 

  5619.     // if Bitmap then read file.

  5620.     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin

  5621.       FillChar(jpeg, SizeOf(jpeg_decompress_struct), $00);

  5622.       FillChar(jpeg_err, SizeOf(jpeg_error_mgr), $00);

  5623. 

  5624.       // error managment

  5625.       jpeg.err := jpeg_std_error(@jpeg_err);

  5626.       jpeg_err.error_exit := glBitmap_libJPEG_error_exit;

  5627.       jpeg_err.output_message := glBitmap_libJPEG_output_message;

  5628. 

  5629.       // decompression struct

  5630.       jpeg_create_decompress(@jpeg);

  5631. 

  5632.       // allocation space for streaming methods

  5633.       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));

  5634. 

  5635.       // seeting up custom functions

  5636.       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin

  5637.         pub.init_source       := glBitmap_libJPEG_init_source;

  5638.         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;

  5639.         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;

  5640.         pub.resync_to_restart := jpeg_resync_to_restart; // use default method

  5641.         pub.term_source       := glBitmap_libJPEG_term_source;

  5642. 

  5643.         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read

  5644.         pub.next_input_byte := nil;   // until buffer loaded

  5645. 

  5646.         SrcStream := Stream;

  5647.       end;

  5648. 

  5649.       // set global decoding state

  5650.       jpeg.global_state := DSTATE_START;

  5651. 

  5652.       // read header of jpeg

  5653.       jpeg_read_header(@jpeg, false);

  5654. 

  5655.       // setting output parameter

  5656.       case jpeg.jpeg_color_space of

  5657.         JCS_GRAYSCALE:

  5658.           begin

  5659.             jpeg.out_color_space := JCS_GRAYSCALE;

  5660.             IntFormat := ifLuminance;

  5661.           end;

  5662.         else

  5663.           jpeg.out_color_space := JCS_RGB;

  5664.           IntFormat := ifRGB8;

  5665.       end;

  5666. 

  5667.       // reading image

  5668.       jpeg_start_decompress(@jpeg);

  5669. 

  5670.       TempHeight := jpeg.output_height;

  5671.       TempWidth := jpeg.output_width;

  5672. 

  5673.       // creating new image

  5674.       GetMem(pImage, FormatGetImageSize(glBitmapPosition(TempWidth, TempHeight), IntFormat));

  5675.       try

  5676.         pTemp := pImage;

  5677. 

  5678.         for Row := 0 to TempHeight -1 do begin

  5679.           jpeg_read_scanlines(@jpeg, @pTemp, 1);

  5680.           Inc(pTemp, Trunc(FormatGetSize(IntFormat) * TempWidth));

  5681.         end;

  5682. 

  5683.         // finish decompression

  5684.         jpeg_finish_decompress(@jpeg);

  5685. 

  5686.         // destroy decompression

  5687.         jpeg_destroy_decompress(@jpeg);

  5688. 

  5689.         SetDataPointer(pImage, IntFormat, TempWidth, TempHeight);

  5690. 

  5691.         result := true;

  5692.       except

  5693.         FreeMem(pImage);

  5694.         raise;

  5695.       end;

  5696.     end;

  5697.   finally

  5698.     quit_libJPEG;

  5699.   end;

  5700. end;

  5701. 

  5702. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}

  5703. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5704. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;

  5705. var

  5706.   bmp: TBitmap;

  5707.   jpg: TJPEGImage;

  5708.   StreamPos: Int64;

  5709.   Temp: array[0..1]of Byte;

  5710. begin

  5711.   result := false;

  5712. 

  5713.   // reading first two bytes to test file and set cursor back to begin

  5714.   StreamPos := Stream.Position;

  5715.   Stream.Read(Temp[0], 2);

  5716.   Stream.Position := StreamPos;

  5717. 

  5718.   // if Bitmap then read file.

  5719.   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin

  5720.     bmp := TBitmap.Create;

  5721.     try

  5722.       jpg := TJPEGImage.Create;

  5723.       try

  5724.         jpg.LoadFromStream(Stream);

  5725.         bmp.Assign(jpg);

  5726.         result := AssignFromBitmap(bmp);

  5727.       finally

  5728.         jpg.Free;

  5729.       end;

  5730.     finally

  5731.       bmp.Free;

  5732.     end;

  5733.   end;

  5734. end;

  5735. {$IFEND}

  5736. {$ENDIF}

  5737. 

  5738. {$IFDEF GLB_SUPPORT_JPEG_WRITE}

  5739. {$IF DEFEFINED(GLB_LIB_JPEG)}

  5740. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5741. procedure TglBitmap.SaveJPEG(Stream: TStream);

  5742. var

  5743.   jpeg: jpeg_compress_struct;

  5744.   jpeg_err: jpeg_error_mgr;

  5745.   Row: Integer;

  5746.   pTemp, pTemp2: pByte;

  5747. 

  5748.   procedure CopyRow(pDest, pSource: pByte);

  5749.   var

  5750.     X: Integer;

  5751.   begin

  5752.     for X := 0 to Width - 1 do begin

  5753.       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];

  5754.       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];

  5755.       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];

  5756.       Inc(pDest, 3);

  5757.       Inc(pSource, 3);

  5758.     end;

  5759.   end;

  5760. 

  5761. begin

  5762.   if not (ftJPEG in FormatGetSupportedFiles(Format)) then

  5763.     raise EglBitmapUnsupportedInternalFormat.Create('SaveJpg - ' + UNSUPPORTED_INTERNAL_FORMAT);

  5764. 

  5765.   if not init_libJPEG then

  5766.     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');

  5767. 

  5768.   try

  5769.     FillChar(jpeg, SizeOf(jpeg_compress_struct), $00);

  5770.     FillChar(jpeg_err, SizeOf(jpeg_error_mgr), $00);

  5771. 

  5772.     // error managment

  5773.     jpeg.err := jpeg_std_error(@jpeg_err);

  5774.     jpeg_err.error_exit := glBitmap_libJPEG_error_exit;

  5775.     jpeg_err.output_message := glBitmap_libJPEG_output_message;

  5776. 

  5777.     // compression struct

  5778.     jpeg_create_compress(@jpeg);

  5779. 

  5780.     // allocation space for streaming methods

  5781.     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));

  5782. 

  5783.     // seeting up custom functions

  5784.     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin

  5785.       pub.init_destination    := glBitmap_libJPEG_init_destination;

  5786.       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;

  5787.       pub.term_destination    := glBitmap_libJPEG_term_destination;

  5788. 

  5789.       pub.next_output_byte  := @DestBuffer[1];

  5790.       pub.free_in_buffer    := Length(DestBuffer);

  5791. 

  5792.       DestStream := Stream;

  5793.     end;

  5794. 

  5795.     // very important state

  5796.     jpeg.global_state := CSTATE_START;

  5797.     jpeg.image_width  := Width;

  5798.     jpeg.image_height := Height;

  5799.     case InternalFormat of

  5800.       ifAlpha, ifLuminance, ifDepth8: begin

  5801.         jpeg.input_components := 1;

  5802.         jpeg.in_color_space := JCS_GRAYSCALE;

  5803.       end;

  5804.       ifRGB8, ifBGR8: begin

  5805.         jpeg.input_components := 3;

  5806.         jpeg.in_color_space := JCS_RGB;

  5807.       end;

  5808.     end;

  5809. 

  5810.     jpeg_set_defaults(@jpeg);

  5811.     jpeg_set_quality(@jpeg, 95, true);

  5812.     jpeg_start_compress(@jpeg, true);

  5813.     pTemp := Data;

  5814. 

  5815.     if InternalFormat = ifBGR8 then

  5816.       GetMem(pTemp2, fRowSize)

  5817.     else

  5818.       pTemp2 := pTemp;

  5819. 

  5820.     try

  5821.       for Row := 0 to jpeg.image_height -1 do begin

  5822.         // prepare row

  5823.         if InternalFormat = ifBGR8 then

  5824.           CopyRow(pTemp2, pTemp)

  5825.         else

  5826.           pTemp2 := pTemp;

  5827. 

  5828.         // write row

  5829.         jpeg_write_scanlines(@jpeg, @pTemp2, 1);

  5830.         inc(pTemp, fRowSize);

  5831.       end;

  5832.     finally

  5833.       // free memory

  5834.       if InternalFormat = ifBGR8 then

  5835.         FreeMem(pTemp2);

  5836.     end;

  5837.     jpeg_finish_compress(@jpeg);

  5838.     jpeg_destroy_compress(@jpeg);

  5839.   finally

  5840.     quit_libJPEG;

  5841.   end;

  5842. end;

  5843. 

  5844. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}

  5845. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5846. procedure TglBitmap.SaveJPEG(Stream: TStream);

  5847. var

  5848.   Bmp: TBitmap;

  5849.   Jpg: TJPEGImage;

  5850. begin

  5851.   if not (ftJPEG in FormatGetSupportedFiles (InternalFormat)) then

  5852.     raise EglBitmapUnsupportedInternalFormat.Create('SaveJpg - ' + UNSUPPORTED_INTERNAL_FORMAT);

  5853. 

  5854.   Bmp := TBitmap.Create;

  5855.   try

  5856.     Jpg := TJPEGImage.Create;

  5857.     try

  5858.       AssignToBitmap(Bmp);

  5859.       if FInternalFormat in [ifAlpha, ifLuminance, ifDepth8] then begin

  5860.         Jpg.Grayscale := true;

  5861.         Jpg.PixelFormat := jf8Bit;

  5862.       end;

  5863.       Jpg.Assign(Bmp);

  5864.       Jpg.SaveToStream(Stream);

  5865.     finally

  5866.       FreeAndNil(Jpg);

  5867.     end;

  5868.   finally

  5869.     FreeAndNil(Bmp);

  5870.   end;

  5871. end;

  5872. {$ENDIF}

  5873. {$ENDIF}

  5874. 

  5875. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5876. //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5877. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5878. const

  5879.   BMP_MAGIC          = $4D42;

  5880. 

  5881.   BMP_COMP_RGB       = 0;

  5882.   BMP_COMP_RLE8      = 1;

  5883.   BMP_COMP_RLE4      = 2;

  5884.   BMP_COMP_BITFIELDS = 3;

  5885. 

  5886. type

  5887.   TBMPHeader = packed record

  5888.     bfType: Word;

  5889.     bfSize: Cardinal;

  5890.     bfReserved1: Word;

  5891.     bfReserved2: Word;

  5892.     bfOffBits: Cardinal;

  5893.   end;

  5894. 

  5895.   TBMPInfo = packed record

  5896.     biSize: Cardinal;

  5897.     biWidth: Longint;

  5898.     biHeight: Longint;

  5899.     biPlanes: Word;

  5900.     biBitCount: Word;

  5901.     biCompression: Cardinal;

  5902.     biSizeImage: Cardinal;

  5903.     biXPelsPerMeter: Longint;

  5904.     biYPelsPerMeter: Longint;

  5905.     biClrUsed: Cardinal;

  5906.     biClrImportant: Cardinal;

  5907.   end;

  5908. 

  5909.   (* TODO: delete?

  5910.   TBMPInfoOS = packed record

  5911.     biSize: Cardinal;

  5912.     biWidth: Longint;

  5913.     biHeight: Longint;

  5914.     biPlanes: Word;

  5915.     biBitCount: Word;

  5916.   end;

  5917.   *)

  5918. 

  5919. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5920. function TglBitmap.LoadBMP(const aStream: TStream): Boolean;

  5921. 

  5922.   //////////////////////////////////////////////////////////////////////////////////////////////////

  5923.   function ReadInfo(var aInfo: TBMPInfo; var aMask: TglBitmapColorRec): TglBitmapFormat;

  5924.   begin

  5925.     result := tfEmpty;

  5926.     aStream.Read(aInfo, SizeOf(aInfo));

  5927.     FillChar(aMask, SizeOf(aMask), 0);

  5928. 

  5929.     //Read Compression

  5930.     case aInfo.biCompression of

  5931.       BMP_COMP_RLE4,

  5932.       BMP_COMP_RLE8: begin

  5933.         raise EglBitmapException.Create('RLE compression is not supported');

  5934.       end;

  5935.       BMP_COMP_BITFIELDS: begin

  5936.         if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin

  5937.           aStream.Read(aMask.r, SizeOf(aMask.r));

  5938.           aStream.Read(aMask.g, SizeOf(aMask.g));

  5939.           aStream.Read(aMask.b, SizeOf(aMask.b));

  5940.           aStream.Read(aMask.a, SizeOf(aMask.a));

  5941.         end else

  5942.           raise EglBitmapException.Create('Bitfields are only supported for 16bit and 32bit formats');

  5943.       end;

  5944.     end;

  5945. 

  5946.     //get suitable format

  5947.     case aInfo.biBitCount of

  5948.        8: result := tfLuminance8;

  5949.       16: result := tfBGR5;

  5950.       24: result := tfBGR8;

  5951.       32: result := tfBGRA8;

  5952.     end;

  5953.   end;

  5954. 

  5955.   function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TColorTableFormat;

  5956.   var

  5957.     i, c: Integer;

  5958.     ColorTable: TColorTable;

  5959.   begin

  5960.     result := nil;

  5961.     if (aInfo.biBitCount >= 16) then

  5962.       exit;

  5963.     aFormat := tfLuminance8;

  5964.     c := aInfo.biClrUsed;

  5965.     if (c = 0) then

  5966.       c := 1 shl aInfo.biBitCount;

  5967.     SetLength(ColorTable, c);

  5968.     for i := 0 to c-1 do begin

  5969.       aStream.Read(ColorTable[i], SizeOf(TColorTableEnty));

  5970.       if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then

  5971.         aFormat := tfRGB8;

  5972.     end;

  5973. 

  5974.     result := TColorTableFormat.Create;

  5975.     result.PixelSize  := aInfo.biBitCount / 8;

  5976.     result.ColorTable := ColorTable;

  5977.     result.Range := glBitmapColorRec($FF, $FF, $FF, $00);

  5978.   end;

  5979. 

  5980.   //////////////////////////////////////////////////////////////////////////////////////////////////

  5981.   function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;

  5982.     const aInfo: TBMPInfo): TBitfieldFormat;

  5983.   var

  5984.     TmpFormat: TglBitmapFormat;

  5985.     FormatDesc: TFormatDescriptor;

  5986.   begin

  5987.     result := nil;

  5988.     if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin

  5989.       for TmpFormat := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin

  5990.         FormatDesc := TFormatDescriptor.Get(TmpFormat);

  5991.         if FormatDesc.MaskMatch(aMask.r, aMask.g, aMask.b, aMask.a) then begin

  5992.           aFormat := FormatDesc.Format;

  5993.           exit;

  5994.         end;

  5995.       end;

  5996. 

  5997.       if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then

  5998.         aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;

  5999.       if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then

  6000.         aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;

  6001. 

  6002.       result := TBitfieldFormat.Create;

  6003.       result.PixelSize := aInfo.biBitCount / 8;

  6004.       result.RedMask   := aMask.r;

  6005.       result.GreenMask := aMask.g;

  6006.       result.BlueMask  := aMask.b;

  6007.       result.AlphaMask := aMask.a;

  6008.     end;

  6009.   end;

  6010. 

  6011. var

  6012.   //simple types

  6013.   StartPos: Int64;

  6014.   ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;

  6015.   PaddingBuff: Cardinal;

  6016.   LineBuf, ImageData, TmpData: PByte;

  6017.   SourceMD, DestMD: Pointer;

  6018.   BmpFormat: TglBitmapFormat;

  6019.   ColorTable: TColorTable;

  6020. 

  6021.   //records

  6022.   Mask: TglBitmapColorRec;

  6023.   Header: TBMPHeader;

  6024.   Info: TBMPInfo;

  6025. 

  6026.   //classes

  6027.   SpecialFormat: TFormatDescriptor;

  6028.   FormatDesc: TFormatDescriptor;

  6029. 

  6030.   //////////////////////////////////////////////////////////////////////////////////////////////////

  6031.   procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);

  6032.   var

  6033.     i, j: Integer;

  6034.     Pixel: TglBitmapPixelData;

  6035.   begin

  6036.     aStream.Read(aLineBuf^, rbLineSize);

  6037.     SpecialFormat.PreparePixel(Pixel);

  6038.     for i := 0 to Info.biWidth-1 do begin

  6039.       SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);

  6040.       with FormatDesc do begin

  6041.         //TODO: use convert function

  6042.         for j := 0 to 3 do

  6043.           if (SpecialFormat.Range.arr[j] <> Range.arr[j]) then begin

  6044.             if (SpecialFormat.Range.arr[j] > 0) then

  6045.               Pixel.Data.arr[j] := Round(Pixel.Data.arr[j] / SpecialFormat.Range.arr[j] * Range.arr[j])

  6046.             else

  6047.               Pixel.Data.arr[j] := 0;

  6048.           end;

  6049.       end;

  6050.       FormatDesc.Map(Pixel, aData, DestMD);

  6051.     end;

  6052.   end;

  6053. 

  6054. begin

  6055.   result        := false;

  6056.   BmpFormat     := tfEmpty;

  6057.   SpecialFormat := nil;

  6058.   LineBuf       := nil;

  6059.   SourceMD      := nil;

  6060.   DestMD        := nil;

  6061. 

  6062.   // Header

  6063.   StartPos := aStream.Position;

  6064.   aStream.Read(Header, SizeOf(Header));

  6065. 

  6066.   if Header.bfType = BMP_MAGIC then begin

  6067.     try try

  6068.       BmpFormat        := ReadInfo(Info, Mask);

  6069.       SpecialFormat    := ReadColorTable(BmpFormat, Info);

  6070.       if not Assigned(SpecialFormat) then

  6071.         SpecialFormat  := CheckBitfields(BmpFormat, Mask, Info);

  6072.       aStream.Position := StartPos + Header.bfOffBits;

  6073. 

  6074.       if (BmpFormat <> tfEmpty) then begin

  6075.         FormatDesc := TFormatDescriptor.Get(BmpFormat);

  6076.         rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize

  6077.         wbLineSize := Trunc(Info.biWidth * FormatDesc.PixelSize);

  6078.         Padding    := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;

  6079. 

  6080.         //get Memory

  6081.         DestMD    := FormatDesc.CreateMappingData;

  6082.         ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));

  6083.         GetMem(ImageData, ImageSize);

  6084.         if Assigned(SpecialFormat) then begin

  6085.           GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields

  6086.           SourceMD := SpecialFormat.CreateMappingData;

  6087.         end;

  6088. 

  6089.         //read Data

  6090.         try try

  6091.           FillChar(ImageData^, ImageSize, $FF);

  6092.           TmpData := ImageData;

  6093.           if (Info.biHeight > 0) then

  6094.             Inc(TmpData, wbLineSize * (Info.biHeight-1));

  6095.           for i := 0 to Abs(Info.biHeight)-1 do begin

  6096.             if Assigned(SpecialFormat) then

  6097.               SpecialFormatReadLine(TmpData, LineBuf)  //if is special format read and convert data

  6098.             else

  6099.               aStream.Read(TmpData^, wbLineSize);   //else only read data

  6100.             if (Info.biHeight > 0) then

  6101.               dec(TmpData, wbLineSize)

  6102.             else

  6103.               inc(TmpData, wbLineSize);

  6104.             aStream.Read(PaddingBuff, Padding);

  6105.           end;

  6106.           SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight));

  6107.           result := true;

  6108.         finally

  6109.           if Assigned(LineBuf) then

  6110.             FreeMem(LineBuf);

  6111.           if Assigned(SourceMD) then

  6112.             SpecialFormat.FreeMappingData(SourceMD);

  6113.           FormatDesc.FreeMappingData(DestMD);

  6114.         end;

  6115.         except

  6116.           FreeMem(ImageData);

  6117.           raise;

  6118.         end;

  6119.       end else

  6120.         raise EglBitmapException.Create('LoadBMP - No suitable format found');

  6121.     except

  6122.       aStream.Position := StartPos;

  6123.       raise;

  6124.     end;

  6125.     finally

  6126.       FreeAndNil(SpecialFormat);

  6127.     end;

  6128.   end

  6129.     else aStream.Position := StartPos;

  6130. end;

  6131. 

  6132. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6133. procedure TglBitmap.SaveBMP(const aStream: TStream);

  6134. var

  6135.   Header: TBMPHeader;

  6136.   Info: TBMPInfo;

  6137.   pData, pTemp: pByte;

  6138. 

  6139.   PixelFormat: TglBitmapPixelData;

  6140.   FormatDesc: TFormatDescriptor;

  6141.   ImageSize, LineSize, Padding, LineIdx, ColorIdx: Integer;

  6142.   Temp, RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;

  6143. 

  6144.   PaddingBuff: Cardinal;

  6145. 

  6146.   function GetLineWidth : Integer;

  6147.   begin

  6148.     result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;

  6149.   end;

  6150. 

  6151. begin

  6152.   if not (ftBMP in FormatGetSupportedFiles(Format)) then

  6153.     raise EglBitmapUnsupportedFormatFormat.Create('SaveBMP - ' + UNSUPPORTED_FORMAT);

  6154. 

  6155.   ImageSize := TFormatDescriptor.Get(Format).GetSize(Dimension);

  6156. 

  6157.   Header.bfType      := BMP_MAGIC;

  6158.   Header.bfSize      := SizeOf(Header) + SizeOf(Info) + ImageSize;

  6159.   Header.bfReserved1 := 0;

  6160.   Header.bfReserved2 := 0;

  6161.   Header.bfOffBits   := SizeOf(Header) + SizeOf(Info);

  6162. 

  6163.   FillChar(Info, SizeOf(Info), 0);

  6164.   Info.biSize        := SizeOf(Info);

  6165.   Info.biWidth       := Width;

  6166.   Info.biHeight      := Height;

  6167.   Info.biPlanes      := 1;

  6168.   Info.biCompression := BMP_COMP_RGB;

  6169.   Info.biSizeImage   := ImageSize;

  6170.   case Format of

  6171.     tfR3G3B2, tfLuminance8: begin

  6172.       Info.biBitCount  :=  8;

  6173.       Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal);

  6174.     end;

  6175. 

  6176.     tfRGB5, tfRGB5A1, tfR5G6B5, tfRGB4, tfRGBA4,

  6177.     tfBGR5, tfBGR5A1, tfB5G6R5, tfBGR4, tfBGRA4: begin

  6178.       Info.biBitCount    := 16;

  6179.       Info.biCompression := BMP_COMP_BITFIELDS;

  6180.     end;

  6181. 

  6182.     tfBGR8, tfRGB8: begin

  6183.       Info.biBitCount := 24;

  6184.     end;

  6185. 

  6186.     tfRGB10, tfRGB10A2, tfRGBA8,

  6187.     tfBGR10, tfBGR10A2, tfBGRA8: begin

  6188.       Info.biBitCount    := 32;

  6189.       Info.biCompression := BMP_COMP_BITFIELDS;

  6190.     end;

  6191.   else

  6192.     raise EglBitmapUnsupportedFormatFormat.Create('SaveBMP - ' + UNSUPPORTED_FORMAT);

  6193.   end;

  6194.   Info.biXPelsPerMeter := 2835;

  6195.   Info.biYPelsPerMeter := 2835;

  6196. 

  6197.   // prepare bitmasks

  6198.   if Info.biCompression = BMP_COMP_BITFIELDS then begin

  6199.     Info.biSize      := Info.biSize      + 4 * SizeOf(Cardinal);

  6200.     Header.bfSize    := Header.bfSize    + 4 * SizeOf(Cardinal);

  6201.     Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);

  6202. 

  6203.     FormatDesc := TFormatDescriptor.Get(Format);

  6204.     RedMask   := FormatDesc.RedMask;

  6205.     GreenMask := FormatDesc.GreenMask;

  6206.     BlueMask  := FormatDesc.BlueMask;

  6207.     AlphaMask := FormatDesc.AlphaMask;

  6208.   end;

  6209. 

  6210.   // headers

  6211.   aStream.Write(Header, SizeOf(Header));

  6212.   aStream.Write(Info, SizeOf(Info));

  6213. 

  6214.   // colortable

  6215.   if Info.biBitCount = 8 then begin

  6216.     Temp := 0;

  6217.     for ColorIdx := Low(Byte) to High(Byte) do begin

  6218.       aStream.Write(Temp, 4);

  6219.       Temp := Temp + $00010101;

  6220.     end;

  6221.   end;

  6222. 

  6223.   // bitmasks

  6224.   if Info.biCompression = BMP_COMP_BITFIELDS then begin

  6225.     aStream.Write(RedMask,   SizeOf(Cardinal));

  6226.     aStream.Write(GreenMask, SizeOf(Cardinal));

  6227.     aStream.Write(BlueMask,  SizeOf(Cardinal));

  6228.     aStream.Write(AlphaMask, SizeOf(Cardinal));

  6229.   end;

  6230. 

  6231.   // image data

  6232.   LineSize := Trunc(Width * TFormatDescriptor.Get(Format).PixelSize);

  6233.   Padding := GetLineWidth - LineSize;

  6234.   PaddingBuff := 0;

  6235. 

  6236.   pData := Data;

  6237.   Inc(pData, (Height -1) * LineSize);

  6238. 

  6239.   // prepare row buffer. But only for RGB because RGBA supports color masks

  6240.   // so it's possible to change color within the image.

  6241.   if (Format = tfRGB8) then

  6242.     GetMem(pTemp, fRowSize)

  6243.   else

  6244.     pTemp := nil;

  6245. 

  6246.   try

  6247.     // write image data

  6248.     for LineIdx := 0 to Height - 1 do begin

  6249.       // preparing row

  6250.       if Format = tfRGB8 then begin

  6251.         Move(pData^, pTemp^, fRowSize);

  6252.         SwapRGB(pTemp, Width, false);

  6253.       end else

  6254.         pTemp := pData;

  6255.       aStream.Write(pTemp^, LineSize);

  6256.       Dec(pData, LineSize);

  6257.       if Padding > 0 then

  6258.         aStream.Write(PaddingBuff, Padding);

  6259.     end;

  6260.   finally

  6261.     // destroy row buffer

  6262.     if Format = tfRGB8 then

  6263.       FreeMem(pTemp);

  6264.   end;

  6265. end;

  6266. 

  6267. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6268. //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6269. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6270. type

  6271.   TTGAHeader = packed record

  6272.     ImageID: Byte;

  6273.     ColorMapType: Byte;

  6274.     ImageType: Byte;

  6275.     ColorMapSpec: Array[0..4] of Byte;

  6276.     OrigX: Word;

  6277.     OrigY: Word;

  6278.     Width: Word;

  6279.     Height: Word;

  6280.     Bpp: Byte;

  6281.     ImageDes: Byte;

  6282.   end;

  6283. 

  6284. const

  6285.   TGA_UNCOMPRESSED_RGB = 2;

  6286.   TGA_UNCOMPRESSED_GRAY = 3;

  6287.   TGA_COMPRESSED_RGB = 10;

  6288.   TGA_COMPRESSED_GRAY = 11;

  6289. 

  6290. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6291. function TglBitmap.LoadTGA(const aStream: TStream): Boolean;

  6292. var

  6293.   Header: TTGAHeader;

  6294.   NewImage, pData: PByte;

  6295.   StreamPos: Int64;

  6296.   PixelSize, LineSize, YStart, YEnd, YInc: Integer;

  6297.   Format: TglBitmapFormat;

  6298. 

  6299. const

  6300.   CACHE_SIZE = $4000;

  6301. 

  6302.   ////////////////////////////////////////////////////////////////////////////////////////

  6303.   procedure ReadUncompressed;

  6304.   var

  6305.     RowSize: Integer;

  6306.   begin

  6307.     RowSize := Header.Width * PixelSize;

  6308.     // copy line by line

  6309.     while YStart <> YEnd + YInc do begin

  6310.       pData := NewImage;

  6311.       Inc(pData, YStart * LineSize);

  6312.       aStream.Read(pData^, RowSize);

  6313.       Inc(YStart, YInc);

  6314.     end;

  6315.   end;

  6316. 

  6317.   ////////////////////////////////////////////////////////////////////////////////////////

  6318.   procedure ReadCompressed;

  6319.   var

  6320.     HeaderWidth, HeaderHeight: Integer;

  6321.     LinePixelsRead, ImgPixelsRead, ImgPixelsToRead: Integer;

  6322. 

  6323.     Cache: PByte;

  6324.     CacheSize, CachePos: Integer;

  6325. 

  6326.     Temp: Byte;

  6327.     TempBuf: Array [0..15] of Byte;

  6328. 

  6329.     PixelRepeat: Boolean;

  6330.     PixelToRead, TempPixels: Integer;

  6331. 

  6332.     /////////////////////////////////////////////////////////////////

  6333.     procedure CheckLine;

  6334.     begin

  6335.       if LinePixelsRead >= HeaderWidth then begin

  6336.         LinePixelsRead := 0;

  6337.         pData := NewImage;

  6338.         Inc(YStart, YInc);

  6339.         Inc(pData, YStart * LineSize);

  6340.       end;

  6341.     end;

  6342. 

  6343.     /////////////////////////////////////////////////////////////////

  6344.     procedure CachedRead(out Buffer; Count: Integer);

  6345.     var

  6346.       BytesRead: Integer;

  6347.     begin

  6348.       if (CachePos + Count) > CacheSize then begin

  6349.         BytesRead := 0;

  6350. 

  6351.         // Read Data

  6352.         if CacheSize - CachePos > 0 then begin

  6353.           BytesRead := CacheSize - CachePos;

  6354.           Move(pByteArray(Cache)^[CachePos], Buffer, BytesRead);

  6355.           Inc(CachePos, BytesRead);

  6356.         end;

  6357. 

  6358.         // Reload Data

  6359.         CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);

  6360.         aStream.Read(Cache^, CacheSize);

  6361.         CachePos := 0;

  6362. 

  6363.         // Read else

  6364.         if Count - BytesRead > 0 then begin

  6365.           Move(pByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);

  6366.           Inc(CachePos, Count - BytesRead);

  6367.         end;

  6368.       end else begin

  6369.         Move(pByteArray(Cache)^[CachePos], Buffer, Count);

  6370.         Inc(CachePos, Count);

  6371.       end;

  6372.     end;

  6373. 

  6374.   begin

  6375.     CacheSize := 0;

  6376.     CachePos := 0;

  6377. 

  6378.     HeaderWidth := Header.Width;

  6379.     HeaderHeight := Header.Height;

  6380. 

  6381.     GetMem(Cache, CACHE_SIZE); // 16K Buffer

  6382.     try

  6383.       ImgPixelsToRead := HeaderWidth * HeaderHeight;

  6384.       ImgPixelsRead := 0;

  6385.       LinePixelsRead := 0;

  6386. 

  6387.       pData := NewImage;

  6388.       Inc(pData, YStart * LineSize);

  6389. 

  6390.       // Read until all Pixels

  6391.       repeat

  6392.         CachedRead(Temp, 1);

  6393. 

  6394.         PixelRepeat := Temp and $80 > 0;

  6395.         PixelToRead := (Temp and $7F) + 1;

  6396. 

  6397.         Inc(ImgPixelsRead, PixelToRead);

  6398. 

  6399.         if PixelRepeat then begin

  6400.           // repeat one pixel x times

  6401.           CachedRead(TempBuf[0], PixelSize);

  6402. 

  6403.           // repeat Pixel

  6404.           while PixelToRead > 0 do begin

  6405.             CheckLine;

  6406. 

  6407.             TempPixels := HeaderWidth - LinePixelsRead;

  6408.             if PixelToRead < TempPixels then

  6409.               TempPixels := PixelToRead;

  6410. 

  6411.             Inc(LinePixelsRead, TempPixels);

  6412.             Dec(PixelToRead, TempPixels);

  6413. 

  6414.             while TempPixels > 0 do begin

  6415.               case PixelSize of

  6416.                 1: begin

  6417.                   pData^ := TempBuf[0];

  6418.                   Inc(pData);

  6419.                 end;

  6420.                 2: begin

  6421.                   pWord(pData)^ := pWord(@TempBuf[0])^;

  6422.                   Inc(pData, 2);

  6423.                 end;

  6424.                 3: begin

  6425.                   pWord(pData)^ := pWord(@TempBuf[0])^;

  6426.                   Inc(pData, 2);

  6427.                   pData^ := TempBuf[2];

  6428.                   Inc(pData);

  6429.                 end;

  6430.                 4: begin

  6431.                   pDWord(pData)^ := pDWord(@TempBuf[0])^;

  6432.                   Inc(pData, 4);

  6433.                 end;

  6434.               end;

  6435.               Dec(TempPixels);

  6436.             end;

  6437.           end;

  6438.         end else begin

  6439.           // copy x pixels

  6440.           while PixelToRead > 0 do begin

  6441.             CheckLine;

  6442.             TempPixels := HeaderWidth - LinePixelsRead;

  6443.             if PixelToRead < TempPixels then

  6444.               TempPixels := PixelToRead;

  6445.             CachedRead(pData^, PixelSize * TempPixels);

  6446.             Inc(pData, PixelSize * TempPixels);

  6447.             Inc(LinePixelsRead, TempPixels);

  6448.             Dec(PixelToRead, TempPixels);

  6449.           end;

  6450.         end;

  6451.       until ImgPixelsRead >= ImgPixelsToRead;

  6452.     finally

  6453.       FreeMem(Cache)

  6454.     end;

  6455.   end;

  6456. 

  6457. begin

  6458.   result := false;

  6459. 

  6460.   // reading header to test file and set cursor back to begin

  6461.   StreamPos := aStream.Position;

  6462.   aStream.Read(Header, SizeOf(Header));

  6463. 

  6464.   // no colormapped files

  6465.   if (Header.ColorMapType = 0) then begin

  6466.     if Header.ImageType in [TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY] then begin

  6467.       case Header.Bpp of

  6468.         //TODO 8: Format := tfAlpha8;

  6469.         16: Format := tfLuminance8Alpha8;

  6470.         24: Format := tfBGR8;

  6471.         32: Format := tfBGRA8;

  6472.       else

  6473.         raise EglBitmapException.Create('LoadTga - unsupported BitsPerPixel found.');

  6474.       end;

  6475. 

  6476.       // skip image ID

  6477.       if Header.ImageID <> 0 then

  6478.         aStream.Position := aStream.Position + Header.ImageID;

  6479. 

  6480.       PixelSize := TFormatDescriptor.Get(Format).GetSize(1, 1);

  6481.       LineSize  := Trunc(Header.Width * PixelSize);

  6482. 

  6483.       GetMem(NewImage, LineSize * Header.Height);

  6484.       try

  6485.         // Row direction

  6486.         if (Header.ImageDes and $20 > 0) then begin

  6487.           YStart := 0;

  6488.           YEnd := Header.Height -1;

  6489.           YInc := 1;

  6490.         end else begin

  6491.           YStart := Header.Height -1;

  6492.           YEnd := 0;

  6493.           YInc := -1;

  6494.         end;

  6495. 

  6496.         // Read Image

  6497.         case Header.ImageType of

  6498.           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:

  6499.             ReadUncompressed;

  6500.           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:

  6501.             ReadCompressed;

  6502.         end;

  6503. 

  6504.         SetDataPointer(NewImage, Format, Header.Width, Header.Height);

  6505.         result := true;

  6506.       except

  6507.         FreeMem(NewImage);

  6508.         raise;

  6509.       end;

  6510.     end

  6511.       else aStream.Position := StreamPos;

  6512.   end

  6513.     else aStream.Position := StreamPos;

  6514. end;

  6515. 

  6516. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6517. procedure TglBitmap.SaveTGA(const aStream: TStream);

  6518. var

  6519.   Header: TTGAHeader;

  6520.   Size: Integer;

  6521.   pTemp: pByte;

  6522.   FormatDesc: TFormatDescriptor;

  6523. 

  6524.   procedure ConvertData(pTemp: pByte);

  6525.   var

  6526.     Idx, PixelSize: Integer;

  6527.     Temp: byte;

  6528.   begin

  6529.     PixelSize := fPixelSize;

  6530.     for Idx := 1 to Height * Width do begin

  6531.       Temp := pByteArray(pTemp)^[2];

  6532.       pByteArray(pTemp)^[2] := pByteArray(pTemp)^[0];

  6533.       pByteArray(pTemp)^[0] := Temp;

  6534.       Inc(pTemp, PixelSize);

  6535.     end;

  6536.   end;

  6537. 

  6538. begin

  6539.   if not (ftTGA in FormatGetSupportedFiles(Format)) then

  6540.     raise EglBitmapUnsupportedFormatFormat.Create('SaveTGA - ' + UNSUPPORTED_FORMAT);

  6541. 

  6542.   FillChar(Header, SizeOf(Header), 0);

  6543.   case Format of

  6544.     //TODO ifAlpha8, ifLuminance8, ifDepth8: begin

  6545.     tfLuminance8: begin

  6546.       Header.ImageType := TGA_UNCOMPRESSED_GRAY;

  6547.       Header.Bpp := 8;

  6548.     end;

  6549.     tfLuminance8Alpha8: begin

  6550.       Header.ImageType := TGA_UNCOMPRESSED_GRAY;

  6551.       Header.Bpp := 16;

  6552.     end;

  6553.     tfRGB8, tfBGR8: begin

  6554.       Header.ImageType := TGA_UNCOMPRESSED_RGB;

  6555.       Header.Bpp := 24;

  6556.     end;

  6557.     tfRGBA8, tfBGRA8: begin

  6558.       Header.ImageType := TGA_UNCOMPRESSED_RGB;

  6559.       Header.Bpp := 32;

  6560.     end;

  6561.   else

  6562.     raise EglBitmapUnsupportedFormatFormat.Create('SaveTGA - ' + UNSUPPORTED_FORMAT);

  6563.   end;

  6564. 

  6565.   Header.Width    := Width;

  6566.   Header.Height   := Height;

  6567.   Header.ImageDes := $20;

  6568.   FormatDesc      := TFormatDescriptor.Get(Format);

  6569. 

  6570.   if FormatDesc.HasAlpha then

  6571.     Header.ImageDes := Header.ImageDes or $08;

  6572.   aStream.Write(Header, SizeOf(Header));

  6573. 

  6574.   // convert RGB(A) to BGR(A)

  6575.   Size := FormatDesc.GetSize(Dimension);

  6576.   if Format in [tfRGB8, tfRGBA8] then begin

  6577.     GetMem(pTemp, Size);

  6578.   end else

  6579.     pTemp := Data;

  6580. 

  6581.   try

  6582.     // convert data

  6583.     if Format in [tfRGB8, tfRGBA8] then begin

  6584.       Move(Data^, pTemp^, Size);

  6585.       ConvertData(pTemp);

  6586.     end;

  6587. 

  6588.     // write data

  6589.     aStream.Write(pTemp^, Size);

  6590.   finally

  6591.     // free tempdata

  6592.     if Format in [tfRGB8, tfRGBA8] then

  6593.       FreeMem(pTemp);

  6594.   end;

  6595. end;

  6596. 

  6597. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6598. //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6599. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6600. const

  6601.   DDS_MAGIC                   = $20534444;

  6602. 

  6603.   // DDS_header.dwFlags

  6604.   DDSD_CAPS                   = $00000001;

  6605.   DDSD_HEIGHT                 = $00000002;

  6606.   DDSD_WIDTH                  = $00000004;

  6607.   DDSD_PITCH                  = $00000008;

  6608.   DDSD_PIXELFORMAT            = $00001000;

  6609.   DDSD_MIPMAPCOUNT            = $00020000;

  6610.   DDSD_LINEARSIZE             = $00080000;

  6611.   DDSD_DEPTH                  = $00800000;

  6612. 

  6613.   // DDS_header.sPixelFormat.dwFlags

  6614.   DDPF_ALPHAPIXELS            = $00000001;

  6615.   DDPF_FOURCC                 = $00000004;

  6616.   DDPF_INDEXED                = $00000020;

  6617.   DDPF_RGB                    = $00000040;

  6618. 

  6619.   // DDS_header.sCaps.dwCaps1

  6620.   DDSCAPS_COMPLEX             = $00000008;

  6621.   DDSCAPS_TEXTURE             = $00001000;

  6622.   DDSCAPS_MIPMAP              = $00400000;

  6623. 

  6624.   // DDS_header.sCaps.dwCaps2

  6625.   DDSCAPS2_CUBEMAP            = $00000200;

  6626.   DDSCAPS2_CUBEMAP_POSITIVEX  = $00000400;

  6627.   DDSCAPS2_CUBEMAP_NEGATIVEX  = $00000800;

  6628.   DDSCAPS2_CUBEMAP_POSITIVEY  = $00001000;

  6629.   DDSCAPS2_CUBEMAP_NEGATIVEY  = $00002000;

  6630.   DDSCAPS2_CUBEMAP_POSITIVEZ  = $00004000;

  6631.   DDSCAPS2_CUBEMAP_NEGATIVEZ  = $00008000;

  6632.   DDSCAPS2_VOLUME             = $00200000;

  6633. 

  6634.   D3DFMT_DXT1                 = $31545844;

  6635.   D3DFMT_DXT3                 = $33545844;

  6636.   D3DFMT_DXT5                 = $35545844;

  6637. 

  6638. type

  6639.   TDDSPixelFormat = packed record

  6640.     dwSize: Cardinal;

  6641.     dwFlags: Cardinal;

  6642.     dwFourCC: Cardinal;

  6643.     dwRGBBitCount: Cardinal;

  6644.     dwRBitMask: Cardinal;

  6645.     dwGBitMask: Cardinal;

  6646.     dwBBitMask: Cardinal;

  6647.     dwABitMask: Cardinal;

  6648.   end;

  6649. 

  6650.   TDDSCaps = packed record

  6651.     dwCaps1: Cardinal;

  6652.     dwCaps2: Cardinal;

  6653.     dwDDSX: Cardinal;

  6654.     dwReserved: Cardinal;

  6655.   end;

  6656. 

  6657.   TDDSHeader = packed record

  6658.     dwMagic: Cardinal;

  6659.     dwSize: Cardinal;

  6660.     dwFlags: Cardinal;

  6661.     dwHeight: Cardinal;

  6662.     dwWidth: Cardinal;

  6663.     dwPitchOrLinearSize: Cardinal;

  6664.     dwDepth: Cardinal;

  6665.     dwMipMapCount: Cardinal;

  6666.     dwReserved: array[0..10] of Cardinal;

  6667.     PixelFormat: TDDSPixelFormat;

  6668.     Caps: TDDSCaps;

  6669.     dwReserved2: Cardinal;

  6670.   end;

  6671. 

  6672. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6673. function TglBitmap.LoadDDS(const aStream: TStream): Boolean;

  6674. var

  6675.   Header: TDDSHeader;

  6676.   StreamPos: Int64;

  6677.   Y, LineSize: Cardinal;

  6678.   RowSize: Cardinal;

  6679.   NewImage, pData: pByte;

  6680.   ddsFormat: TglBitmapFormat;

  6681. 

  6682.   function RaiseEx : Exception;

  6683.   begin

  6684.     result := EglBitmapException.Create('LoadDDS - unsupported Pixelformat found.');

  6685.   end;

  6686. 

  6687.   function GetDDSFormat: TglBitmapFormat;

  6688.   begin

  6689.     with Header.PixelFormat do begin

  6690.       // Compresses

  6691.       if (dwFlags and DDPF_FOURCC) > 0 then begin

  6692.         (* TODO

  6693.         case Header.PixelFormat.dwFourCC of

  6694.           D3DFMT_DXT1: result := ifDXT1;

  6695.           D3DFMT_DXT3: result := ifDXT3;

  6696.           D3DFMT_DXT5: result := ifDXT5;

  6697.         else

  6698.           raise RaiseEx;

  6699.         end;

  6700.         *)

  6701.         raise RaiseEx;

  6702.       end else

  6703. 

  6704.       // RGB

  6705.       if (dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS)) > 0 then begin

  6706.         case dwRGBBitCount of

  6707.           8: begin

  6708.             (* TODO if dwFlags and DDPF_ALPHAPIXELS > 0 then

  6709.               result := tfAlpha

  6710.             else

  6711.             *)

  6712.               result := tfLuminance8;

  6713.           end;

  6714.           16: begin

  6715.             if dwFlags and DDPF_ALPHAPIXELS > 0 then begin

  6716.               // Alpha

  6717.               case CountSetBits(dwRBitMask) of

  6718.                 5: result := tfRGB5A1;

  6719.                 //TODO 4: result := tfRGBA4;

  6720.               else

  6721.                 result := tfLuminance8Alpha8;

  6722.               end;

  6723.             end else begin

  6724.               // no Alpha

  6725.               //TODO result := ifR5G6B5;

  6726.               raise RaiseEx;

  6727.             end;

  6728.           end;

  6729.           24: begin

  6730.             if dwRBitMask > dwBBitMask then

  6731.               result := tfBGR8

  6732.             else

  6733.               result := tfRGB8;

  6734.           end;

  6735.         32: begin

  6736.             if CountSetBits(dwRBitMask) = 10 then

  6737.               //TODO result := tfRGB10A2

  6738.               raise RaiseEx

  6739.             else

  6740. 

  6741.             if dwRBitMask > dwBBitMask then

  6742.               result := tfBGRA8

  6743.             else

  6744.               result := tfRGBA8;

  6745.           end;

  6746.         else

  6747.           raise RaiseEx;

  6748.         end;

  6749.       end else

  6750.         raise RaiseEx;

  6751.     end;

  6752.   end;

  6753. 

  6754. begin

  6755.   result := false;

  6756. 

  6757.   // Header

  6758.   StreamPos := aStream.Position;

  6759.   aStream.Read(Header, sizeof(Header));

  6760. 

  6761.   if ((Header.dwMagic <> DDS_MAGIC) or (Header.dwSize <> 124) or

  6762.      ((Header.dwFlags and DDSD_PIXELFORMAT) = 0) or ((Header.dwFlags and DDSD_CAPS) = 0)) then begin

  6763.     aStream.Position := StreamPos;

  6764.     exit;

  6765.   end;

  6766. 

  6767.   ddsFormat := GetDDSFormat;

  6768.   LineSize  := Trunc(Header.dwWidth * TFormatDescriptor.Get(ddsFormat).PixelSize);

  6769.   GetMem(NewImage, Header.dwHeight * LineSize);

  6770.   try

  6771.     pData := NewImage;

  6772. 

  6773.     // Compressed

  6774.     if (Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0 then begin

  6775.       RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;

  6776.       for Y := 0 to Header.dwHeight -1 do begin

  6777.         aStream.Read(pData^, RowSize);

  6778.         Inc(pData, LineSize);

  6779.       end;

  6780.     end else

  6781. 

  6782.     // RGB(A)

  6783.     if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS)) > 0 then begin

  6784.       RowSize := Header.dwPitchOrLinearSize;

  6785. 

  6786.       for Y := 0 to Header.dwHeight -1 do begin

  6787.         aStream.Read(pData^, RowSize);

  6788.         Inc(pData, LineSize);

  6789.       end;

  6790.     end else

  6791.       raise RaiseEx;

  6792. 

  6793.     SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight);

  6794.     result := true;

  6795.   except

  6796.     FreeMem(NewImage);

  6797.     raise;

  6798.   end;

  6799. end;

  6800. 

  6801. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6802. procedure TglBitmap.SaveDDS(const aStream: TStream);

  6803. var

  6804.   Header: TDDSHeader;

  6805.   Pix: TglBitmapPixelData;

  6806.   FormatDesc: TFormatDescriptor;

  6807. begin

  6808.   //if not FormatIsUncompressed(InternalFormat) then

  6809.   //  raise EglBitmapUnsupportedFormatFormat.Create('SaveDDS - ' + UNSUPPORTED_FORMAT);

  6810. 

  6811.   (* TODO if Format = tfAlpha8 then

  6812.     FORMAT_DESCRIPTORS[tfLuminance8].PreparePixel(Pix);

  6813.   else    *)

  6814.     TFormatDescriptor.Get(Format).PreparePixel(Pix);

  6815. 

  6816.   // Generell

  6817.   FillChar(Header, SizeOf(Header), 0);

  6818.   Header.dwMagic := DDS_MAGIC;

  6819.   Header.dwSize  := 124;

  6820.   Header.dwFlags := DDSD_PITCH or DDSD_CAPS or DDSD_PIXELFORMAT;

  6821. 

  6822.   if Width > 0 then begin

  6823.     Header.dwWidth := Width;

  6824.     Header.dwFlags := Header.dwFlags or DDSD_WIDTH;

  6825.   end;

  6826. 

  6827.   if Height > 0 then begin

  6828.     Header.dwHeight := Height;

  6829.     Header.dwFlags := Header.dwFlags or DDSD_HEIGHT;

  6830.   end;

  6831. 

  6832.   Header.dwPitchOrLinearSize := fRowSize;

  6833.   Header.dwMipMapCount := 1;

  6834. 

  6835.   // Caps

  6836.   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;

  6837. 

  6838.   // Pixelformat

  6839.   Header.PixelFormat.dwSize  := Sizeof(Header.PixelFormat);

  6840.   Header.PixelFormat.dwFlags := DDPF_RGB;

  6841. 

  6842.   (* TODO tfAlpha8

  6843.   if FORMAT_DESCRIPTORS[Format].HasAlpha and (Format <> tfAlpha8) then

  6844.     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;

  6845.   *)

  6846. 

  6847.   FormatDesc := TFormatDescriptor.Get(Format);

  6848.   Header.PixelFormat.dwRGBBitCount  := Trunc(FormatDesc.PixelSize * 8);

  6849.   Header.PixelFormat.dwRBitMask     := FormatDesc.RedMask;

  6850.   Header.PixelFormat.dwGBitMask     := FormatDesc.GreenMask;

  6851.   Header.PixelFormat.dwBBitMask     := FormatDesc.BlueMask;

  6852.   Header.PixelFormat.dwABitMask := FormatDesc.AlphaMask;

  6853. 

  6854.   aStream.Write(Header, SizeOf(Header));

  6855.   aStream.Write(Data^, FormatDesc.GetSize(Dimension));

  6856. end;

  6857. 

  6858. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6859. //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6860. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6861. function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;

  6862. begin

  6863.   if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then

  6864.     result := fLines[aIndex]

  6865.   else

  6866.     result := nil;

  6867. end;

  6868. 

  6869. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6870. procedure TglBitmap2D.SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;

  6871.   const aWidth: Integer; const aHeight: Integer);

  6872. var

  6873.   Idx, LineWidth: Integer;

  6874. begin

  6875.   inherited SetDataPointer(aData, aFormat, aWidth, aHeight);

  6876. 

  6877.   //TODO compression

  6878.   if {FormatIsUncompressed(Format)} true then begin

  6879.     (* TODO PixelFuncs

  6880.     fGetPixelFunc := GetPixel2DUnmap;

  6881.     fSetPixelFunc := SetPixel2DUnmap;

  6882.     *)

  6883.     // Assigning Data

  6884.     if Assigned(Data) then begin

  6885.       SetLength(fLines, GetHeight);

  6886.       LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);

  6887. 

  6888.       for Idx := 0 to GetHeight -1 do begin

  6889.         fLines[Idx] := Data;

  6890.         Inc(fLines[Idx], Idx * LineWidth);

  6891.       end;

  6892.     end

  6893.       else SetLength(fLines, 0);

  6894.   end else begin

  6895.     (*

  6896.     SetLength(fLines, 0);

  6897. 

  6898.     fSetPixelFunc := nil;

  6899. 

  6900.     case Format of

  6901.       ifDXT1:

  6902.         fGetPixelFunc := GetPixel2DDXT1;

  6903.       ifDXT3:

  6904.         fGetPixelFunc := GetPixel2DDXT3;

  6905.       ifDXT5:

  6906.         fGetPixelFunc := GetPixel2DDXT5;

  6907.       else

  6908.         fGetPixelFunc := nil;

  6909.     end;

  6910.     *)

  6911.   end;

  6912. end;

  6913. 

  6914. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  6916. var

  6917.   FormatDesc: TFormatDescriptor;

  6918. begin

  6919.   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);

  6920. 

  6921.   (* TODO compression

  6922.   if Self.InternalFormat in [ifDXT1, ifDXT3, ifDXT5] then

  6923.     glCompressedTexImage2D(Target, 0, InternalFormat, Width, Height, 0, Trunc(Width * Height * FormatGetSize(Self.InternalFormat)), Data)

  6924.   else

  6925.   *)

  6926. 

  6927.   FormatDesc := TFormatDescriptor.Get(Format);

  6928.   if aBuildWithGlu then

  6929.     gluBuild2DMipmaps(aTarget, FormatDesc.Components, Width, Height,

  6930.       FormatDesc.glFormat, FormatDesc.glDataFormat, Data)

  6931.   else

  6932.     glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,

  6933.       FormatDesc.glFormat, FormatDesc.glDataFormat, Data);

  6934. 

  6935.   // Freigeben

  6936.   if (FreeDataAfterGenTexture) then

  6937.     FreeData;

  6938. end;

  6939. 

  6940. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6941. procedure TglBitmap2D.AfterConstruction;

  6942. begin

  6943.   inherited;

  6944.   Target := GL_TEXTURE_2D;

  6945. end;

  6946. 

  6947. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  6949. var

  6950.   Temp: pByte;

  6951.   Size, w, h: Integer;

  6952.   FormatDesc: TFormatDescriptor;

  6953. begin

  6954.   (* TODO compression

  6955.   if not FormatIsUncompressed(Format) then

  6956.     raise EglBitmapUnsupportedFormatFormat.Create('TglBitmap2D.GrabScreen - ' + UNSUPPORTED_FORMAT);

  6957.   *)

  6958. 

  6959.   w := aRight  - aLeft;

  6960.   h := aBottom - aTop;

  6961.   FormatDesc   := TFormatDescriptor.Get(Format);

  6962.   Size         := FormatDesc.GetSize(w, h);

  6963.   GetMem(Temp, Size);

  6964.   try

  6965.     glPixelStorei(GL_PACK_ALIGNMENT, 1);

  6966.     glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);

  6967.     SetDataPointer(Temp, Format, w, h);

  6968.     FlipVert;

  6969.   except

  6970.     FreeMem(Temp);

  6971.     raise;

  6972.   end;

  6973. end;

  6974. 

  6975. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6976. procedure TglBitmap2D.GetDataFromTexture;

  6977. var

  6978.   Temp: PByte;

  6979.   TempWidth, TempHeight: Integer;

  6980.   TempType, TempIntFormat: Cardinal;

  6981.   IntFormat, f: TglBitmapFormat;

  6982.   FormatDesc: TFormatDescriptor;

  6983. begin

  6984.   Bind;

  6985. 

  6986.   // Request Data

  6987.   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH,           @TempWidth);

  6988.   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT,          @TempHeight);

  6989.   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);

  6990. 

  6991.   IntFormat := tfEmpty;

  6992.   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do

  6993.     if (TFormatDescriptor.Get(f).glInternalFormat = TempIntFormat) then begin

  6994.       IntFormat := FormatDesc.Format;

  6995.       break;

  6996.     end;

  6997. 

  6998.   // Getting data from OpenGL

  6999.   FormatDesc := TFormatDescriptor.Get(IntFormat);

  7000.   GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));

  7001.   try

  7002.     (* TODO Compression

  7003.     if FormatIsCompressed(IntFormat) and (GL_VERSION_1_3 or GL_ARB_texture_compression) then

  7004.       glGetCompressedTexImage(Target, 0, Temp)

  7005.     else

  7006.     *)

  7007.     glGetTexImage(Target, 0, FormatDesc.glInternalFormat, FormatDesc.glDataFormat, Temp);

  7008.     SetDataPointer(Temp, IntFormat, TempWidth, TempHeight);

  7009.   except

  7010.     FreeMem(Temp);

  7011.     raise;

  7012.   end;

  7013. end;

  7014. 

  7015. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7016. procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);

  7017. var

  7018.   BuildWithGlu, PotTex, TexRec: Boolean;

  7019.   TexSize: Integer;

  7020. begin

  7021.   if Assigned(Data) then begin

  7022.     // Check Texture Size

  7023.     if (aTestTextureSize) then begin

  7024.       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);

  7025. 

  7026.       if ((Height > TexSize) or (Width > TexSize)) then

  7027.         raise EglBitmapSizeToLargeException.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');

  7028. 

  7029.       PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);

  7030.       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE_ARB);

  7031. 

  7032.       if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then

  7033.         raise EglBitmapNonPowerOfTwoException.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');

  7034.     end;

  7035. 

  7036.     CreateId;

  7037.     SetupParameters(BuildWithGlu);

  7038.     UploadData(Target, BuildWithGlu);

  7039.     glAreTexturesResident(1, @fID, @fIsResident);

  7040.   end;

  7041. end;

  7042. 

  7043. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7044. function TglBitmap2D.FlipHorz: Boolean;

  7045. var

  7046.   Col, Row: Integer;

  7047.   TempDestData, DestData, SourceData: PByte;

  7048.   ImgSize: Integer;

  7049. begin

  7050.   result := inherited FlipHorz;

  7051.   if Assigned(Data) then begin

  7052.     SourceData := Data;

  7053.     ImgSize := Height * fRowSize;

  7054.     GetMem(DestData, ImgSize);

  7055.     try

  7056.       TempDestData := DestData;

  7057.       Dec(TempDestData, fRowSize + fPixelSize);

  7058.       for Row := 0 to Height -1 do begin

  7059.         Inc(TempDestData, fRowSize * 2);

  7060.         for Col := 0 to Width -1 do begin

  7061.           Move(SourceData^, TempDestData^, fPixelSize);

  7062.           Inc(SourceData, fPixelSize);

  7063.           Dec(TempDestData, fPixelSize);

  7064.         end;

  7065.       end;

  7066.       SetDataPointer(DestData, Format);

  7067.       result := true;

  7068.     except

  7069.       FreeMem(DestData);

  7070.       raise;

  7071.     end;

  7072.   end;

  7073. end;

  7074. 

  7075. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7076. function TglBitmap2D.FlipVert: Boolean;

  7077. var

  7078.   Row: Integer;

  7079.   TempDestData, DestData, SourceData: PByte;

  7080. begin

  7081.   result := inherited FlipVert;

  7082.   if Assigned(Data) then begin

  7083.     SourceData := Data;

  7084.     GetMem(DestData, Height * fRowSize);

  7085.     try

  7086.       TempDestData := DestData;

  7087.       Inc(TempDestData, Width * (Height -1) * fPixelSize);

  7088.       for Row := 0 to Height -1 do begin

  7089.         Move(SourceData^, TempDestData^, fRowSize);

  7090.         Dec(TempDestData, fRowSize);

  7091.         Inc(SourceData, fRowSize);

  7092.       end;

  7093.       SetDataPointer(DestData, Format);

  7094.       result := true;

  7095.     except

  7096.       FreeMem(DestData);

  7097.       raise;

  7098.     end;

  7099.   end;

  7100. end;

  7101. 

  7102. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7103. //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7104. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7105. type

  7106.   TMatrixItem = record

  7107.     X, Y: Integer;

  7108.     W: Single;

  7109.   end;

  7110. 

  7111.   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;

  7112.   TglBitmapToNormalMapRec = Record

  7113.     Scale: Single;

  7114.     Heights: array of Single;

  7115.     MatrixU : array of TMatrixItem;

  7116.     MatrixV : array of TMatrixItem;

  7117.   end;

  7118. 

  7119. const

  7120.   ONE_OVER_255 = 1 / 255;

  7121. 

  7122.   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7123. procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);

  7124. var

  7125.   Val: Single;

  7126. begin

  7127.   with FuncRec do begin

  7128.     Val :=

  7129.       Source.Data.r * LUMINANCE_WEIGHT_R +

  7130.       Source.Data.g * LUMINANCE_WEIGHT_G +

  7131.       Source.Data.b * LUMINANCE_WEIGHT_B;

  7132.     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;

  7133.   end;

  7134. end;

  7135. 

  7136. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7137. procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);

  7138. begin

  7139.   with FuncRec do

  7140.     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;

  7141. end;

  7142. 

  7143. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7144. procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);

  7145. type

  7146.   TVec = Array[0..2] of Single;

  7147. var

  7148.   Idx: Integer;

  7149.   du, dv: Double;

  7150.   Len: Single;

  7151.   Vec: TVec;

  7152. 

  7153.   function GetHeight(X, Y: Integer): Single;

  7154.   begin

  7155.     with FuncRec do begin

  7156.       X := Max(0, Min(Size.X -1, X));

  7157.       Y := Max(0, Min(Size.Y -1, Y));

  7158.       result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];

  7159.     end;

  7160.   end;

  7161. 

  7162. begin

  7163.   with FuncRec do begin

  7164.     with PglBitmapToNormalMapRec(Args)^ do begin

  7165.       du := 0;

  7166.       for Idx := Low(MatrixU) to High(MatrixU) do

  7167.         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;

  7168. 

  7169.       dv := 0;

  7170.       for Idx := Low(MatrixU) to High(MatrixU) do

  7171.         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;

  7172. 

  7173.       Vec[0] := -du * Scale;

  7174.       Vec[1] := -dv * Scale;

  7175.       Vec[2] := 1;

  7176.     end;

  7177. 

  7178.     // Normalize

  7179.     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));

  7180.     if Len <> 0 then begin

  7181.       Vec[0] := Vec[0] * Len;

  7182.       Vec[1] := Vec[1] * Len;

  7183.       Vec[2] := Vec[2] * Len;

  7184.     end;

  7185. 

  7186.     // Farbe zuweisem

  7187.     Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);

  7188.     Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);

  7189.     Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);

  7190.   end;

  7191. end;

  7192. 

  7193. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7194. procedure TglBitmap2D.ToNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);

  7195. var

  7196.   Rec: TglBitmapToNormalMapRec;

  7197. 

  7198.   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);

  7199.   begin

  7200.     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin

  7201.       Matrix[Index].X := X;

  7202.       Matrix[Index].Y := Y;

  7203.       Matrix[Index].W := W;

  7204.     end;

  7205.   end;

  7206. 

  7207. begin

  7208.   (* TODO Compression

  7209.   if not FormatIsUncompressed(InternalFormat) then

  7210.     raise EglBitmapUnsupportedFormatFormat.Create('TglBitmap2D.ToNormalMap - ' + UNSUPPORTED_FORMAT);

  7211.     *)

  7212. 

  7213.   if aScale > 100 then

  7214.     Rec.Scale := 100

  7215.   else if aScale < -100 then

  7216.     Rec.Scale := -100

  7217.   else

  7218.     Rec.Scale := aScale;

  7219. 

  7220.   SetLength(Rec.Heights, Width * Height);

  7221.   try

  7222.     case aFunc of

  7223.       nm4Samples: begin

  7224.         SetLength(Rec.MatrixU, 2);

  7225.         SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);

  7226.         SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);

  7227. 

  7228.         SetLength(Rec.MatrixV, 2);

  7229.         SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);

  7230.         SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);

  7231.       end;

  7232. 

  7233.       nmSobel: begin

  7234.         SetLength(Rec.MatrixU, 6);

  7235.         SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);

  7236.         SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);

  7237.         SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);

  7238.         SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);

  7239.         SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);

  7240.         SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);

  7241. 

  7242.         SetLength(Rec.MatrixV, 6);

  7243.         SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);

  7244.         SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);

  7245.         SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);

  7246.         SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);

  7247.         SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);

  7248.         SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);

  7249.       end;

  7250. 

  7251.       nm3x3: begin

  7252.         SetLength(Rec.MatrixU, 6);

  7253.         SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);

  7254.         SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);

  7255.         SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);

  7256.         SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);

  7257.         SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);

  7258.         SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);

  7259. 

  7260.         SetLength(Rec.MatrixV, 6);

  7261.         SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);

  7262.         SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);

  7263.         SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);

  7264.         SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);

  7265.         SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);

  7266.         SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);

  7267.       end;

  7268. 

  7269.       nm5x5: begin

  7270.         SetLength(Rec.MatrixU, 20);

  7271.         SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);

  7272.         SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);

  7273.         SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);

  7274.         SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);

  7275.         SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);

  7276.         SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);

  7277.         SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);

  7278.         SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);

  7279.         SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);

  7280.         SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);

  7281.         SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);

  7282.         SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);

  7283.         SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);

  7284.         SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);

  7285.         SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);

  7286.         SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);

  7287.         SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);

  7288.         SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);

  7289.         SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);

  7290.         SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);

  7291. 

  7292.         SetLength(Rec.MatrixV, 20);

  7293.         SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);

  7294.         SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);

  7295.         SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);

  7296.         SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);

  7297.         SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);

  7298.         SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);

  7299.         SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);

  7300.         SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);

  7301.         SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);

  7302.         SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);

  7303.         SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);

  7304.         SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);

  7305.         SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);

  7306.         SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);

  7307.         SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);

  7308.         SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);

  7309.         SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);

  7310.         SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);

  7311.         SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);

  7312.         SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);

  7313.       end;

  7314.     end;

  7315. 

  7316.     // Daten Sammeln

  7317.     if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then

  7318.       AddFunc(glBitmapToNormalMapPrepareAlphaFunc, false, PtrInt(@Rec))

  7319.     else

  7320.       AddFunc(glBitmapToNormalMapPrepareFunc, false, PtrInt(@Rec));

  7321.     AddFunc(glBitmapToNormalMapFunc, false, PtrInt(@Rec));

  7322.   finally

  7323.     SetLength(Rec.Heights, 0);

  7324.   end;

  7325. end;

  7326. 

  7327. 

  7328. 

  7329. 

  7330. 

  7331. 

  7332. 

  7333. 

  7334. 

  7335. (*

  7336. procedure TglBitmap1D.SetDataPointer(Data: pByte; Format: TglBitmapInternalFormat; Width, Height: Integer);

  7337. var

  7338.   pTemp: pByte;

  7339.   Size: Integer;

  7340. begin

  7341.   if Height > 1 then begin

  7342.     // extract first line of the data

  7343.     Size := FormatGetImageSize(glBitmapPosition(Width), Format);

  7344.     GetMem(pTemp, Size);

  7345. 

  7346.     Move(Data^, pTemp^, Size);

  7347. 

  7348.     FreeMem(Data);

  7349.   end else

  7350.     pTemp := Data;

  7351. 

  7352.   // set data pointer

  7353.   inherited SetDataPointer(pTemp, Format, Width);

  7354. 

  7355.   if FormatIsUncompressed(Format) then begin

  7356.     fUnmapFunc := FormatGetUnMapFunc(Format);

  7357.     fGetPixelFunc := GetPixel1DUnmap;

  7358.   end;

  7359. end;

  7360. 

  7361. 

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

  7363. var

  7364.   pTemp: pByte;

  7365. begin

  7366.   pTemp := Data;

  7367.   Inc(pTemp, Pos.X * fPixelSize);

  7368. 

  7369.   fUnmapFunc(pTemp, Pixel);

  7370. end;

  7371. 

  7372. 

  7373. function TglBitmap1D.FlipHorz: Boolean;

  7374. var

  7375.   Col: Integer;

  7376.   pTempDest, pDest, pSource: pByte;

  7377. begin

  7378.   result := inherited FlipHorz;

  7379. 

  7380.   if Assigned(Data) and FormatIsUncompressed(InternalFormat) then begin

  7381.     pSource := Data;

  7382. 

  7383.     GetMem(pDest, fRowSize);

  7384.     try

  7385.       pTempDest := pDest;

  7386. 

  7387.       Inc(pTempDest, fRowSize);

  7388.       for Col := 0 to Width -1 do begin

  7389.         Move(pSource^, pTempDest^, fPixelSize);

  7390. 

  7391.         Inc(pSource, fPixelSize);

  7392.         Dec(pTempDest, fPixelSize);

  7393.       end;

  7394. 

  7395.       SetDataPointer(pDest, InternalFormat);

  7396. 

  7397.       result := true;

  7398.     finally

  7399.       FreeMem(pDest);

  7400.     end;

  7401.   end;

  7402. end;

  7403. 

  7404. 

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

  7406. begin

  7407.   // Upload data

  7408.   if Self.InternalFormat in [ifDXT1, ifDXT3, ifDXT5] then

  7409.     glCompressedTexImage1D(Target, 0, InternalFormat, Width, 0, Trunc(Width * FormatGetSize(Self.InternalFormat)), Data)

  7410.   else

  7411. 

  7412.   // Upload data

  7413.   if BuildWithGlu then

  7414.     gluBuild1DMipmaps(Target, InternalFormat, Width, Format, Typ, Data)

  7415.   else

  7416.     glTexImage1D(Target, 0, InternalFormat, Width, 0, Format, Typ, Data);

  7417. 

  7418.   // Freigeben

  7419.   if (FreeDataAfterGenTexture) then

  7420.     FreeData;

  7421. end;

  7422. 

  7423. 

  7424. procedure TglBitmap1D.GenTexture(TestTextureSize: Boolean);

  7425. var

  7426.   BuildWithGlu, TexRec: Boolean;

  7427.   glFormat, glInternalFormat, glType: Cardinal;

  7428.   TexSize: Integer;

  7429. begin

  7430.   if Assigned(Data) then begin

  7431.     // Check Texture Size

  7432.     if (TestTextureSize) then begin

  7433.       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);

  7434. 

  7435.       if (Width > TexSize) then

  7436.         raise EglBitmapSizeToLargeException.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');

  7437. 

  7438.       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and

  7439.                 (Target = GL_TEXTURE_RECTANGLE_ARB);

  7440. 

  7441.       if not (IsPowerOfTwo (Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then

  7442.         raise EglBitmapNonPowerOfTwoException.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');

  7443.     end;

  7444. 

  7445.     CreateId;

  7446. 

  7447.     SetupParameters(BuildWithGlu);

  7448.     SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);

  7449. 

  7450.     UploadData(Target, glFormat, glInternalFormat, glType, BuildWithGlu);

  7451. 

  7452.     // Infos sammeln

  7453.     glAreTexturesResident(1, @fID, @fIsResident);

  7454.   end;

  7455. end;

  7456. 

  7457. 

  7458. procedure TglBitmap1D.AfterConstruction;

  7459. begin

  7460.   inherited;

  7461. 

  7462.   Target := GL_TEXTURE_1D;

  7463. end;

  7464. 

  7465. 

  7466. { TglBitmapCubeMap }

  7467. 

  7468. procedure TglBitmapCubeMap.AfterConstruction;

  7469. begin

  7470.   inherited;

  7471. 

  7472.   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then

  7473.     raise EglBitmapException.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');

  7474. 

  7475.   SetWrap; // set all to GL_CLAMP_TO_EDGE

  7476.   Target := GL_TEXTURE_CUBE_MAP;

  7477.   fGenMode := GL_REFLECTION_MAP;

  7478. end;

  7479. 

  7480. 

  7481. procedure TglBitmapCubeMap.Bind(EnableTexCoordsGen, EnableTextureUnit: Boolean);

  7482. begin

  7483.   inherited Bind (EnableTextureUnit);

  7484. 

  7485.   if EnableTexCoordsGen then begin

  7486.     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);

  7487.     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);

  7488.     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);

  7489.     glEnable(GL_TEXTURE_GEN_S);

  7490.     glEnable(GL_TEXTURE_GEN_T);

  7491.     glEnable(GL_TEXTURE_GEN_R);

  7492.   end;

  7493. end;

  7494. 

  7495. 

  7496. procedure TglBitmapCubeMap.GenerateCubeMap(CubeTarget: Cardinal; TestTextureSize: Boolean);

  7497. var

  7498.   glFormat, glInternalFormat, glType: Cardinal;

  7499.   BuildWithGlu: Boolean;

  7500.   TexSize: Integer;

  7501. begin

  7502.   // Check Texture Size

  7503.   if (TestTextureSize) then begin

  7504.     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);

  7505. 

  7506.     if ((Height > TexSize) or (Width > TexSize)) then

  7507.       raise EglBitmapSizeToLargeException.Create('TglBitmapCubeMap.GenTexture - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');

  7508. 

  7509.     if not ((IsPowerOfTwo (Height) and IsPowerOfTwo (Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then

  7510.       raise EglBitmapNonPowerOfTwoException.Create('TglBitmapCubeMap.GenTexture - Cubemaps dosn''t support non power of two texture.');

  7511.   end;

  7512. 

  7513.   // create Texture

  7514.   if ID = 0 then begin

  7515.     CreateID;

  7516.     SetupParameters(BuildWithGlu);

  7517.   end;

  7518. 

  7519.   SelectFormat(InternalFormat, glFormat, glInternalFormat, glType);

  7520. 

  7521.   UploadData (CubeTarget, glFormat, glInternalFormat, glType, BuildWithGlu);

  7522. end;

  7523. 

  7524. 

  7525. procedure TglBitmapCubeMap.GenTexture(TestTextureSize: Boolean);

  7526. begin

  7527.   Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');

  7528. end;

  7529. 

  7530. 

  7531. procedure TglBitmapCubeMap.Unbind(DisableTexCoordsGen,

  7532.   DisableTextureUnit: Boolean);

  7533. begin

  7534.   inherited Unbind (DisableTextureUnit);

  7535. 

  7536.   if DisableTexCoordsGen then begin

  7537.     glDisable(GL_TEXTURE_GEN_S);

  7538.     glDisable(GL_TEXTURE_GEN_T);

  7539.     glDisable(GL_TEXTURE_GEN_R);

  7540.   end;

  7541. end;

  7542. 

  7543. 

  7544. { TglBitmapNormalMap }

  7545. 

  7546. type

  7547.   TVec = Array[0..2] of Single;

  7548.   TglBitmapNormalMapGetVectorFunc = procedure (var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);

  7549. 

  7550.   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;

  7551.   TglBitmapNormalMapRec = record

  7552.     HalfSize : Integer;

  7553.     Func: TglBitmapNormalMapGetVectorFunc;

  7554.   end;

  7555. 

  7556. 

  7557. procedure glBitmapNormalMapPosX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);

  7558. begin

  7559.   Vec[0] := HalfSize;

  7560.   Vec[1] := - (Position.Y + 0.5 - HalfSize);

  7561.   Vec[2] := - (Position.X + 0.5 - HalfSize);

  7562. end;

  7563. 

  7564. 

  7565. procedure glBitmapNormalMapNegX(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);

  7566. begin

  7567.   Vec[0] := - HalfSize;

  7568.   Vec[1] := - (Position.Y + 0.5 - HalfSize);

  7569.   Vec[2] := Position.X + 0.5 - HalfSize;

  7570. end;

  7571. 

  7572. 

  7573. procedure glBitmapNormalMapPosY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);

  7574. begin

  7575.   Vec[0] := Position.X + 0.5 - HalfSize;

  7576.   Vec[1] := HalfSize;

  7577.   Vec[2] := Position.Y + 0.5 - HalfSize;

  7578. end;

  7579. 

  7580. 

  7581. procedure glBitmapNormalMapNegY(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);

  7582. begin

  7583.   Vec[0] := Position.X + 0.5 - HalfSize;

  7584.   Vec[1] := - HalfSize;

  7585.   Vec[2] := - (Position.Y + 0.5 - HalfSize);

  7586. end;

  7587. 

  7588. 

  7589. procedure glBitmapNormalMapPosZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);

  7590. begin

  7591.   Vec[0] := Position.X + 0.5 - HalfSize;

  7592.   Vec[1] := - (Position.Y + 0.5 - HalfSize);

  7593.   Vec[2] := HalfSize;

  7594. end;

  7595. 

  7596. 

  7597. procedure glBitmapNormalMapNegZ(var Vec: TVec; const Position: TglBitmapPixelPosition; const HalfSize: Integer);

  7598. begin

  7599.   Vec[0] := - (Position.X + 0.5 - HalfSize);

  7600.   Vec[1] := - (Position.Y + 0.5 - HalfSize);

  7601.   Vec[2] := - HalfSize;

  7602. end;

  7603. 

  7604. 

  7605. procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);

  7606. var

  7607.   Vec : TVec;

  7608.   Len: Single;

  7609. begin

  7610.   with FuncRec do begin

  7611.     with PglBitmapNormalMapRec (CustomData)^ do begin

  7612.       Func(Vec, Position, HalfSize);

  7613. 

  7614.       // Normalize

  7615.       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));

  7616.       if Len <> 0 then begin

  7617.         Vec[0] := Vec[0] * Len;

  7618.         Vec[1] := Vec[1] * Len;

  7619.         Vec[2] := Vec[2] * Len;

  7620.       end;

  7621. 

  7622.       // Scale Vector and AddVectro

  7623.       Vec[0] := Vec[0] * 0.5 + 0.5;

  7624.       Vec[1] := Vec[1] * 0.5 + 0.5;

  7625.       Vec[2] := Vec[2] * 0.5 + 0.5;

  7626.     end;

  7627. 

  7628.     // Set Color

  7629.     Dest.Red   := Round(Vec[0] * 255);

  7630.     Dest.Green := Round(Vec[1] * 255);

  7631.     Dest.Blue  := Round(Vec[2] * 255);

  7632.   end;

  7633. end;

  7634. 

  7635. 

  7636. procedure TglBitmapNormalMap.AfterConstruction;

  7637. begin

  7638.   inherited;

  7639. 

  7640.   fGenMode := GL_NORMAL_MAP;

  7641. end;

  7642. 

  7643. 

  7644. procedure TglBitmapNormalMap.GenerateNormalMap(Size: Integer;

  7645.   TestTextureSize: Boolean);

  7646. var

  7647.   Rec: TglBitmapNormalMapRec;

  7648.   SizeRec: TglBitmapPixelPosition;

  7649. begin

  7650.   Rec.HalfSize := Size div 2;

  7651. 

  7652.   FreeDataAfterGenTexture := false;

  7653. 

  7654.   SizeRec.Fields := [ffX, ffY];

  7655.   SizeRec.X := Size;

  7656.   SizeRec.Y := Size;

  7657. 

  7658.   // Positive X

  7659.   Rec.Func := glBitmapNormalMapPosX;

  7660.   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);

  7661.   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, TestTextureSize);

  7662. 

  7663.   // Negative X

  7664.   Rec.Func := glBitmapNormalMapNegX;

  7665.   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);

  7666.   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, TestTextureSize);

  7667. 

  7668.   // Positive Y

  7669.   Rec.Func := glBitmapNormalMapPosY;

  7670.   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);

  7671.   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, TestTextureSize);

  7672. 

  7673.   // Negative Y

  7674.   Rec.Func := glBitmapNormalMapNegY;

  7675.   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);

  7676.   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, TestTextureSize);

  7677. 

  7678.   // Positive Z

  7679.   Rec.Func := glBitmapNormalMapPosZ;

  7680.   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);

  7681.   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, TestTextureSize);

  7682. 

  7683.   // Negative Z

  7684.   Rec.Func := glBitmapNormalMapNegZ;

  7685.   LoadFromFunc (SizeRec, glBitmapNormalMapFunc, ifBGR8, @Rec);

  7686.   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, TestTextureSize);

  7687. end;

  7688. *)

  7689. 

  7690. initialization

  7691.   glBitmapSetDefaultFormat(tfEmpty);

  7692.   glBitmapSetDefaultMipmap(mmMipmap);

  7693.   glBitmapSetDefaultFilter(GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);

  7694.   glBitmapSetDefaultWrap  (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);

  7695. 

  7696.   glBitmapSetDefaultFreeDataAfterGenTexture(true);

  7697.   glBitmapSetDefaultDeleteTextureOnFree    (true);

  7698. 

  7699.   TFormatDescriptor.Init;

  7700. 

  7701. finalization

  7702.   TFormatDescriptor.Finalize;

  7703. 

  7704. end.