opengl
/
OpenGLCore
1
0
Fork 0
Code Issues 0 Pull Requests 0 Releases 0 Wiki Activity
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
45 Commits
1 Branch
1.8 MiB
 
Tree: 1f9d3b8b9c
Branches Tags
${ item.name }
Create branch ${ searchTerm }
from '1f9d3b8b9c'
${ noResults }
OpenGLCore/glBitmap.pas

9551 lines
346 KiB
Raw Blame History 

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

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

  3. 

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

  5. 

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

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

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

  9.   obtain a copy of the License at

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

  11. 

  12.   The glBitmap is a Delphi/FPC unit that contains several wrapper classes

  13.   to manage OpenGL texture objects. Below you can find a list of the main

  14.   functionality of this classes:

  15.   - load texture data from file (e.g. BMP, TGA, DDS, PNG, JPEG, ...)

  16.   - load texture data from several other image objects (e.g. TBitmap, TLazIntfImage, SDL Surface)

  17.   - save texture data to file (e.g. BMP, TGA, DDS, PNG, JPEG, ...)

  18.   - save texture data to several other image objects (e.g. TBitmap, TLazIntfImage, SDL Surface)

  19.   - support for many texture formats (e.g. RGB8, BGR8, RGBA8, BGRA8, ...)

  20.   - manage texture properties (e.g. Filter, Clamp, Mipmap, ...)

  21.   - upload texture data to video card

  22.   - download texture data from video card

  23.   - manipulate texture data (e.g. add alpha, remove alpha, convert to other format, switch RGB, ...) }

  24. 

  25. unit glBitmap;

  26. 

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

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

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

  30. 

  31. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  32. // Preferences ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  33. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  34. // enable support for OpenGL ES 1.1

  35. {.$DEFINE OPENGL_ES_1_1}

  36. 

  37. // enable support for OpenGL ES 2.0

  38. {.$DEFINE OPENGL_ES_2_0}

  39. 

  40. // enable support for OpenGL ES 3.0

  41. {.$DEFINE OPENGL_ES_3_0}

  42. 

  43. // enable support for all OpenGL ES extensions

  44. {.$DEFINE OPENGL_ES_EXT}

  45. 

  46. 

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

  48. // use dglOpenGL.pas if not enabled

  49. {.$DEFINE GLB_NATIVE_OGL_STATIC}

  50. 

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

  52. // use dglOpenGL.pas if not enabled

  53. {.$DEFINE GLB_NATIVE_OGL_DYNAMIC}

  54. 

  55. 

  56. // activate to enable the support for SDL_surfaces

  57. {.$DEFINE GLB_SDL}

  58. 

  59. // activate  to enable the support for Delphi (including support for Delphi's (not Lazarus') TBitmap)

  60. {.$DEFINE GLB_DELPHI}

  61. 

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

  63. {.$DEFINE GLB_LAZARUS}

  64. 

  65. 

  66. 

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

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

  69. {.$DEFINE GLB_SDL_IMAGE}

  70. 

  71. 

  72. 

  73. // activate to enable Lazarus TPortableNetworkGraphic support

  74. // if you enable this pngImage and libPNG will be ignored

  75. {.$DEFINE GLB_LAZ_PNG}

  76. 

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

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

  79. {.$DEFINE GLB_PNGIMAGE}

  80. 

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

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

  83. {.$DEFINE GLB_LIB_PNG}

  84. 

  85. 

  86. 

  87. // activate to enable Lazarus TJPEGImage support

  88. // if you enable this delphi jpegs and libJPEG will be ignored

  89. {.$DEFINE GLB_LAZ_JPEG}

  90. 

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

  92. {.$DEFINE GLB_DELPHI_JPEG}

  93. 

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

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

  96. {.$DEFINE GLB_LIB_JPEG}

  97. 

  98. 

  99. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  101. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  102. // Delphi Versions

  103. {$IFDEF fpc}

  104.   {$MODE Delphi}

  105. 

  106.   {$IFDEF CPUI386}

  107.     {$DEFINE CPU386}

  108.     {$ASMMODE INTEL}

  109.   {$ENDIF}

  110. 

  111.   {$IFNDEF WINDOWS}

  112.     {$linklib c}

  113.   {$ENDIF}

  114. {$ENDIF}

  115. 

  116. // Operation System

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

  118.   {$DEFINE GLB_WIN}

  119. {$ELSEIF DEFINED(LINUX)}

  120.   {$DEFINE GLB_LINUX}

  121. {$IFEND}

  122. 

  123. // OpenGL ES

  124. {$IF DEFINED(OPENGL_ES_EXT)} {$DEFINE OPENGL_ES_1_1} {$IFEND}

  125. {$IF DEFINED(OPENGL_ES_3_0)} {$DEFINE OPENGL_ES_2_0} {$IFEND}

  126. {$IF DEFINED(OPENGL_ES_2_0)} {$DEFINE OPENGL_ES_1_1} {$IFEND}

  127. {$IF DEFINED(OPENGL_ES_1_1)} {$DEFINE OPENGL_ES}     {$IFEND}

  128. 

  129. // native OpenGL Support

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

  131.   {$IFDEF OPENGL_ES}

  132.     {$ERROR 'native OpenGL is not supported yet for OpenGL ES, please use dglOpenGLES.pas instead'}

  133.   {$ELSE}

  134.     {$DEFINE GLB_NATIVE_OGL}

  135.   {$ENDIF}

  136. {$IFEND}

  137. 

  138. // checking define combinations

  139. //SDL Image

  140. {$IFDEF GLB_SDL_IMAGE}

  141.   {$IFNDEF GLB_SDL}

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

  143.     {$DEFINE GLB_SDL}

  144.   {$ENDIF}

  145. 

  146.   {$IFDEF GLB_LAZ_PNG}

  147.     {$MESSAGE warn 'The Lazarus TPortableNetworkGraphics will be ignored because you are using SDL_image.'}

  148.     {$undef GLB_LAZ_PNG}

  149.   {$ENDIF}

  150. 

  151.   {$IFDEF GLB_PNGIMAGE}

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

  153.     {$undef GLB_PNGIMAGE}

  154.   {$ENDIF}

  155. 

  156.   {$IFDEF GLB_LAZ_JPEG}

  157.     {$MESSAGE warn 'The Lazarus TJPEGImage will be ignored because you are using SDL_image.'}

  158.     {$undef GLB_LAZ_JPEG}

  159.   {$ENDIF}

  160. 

  161.   {$IFDEF GLB_DELPHI_JPEG}

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

  163.     {$undef GLB_DELPHI_JPEG}

  164.   {$ENDIF}

  165. 

  166.   {$IFDEF GLB_LIB_PNG}

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

  168.     {$undef GLB_LIB_PNG}

  169.   {$ENDIF}

  170. 

  171.   {$IFDEF GLB_LIB_JPEG}

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

  173.     {$undef GLB_LIB_JPEG}

  174.   {$ENDIF}

  175. 

  176.   {$DEFINE GLB_SUPPORT_PNG_READ}

  177.   {$DEFINE GLB_SUPPORT_JPEG_READ}

  178. {$ENDIF}

  179. 

  180. // Lazarus TPortableNetworkGraphic

  181. {$IFDEF GLB_LAZ_PNG}

  182.   {$IFNDEF GLB_LAZARUS}

  183.     {$MESSAGE warn 'Lazarus TPortableNetworkGraphic won''t work without Lazarus. Lazarus will be activated.'}

  184.     {$DEFINE GLB_LAZARUS}

  185.   {$ENDIF}

  186. 

  187.   {$IFDEF GLB_PNGIMAGE}

  188.     {$MESSAGE warn 'The pngimage will be ignored if you are using Lazarus TPortableNetworkGraphic.'}

  189.     {$undef GLB_PNGIMAGE}

  190.   {$ENDIF}

  191. 

  192.   {$IFDEF GLB_LIB_PNG}

  193.     {$MESSAGE warn 'The library libPNG will be ignored if you are using Lazarus TPortableNetworkGraphic.'}

  194.     {$undef GLB_LIB_PNG}

  195.   {$ENDIF}

  196. 

  197.   {$DEFINE GLB_SUPPORT_PNG_READ}

  198.   {$DEFINE GLB_SUPPORT_PNG_WRITE}

  199. {$ENDIF}

  200. 

  201. // PNG Image

  202. {$IFDEF GLB_PNGIMAGE}

  203.   {$IFDEF GLB_LIB_PNG}

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

  205.     {$undef GLB_LIB_PNG}

  206.   {$ENDIF}

  207. 

  208.   {$DEFINE GLB_SUPPORT_PNG_READ}

  209.   {$DEFINE GLB_SUPPORT_PNG_WRITE}

  210. {$ENDIF}

  211. 

  212. // libPNG

  213. {$IFDEF GLB_LIB_PNG}

  214.   {$DEFINE GLB_SUPPORT_PNG_READ}

  215.   {$DEFINE GLB_SUPPORT_PNG_WRITE}

  216. {$ENDIF}

  217. 

  218. // Lazarus TJPEGImage

  219. {$IFDEF GLB_LAZ_JPEG}

  220.   {$IFNDEF GLB_LAZARUS}

  221.     {$MESSAGE warn 'Lazarus TJPEGImage won''t work without Lazarus. Lazarus will be activated.'}

  222.     {$DEFINE GLB_LAZARUS}

  223.   {$ENDIF}

  224. 

  225.   {$IFDEF GLB_DELPHI_JPEG}

  226.     {$MESSAGE warn 'The Delphi JPEGImage will be ignored if you are using the Lazarus TJPEGImage.'}

  227.     {$undef GLB_DELPHI_JPEG}

  228.   {$ENDIF}

  229. 

  230.   {$IFDEF GLB_LIB_JPEG}

  231.     {$MESSAGE warn 'The library libJPEG will be ignored if you are using the Lazarus TJPEGImage.'}

  232.     {$undef GLB_LIB_JPEG}

  233.   {$ENDIF}

  234. 

  235.   {$DEFINE GLB_SUPPORT_JPEG_READ}

  236.   {$DEFINE GLB_SUPPORT_JPEG_WRITE}

  237. {$ENDIF}

  238. 

  239. // JPEG Image

  240. {$IFDEF GLB_DELPHI_JPEG}

  241.   {$IFDEF GLB_LIB_JPEG}

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

  243.     {$undef GLB_LIB_JPEG}

  244.   {$ENDIF}

  245. 

  246.   {$DEFINE GLB_SUPPORT_JPEG_READ}

  247.   {$DEFINE GLB_SUPPORT_JPEG_WRITE}

  248. {$ENDIF}

  249. 

  250. // libJPEG

  251. {$IFDEF GLB_LIB_JPEG}

  252.   {$DEFINE GLB_SUPPORT_JPEG_READ}

  253.   {$DEFINE GLB_SUPPORT_JPEG_WRITE}

  254. {$ENDIF}

  255. 

  256. // native OpenGL

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

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

  259. {$IFEND}

  260. 

  261. // general options

  262. {$EXTENDEDSYNTAX ON}

  263. {$LONGSTRINGS ON}

  264. {$ALIGN ON}

  265. {$IFNDEF FPC}

  266.   {$OPTIMIZATION ON}

  267. {$ENDIF}

  268. 

  269. interface

  270. 

  271. uses

  272.   {$IFNDEF GLB_NATIVE_OGL}

  273.     {$IFDEF OPENGL_ES}          dglOpenGLES,

  274.     {$ELSE}                     dglOpenGL,                          {$ENDIF}

  275.                                                                     {$ENDIF}

  276.   {$IF DEFINED(GLB_WIN) AND

  277.        (DEFINED(GLB_NATIVE_OGL) OR

  278.         DEFINED(GLB_DELPHI))}   windows,                            {$IFEND}

  279. 

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

  281.   {$IFDEF GLB_LAZARUS}          IntfGraphics, GraphType, Graphics,  {$ENDIF}

  282.   {$IFDEF GLB_DELPHI}           Dialogs, Graphics, Types,           {$ENDIF}

  283. 

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

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

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

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

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

  289. 

  290.   Classes, SysUtils;

  291. 

  292. {$IFDEF GLB_NATIVE_OGL}

  293. const

  294.   GL_TRUE   = 1;

  295.   GL_FALSE  = 0;

  296. 

  297.   GL_ZERO = 0;

  298.   GL_ONE  = 1;

  299. 

  300.   GL_VERSION    = $1F02;

  301.   GL_EXTENSIONS = $1F03;

  302. 

  303.   GL_TEXTURE_1D         = $0DE0;

  304.   GL_TEXTURE_2D         = $0DE1;

  305.   GL_TEXTURE_RECTANGLE  = $84F5;

  306. 

  307.   GL_NORMAL_MAP                   = $8511;

  308.   GL_TEXTURE_CUBE_MAP             = $8513;

  309.   GL_REFLECTION_MAP               = $8512;

  310.   GL_TEXTURE_CUBE_MAP_POSITIVE_X  = $8515;

  311.   GL_TEXTURE_CUBE_MAP_NEGATIVE_X  = $8516;

  312.   GL_TEXTURE_CUBE_MAP_POSITIVE_Y  = $8517;

  313.   GL_TEXTURE_CUBE_MAP_NEGATIVE_Y  = $8518;

  314.   GL_TEXTURE_CUBE_MAP_POSITIVE_Z  = $8519;

  315.   GL_TEXTURE_CUBE_MAP_NEGATIVE_Z  = $851A;

  316. 

  317.   GL_TEXTURE_WIDTH            = $1000;

  318.   GL_TEXTURE_HEIGHT           = $1001;

  319.   GL_TEXTURE_INTERNAL_FORMAT  = $1003;

  320.   GL_TEXTURE_SWIZZLE_RGBA     = $8E46;

  321. 

  322.   GL_S = $2000;

  323.   GL_T = $2001;

  324.   GL_R = $2002;

  325.   GL_Q = $2003;

  326. 

  327.   GL_TEXTURE_GEN_S = $0C60;

  328.   GL_TEXTURE_GEN_T = $0C61;

  329.   GL_TEXTURE_GEN_R = $0C62;

  330.   GL_TEXTURE_GEN_Q = $0C63;

  331. 

  332.   GL_RED    = $1903;

  333.   GL_GREEN  = $1904;

  334.   GL_BLUE   = $1905;

  335. 

  336.   GL_ALPHA    = $1906;

  337.   GL_ALPHA4   = $803B;

  338.   GL_ALPHA8   = $803C;

  339.   GL_ALPHA12  = $803D;

  340.   GL_ALPHA16  = $803E;

  341. 

  342.   GL_LUMINANCE    = $1909;

  343.   GL_LUMINANCE4   = $803F;

  344.   GL_LUMINANCE8   = $8040;

  345.   GL_LUMINANCE12  = $8041;

  346.   GL_LUMINANCE16  = $8042;

  347. 

  348.   GL_LUMINANCE_ALPHA      = $190A;

  349.   GL_LUMINANCE4_ALPHA4    = $8043;

  350.   GL_LUMINANCE6_ALPHA2    = $8044;

  351.   GL_LUMINANCE8_ALPHA8    = $8045;

  352.   GL_LUMINANCE12_ALPHA4   = $8046;

  353.   GL_LUMINANCE12_ALPHA12  = $8047;

  354.   GL_LUMINANCE16_ALPHA16  = $8048;

  355. 

  356.   GL_RGB      = $1907;

  357.   GL_BGR      = $80E0;

  358.   GL_R3_G3_B2 = $2A10;

  359.   GL_RGB4     = $804F;

  360.   GL_RGB5     = $8050;

  361.   GL_RGB565   = $8D62;

  362.   GL_RGB8     = $8051;

  363.   GL_RGB10    = $8052;

  364.   GL_RGB12    = $8053;

  365.   GL_RGB16    = $8054;

  366. 

  367.   GL_RGBA     = $1908;

  368.   GL_BGRA     = $80E1;

  369.   GL_RGBA2    = $8055;

  370.   GL_RGBA4    = $8056;

  371.   GL_RGB5_A1  = $8057;

  372.   GL_RGBA8    = $8058;

  373.   GL_RGB10_A2 = $8059;

  374.   GL_RGBA12   = $805A;

  375.   GL_RGBA16   = $805B;

  376. 

  377.   GL_DEPTH_COMPONENT    = $1902;

  378.   GL_DEPTH_COMPONENT16  = $81A5;

  379.   GL_DEPTH_COMPONENT24  = $81A6;

  380.   GL_DEPTH_COMPONENT32  = $81A7;

  381. 

  382.   GL_COMPRESSED_RGB                 = $84ED;

  383.   GL_COMPRESSED_RGBA                = $84EE;

  384.   GL_COMPRESSED_RGB_S3TC_DXT1_EXT   = $83F0;

  385.   GL_COMPRESSED_RGBA_S3TC_DXT1_EXT  = $83F1;

  386.   GL_COMPRESSED_RGBA_S3TC_DXT3_EXT  = $83F2;

  387.   GL_COMPRESSED_RGBA_S3TC_DXT5_EXT  = $83F3;

  388. 

  389.   GL_UNSIGNED_BYTE            = $1401;

  390.   GL_UNSIGNED_BYTE_3_3_2      = $8032;

  391.   GL_UNSIGNED_BYTE_2_3_3_REV  = $8362;

  392. 

  393.   GL_UNSIGNED_SHORT             = $1403;

  394.   GL_UNSIGNED_SHORT_5_6_5       = $8363;

  395.   GL_UNSIGNED_SHORT_4_4_4_4     = $8033;

  396.   GL_UNSIGNED_SHORT_5_5_5_1     = $8034;

  397.   GL_UNSIGNED_SHORT_5_6_5_REV   = $8364;

  398.   GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;

  399.   GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;

  400. 

  401.   GL_UNSIGNED_INT                 = $1405;

  402.   GL_UNSIGNED_INT_8_8_8_8         = $8035;

  403.   GL_UNSIGNED_INT_10_10_10_2      = $8036;

  404.   GL_UNSIGNED_INT_8_8_8_8_REV     = $8367;

  405.   GL_UNSIGNED_INT_2_10_10_10_REV  = $8368;

  406. 

  407.   { Texture Filter }

  408.   GL_TEXTURE_MAG_FILTER     = $2800;

  409.   GL_TEXTURE_MIN_FILTER     = $2801;

  410.   GL_NEAREST                = $2600;

  411.   GL_NEAREST_MIPMAP_NEAREST = $2700;

  412.   GL_NEAREST_MIPMAP_LINEAR  = $2702;

  413.   GL_LINEAR                 = $2601;

  414.   GL_LINEAR_MIPMAP_NEAREST  = $2701;

  415.   GL_LINEAR_MIPMAP_LINEAR   = $2703;

  416. 

  417.   { Texture Wrap }

  418.   GL_TEXTURE_WRAP_S   = $2802;

  419.   GL_TEXTURE_WRAP_T   = $2803;

  420.   GL_TEXTURE_WRAP_R   = $8072;

  421.   GL_CLAMP            = $2900;

  422.   GL_REPEAT           = $2901;

  423.   GL_CLAMP_TO_EDGE    = $812F;

  424.   GL_CLAMP_TO_BORDER  = $812D;

  425.   GL_MIRRORED_REPEAT  = $8370;

  426. 

  427.   { Other }

  428.   GL_GENERATE_MIPMAP      = $8191;

  429.   GL_TEXTURE_BORDER_COLOR = $1004;

  430.   GL_MAX_TEXTURE_SIZE     = $0D33;

  431.   GL_PACK_ALIGNMENT       = $0D05;

  432.   GL_UNPACK_ALIGNMENT     = $0CF5;

  433. 

  434.   GL_TEXTURE_MAX_ANISOTROPY_EXT     = $84FE;

  435.   GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;

  436.   GL_MAX_CUBE_MAP_TEXTURE_SIZE      = $851C;

  437.   GL_TEXTURE_GEN_MODE               = $2500;

  438. 

  439. {$IF DEFINED(GLB_WIN)}

  440.   libglu    = 'glu32.dll';

  441.   libopengl = 'opengl32.dll';

  442. {$ELSEIF DEFINED(GLB_LINUX)}

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

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

  445. {$IFEND}

  446. 

  447. type

  448.   GLboolean = BYTEBOOL;

  449.   GLint     = Integer;

  450.   GLsizei   = Integer;

  451.   GLuint    = Cardinal;

  452.   GLfloat   = Single;

  453.   GLenum    = Cardinal;

  454. 

  455.   PGLvoid    = Pointer;

  456.   PGLboolean = ^GLboolean;

  457.   PGLint     = ^GLint;

  458.   PGLuint    = ^GLuint;

  459.   PGLfloat   = ^GLfloat;

  460. 

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

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

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

  464. 

  465. {$IF DEFINED(GLB_WIN)}

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

  467. {$ELSEIF DEFINED(GLB_LINUX)}

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

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

  470. {$IFEND}

  471. 

  472. {$IF DEFINED(GLB_NATIVE_OGL_DYNAMIC)}

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

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

  475. 

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

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

  478. 

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

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

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

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

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

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

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

  486. 

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

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

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

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

  491. 

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

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

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

  495. 

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

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

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

  499. 

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

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

  502. 

  503. {$ELSEIF DEFINED(GLB_NATIVE_OGL_STATIC)}

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

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

  506. 

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

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

  509. 

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

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

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

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

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

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

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

  517. 

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

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

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

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

  522. 

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

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

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

  526. 

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

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

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

  530. 

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

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

  533. {$IFEND}

  534. 

  535. var

  536.   GL_VERSION_1_2,

  537.   GL_VERSION_1_3,

  538.   GL_VERSION_1_4,

  539.   GL_VERSION_2_0,

  540.   GL_VERSION_3_3,

  541. 

  542.   GL_SGIS_generate_mipmap,

  543. 

  544.   GL_ARB_texture_border_clamp,

  545.   GL_ARB_texture_mirrored_repeat,

  546.   GL_ARB_texture_rectangle,

  547.   GL_ARB_texture_non_power_of_two,

  548.   GL_ARB_texture_swizzle,

  549.   GL_ARB_texture_cube_map,

  550. 

  551.   GL_IBM_texture_mirrored_repeat,

  552. 

  553.   GL_NV_texture_rectangle,

  554. 

  555.   GL_EXT_texture_edge_clamp,

  556.   GL_EXT_texture_rectangle,

  557.   GL_EXT_texture_swizzle,

  558.   GL_EXT_texture_cube_map,

  559.   GL_EXT_texture_filter_anisotropic: Boolean;

  560. 

  561.   glCompressedTexImage1D: TglCompressedTexImage1D;

  562.   glCompressedTexImage2D: TglCompressedTexImage2D;

  563.   glGetCompressedTexImage: TglGetCompressedTexImage;

  564. 

  565. {$IF DEFINED(GLB_WIN)}

  566.   wglGetProcAddress: TwglGetProcAddress;

  567. {$ELSEIF DEFINED(GLB_LINUX)}

  568.   glXGetProcAddress: TglXGetProcAddress;

  569.   glXGetProcAddressARB: TglXGetProcAddress;

  570. {$IFEND}

  571. 

  572. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}

  573.   glEnable: TglEnable;

  574.   glDisable: TglDisable;

  575. 

  576.   glGetString: TglGetString;

  577.   glGetIntegerv: TglGetIntegerv;

  578. 

  579.   glTexParameteri: TglTexParameteri;

  580.   glTexParameteriv: TglTexParameteriv;

  581.   glTexParameterfv: TglTexParameterfv;

  582.   glGetTexParameteriv: TglGetTexParameteriv;

  583.   glGetTexParameterfv: TglGetTexParameterfv;

  584.   glGetTexLevelParameteriv: TglGetTexLevelParameteriv;

  585.   glGetTexLevelParameterfv: TglGetTexLevelParameterfv;

  586. 

  587.   glTexGeni: TglTexGeni;

  588.   glGenTextures: TglGenTextures;

  589.   glBindTexture: TglBindTexture;

  590.   glDeleteTextures: TglDeleteTextures;

  591. 

  592.   glAreTexturesResident: TglAreTexturesResident;

  593.   glReadPixels: TglReadPixels;

  594.   glPixelStorei: TglPixelStorei;

  595. 

  596.   glTexImage1D: TglTexImage1D;

  597.   glTexImage2D: TglTexImage2D;

  598.   glGetTexImage: TglGetTexImage;

  599. 

  600.   gluBuild1DMipmaps: TgluBuild1DMipmaps;

  601.   gluBuild2DMipmaps: TgluBuild2DMipmaps;

  602. {$ENDIF}

  603. {$ENDIF}

  604. 

  605. type

  606. {$IFNDEF fpc}

  607.   QWord   = System.UInt64;

  608.   PQWord  = ^QWord;

  609. 

  610.   PtrInt  = Longint;

  611.   PtrUInt = DWord;

  612. {$ENDIF}

  613. 

  614. 

  615.   { type that describes the format of the data stored in a texture.

  616.     the name of formats is composed of the following constituents:

  617.     - multiple channels:

  618.        - channel                          (e.g. R, G, B, A or Alpha, Luminance or X (reserved))

  619.        - width of the chanel in bit       (4, 8, 16, ...)

  620.     - data type                           (e.g. ub, us, ui)

  621.     - number of elements of data types }

  622.   TglBitmapFormat = (

  623.     tfEmpty = 0,

  624. 

  625.     tfAlpha4ub1,                //< 1 x unsigned byte

  626.     tfAlpha8ub1,                //< 1 x unsigned byte

  627.     tfAlpha16us1,               //< 1 x unsigned short

  628. 

  629.     tfLuminance4ub1,            //< 1 x unsigned byte

  630.     tfLuminance8ub1,            //< 1 x unsigned byte

  631.     tfLuminance16us1,           //< 1 x unsigned short

  632. 

  633.     tfLuminance4Alpha4ub2,      //< 1 x unsigned byte (lum), 1 x unsigned byte (alpha)

  634.     tfLuminance6Alpha2ub2,      //< 1 x unsigned byte (lum), 1 x unsigned byte (alpha)

  635.     tfLuminance8Alpha8ub2,      //< 1 x unsigned byte (lum), 1 x unsigned byte (alpha)

  636.     tfLuminance12Alpha4us2,     //< 1 x unsigned short (lum), 1 x unsigned short (alpha)

  637.     tfLuminance16Alpha16us2,    //< 1 x unsigned short (lum), 1 x unsigned short (alpha)

  638. 

  639.     tfR3G3B2ub1,                //< 1 x unsigned byte (3bit red, 3bit green, 2bit blue)

  640.     tfRGBX4us1,                 //< 1 x unsigned short (4bit red, 4bit green, 4bit blue, 4bit reserverd)

  641.     tfXRGB4us1,                 //< 1 x unsigned short (4bit reserved, 4bit red, 4bit green, 4bit blue)

  642.     tfR5G6B5us1,                //< 1 x unsigned short (5bit red, 6bit green, 5bit blue)

  643.     tfRGB5X1us1,                //< 1 x unsigned short (5bit red, 5bit green, 5bit blue, 1bit reserved)

  644.     tfX1RGB5us1,                //< 1 x unsigned short (1bit reserved, 5bit red, 5bit green, 5bit blue)

  645.     tfRGB8ub3,                  //< 1 x unsigned byte (red), 1 x unsigned byte (green), 1 x unsigned byte (blue)

  646.     tfRGBX8ui1,                 //< 1 x unsigned int (8bit red, 8bit green, 8bit blue, 8bit reserved)

  647.     tfXRGB8ui1,                 //< 1 x unsigned int (8bit reserved, 8bit red, 8bit green, 8bit blue)

  648.     tfRGB10X2ui1,               //< 1 x unsigned int (10bit red, 10bit green, 10bit blue, 2bit reserved)

  649.     tfX2RGB10ui1,               //< 1 x unsigned int (2bit reserved, 10bit red, 10bit green, 10bit blue)

  650.     tfRGB16us3,                 //< 1 x unsigned short (red), 1 x unsigned short (green), 1 x unsigned short (blue)

  651. 

  652.     tfRGBA4us1,                 //< 1 x unsigned short (4bit red, 4bit green, 4bit blue, 4bit alpha)

  653.     tfARGB4us1,                 //< 1 x unsigned short (4bit alpha, 4bit red, 4bit green, 4bit blue)

  654.     tfRGB5A1us1,                //< 1 x unsigned short (5bit red, 5bit green, 5bit blue, 1bit alpha)

  655.     tfA1RGB5us1,                //< 1 x unsigned short (1bit alpha, 5bit red, 5bit green, 5bit blue)

  656.     tfRGBA8ui1,                 //< 1 x unsigned int (8bit red, 8bit green, 8bit blue, 8 bit alpha)

  657.     tfARGB8ui1,                 //< 1 x unsigned int (8 bit alpha, 8bit red, 8bit green, 8bit blue)

  658.     tfRGBA8ub4,                 //< 1 x unsigned byte (red), 1 x unsigned byte (green), 1 x unsigned byte (blue), 1 x unsigned byte (alpha)

  659.     tfRGB10A2ui1,               //< 1 x unsigned int (10bit red, 10bit green, 10bit blue, 2bit alpha)

  660.     tfA2RGB10ui1,               //< 1 x unsigned int (2bit alpha, 10bit red, 10bit green, 10bit blue)

  661.     tfRGBA16us4,                //< 1 x unsigned short (red), 1 x unsigned short (green), 1 x unsigned short (blue), 1 x unsigned short (alpha)

  662. 

  663.     tfBGRX4us1,                 //< 1 x unsigned short (4bit blue, 4bit green, 4bit red, 4bit reserved)

  664.     tfXBGR4us1,                 //< 1 x unsigned short (4bit reserved, 4bit blue, 4bit green, 4bit red)

  665.     tfB5G6R5us1,                //< 1 x unsigned short (5bit blue, 6bit green, 5bit red)

  666.     tfBGR5X1us1,                //< 1 x unsigned short (5bit blue, 5bit green, 5bit red, 1bit reserved)

  667.     tfX1BGR5us1,                //< 1 x unsigned short (1bit reserved, 5bit blue, 5bit green, 5bit red)

  668.     tfBGR8ub3,                  //< 1 x unsigned byte (blue), 1 x unsigned byte (green), 1 x unsigned byte (red)

  669.     tfBGRX8ui1,                 //< 1 x unsigned int (8bit blue, 8bit green, 8bit red, 8bit reserved)

  670.     tfXBGR8ui1,                 //< 1 x unsigned int (8bit reserved, 8bit blue, 8bit green, 8bit red)

  671.     tfBGR10X2ui1,               //< 1 x unsigned int (10bit blue, 10bit green, 10bit red, 2bit reserved)

  672.     tfX2BGR10ui1,               //< 1 x unsigned int (2bit reserved, 10bit blue, 10bit green, 10bit red)

  673.     tfBGR16us3,                 //< 1 x unsigned short (blue), 1 x unsigned short (green), 1 x unsigned short (red)

  674. 

  675.     tfBGRA4us1,                 //< 1 x unsigned short (4bit blue, 4bit green, 4bit red, 4bit alpha)

  676.     tfABGR4us1,                 //< 1 x unsigned short (4bit alpha, 4bit blue, 4bit green, 4bit red)

  677.     tfBGR5A1us1,                //< 1 x unsigned short (5bit blue, 5bit green, 5bit red, 1bit alpha)

  678.     tfA1BGR5us1,                //< 1 x unsigned short (1bit alpha, 5bit blue, 5bit green, 5bit red)

  679.     tfBGRA8ui1,                 //< 1 x unsigned int (8bit blue, 8bit green, 8bit red, 8bit alpha)

  680.     tfABGR8ui1,                 //< 1 x unsigned int (8bit alpha, 8bit blue, 8bit green, 8bit red)

  681.     tfBGRA8ub4,                 //< 1 x unsigned byte (blue), 1 x unsigned byte (green), 1 x unsigned byte (red), 1 x unsigned byte (alpha)

  682.     tfBGR10A2ui1,               //< 1 x unsigned int (10bit blue, 10bit green, 10bit red, 2bit alpha)

  683.     tfA2BGR10ui1,               //< 1 x unsigned int (2bit alpha, 10bit blue, 10bit green, 10bit red)

  684.     tfBGRA16us4,                //< 1 x unsigned short (blue), 1 x unsigned short (green), 1 x unsigned short (red), 1 x unsigned short (alpha)

  685. 

  686.     tfDepth16us1,               //< 1 x unsigned short (depth)

  687.     tfDepth24ui1,               //< 1 x unsigned int (depth)

  688.     tfDepth32ui1,               //< 1 x unsigned int (depth)

  689. 

  690.     tfS3tcDtx1RGBA,

  691.     tfS3tcDtx3RGBA,

  692.     tfS3tcDtx5RGBA

  693.   );

  694. 

  695.   { type to define suitable file formats }

  696.   TglBitmapFileType = (

  697.      {$IFDEF GLB_SUPPORT_PNG_WRITE} ftPNG,  {$ENDIF}    //< Portable Network Graphic file (PNG)

  698.      {$IFDEF GLB_SUPPORT_JPEG_WRITE}ftJPEG, {$ENDIF}    //< JPEG file

  699.      ftDDS,                                             //< Direct Draw Surface file (DDS)

  700.      ftTGA,                                             //< Targa Image File (TGA)

  701.      ftBMP,                                             //< Windows Bitmap File (BMP)

  702.      ftRAW);                                            //< glBitmap RAW file format

  703.    TglBitmapFileTypes = set of TglBitmapFileType;

  704. 

  705.   { possible mipmap types }

  706.   TglBitmapMipMap = (

  707.      mmNone,                //< no mipmaps

  708.      mmMipmap,              //< normal mipmaps

  709.      mmMipmapGlu);          //< mipmaps generated with glu functions

  710. 

  711.   { possible normal map functions }

  712.    TglBitmapNormalMapFunc = (

  713.      nm4Samples,

  714.      nmSobel,

  715.      nm3x3,

  716.      nm5x5);

  717. 

  718.  ////////////////////////////////////////////////////////////////////////////////////////////////////

  719.    EglBitmap                  = class(Exception);   //< glBitmap exception

  720.    EglBitmapNotSupported      = class(Exception);   //< exception for not supported functions

  721.    EglBitmapSizeToLarge       = class(EglBitmap);   //< exception for to large textures

  722.    EglBitmapNonPowerOfTwo     = class(EglBitmap);   //< exception for non power of two textures

  723.    EglBitmapUnsupportedFormat = class(EglBitmap)    //< exception for unsupporetd formats

  724.    public

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

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

  727.    end;

  728. 

  729. ////////////////////////////////////////////////////////////////////////////////////////////////////

  730.   { record that stores 4 unsigned integer values }

  731.   TglBitmapRec4ui = packed record

  732.   case Integer of

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

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

  735.   end;

  736. 

  737.   { record that stores 4 unsigned byte values }

  738.   TglBitmapRec4ub = packed record

  739.   case Integer of

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

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

  742.   end;

  743. 

  744.   { record that stores 4 unsigned long integer values }

  745.   TglBitmapRec4ul = packed record

  746.   case Integer of

  747.     0: (r, g, b, a: QWord);

  748.     1: (arr: array[0..3] of QWord);

  749.   end;

  750. 

  751.   { describes the properties of a given texture data format }

  752.   TglBitmapFormatDescriptor = class(TObject)

  753.   private

  754.     // cached properties

  755.     fBytesPerPixel: Single;   //< number of bytes for each pixel

  756.     fChannelCount: Integer;   //< number of color channels

  757.     fMask: TglBitmapRec4ul;   //< bitmask for each color channel

  758.     fRange: TglBitmapRec4ui;  //< maximal value of each color channel

  759. 

  760.     { @return @true if the format has a red color channel, @false otherwise }

  761.     function GetHasRed: Boolean;

  762. 

  763.     { @return @true if the format has a green color channel, @false otherwise }

  764.     function GetHasGreen: Boolean;

  765. 

  766.     { @return @true if the format has a blue color channel, @false otherwise }

  767.     function GetHasBlue: Boolean;

  768. 

  769.     { @return @true if the format has a alpha color channel, @false otherwise }

  770.     function GetHasAlpha: Boolean;

  771. 

  772.     { @return @true if the format has any color color channel, @false otherwise }

  773.     function GetHasColor: Boolean;

  774. 

  775.     { @return @true if the format is a grayscale format, @false otherwise }

  776.     function GetIsGrayscale: Boolean;

  777.   protected

  778.     fFormat:        TglBitmapFormat;  //< format this descriptor belongs to

  779.     fWithAlpha:     TglBitmapFormat;  //< suitable format with alpha channel

  780.     fWithoutAlpha:  TglBitmapFormat;  //< suitable format without alpha channel

  781.     fOpenGLFormat:  TglBitmapFormat;  //< suitable format that is supported by OpenGL

  782.     fRGBInverted:   TglBitmapFormat;  //< suitable format with inverted RGB channels

  783.     fUncompressed:  TglBitmapFormat;  //< suitable format with uncompressed data

  784. 

  785.     fBitsPerPixel: Integer;           //< number of bits per pixel

  786.     fIsCompressed: Boolean;           //< @true if the format is compressed, @false otherwise

  787. 

  788.     fPrecision: TglBitmapRec4ub;      //< number of bits for each color channel

  789.     fShift:     TglBitmapRec4ub;      //< bit offset for each color channel

  790. 

  791.     fglFormat:         GLenum;        //< OpenGL format enum (e.g. GL_RGB)

  792.     fglInternalFormat: GLenum;        //< OpenGL internal format enum (e.g. GL_RGB8)

  793.     fglDataFormat:     GLenum;        //< OpenGL data format enum (e.g. GL_UNSIGNED_BYTE)

  794. 

  795.     { set values for this format descriptor }

  796.     procedure SetValues; virtual;

  797. 

  798.     { calculate cached values }

  799.     procedure CalcValues;

  800.   public

  801.     property Format:        TglBitmapFormat read fFormat;         //< format this descriptor belongs to

  802.     property ChannelCount:  Integer         read fChannelCount;   //< number of color channels

  803.     property IsCompressed:  Boolean         read fIsCompressed;   //< @true if the format is compressed, @false otherwise

  804.     property BitsPerPixel:  Integer         read fBitsPerPixel;   //< number of bytes per pixel

  805.     property BytesPerPixel: Single          read fBytesPerPixel;  //< number of bits per pixel

  806. 

  807.     property Precision: TglBitmapRec4ub read fPrecision;  //< number of bits for each color channel

  808.     property Shift:     TglBitmapRec4ub read fShift;      //< bit offset for each color channel

  809.     property Range:     TglBitmapRec4ui read fRange;      //< maximal value of each color channel

  810.     property Mask:      TglBitmapRec4ul read fMask;       //< bitmask for each color channel

  811. 

  812.     property RGBInverted:  TglBitmapFormat read fRGBInverted;  //< suitable format with inverted RGB channels

  813.     property WithAlpha:    TglBitmapFormat read fWithAlpha;    //< suitable format with alpha channel

  814.     property WithoutAlpha: TglBitmapFormat read fWithAlpha;    //< suitable format without alpha channel

  815.     property OpenGLFormat: TglBitmapFormat read fOpenGLFormat; //< suitable format that is supported by OpenGL

  816.     property Uncompressed: TglBitmapFormat read fUncompressed; //< suitable format with uncompressed data

  817. 

  818.     property glFormat:         GLenum  read fglFormat;         //< OpenGL format enum (e.g. GL_RGB)

  819.     property glInternalFormat: GLenum  read fglInternalFormat; //< OpenGL internal format enum (e.g. GL_RGB8)

  820.     property glDataFormat:     GLenum  read fglDataFormat;     //< OpenGL data format enum (e.g. GL_UNSIGNED_BYTE)

  821. 

  822.     property HasRed:       Boolean read GetHasRed;        //< @true if the format has a red color channel, @false otherwise

  823.     property HasGreen:     Boolean read GetHasGreen;      //< @true if the format has a green color channel, @false otherwise

  824.     property HasBlue:      Boolean read GetHasBlue;       //< @true if the format has a blue color channel, @false otherwise

  825.     property HasAlpha:     Boolean read GetHasAlpha;      //< @true if the format has a alpha color channel, @false otherwise

  826.     property HasColor:     Boolean read GetHasColor;      //< @true if the format has any color color channel, @false otherwise

  827.     property IsGrayscale:  Boolean read GetIsGrayscale;   //< @true if the format is a grayscale format, @false otherwise

  828. 

  829.     { constructor }

  830.     constructor Create;

  831.   public

  832.     { get the format descriptor by a given OpenGL internal format

  833.         @param aInternalFormat  OpenGL internal format to get format descriptor for

  834.         @returns                suitable format descriptor or tfEmpty-Descriptor }

  835.     class function GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;

  836.   end;

  837. 

  838. ////////////////////////////////////////////////////////////////////////////////////////////////////

  839.   { structure to store pixel data in }

  840.   TglBitmapPixelData = packed record

  841.     Data:   TglBitmapRec4ui;  //< color data for each color channel

  842.     Range:  TglBitmapRec4ui;  //< maximal color value for each channel

  843.     Format: TglBitmapFormat;  //< format of the pixel

  844.   end;

  845.   PglBitmapPixelData = ^TglBitmapPixelData;

  846. 

  847.   TglBitmapSizeFields = set of (ffX, ffY);

  848.   TglBitmapSize = packed record

  849.     Fields: TglBitmapSizeFields;

  850.     X: Word;

  851.     Y: Word;

  852.   end;

  853.   TglBitmapPixelPosition = TglBitmapSize;

  854. 

  855. ////////////////////////////////////////////////////////////////////////////////////////////////////

  856.   TglBitmap = class;

  857. 

  858.   { structure to store data for converting in }

  859.   TglBitmapFunctionRec = record

  860.     Sender:   TglBitmap;              //< texture object that stores the data to convert

  861.     Size:     TglBitmapSize;          //< size of the texture

  862.     Position: TglBitmapPixelPosition; //< position of the currently pixel

  863.     Source:   TglBitmapPixelData;     //< pixel data of the current pixel

  864.     Dest:     TglBitmapPixelData;     //< new data of the pixel (must be filled in)

  865.     Args:     Pointer;                //< user defined args that was passed to the convert function

  866.   end;

  867. 

  868.   { callback to use for converting texture data }

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

  870. 

  871. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  872.   { base class for all glBitmap classes. used to manage OpenGL texture objects

  873.     and to load, save and manipulate texture data }

  874.   TglBitmap = class

  875.   private

  876.     { @returns format descriptor that describes the format of the stored data }

  877.     function GetFormatDesc: TglBitmapFormatDescriptor;

  878.   protected

  879.     fID: GLuint;                          //< name of the OpenGL texture object

  880.     fTarget: GLuint;                      //< texture target (e.g. GL_TEXTURE_2D)

  881.     fAnisotropic: Integer;                //< anisotropic level

  882.     fDeleteTextureOnFree: Boolean;        //< delete OpenGL texture object when this object is destroyed

  883.     fFreeDataOnDestroy: Boolean;          //< free stored data when this object is destroyed

  884.     fFreeDataAfterGenTexture: Boolean;    //< free stored data after data was uploaded to video card

  885.     fData: PByte;                         //< data of this texture

  886. {$IFNDEF OPENGL_ES}

  887.     fIsResident: GLboolean;               //< @true if OpenGL texture object has data, @false otherwise

  888. {$ENDIF}

  889.     fBorderColor: array[0..3] of Single;  //< color of the texture border

  890. 

  891.     fDimension: TglBitmapSize;            //< size of this texture

  892.     fMipMap: TglBitmapMipMap;             //< mipmap type

  893.     fFormat: TglBitmapFormat;             //< format the texture data is stored in

  894. 

  895.     // Mapping

  896.     fPixelSize: Integer;                  //< size of one pixel (in byte)

  897.     fRowSize: Integer;                    //< size of one pixel row (in byte)

  898. 

  899.     // Filtering

  900.     fFilterMin: GLenum;                   //< min filter to apply to the texture

  901.     fFilterMag: GLenum;                   //< mag filter to apply to the texture

  902. 

  903.     // TexturWarp

  904.     fWrapS: GLenum;                       //< texture wrapping for x axis

  905.     fWrapT: GLenum;                       //< texture wrapping for y axis

  906.     fWrapR: GLenum;                       //< texture wrapping for z axis

  907. 

  908. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}

  909.     //Swizzle

  910.     fSwizzle: array[0..3] of GLenum;      //< color channel swizzle

  911. {$IFEND}

  912. 

  913.     // CustomData

  914.     fFilename: String;                    //< filename the texture was load from

  915.     fCustomName: String;                  //< user defined name

  916.     fCustomNameW: WideString;             //< user defined name

  917.     fCustomData: Pointer;                 //< user defined data

  918. 

  919.   protected

  920.     { @returns the actual width of the texture }

  921.     function GetWidth:  Integer; virtual;

  922. 

  923.     { @returns the actual height of the texture }

  924.     function GetHeight: Integer; virtual;

  925. 

  926.     { @returns the width of the texture or 1 if the width is zero }

  927.     function GetFileWidth:  Integer; virtual;

  928. 

  929.     { @returns the height of the texture or 1 if the height is zero }

  930.     function GetFileHeight: Integer; virtual;

  931. 

  932.   protected

  933.     { set a new value for fCustomData }

  934.     procedure SetCustomData(const aValue: Pointer);

  935. 

  936.     { set a new value for fCustomName }

  937.     procedure SetCustomName(const aValue: String);

  938. 

  939.     { set a new value for fCustomNameW }

  940.     procedure SetCustomNameW(const aValue: WideString);

  941. 

  942.     { set new value for fFreeDataOnDestroy }

  943.     procedure SetFreeDataOnDestroy(const aValue: Boolean);

  944. 

  945.     { set new value for fDeleteTextureOnFree }

  946.     procedure SetDeleteTextureOnFree(const aValue: Boolean);

  947. 

  948.     { set new value for the data format. only possible if new format has the same pixel size.

  949.       if you want to convert the texture data, see ConvertTo function }

  950.     procedure SetFormat(const aValue: TglBitmapFormat);

  951. 

  952.     { set new value for fFreeDataAfterGenTexture }

  953.     procedure SetFreeDataAfterGenTexture(const aValue: Boolean);

  954. 

  955.     { set name of OpenGL texture object }

  956.     procedure SetID(const aValue: Cardinal);

  957. 

  958.     { set new value for fMipMap }

  959.     procedure SetMipMap(const aValue: TglBitmapMipMap);

  960. 

  961.     { set new value for target }

  962.     procedure SetTarget(const aValue: Cardinal);

  963. 

  964.     { set new value for fAnisotrophic }

  965.     procedure SetAnisotropic(const aValue: Integer);

  966. 

  967.   protected

  968.     { create OpenGL texture object (delete exisiting object if exists) }

  969.     procedure CreateID;

  970. 

  971.     { setup texture parameters }

  972.     procedure SetupParameters({$IFNDEF OPENGL_ES}out aBuildWithGlu: Boolean{$ENDIF});

  973. 

  974.     { set data pointer of texture data

  975.         @param aData    pointer to new texture data (be carefull, aData could be freed by this function)

  976.         @param aFormat  format of the data stored at aData

  977.         @param aWidth   width of the texture data

  978.         @param aHeight  height of the texture data }

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

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

  981. 

  982.     { generate texture (upload texture data to video card)

  983.         @param aTestTextureSize   test texture size before uploading and raise exception if something is wrong }

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

  985. 

  986.     { flip texture horizontal

  987.         @returns @true in success, @false otherwise }

  988.     function FlipHorz: Boolean; virtual;

  989. 

  990.     { flip texture vertical

  991.         @returns @true in success, @false otherwise }

  992.     function FlipVert: Boolean; virtual;

  993. 

  994.   protected

  995.     property Width:  Integer read GetWidth;             //< the actual width of the texture

  996.     property Height: Integer read GetHeight;            //< the actual height of the texture

  997. 

  998.     property FileWidth:  Integer read GetFileWidth;     //< the width of the texture or 1 if the width is zero

  999.     property FileHeight: Integer read GetFileHeight;    //< the height of the texture or 1 if the height is zero

  1000.   public

  1001.     property ID:           Cardinal        read fID          write SetID;           //< name of the OpenGL texture object

  1002.     property Target:       Cardinal        read fTarget      write SetTarget;       //< texture target (e.g. GL_TEXTURE_2D)

  1003.     property Format:       TglBitmapFormat read fFormat      write SetFormat;       //< format the texture data is stored in

  1004.     property MipMap:       TglBitmapMipMap read fMipMap      write SetMipMap;       //< mipmap type

  1005.     property Anisotropic:  Integer         read fAnisotropic write SetAnisotropic;  //< anisotropic level

  1006. 

  1007.     property FormatDesc:   TglBitmapFormatDescriptor read GetFormatDesc;      //< format descriptor that describes the format of the stored data

  1008. 

  1009.     property Filename:    String     read fFilename;                          //< filename the texture was load from

  1010.     property CustomName:  String     read fCustomName  write SetCustomName;   //< user defined name (use at will)

  1011.     property CustomNameW: WideString read fCustomNameW write SetCustomNameW;  //< user defined name (as WideString; use at will)

  1012.     property CustomData:  Pointer    read fCustomData  write SetCustomData;   //< user defined data (use at will)

  1013. 

  1014.     property DeleteTextureOnFree:     Boolean read fDeleteTextureOnFree     write SetDeleteTextureOnFree;     //< delete texture object when this object is destroyed

  1015.     property FreeDataOnDestroy:       Boolean read fFreeDataOnDestroy       write SetFreeDataOnDestroy;       //< free stored data when this object is destroyed

  1016.     property FreeDataAfterGenTexture: Boolean read fFreeDataAfterGenTexture write SetFreeDataAfterGenTexture; //< free stored data after it is uplaoded to video card

  1017. 

  1018.     property Dimension:  TglBitmapSize read fDimension;     //< size of the texture

  1019.     property Data:       PByte         read fData;          //< texture data (or @nil if unset)

  1020. {$IFNDEF OPENGL_ES}

  1021.     property IsResident: GLboolean read fIsResident;        //< @true if OpenGL texture object has data, @false otherwise

  1022. {$ENDIF}

  1023. 

  1024.     { this method is called after the constructor and sets the default values of this object }

  1025.     procedure AfterConstruction; override;

  1026. 

  1027.     { this method is called before the destructor and does some cleanup }

  1028.     procedure BeforeDestruction; override;

  1029. 

  1030.     { splits a resource identifier into the resource and it's type

  1031.         @param aResource  resource identifier to split and store name in

  1032.         @param aResType   type of the resource }

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

  1034. 

  1035.   public

  1036.     { load a texture from a file

  1037.         @param aFilename file to load texuture from }

  1038.     procedure LoadFromFile(const aFilename: String);

  1039. 

  1040.     { load a texture from a stream

  1041.         @param aStream  stream to load texture from }

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

  1043. 

  1044.     { use a function to generate texture data

  1045.         @param aSize    size of the texture

  1046.         @param aFunc    callback to use for generation

  1047.         @param aFormat  format of the texture data

  1048.         @param aArgs    user defined paramaters (use at will) }

  1049.     procedure LoadFromFunc(const aSize: TglBitmapSize; const aFunc: TglBitmapFunction;

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

  1051. 

  1052.     { load a texture from a resource

  1053.         @param aInstance  resource handle

  1054.         @param aResource  resource indentifier

  1055.         @param aResType   resource type (if known) }

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

  1057. 

  1058.     { load a texture from a resource id

  1059.         @param aInstance  resource handle

  1060.         @param aResource  resource ID

  1061.         @param aResType   resource type }

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

  1063. 

  1064.   public

  1065.     { save texture data to a file

  1066.         @param aFilename  filename to store texture in

  1067.         @param aFileType  file type to store data into }

  1068.     procedure SaveToFile(const aFilename: String; const aFileType: TglBitmapFileType);

  1069. 

  1070.     { save texture data to a stream

  1071.         @param aFilename  filename to store texture in

  1072.         @param aFileType  file type to store data into }

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

  1074. 

  1075.   public

  1076.     { convert texture data using a user defined callback

  1077.         @param aFunc        callback to use for converting

  1078.         @param aCreateTemp  create a temporary buffer to use for converting

  1079.         @param aArgs        user defined paramters (use at will)

  1080.         @returns            @true if converting was successful, @false otherwise }

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

  1082. 

  1083.     { convert texture data using a user defined callback

  1084.         @param aSource      glBitmap to read data from

  1085.         @param aFunc        callback to use for converting

  1086.         @param aCreateTemp  create a temporary buffer to use for converting

  1087.         @param aFormat      format of the new data

  1088.         @param aArgs        user defined paramters (use at will)

  1089.         @returns            @true if converting was successful, @false otherwise }

  1090.     function Convert(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;

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

  1092. 

  1093.     { convert texture data using a specific format

  1094.         @param aFormat  new format of texture data

  1095.         @returns        @true if converting was successful, @false otherwise }

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

  1097. 

  1098. {$IFDEF GLB_SDL}

  1099.   public

  1100.     { assign texture data to SDL surface

  1101.         @param aSurface SDL surface to write data to

  1102.         @returns        @true on success, @false otherwise }

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

  1104. 

  1105.     { assign texture data from SDL surface

  1106.         @param aSurface SDL surface to read data from

  1107.         @returns        @true on success, @false otherwise }

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

  1109. 

  1110.     { assign alpha channel data to SDL surface

  1111.         @param aSurface SDL surface to write alpha channel data to

  1112.         @returns        @true on success, @false otherwise }

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

  1114. 

  1115.     { assign alpha channel data from SDL surface

  1116.         @param aSurface SDL surface to read data from

  1117.         @param aFunc    callback to use for converting

  1118.         @param aArgs    user defined parameters (use at will)

  1119.         @returns        @true on success, @false otherwise }

  1120.     function AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;

  1121. {$ENDIF}

  1122. 

  1123. {$IFDEF GLB_DELPHI}

  1124.   public

  1125.     { assign texture data to TBitmap object

  1126.         @param aBitmap  TBitmap to write data to

  1127.         @returns        @true on success, @false otherwise }

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

  1129. 

  1130.     { assign texture data from TBitmap object

  1131.         @param aBitmap  TBitmap to read data from

  1132.         @returns        @true on success, @false otherwise }

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

  1134. 

  1135.     { assign alpha channel data to TBitmap object

  1136.         @param aBitmap  TBitmap to write data to

  1137.         @returns        @true on success, @false otherwise }

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

  1139. 

  1140.     { assign alpha channel data from TBitmap object

  1141.         @param aBitmap  TBitmap to read data from

  1142.         @param aFunc    callback to use for converting

  1143.         @param aArgs    user defined parameters (use at will)

  1144.         @returns        @true on success, @false otherwise }

  1145.     function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;

  1146. {$ENDIF}

  1147. 

  1148. {$IFDEF GLB_LAZARUS}

  1149.   public

  1150.     { assign texture data to TLazIntfImage object

  1151.         @param aImage   TLazIntfImage to write data to

  1152.         @returns        @true on success, @false otherwise }

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

  1154. 

  1155.     { assign texture data from TLazIntfImage object

  1156.         @param aImage   TLazIntfImage to read data from

  1157.         @returns        @true on success, @false otherwise }

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

  1159. 

  1160.     { assign alpha channel data to TLazIntfImage object

  1161.         @param aImage   TLazIntfImage to write data to

  1162.         @returns        @true on success, @false otherwise }

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

  1164. 

  1165.     { assign alpha channel data from TLazIntfImage object

  1166.         @param aImage   TLazIntfImage to read data from

  1167.         @param aFunc    callback to use for converting

  1168.         @param aArgs    user defined parameters (use at will)

  1169.         @returns        @true on success, @false otherwise }

  1170.     function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;

  1171. {$ENDIF}

  1172. 

  1173.   public

  1174.     { load alpha channel data from resource

  1175.         @param aInstance  resource handle

  1176.         @param aResource  resource ID

  1177.         @param aResType   resource type

  1178.         @param aFunc      callback to use for converting

  1179.         @param aArgs      user defined parameters (use at will)

  1180.         @returns          @true on success, @false otherwise }

  1181.     function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;

  1182. 

  1183.     { load alpha channel data from resource ID

  1184.         @param aInstance    resource handle

  1185.         @param aResourceID  resource ID

  1186.         @param aResType     resource type

  1187.         @param aFunc        callback to use for converting

  1188.         @param aArgs        user defined parameters (use at will)

  1189.         @returns            @true on success, @false otherwise }

  1190.     function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;

  1191. 

  1192.     { add alpha channel data from function

  1193.         @param aFunc  callback to get data from

  1194.         @param aArgs  user defined parameters (use at will)

  1195.         @returns      @true on success, @false otherwise }

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

  1197. 

  1198.     { add alpha channel data from file (macro for: new glBitmap, LoadFromFile, AddAlphaFromGlBitmap)

  1199.         @param aFilename  file to load alpha channel data from

  1200.         @param aFunc      callback to use for converting

  1201.         @param aArgs      user defined parameters (use at will)

  1202.         @returns          @true on success, @false otherwise }

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

  1204. 

  1205.     { add alpha channel data from stream (macro for: new glBitmap, LoadFromStream, AddAlphaFromGlBitmap)

  1206.         @param aStream  stream to load alpha channel data from

  1207.         @param aFunc    callback to use for converting

  1208.         @param aArgs    user defined parameters (use at will)

  1209.         @returns        @true on success, @false otherwise }

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

  1211. 

  1212.     { add alpha channel data from existing glBitmap object

  1213.         @param aBitmap  TglBitmap to copy alpha channel data from

  1214.         @param aFunc    callback to use for converting

  1215.         @param aArgs    user defined parameters (use at will)

  1216.         @returns        @true on success, @false otherwise }

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

  1218. 

  1219.     { add alpha to pixel if the pixels color is greter than the given color value

  1220.         @param aRed         red threshold (0-255)

  1221.         @param aGreen       green threshold (0-255)

  1222.         @param aBlue        blue threshold (0-255)

  1223.         @param aDeviatation accepted deviatation (0-255)

  1224.         @returns            @true on success, @false otherwise }

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

  1226. 

  1227.     { add alpha to pixel if the pixels color is greter than the given color value

  1228.         @param aRed         red threshold (0-Range.r)

  1229.         @param aGreen       green threshold (0-Range.g)

  1230.         @param aBlue        blue threshold (0-Range.b)

  1231.         @param aDeviatation accepted deviatation (0-max(Range.rgb))

  1232.         @returns            @true on success, @false otherwise }

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

  1234. 

  1235.     { add alpha to pixel if the pixels color is greter than the given color value

  1236.         @param aRed         red threshold (0.0-1.0)

  1237.         @param aGreen       green threshold (0.0-1.0)

  1238.         @param aBlue        blue threshold (0.0-1.0)

  1239.         @param aDeviatation accepted deviatation (0.0-1.0)

  1240.         @returns            @true on success, @false otherwise }

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

  1242. 

  1243.     { add a constand alpha value to all pixels

  1244.         @param aAlpha alpha value to add (0-255)

  1245.         @returns      @true on success, @false otherwise }

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

  1247. 

  1248.     { add a constand alpha value to all pixels

  1249.         @param aAlpha alpha value to add (0-max(Range.rgb))

  1250.         @returns      @true on success, @false otherwise }

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

  1252. 

  1253.     { add a constand alpha value to all pixels

  1254.         @param aAlpha alpha value to add (0.0-1.0)

  1255.         @returns      @true on success, @false otherwise }

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

  1257. 

  1258.     { remove alpha channel

  1259.         @returns  @true on success, @false otherwise }

  1260.     function RemoveAlpha: Boolean; virtual;

  1261. 

  1262.   public

  1263.     { create a clone of the current object

  1264.         @returns clone of this object}

  1265.     function Clone: TglBitmap;

  1266. 

  1267.     { invert color data (xor)

  1268.         @param aUseRGB   xor each color channel

  1269.         @param aUseAlpha xor alpha channel }

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

  1271. 

  1272.     { free texture stored data }

  1273.     procedure FreeData;

  1274. 

  1275. {$IFNDEF OPENGL_ES}

  1276.     { set the new value for texture border color

  1277.         @param aRed   red color for border (0.0-1.0)

  1278.         @param aGreen green color for border (0.0-1.0)

  1279.         @param aBlue  blue color for border (0.0-1.0)

  1280.         @param aAlpha alpha color for border (0.0-1.0) }

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

  1282. {$ENDIF}

  1283. 

  1284.   public

  1285.     { fill complete texture with one color

  1286.         @param aRed   red color for border (0-255)

  1287.         @param aGreen green color for border (0-255)

  1288.         @param aBlue  blue color for border (0-255)

  1289.         @param aAlpha alpha color for border (0-255) }

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

  1291. 

  1292.     { fill complete texture with one color

  1293.         @param aRed   red color for border (0-Range.r)

  1294.         @param aGreen green color for border (0-Range.g)

  1295.         @param aBlue  blue color for border (0-Range.b)

  1296.         @param aAlpha alpha color for border (0-Range.a) }

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

  1298. 

  1299.     { fill complete texture with one color

  1300.         @param aRed   red color for border (0.0-1.0)

  1301.         @param aGreen green color for border (0.0-1.0)

  1302.         @param aBlue  blue color for border (0.0-1.0)

  1303.         @param aAlpha alpha color for border (0.0-1.0) }

  1304.     procedure FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single = 1.0);

  1305. 

  1306.   public

  1307.     { set new texture filer

  1308.         @param aMin   min filter

  1309.         @param aMag   mag filter }

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

  1311. 

  1312.     { set new texture wrapping

  1313.         @param S  texture wrapping for x axis

  1314.         @param T  texture wrapping for y axis

  1315.         @param R  texture wrapping for z axis }

  1316.     procedure SetWrap(

  1317.       const S: GLenum = GL_CLAMP_TO_EDGE;

  1318.       const T: GLenum = GL_CLAMP_TO_EDGE;

  1319.       const R: GLenum = GL_CLAMP_TO_EDGE);

  1320. 

  1321. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}

  1322.     { set new swizzle

  1323.         @param r  swizzle for red channel

  1324.         @param g  swizzle for green channel

  1325.         @param b  swizzle for blue channel

  1326.         @param a  swizzle for alpha channel }

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

  1328. {$IFEND}

  1329. 

  1330.   public

  1331.     { bind texture

  1332.         @param aEnableTextureUnit   enable texture unit for this texture (e.g. glEnable(GL_TEXTURE_2D)) }

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

  1334. 

  1335.     { bind texture

  1336.         @param aDisableTextureUnit  disable texture unit for this texture (e.g. glEnable(GL_TEXTURE_2D)) }

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

  1338. 

  1339.   public

  1340.     { constructor - created an empty texture }

  1341.     constructor Create; overload;

  1342. 

  1343.     { constructor - creates a texture and load it from a file

  1344.         @param aFilename file to load texture from }

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

  1346. 

  1347.     { constructor - creates a texture and load it from a stream

  1348.         @param aStream stream to load texture from }

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

  1350. 

  1351.     { constructor - creates a texture with the given size, format and data

  1352.         @param aSize    size of the texture

  1353.         @param aFormat  format of the given data

  1354.         @param aData    texture data - be carefull: the data will now be managed by the glBitmap object,

  1355.                         you can control this by setting DeleteTextureOnFree, FreeDataOnDestroy and FreeDataAfterGenTexture }

  1356.     constructor Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; aData: PByte = nil); overload;

  1357. 

  1358.     { constructor - creates a texture with the given size and format and uses the given callback to create the data

  1359.         @param aSize    size of the texture

  1360.         @param aFormat  format of the given data

  1361.         @param aFunc    callback to use for generating the data

  1362.         @param aArgs    user defined parameters (use at will) }

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

  1364. 

  1365.     { constructor - creates a texture and loads it from a resource

  1366.         @param aInstance  resource handle

  1367.         @param aResource  resource indentifier

  1368.         @param aResType   resource type (if known) }

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

  1370. 

  1371.     { constructor - creates a texture and loads it from a resource

  1372.         @param aInstance    resource handle

  1373.         @param aResourceID  resource ID

  1374.         @param aResType     resource type (if known) }

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

  1376. 

  1377.   private

  1378. {$IFDEF GLB_SUPPORT_PNG_READ}

  1379.     { try to load a PNG from a stream

  1380.         @param aStream  stream to load PNG from

  1381.         @returns        @true on success, @false otherwise }

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

  1383. {$ENDIF}

  1384. 

  1385. {$ifdef GLB_SUPPORT_PNG_WRITE}

  1386.     { save texture data as PNG to stream

  1387.         @param aStream stream to save data to}

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

  1389. {$ENDIF}

  1390. 

  1391. {$IFDEF GLB_SUPPORT_JPEG_READ}

  1392.     { try to load a JPEG from a stream

  1393.         @param aStream  stream to load JPEG from

  1394.         @returns        @true on success, @false otherwise }

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

  1396. {$ENDIF}

  1397. 

  1398. {$IFDEF GLB_SUPPORT_JPEG_WRITE}

  1399.     { save texture data as JPEG to stream

  1400.         @param aStream stream to save data to}

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

  1402. {$ENDIF}

  1403. 

  1404.     { try to load a RAW image from a stream

  1405.         @param aStream  stream to load RAW image from

  1406.         @returns        @true on success, @false otherwise }

  1407.     function LoadRAW(const aStream: TStream): Boolean;

  1408. 

  1409.     { save texture data as RAW image to stream

  1410.         @param aStream stream to save data to}

  1411.     procedure SaveRAW(const aStream: TStream);

  1412. 

  1413.     { try to load a BMP from a stream

  1414.         @param aStream  stream to load BMP from

  1415.         @returns        @true on success, @false otherwise }

  1416.     function LoadBMP(const aStream: TStream): Boolean;

  1417. 

  1418.     { save texture data as BMP to stream

  1419.         @param aStream stream to save data to}

  1420.     procedure SaveBMP(const aStream: TStream);

  1421. 

  1422.     { try to load a TGA from a stream

  1423.         @param aStream  stream to load TGA from

  1424.         @returns        @true on success, @false otherwise }

  1425.     function LoadTGA(const aStream: TStream): Boolean;

  1426. 

  1427.     { save texture data as TGA to stream

  1428.         @param aStream stream to save data to}

  1429.     procedure SaveTGA(const aStream: TStream);

  1430. 

  1431.     { try to load a DDS from a stream

  1432.         @param aStream  stream to load DDS from

  1433.         @returns        @true on success, @false otherwise }

  1434.     function LoadDDS(const aStream: TStream): Boolean;

  1435. 

  1436.     { save texture data as DDS to stream

  1437.         @param aStream stream to save data to}

  1438.     procedure SaveDDS(const aStream: TStream);

  1439.   end;

  1440. 

  1441. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1442. {$IF NOT DEFINED(OPENGL_ES)}

  1443.   { wrapper class for 1-dimensional textures (OpenGL target = GL_TEXTURE_1D }

  1444.   TglBitmap1D = class(TglBitmap)

  1445.   protected

  1446.     { set data pointer of texture data

  1447.         @param aData    pointer to new texture data (be carefull, aData could be freed by this function)

  1448.         @param aFormat  format of the data stored at aData

  1449.         @param aWidth   width of the texture data

  1450.         @param aHeight  height of the texture data }

  1451.     procedure SetDataPointer(var aData: PByte; const aFormat: TglBitmapFormat; const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;

  1452. 

  1453.     { upload the texture data to video card

  1454.         @param aBuildWithGlu  use glu functions to build mipmaps }

  1455.     procedure UploadData(const aBuildWithGlu: Boolean);

  1456.   public

  1457.     property Width; //< actual with of the texture

  1458. 

  1459.     { this method is called after constructor and initializes the object }

  1460.     procedure AfterConstruction; override;

  1461. 

  1462.     { flip texture horizontally

  1463.         @returns @true on success, @fals otherwise }

  1464.     function FlipHorz: Boolean; override;

  1465. 

  1466.     { generate texture (create texture object if not exist, set texture parameters and upload data

  1467.         @param aTestTextureSize   check the size of the texture and throw exception if something is wrong }

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

  1469.   end;

  1470. {$IFEND}

  1471. 

  1472. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1473.   { wrapper class for 2-dimensional textures (OpenGL target = GL_TEXTURE_2D) }

  1474.   TglBitmap2D = class(TglBitmap)

  1475.   protected

  1476.     fLines: array of PByte; //< array to store scanline entry points in

  1477. 

  1478.     { get a specific scanline

  1479.         @param aIndex   index of the scanline to return

  1480.         @returns        scanline at position aIndex or @nil }

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

  1482. 

  1483.     { set data pointer of texture data

  1484.         @param aData    pointer to new texture data (be carefull, aData could be freed by this function)

  1485.         @param aFormat  format of the data stored at aData

  1486.         @param aWidth   width of the texture data

  1487.         @param aHeight  height of the texture data }

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

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

  1490. 

  1491.     { upload the texture data to video card

  1492.         @param aTarget        target o upload data to (e.g. GL_TEXTURE_2D)

  1493.         @param aBuildWithGlu  use glu functions to build mipmaps }

  1494.     procedure UploadData(const aTarget: GLenum{$IFNDEF OPENGL_ES}; const aBuildWithGlu: Boolean{$ENDIF});

  1495.   public

  1496.     property Width;                                                       //< actual width of the texture

  1497.     property Height;                                                      //< actual height of the texture

  1498.     property Scanline[const aIndex: Integer]: Pointer read GetScanline;   //< scanline to access texture data directly

  1499. 

  1500.     { this method is called after constructor and initializes the object }

  1501.     procedure AfterConstruction; override;

  1502. 

  1503.     { copy a part of the frame buffer top the texture

  1504.         @param aTop     topmost pixel to copy

  1505.         @param aLeft    leftmost pixel to copy

  1506.         @param aRight   rightmost pixel to copy

  1507.         @param aBottom  bottommost pixel to copy

  1508.         @param aFormat  format to store data in }

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

  1510. 

  1511. {$IFNDEF OPENGL_ES}

  1512.     { downlaod texture data from OpenGL texture object }

  1513.     procedure GetDataFromTexture;

  1514. {$ENDIF}

  1515. 

  1516.     { generate texture (create texture object if not exist, set texture parameters and upload data)

  1517.         @param aTestTextureSize   check the size of the texture and throw exception if something is wrong }

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

  1519. 

  1520.     { flip texture horizontally

  1521.         @returns @true on success, @false otherwise }

  1522.     function FlipHorz: Boolean; override;

  1523. 

  1524.     { flip texture vertically

  1525.         @returns @true on success, @false otherwise }

  1526.     function FlipVert: Boolean; override;

  1527. 

  1528.     { create normal map from texture data

  1529.         @param aFunc      normal map function to generate normalmap with

  1530.         @param aScale     scale of the normale stored in the normal map

  1531.         @param aUseAlpha  generate normalmap from alpha channel data (if present) }

  1532.     procedure GenerateNormalMap(const aFunc: TglBitmapNormalMapFunc = nm3x3;

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

  1534.   end;

  1535. 

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

  1537. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}

  1538.   { wrapper class for cube maps (OpenGL target = GL_TEXTURE_CUBE_MAP) }

  1539.   TglBitmapCubeMap = class(TglBitmap2D)

  1540.   protected

  1541.   {$IFNDEF OPENGL_ES}

  1542.     fGenMode: Integer;  //< generation mode for the cube map (e.g. GL_REFLECTION_MAP)

  1543.   {$ENDIF}

  1544. 

  1545.     { generate texture (create texture object if not exist, set texture parameters and upload data

  1546.       do not call directly for cubemaps, use GenerateCubeMap instead

  1547.         @param aTestTextureSize   check the size of the texture and throw exception if something is wrong }

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

  1549.   public

  1550.     { this method is called after constructor and initializes the object }

  1551.     procedure AfterConstruction; override;

  1552. 

  1553.     { generate texture (create texture object if not exist, set texture parameters and upload data

  1554.         @param aCubeTarget        cube map target to upload data to (e.g. GL_TEXTURE_CUBE_MAP_POSITIVE_X)

  1555.         @param aTestTextureSize   check the size of the texture and throw exception if something is wrong }

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

  1557. 

  1558.     { bind texture

  1559.         @param aEnableTexCoordsGen  enable cube map generator

  1560.         @param aEnableTextureUnit   enable texture unit }

  1561.     procedure Bind({$IFNDEF OPENGL_ES}const aEnableTexCoordsGen: Boolean = true;{$ENDIF} const aEnableTextureUnit: Boolean = true); reintroduce; virtual;

  1562. 

  1563.     { unbind texture

  1564.         @param aDisableTexCoordsGen   disable cube map generator

  1565.         @param aDisableTextureUnit    disable texture unit }

  1566.     procedure Unbind({$IFNDEF OPENGL_ES}const aDisableTexCoordsGen: Boolean = true;{$ENDIF} const aDisableTextureUnit: Boolean = true); reintroduce; virtual;

  1567.   end;

  1568. {$IFEND}

  1569. 

  1570. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}

  1571. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1572.   { wrapper class for cube normal maps }

  1573.   TglBitmapNormalMap = class(TglBitmapCubeMap)

  1574.   public

  1575.     { this method is called after constructor and initializes the object }

  1576.     procedure AfterConstruction; override;

  1577. 

  1578.     { create cube normal map from texture data and upload it to video card

  1579.         @param aSize              size of each cube map texture

  1580.         @param aTestTextureSize   check texture size when uploading and throw exception if something is wrong  }

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

  1582.   end;

  1583. {$IFEND}

  1584. 

  1585. const

  1586.   NULL_SIZE: TglBitmapSize = (Fields: []; X: 0; Y: 0);

  1587. 

  1588. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);

  1589. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);

  1590. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);

  1591. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);

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

  1593. procedure glBitmapSetDefaultWrap(

  1594.   const S: Cardinal = GL_CLAMP_TO_EDGE;

  1595.   const T: Cardinal = GL_CLAMP_TO_EDGE;

  1596.   const R: Cardinal = GL_CLAMP_TO_EDGE);

  1597. 

  1598. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}

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

  1600. {$IFEND}

  1601. 

  1602. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;

  1603. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;

  1604. function glBitmapGetDefaultMipmap: TglBitmapMipMap;

  1605. function glBitmapGetDefaultFormat: TglBitmapFormat;

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

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

  1608. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}

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

  1610. {$IFEND}

  1611. 

  1612. function glBitmapSize(X: Integer = -1; Y: Integer = -1): TglBitmapSize;

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

  1614. function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;

  1615. function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;

  1616. function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;

  1617. function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;

  1618. function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;

  1619. 

  1620. function glBitmapCreateTestTexture(const aFormat: TglBitmapFormat): TglBitmap2D;

  1621. 

  1622. {$IFDEF GLB_DELPHI}

  1623. function CreateGrayPalette: HPALETTE;

  1624. {$ENDIF}

  1625. 

  1626. implementation

  1627. 

  1628. uses

  1629.   Math, syncobjs, typinfo

  1630.   {$IF DEFINED(GLB_SUPPORT_JPEG_READ) AND DEFINED(GLB_LAZ_JPEG)}, FPReadJPEG{$IFEND};

  1631. 

  1632. 

  1633. var

  1634.   glBitmapDefaultDeleteTextureOnFree: Boolean;

  1635.   glBitmapDefaultFreeDataAfterGenTextures: Boolean;

  1636.   glBitmapDefaultFormat: TglBitmapFormat;

  1637.   glBitmapDefaultMipmap: TglBitmapMipMap;

  1638.   glBitmapDefaultFilterMin: Cardinal;

  1639.   glBitmapDefaultFilterMag: Cardinal;

  1640.   glBitmapDefaultWrapS: Cardinal;

  1641.   glBitmapDefaultWrapT: Cardinal;

  1642.   glBitmapDefaultWrapR: Cardinal;

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

  1644. 

  1645. ////////////////////////////////////////////////////////////////////////////////////////////////////

  1646. type

  1647.   TFormatDescriptor = class(TglBitmapFormatDescriptor)

  1648.   public

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

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

  1651. 

  1652.     function GetSize(const aSize: TglBitmapSize): Integer; overload; virtual;

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

  1654. 

  1655.     function CreateMappingData: Pointer; virtual;

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

  1657. 

  1658.     function IsEmpty: Boolean; virtual;

  1659.     function MaskMatch(const aMask: TglBitmapRec4ul): Boolean; virtual;

  1660. 

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

  1662. 

  1663.     constructor Create; virtual;

  1664.   public

  1665.     class procedure Init;

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

  1667.     class function GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;

  1668.     class function GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer = 0): TFormatDescriptor;

  1669.     class function GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;

  1670.     class procedure Clear;

  1671.     class procedure Finalize;

  1672.   end;

  1673.   TFormatDescriptorClass = class of TFormatDescriptor;

  1674. 

  1675.   TfdEmpty = class(TFormatDescriptor);

  1676. 

  1677. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1678.   TfdAlphaUB1 = class(TFormatDescriptor) //1* unsigned byte

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

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

  1681.   end;

  1682. 

  1683.   TfdLuminanceUB1 = class(TFormatDescriptor) //1* unsigned byte

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

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

  1686.   end;

  1687. 

  1688.   TfdUniversalUB1 = class(TFormatDescriptor) //1* unsigned byte

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

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

  1691.   end;

  1692. 

  1693.   TfdLuminanceAlphaUB2 = class(TfdLuminanceUB1) //2* unsigned byte

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

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

  1696.   end;

  1697. 

  1698.   TfdRGBub3 = class(TFormatDescriptor) //3* unsigned byte

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

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

  1701.   end;

  1702. 

  1703.   TfdBGRub3 = class(TFormatDescriptor) //3* unsigned byte (inverse)

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

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

  1706.   end;

  1707. 

  1708.   TfdRGBAub4 = class(TfdRGBub3) //3* unsigned byte

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

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

  1711.   end;

  1712. 

  1713.   TfdBGRAub4 = class(TfdBGRub3) //3* unsigned byte (inverse)

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

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

  1716.   end;

  1717. 

  1718. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1719.   TfdAlphaUS1 = class(TFormatDescriptor) //1* unsigned short

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

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

  1722.   end;

  1723. 

  1724.   TfdLuminanceUS1 = class(TFormatDescriptor) //1* unsigned short

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

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

  1727.   end;

  1728. 

  1729.   TfdUniversalUS1 = class(TFormatDescriptor) //1* unsigned short

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

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

  1732.   end;

  1733. 

  1734.   TfdDepthUS1 = class(TFormatDescriptor) //1* unsigned short

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

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

  1737.   end;

  1738. 

  1739.   TfdLuminanceAlphaUS2 = class(TfdLuminanceUS1) //2* unsigned short

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

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

  1742.   end;

  1743. 

  1744.   TfdRGBus3 = class(TFormatDescriptor) //3* unsigned short

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

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

  1747.   end;

  1748. 

  1749.   TfdBGRus3 = class(TFormatDescriptor) //3* unsigned short (inverse)

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

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

  1752.   end;

  1753. 

  1754.   TfdRGBAus4 = class(TfdRGBus3) //4* unsigned short

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

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

  1757.   end;

  1758. 

  1759.   TfdARGBus4 = class(TfdRGBus3) //4* unsigned short

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

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

  1762.   end;

  1763. 

  1764.   TfdBGRAus4 = class(TfdBGRus3) //4* unsigned short (inverse)

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

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

  1767.   end;

  1768. 

  1769.   TfdABGRus4 = class(TfdBGRus3) //4* unsigned short (inverse)

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

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

  1772.   end;

  1773. 

  1774. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1775.   TfdUniversalUI1 = class(TFormatDescriptor) //1* unsigned int

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

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

  1778.   end;

  1779. 

  1780.   TfdDepthUI1 = class(TFormatDescriptor) //1* unsigned int

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

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

  1783.   end;

  1784. 

  1785. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1786.   TfdAlpha4ub1 = class(TfdAlphaUB1)

  1787.     procedure SetValues; override;

  1788.   end;

  1789. 

  1790.   TfdAlpha8ub1 = class(TfdAlphaUB1)

  1791.     procedure SetValues; override;

  1792.   end;

  1793. 

  1794.   TfdAlpha16us1 = class(TfdAlphaUS1)

  1795.     procedure SetValues; override;

  1796.   end;

  1797. 

  1798.   TfdLuminance4ub1 = class(TfdLuminanceUB1)

  1799.     procedure SetValues; override;

  1800.   end;

  1801. 

  1802.   TfdLuminance8ub1 = class(TfdLuminanceUB1)

  1803.     procedure SetValues; override;

  1804.   end;

  1805. 

  1806.   TfdLuminance16us1 = class(TfdLuminanceUS1)

  1807.     procedure SetValues; override;

  1808.   end;

  1809. 

  1810.   TfdLuminance4Alpha4ub2 = class(TfdLuminanceAlphaUB2)

  1811.     procedure SetValues; override;

  1812.   end;

  1813. 

  1814.   TfdLuminance6Alpha2ub2 = class(TfdLuminanceAlphaUB2)

  1815.     procedure SetValues; override;

  1816.   end;

  1817. 

  1818.   TfdLuminance8Alpha8ub2 = class(TfdLuminanceAlphaUB2)

  1819.     procedure SetValues; override;

  1820.   end;

  1821. 

  1822.   TfdLuminance12Alpha4us2 = class(TfdLuminanceAlphaUS2)

  1823.     procedure SetValues; override;

  1824.   end;

  1825. 

  1826.   TfdLuminance16Alpha16us2 = class(TfdLuminanceAlphaUS2)

  1827.     procedure SetValues; override;

  1828.   end;

  1829. 

  1830. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1831.   TfdR3G3B2ub1 = class(TfdUniversalUB1)

  1832.     procedure SetValues; override;

  1833.   end;

  1834. 

  1835.   TfdRGBX4us1 = class(TfdUniversalUS1)

  1836.     procedure SetValues; override;

  1837.   end;

  1838. 

  1839.   TfdXRGB4us1 = class(TfdUniversalUS1)

  1840.     procedure SetValues; override;

  1841.   end;

  1842. 

  1843.   TfdR5G6B5us1 = class(TfdUniversalUS1)

  1844.     procedure SetValues; override;

  1845.   end;

  1846. 

  1847.   TfdRGB5X1us1 = class(TfdUniversalUS1)

  1848.     procedure SetValues; override;

  1849.   end;

  1850. 

  1851.   TfdX1RGB5us1 = class(TfdUniversalUS1)

  1852.     procedure SetValues; override;

  1853.   end;

  1854. 

  1855.   TfdRGB8ub3 = class(TfdRGBub3)

  1856.     procedure SetValues; override;

  1857.   end;

  1858. 

  1859.   TfdRGBX8ui1 = class(TfdUniversalUI1)

  1860.     procedure SetValues; override;

  1861.   end;

  1862. 

  1863.   TfdXRGB8ui1 = class(TfdUniversalUI1)

  1864.     procedure SetValues; override;

  1865.   end;

  1866. 

  1867.   TfdRGB10X2ui1 = class(TfdUniversalUI1)

  1868.     procedure SetValues; override;

  1869.   end;

  1870. 

  1871.   TfdX2RGB10ui1 = class(TfdUniversalUI1)

  1872.     procedure SetValues; override;

  1873.   end;

  1874. 

  1875.   TfdRGB16us3 = class(TfdRGBus3)

  1876.     procedure SetValues; override;

  1877.   end;

  1878. 

  1879.   TfdRGBA4us1 = class(TfdUniversalUS1)

  1880.     procedure SetValues; override;

  1881.   end;

  1882. 

  1883.   TfdARGB4us1 = class(TfdUniversalUS1)

  1884.     procedure SetValues; override;

  1885.   end;

  1886. 

  1887.   TfdRGB5A1us1 = class(TfdUniversalUS1)

  1888.     procedure SetValues; override;

  1889.   end;

  1890. 

  1891.   TfdA1RGB5us1 = class(TfdUniversalUS1)

  1892.     procedure SetValues; override;

  1893.   end;

  1894. 

  1895.   TfdRGBA8ui1 = class(TfdUniversalUI1)

  1896.     procedure SetValues; override;

  1897.   end;

  1898. 

  1899.   TfdARGB8ui1 = class(TfdUniversalUI1)

  1900.     procedure SetValues; override;

  1901.   end;

  1902. 

  1903.   TfdRGBA8ub4 = class(TfdRGBAub4)

  1904.     procedure SetValues; override;

  1905.   end;

  1906. 

  1907.   TfdRGB10A2ui1 = class(TfdUniversalUI1)

  1908.     procedure SetValues; override;

  1909.   end;

  1910. 

  1911.   TfdA2RGB10ui1 = class(TfdUniversalUI1)

  1912.     procedure SetValues; override;

  1913.   end;

  1914. 

  1915.   TfdRGBA16us4 = class(TfdRGBAus4)

  1916.     procedure SetValues; override;

  1917.   end;

  1918. 

  1919. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  1920.   TfdBGRX4us1 = class(TfdUniversalUS1)

  1921.     procedure SetValues; override;

  1922.   end;

  1923. 

  1924.   TfdXBGR4us1 = class(TfdUniversalUS1)

  1925.     procedure SetValues; override;

  1926.   end;

  1927. 

  1928.   TfdB5G6R5us1 = class(TfdUniversalUS1)

  1929.     procedure SetValues; override;

  1930.   end;

  1931. 

  1932.   TfdBGR5X1us1 = class(TfdUniversalUS1)

  1933.     procedure SetValues; override;

  1934.   end;

  1935. 

  1936.   TfdX1BGR5us1 = class(TfdUniversalUS1)

  1937.     procedure SetValues; override;

  1938.   end;

  1939. 

  1940.   TfdBGR8ub3 = class(TfdBGRub3)

  1941.     procedure SetValues; override;

  1942.   end;

  1943. 

  1944.   TfdBGRX8ui1 = class(TfdUniversalUI1)

  1945.     procedure SetValues; override;

  1946.   end;

  1947. 

  1948.   TfdXBGR8ui1 = class(TfdUniversalUI1)

  1949.     procedure SetValues; override;

  1950.   end;

  1951. 

  1952.   TfdBGR10X2ui1 = class(TfdUniversalUI1)

  1953.     procedure SetValues; override;

  1954.   end;

  1955. 

  1956.   TfdX2BGR10ui1 = class(TfdUniversalUI1)

  1957.     procedure SetValues; override;

  1958.   end;

  1959. 

  1960.   TfdBGR16us3 = class(TfdBGRus3)

  1961.     procedure SetValues; override;

  1962.   end;

  1963. 

  1964.   TfdBGRA4us1 = class(TfdUniversalUS1)

  1965.     procedure SetValues; override;

  1966.   end;

  1967. 

  1968.   TfdABGR4us1 = class(TfdUniversalUS1)

  1969.     procedure SetValues; override;

  1970.   end;

  1971. 

  1972.   TfdBGR5A1us1 = class(TfdUniversalUS1)

  1973.     procedure SetValues; override;

  1974.   end;

  1975. 

  1976.   TfdA1BGR5us1 = class(TfdUniversalUS1)

  1977.     procedure SetValues; override;

  1978.   end;

  1979. 

  1980.   TfdBGRA8ui1 = class(TfdUniversalUI1)

  1981.     procedure SetValues; override;

  1982.   end;

  1983. 

  1984.   TfdABGR8ui1 = class(TfdUniversalUI1)

  1985.     procedure SetValues; override;

  1986.   end;

  1987. 

  1988.   TfdBGRA8ub4 = class(TfdBGRAub4)

  1989.     procedure SetValues; override;

  1990.   end;

  1991. 

  1992.   TfdBGR10A2ui1 = class(TfdUniversalUI1)

  1993.     procedure SetValues; override;

  1994.   end;

  1995. 

  1996.   TfdA2BGR10ui1 = class(TfdUniversalUI1)

  1997.     procedure SetValues; override;

  1998.   end;

  1999. 

  2000.   TfdBGRA16us4 = class(TfdBGRAus4)

  2001.     procedure SetValues; override;

  2002.   end;

  2003. 

  2004.   TfdDepth16us1 = class(TfdDepthUS1)

  2005.     procedure SetValues; override;

  2006.   end;

  2007. 

  2008.   TfdDepth24ui1 = class(TfdDepthUI1)

  2009.     procedure SetValues; override;

  2010.   end;

  2011. 

  2012.   TfdDepth32ui1 = class(TfdDepthUI1)

  2013.     procedure SetValues; override;

  2014.   end;

  2015. 

  2016.   TfdS3tcDtx1RGBA = class(TFormatDescriptor)

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

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

  2019.     procedure SetValues; override;

  2020.   end;

  2021. 

  2022.   TfdS3tcDtx3RGBA = class(TFormatDescriptor)

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

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

  2025.     procedure SetValues; override;

  2026.   end;

  2027. 

  2028.   TfdS3tcDtx5RGBA = class(TFormatDescriptor)

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

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

  2031.     procedure SetValues; override;

  2032.   end;

  2033. 

  2034. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2035.   TbmpBitfieldFormat = class(TFormatDescriptor)

  2036.   public

  2037.     procedure SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul); overload;

  2038.     procedure SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;

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

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

  2041.   end;

  2042. 

  2043. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2044.   TbmpColorTableEnty = packed record

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

  2046.   end;

  2047.   TbmpColorTable = array of TbmpColorTableEnty;

  2048.   TbmpColorTableFormat = class(TFormatDescriptor)

  2049.   private

  2050.     fBitsPerPixel: Integer;

  2051.     fColorTable: TbmpColorTable;

  2052.   protected

  2053.     procedure SetValues; override;

  2054.   public

  2055.     property ColorTable:   TbmpColorTable  read fColorTable   write fColorTable;

  2056.     property BitsPerPixel: Integer         read fBitsPerPixel write fBitsPerPixel;

  2057. 

  2058.     procedure SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub); overload;

  2059.     procedure CalcValues;

  2060.     procedure CreateColorTable;

  2061. 

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

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

  2064.     destructor Destroy; override;

  2065.   end;

  2066. 

  2067. const

  2068.   LUMINANCE_WEIGHT_R = 0.30;

  2069.   LUMINANCE_WEIGHT_G = 0.59;

  2070.   LUMINANCE_WEIGHT_B = 0.11;

  2071. 

  2072.   ALPHA_WEIGHT_R = 0.30;

  2073.   ALPHA_WEIGHT_G = 0.59;

  2074.   ALPHA_WEIGHT_B = 0.11;

  2075. 

  2076.   DEPTH_WEIGHT_R = 0.333333333;

  2077.   DEPTH_WEIGHT_G = 0.333333333;

  2078.   DEPTH_WEIGHT_B = 0.333333333;

  2079. 

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

  2081.     TfdEmpty,

  2082. 

  2083.     TfdAlpha4ub1,

  2084.     TfdAlpha8ub1,

  2085.     TfdAlpha16us1,

  2086. 

  2087.     TfdLuminance4ub1,

  2088.     TfdLuminance8ub1,

  2089.     TfdLuminance16us1,

  2090. 

  2091.     TfdLuminance4Alpha4ub2,

  2092.     TfdLuminance6Alpha2ub2,

  2093.     TfdLuminance8Alpha8ub2,

  2094.     TfdLuminance12Alpha4us2,

  2095.     TfdLuminance16Alpha16us2,

  2096. 

  2097.     TfdR3G3B2ub1,

  2098.     TfdRGBX4us1,

  2099.     TfdXRGB4us1,

  2100.     TfdR5G6B5us1,

  2101.     TfdRGB5X1us1,

  2102.     TfdX1RGB5us1,

  2103.     TfdRGB8ub3,

  2104.     TfdRGBX8ui1,

  2105.     TfdXRGB8ui1,

  2106.     TfdRGB10X2ui1,

  2107.     TfdX2RGB10ui1,

  2108.     TfdRGB16us3,

  2109. 

  2110.     TfdRGBA4us1,

  2111.     TfdARGB4us1,

  2112.     TfdRGB5A1us1,

  2113.     TfdA1RGB5us1,

  2114.     TfdRGBA8ui1,

  2115.     TfdARGB8ui1,

  2116.     TfdRGBA8ub4,

  2117.     TfdRGB10A2ui1,

  2118.     TfdA2RGB10ui1,

  2119.     TfdRGBA16us4,

  2120. 

  2121.     TfdBGRX4us1,

  2122.     TfdXBGR4us1,

  2123.     TfdB5G6R5us1,

  2124.     TfdBGR5X1us1,

  2125.     TfdX1BGR5us1,

  2126.     TfdBGR8ub3,

  2127.     TfdBGRX8ui1,

  2128.     TfdXBGR8ui1,

  2129.     TfdBGR10X2ui1,

  2130.     TfdX2BGR10ui1,

  2131.     TfdBGR16us3,

  2132. 

  2133.     TfdBGRA4us1,

  2134.     TfdABGR4us1,

  2135.     TfdBGR5A1us1,

  2136.     TfdA1BGR5us1,

  2137.     TfdBGRA8ui1,

  2138.     TfdABGR8ui1,

  2139.     TfdBGRA8ub4,

  2140.     TfdBGR10A2ui1,

  2141.     TfdA2BGR10ui1,

  2142.     TfdBGRA16us4,

  2143. 

  2144.     TfdDepth16us1,

  2145.     TfdDepth24ui1,

  2146.     TfdDepth32ui1,

  2147. 

  2148.     TfdS3tcDtx1RGBA,

  2149.     TfdS3tcDtx3RGBA,

  2150.     TfdS3tcDtx5RGBA

  2151.   );

  2152. 

  2153. var

  2154.   FormatDescriptorCS: TCriticalSection;

  2155.   FormatDescriptors: array[TglBitmapFormat] of TFormatDescriptor;

  2156. 

  2157. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2159. begin

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

  2161. end;

  2162. 

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

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

  2165. begin

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

  2167. end;

  2168. 

  2169. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2170. function glBitmapSize(X: Integer; Y: Integer): TglBitmapSize;

  2171. begin

  2172.   result.Fields := [];

  2173.   if (X >= 0) then

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

  2175.   if (Y >= 0) then

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

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

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

  2179. end;

  2180. 

  2181. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2182. function glBitmapPosition(X: Integer; Y: Integer): TglBitmapPixelPosition;

  2183. begin

  2184.   result := glBitmapSize(X, Y);

  2185. end;

  2186. 

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

  2188. function glBitmapRec4ub(const r, g, b, a: Byte): TglBitmapRec4ub;

  2189. begin

  2190.   result.r := r;

  2191.   result.g := g;

  2192.   result.b := b;

  2193.   result.a := a;

  2194. end;

  2195. 

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

  2197. function glBitmapRec4ui(const r, g, b, a: Cardinal): TglBitmapRec4ui;

  2198. begin

  2199.   result.r := r;

  2200.   result.g := g;

  2201.   result.b := b;

  2202.   result.a := a;

  2203. end;

  2204. 

  2205. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2206. function glBitmapRec4ul(const r, g, b, a: QWord): TglBitmapRec4ul;

  2207. begin

  2208.   result.r := r;

  2209.   result.g := g;

  2210.   result.b := b;

  2211.   result.a := a;

  2212. end;

  2213. 

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

  2215. function glBitmapRec4ubCompare(const r1, r2: TglBitmapRec4ub): Boolean;

  2216. var

  2217.   i: Integer;

  2218. begin

  2219.   result := false;

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

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

  2222.       exit;

  2223.   result := true;

  2224. end;

  2225. 

  2226. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2227. function glBitmapRec4uiCompare(const r1, r2: TglBitmapRec4ui): Boolean;

  2228. var

  2229.   i: Integer;

  2230. begin

  2231.   result := false;

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

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

  2234.       exit;

  2235.   result := true;

  2236. end;

  2237. 

  2238. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2239. function glBitmapCreateTestTexture(const aFormat: TglBitmapFormat): TglBitmap2D;

  2240. var

  2241.   desc: TFormatDescriptor;

  2242.   p, tmp: PByte;

  2243.   x, y, i: Integer;

  2244.   md: Pointer;

  2245.   px: TglBitmapPixelData;

  2246. begin

  2247.   result := nil;

  2248.   desc := TFormatDescriptor.Get(aFormat);

  2249.   if (desc.IsCompressed) or (desc.glFormat = 0) then

  2250.     exit;

  2251. 

  2252.   p := GetMemory(ceil(25 * desc.BytesPerPixel)); // 5 x 5 pixel

  2253.   md := desc.CreateMappingData;

  2254.   try

  2255.     tmp := p;

  2256.     desc.PreparePixel(px);

  2257.     for y := 0 to 4 do

  2258.       for x := 0 to 4 do begin

  2259.         px.Data := glBitmapRec4ui(0, 0, 0, 0);

  2260.         for i := 0 to 3 do begin

  2261.           if ((y < 3) and (y = i)) or

  2262.              ((y = 3) and (i < 3)) or

  2263.              ((y = 4) and (i = 3))

  2264.           then

  2265.             px.Data.arr[i] := Trunc(px.Range.arr[i] / 4 * x)

  2266.           else if ((y < 4) and (i = 3)) or

  2267.                   ((y = 4) and (i < 3))

  2268.           then

  2269.             px.Data.arr[i] := px.Range.arr[i]

  2270.           else

  2271.             px.Data.arr[i] := 0; //px.Range.arr[i];

  2272.         end;

  2273.         desc.Map(px, tmp, md);

  2274.       end;

  2275.   finally

  2276.     desc.FreeMappingData(md);

  2277.   end;

  2278. 

  2279.   result := TglBitmap2D.Create(glBitmapPosition(5, 5), aFormat, p);

  2280.   result.FreeDataOnDestroy       := true;

  2281.   result.FreeDataAfterGenTexture := false;

  2282.   result.SetFilter(GL_NEAREST, GL_NEAREST);

  2283. end;

  2284. 

  2285. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2286. function glBitmapShiftRec(const r, g, b, a: Byte): TglBitmapRec4ub;

  2287. begin

  2288.   result.r := r;

  2289.   result.g := g;

  2290.   result.b := b;

  2291.   result.a := a;

  2292. end;

  2293. 

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

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

  2296. begin

  2297.   result := [];

  2298. 

  2299.   if (aFormat in [

  2300.         //8bpp

  2301.         tfAlpha4ub1, tfAlpha8ub1,

  2302.         tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1,

  2303. 

  2304.         //16bpp

  2305.         tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,

  2306.         tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,

  2307.         tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1,

  2308. 

  2309.         //24bpp

  2310.         tfBGR8ub3, tfRGB8ub3,

  2311. 

  2312.         //32bpp

  2313.         tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,

  2314.         tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1])

  2315.   then

  2316.     result := result + [ ftBMP ];

  2317. 

  2318.   if (aFormat in [

  2319.         //8bbp

  2320.         tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1,

  2321. 

  2322.         //16bbp

  2323.         tfAlpha16us1, tfLuminance16us1,

  2324.         tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,

  2325.         tfX1RGB5us1, tfARGB4us1, tfA1RGB5us1, tfDepth16us1,

  2326. 

  2327.         //24bbp

  2328.         tfBGR8ub3,

  2329. 

  2330.         //32bbp

  2331.         tfX2RGB10ui1, tfARGB8ui1, tfBGRA8ub4, tfA2RGB10ui1,

  2332.         tfDepth24ui1, tfDepth32ui1])

  2333.   then

  2334.     result := result + [ftTGA];

  2335. 

  2336.   if not (aFormat in [tfEmpty, tfRGB16us3, tfBGR16us3]) then

  2337.     result := result + [ftDDS];

  2338. 

  2339. {$IFDEF GLB_SUPPORT_PNG_WRITE}

  2340.   if aFormat in [

  2341.       tfAlpha8ub1, tfLuminance8ub1, tfLuminance8Alpha8ub2,

  2342.       tfRGB8ub3, tfRGBA8ui1,

  2343.       tfBGR8ub3, tfBGRA8ui1] then

  2344.     result := result + [ftPNG];

  2345. {$ENDIF}

  2346. 

  2347. {$IFDEF GLB_SUPPORT_JPEG_WRITE}

  2348.   if aFormat in [tfAlpha8ub1, tfLuminance8ub1, tfRGB8ub3, tfBGR8ub3] then

  2349.     result := result + [ftJPEG];

  2350. {$ENDIF}

  2351. end;

  2352. 

  2353. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2355. begin

  2356.   while (aNumber and 1) = 0 do

  2357.     aNumber := aNumber shr 1;

  2358.   result := aNumber = 1;

  2359. end;

  2360. 

  2361. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2363. begin

  2364.   result := 0;

  2365.   while aBitSet > 0 do begin

  2366.     inc(result);

  2367.     aBitSet := aBitSet shr 1;

  2368.   end;

  2369. end;

  2370. 

  2371. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2373. begin

  2374.   result := 0;

  2375.   while aBitSet > 0 do begin

  2376.     if (aBitSet and 1) = 1 then

  2377.       inc(result);

  2378.     aBitSet := aBitSet shr 1;

  2379.   end;

  2380. end;

  2381. 

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

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

  2384. begin

  2385.   result := Trunc(

  2386.     LUMINANCE_WEIGHT_R * aPixel.Data.r +

  2387.     LUMINANCE_WEIGHT_G * aPixel.Data.g +

  2388.     LUMINANCE_WEIGHT_B * aPixel.Data.b);

  2389. end;

  2390. 

  2391. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2393. begin

  2394.   result := Trunc(

  2395.     DEPTH_WEIGHT_R * aPixel.Data.r +

  2396.     DEPTH_WEIGHT_G * aPixel.Data.g +

  2397.     DEPTH_WEIGHT_B * aPixel.Data.b);

  2398. end;

  2399. 

  2400. {$IFDEF GLB_NATIVE_OGL}

  2401. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2402. //OpenGLInitialization///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2403. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2404. var

  2405.   GL_LibHandle: Pointer = nil;

  2406. 

  2407. function glbGetProcAddress(aProcName: PAnsiChar; aLibHandle: Pointer = nil; const aRaiseOnErr: Boolean = true): Pointer;

  2408. begin

  2409.   if not Assigned(aLibHandle) then

  2410.     aLibHandle := GL_LibHandle;

  2411. 

  2412. {$IF DEFINED(GLB_WIN)}

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

  2414.   if Assigned(result) then

  2415.     exit;

  2416. 

  2417.   if Assigned(wglGetProcAddress) then

  2418.     result := wglGetProcAddress(aProcName);

  2419. {$ELSEIF DEFINED(GLB_LINUX)}

  2420.   if Assigned(glXGetProcAddress) then begin

  2421.     result := glXGetProcAddress(aProcName);

  2422.     if Assigned(result) then

  2423.       exit;

  2424.   end;

  2425. 

  2426.   if Assigned(glXGetProcAddressARB) then begin

  2427.     result := glXGetProcAddressARB(aProcName);

  2428.     if Assigned(result) then

  2429.       exit;

  2430.   end;

  2431. 

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

  2433. {$IFEND}

  2434.   if not Assigned(result) and aRaiseOnErr then

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

  2436. end;

  2437. 

  2438. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}

  2439. var

  2440.   GLU_LibHandle: Pointer = nil;

  2441.   OpenGLInitialized: Boolean;

  2442.   InitOpenGLCS: TCriticalSection;

  2443. 

  2444. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2445. procedure glbInitOpenGL;

  2446. 

  2447.   ////////////////////////////////////////////////////////////////////////////////

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

  2449.   begin

  2450.     {$IF DEFINED(GLB_WIN)}

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

  2452.     {$ELSEIF DEFINED(GLB_LINUX)}

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

  2454.     {$ELSE}

  2455.     result := nil;

  2456.     {$IFEND}

  2457.   end;

  2458. 

  2459.   ////////////////////////////////////////////////////////////////////////////////

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

  2461.   begin

  2462.     result := false;

  2463.     if not Assigned(aLibHandle) then

  2464.       exit;

  2465. 

  2466.     {$IF DEFINED(GLB_WIN)}

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

  2468.     {$ELSEIF DEFINED(GLB_LINUX)}

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

  2470.     {$IFEND}

  2471.   end;

  2472. 

  2473. begin

  2474.   if Assigned(GL_LibHandle) then

  2475.     glbFreeLibrary(GL_LibHandle);

  2476. 

  2477.   if Assigned(GLU_LibHandle) then

  2478.     glbFreeLibrary(GLU_LibHandle);

  2479. 

  2480.   GL_LibHandle := glbLoadLibrary(libopengl);

  2481.   if not Assigned(GL_LibHandle) then

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

  2483. 

  2484.   GLU_LibHandle := glbLoadLibrary(libglu);

  2485.   if not Assigned(GLU_LibHandle) then

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

  2487. 

  2488. {$IF DEFINED(GLB_WIN)}

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

  2490. {$ELSEIF DEFINED(GLB_LINUX)}

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

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

  2493. {$IFEND}

  2494. 

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

  2516. 

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

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

  2519. end;

  2520. {$ENDIF}

  2521. 

  2522. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2523. procedure glbReadOpenGLExtensions;

  2524. var

  2525.   Buffer: AnsiString;

  2526.   MajorVersion, MinorVersion: Integer;

  2527. 

  2528.   ///////////////////////////////////////////////////////////////////////////////////////////

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

  2530.   var

  2531.     Separator: Integer;

  2532.   begin

  2533.     aMinor := 0;

  2534.     aMajor := 0;

  2535. 

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

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

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

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

  2540. 

  2541.       Dec(Separator);

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

  2543.         Dec(Separator);

  2544. 

  2545.       Delete(aBuffer, 1, Separator);

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

  2547. 

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

  2549.         Inc(Separator);

  2550. 

  2551.       Delete(aBuffer, Separator, 255);

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

  2553. 

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

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

  2556.     end;

  2557.   end;

  2558. 

  2559.   ///////////////////////////////////////////////////////////////////////////////////////////

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

  2561.   var

  2562.     ExtPos: Integer;

  2563.   begin

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

  2565.     result := ExtPos > 0;

  2566.     if result then

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

  2568.   end;

  2569. 

  2570.   ///////////////////////////////////////////////////////////////////////////////////////////

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

  2572.   begin

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

  2574.   end;

  2575. 

  2576. begin

  2577. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}

  2578.   InitOpenGLCS.Enter;

  2579.   try

  2580.     if not OpenGLInitialized then begin

  2581.       glbInitOpenGL;

  2582.       OpenGLInitialized := true;

  2583.     end;

  2584.   finally

  2585.     InitOpenGLCS.Leave;

  2586.   end;

  2587. {$ENDIF}

  2588. 

  2589.   // Version

  2590.   Buffer := glGetString(GL_VERSION);

  2591.   TrimVersionString(Buffer, MajorVersion, MinorVersion);

  2592. 

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

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

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

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

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

  2598. 

  2599.   // Extensions

  2600.   Buffer := glGetString(GL_EXTENSIONS);

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

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

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

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

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

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

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

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

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

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

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

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

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

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

  2615. 

  2616.   if GL_VERSION_1_3 then begin

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

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

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

  2620.   end else begin

  2621.     glCompressedTexImage1D  := glbGetProcAddress('glCompressedTexImage1DARB',  nil, false);

  2622.     glCompressedTexImage2D  := glbGetProcAddress('glCompressedTexImage2DARB',  nil, false);

  2623.     glGetCompressedTexImage := glbGetProcAddress('glGetCompressedTexImageARB', nil, false);

  2624.   end;

  2625. end;

  2626. {$ENDIF}

  2627. 

  2628. {$IFDEF GLB_SDL_IMAGE}

  2629. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2630. // SDL Image Helper /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2631. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2633. begin

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

  2635. end;

  2636. 

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

  2638. begin

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

  2640. end;

  2641. 

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

  2643. begin

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

  2645. end;

  2646. 

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

  2648. begin

  2649.   result := 0;

  2650. end;

  2651. 

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

  2653. begin

  2654.   result := SDL_AllocRW;

  2655. 

  2656.   if result = nil then

  2657.     raise EglBitmap.Create('glBitmapCreateRWops - SDL_AllocRW failed.');

  2658. 

  2659.   result^.seek := glBitmapRWseek;

  2660.   result^.read := glBitmapRWread;

  2661.   result^.write := glBitmapRWwrite;

  2662.   result^.close := glBitmapRWclose;

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

  2664. end;

  2665. {$ENDIF}

  2666. 

  2667. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2668. procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);

  2669. begin

  2670.   glBitmapDefaultDeleteTextureOnFree := aDeleteTextureOnFree;

  2671. end;

  2672. 

  2673. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2674. procedure glBitmapSetDefaultFreeDataAfterGenTexture(const aFreeData: Boolean);

  2675. begin

  2676.   glBitmapDefaultFreeDataAfterGenTextures := aFreeData;

  2677. end;

  2678. 

  2679. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2680. procedure glBitmapSetDefaultMipmap(const aValue: TglBitmapMipMap);

  2681. begin

  2682.   glBitmapDefaultMipmap := aValue;

  2683. end;

  2684. 

  2685. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2686. procedure glBitmapSetDefaultFormat(const aFormat: TglBitmapFormat);

  2687. begin

  2688.   glBitmapDefaultFormat := aFormat;

  2689. end;

  2690. 

  2691. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2693. begin

  2694.   glBitmapDefaultFilterMin := aMin;

  2695.   glBitmapDefaultFilterMag := aMag;

  2696. end;

  2697. 

  2698. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2700. begin

  2701.   glBitmapDefaultWrapS := S;

  2702.   glBitmapDefaultWrapT := T;

  2703.   glBitmapDefaultWrapR := R;

  2704. end;

  2705. 

  2706. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2707. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}

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

  2709. begin

  2710.   glDefaultSwizzle[0] := r;

  2711.   glDefaultSwizzle[1] := g;

  2712.   glDefaultSwizzle[2] := b;

  2713.   glDefaultSwizzle[3] := a;

  2714. end;

  2715. {$IFEND}

  2716. 

  2717. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2718. function glBitmapGetDefaultDeleteTextureOnFree: Boolean;

  2719. begin

  2720.   result := glBitmapDefaultDeleteTextureOnFree;

  2721. end;

  2722. 

  2723. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2724. function glBitmapGetDefaultFreeDataAfterGenTexture: Boolean;

  2725. begin

  2726.   result := glBitmapDefaultFreeDataAfterGenTextures;

  2727. end;

  2728. 

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

  2730. function glBitmapGetDefaultMipmap: TglBitmapMipMap;

  2731. begin

  2732.   result := glBitmapDefaultMipmap;

  2733. end;

  2734. 

  2735. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2736. function glBitmapGetDefaultFormat: TglBitmapFormat;

  2737. begin

  2738.   result := glBitmapDefaultFormat;

  2739. end;

  2740. 

  2741. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2743. begin

  2744.   aMin := glBitmapDefaultFilterMin;

  2745.   aMag := glBitmapDefaultFilterMag;

  2746. end;

  2747. 

  2748. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2750. begin

  2751.   S := glBitmapDefaultWrapS;

  2752.   T := glBitmapDefaultWrapT;

  2753.   R := glBitmapDefaultWrapR;

  2754. end;

  2755. 

  2756. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}

  2757. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2759. begin

  2760.   r := glDefaultSwizzle[0];

  2761.   g := glDefaultSwizzle[1];

  2762.   b := glDefaultSwizzle[2];

  2763.   a := glDefaultSwizzle[3];

  2764. end;

  2765. {$ENDIF}

  2766. 

  2767. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2768. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2769. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2770. function TFormatDescriptor.GetSize(const aSize: TglBitmapSize): Integer;

  2771. var

  2772.   w, h: Integer;

  2773. begin

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

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

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

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

  2778.   end else

  2779.     result := 0;

  2780. end;

  2781. 

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

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

  2784. begin

  2785.   result := 0;

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

  2787.     exit;

  2788.   result := Ceil(aWidth * aHeight * BytesPerPixel);

  2789. end;

  2790. 

  2791. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2792. function TFormatDescriptor.CreateMappingData: Pointer;

  2793. begin

  2794.   result := nil;

  2795. end;

  2796. 

  2797. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  2799. begin

  2800.   //DUMMY

  2801. end;

  2802. 

  2803. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2804. function TFormatDescriptor.IsEmpty: Boolean;

  2805. begin

  2806.   result := (fFormat = tfEmpty);

  2807. end;

  2808. 

  2809. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2810. function TFormatDescriptor.MaskMatch(const aMask: TglBitmapRec4ul): Boolean;

  2811. var

  2812.   i: Integer;

  2813.   m: TglBitmapRec4ul;

  2814. begin

  2815.   result := false;

  2816.   if (aMask.r = 0) and (aMask.g = 0) and (aMask.b = 0) and (aMask.a = 0) then

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

  2818.   m := Mask;

  2819.   for i := 0 to 3 do

  2820.     if (aMask.arr[i] <> m.arr[i]) then

  2821.       exit;

  2822.   result := true;

  2823. end;

  2824. 

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

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

  2827. begin

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

  2829.   aPixel.Data   := Range;

  2830.   aPixel.Format := fFormat;

  2831.   aPixel.Range  := Range;

  2832. end;

  2833. 

  2834. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2835. constructor TFormatDescriptor.Create;

  2836. begin

  2837.   inherited Create;

  2838. end;

  2839. 

  2840. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2841. //TfdAlpha_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2842. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2843. procedure TfdAlphaUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);

  2844. begin

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

  2846.   inc(aData);

  2847. end;

  2848. 

  2849. procedure TfdAlphaUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);

  2850. begin

  2851.   aPixel.Data.r := 0;

  2852.   aPixel.Data.g := 0;

  2853.   aPixel.Data.b := 0;

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

  2855.   inc(aData);

  2856. end;

  2857. 

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

  2859. //TfdLuminance_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2860. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2861. procedure TfdLuminanceUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);

  2862. begin

  2863.   aData^ := LuminanceWeight(aPixel);

  2864.   inc(aData);

  2865. end;

  2866. 

  2867. procedure TfdLuminanceUB1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);

  2868. begin

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

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

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

  2872.   aPixel.Data.a := 0;

  2873.   inc(aData);

  2874. end;

  2875. 

  2876. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2877. //TfdUniversal_UB1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2878. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2879. procedure TfdUniversalUB1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);

  2880. var

  2881.   i: Integer;

  2882. begin

  2883.   aData^ := 0;

  2884.   for i := 0 to 3 do

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

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

  2887.   inc(aData);

  2888. end;

  2889. 

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

  2891. var

  2892.   i: Integer;

  2893. begin

  2894.   for i := 0 to 3 do

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

  2896.   inc(aData);

  2897. end;

  2898. 

  2899. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2900. //TfdLuminanceAlpha_UB2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2901. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2902. procedure TfdLuminanceAlphaUB2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);

  2903. begin

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

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

  2906.   inc(aData);

  2907. end;

  2908. 

  2909. procedure TfdLuminanceAlphaUB2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);

  2910. begin

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

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

  2913.   inc(aData);

  2914. end;

  2915. 

  2916. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2917. //TfdRGB_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2918. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2919. procedure TfdRGBub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);

  2920. begin

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

  2922.   inc(aData);

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

  2924.   inc(aData);

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

  2926.   inc(aData);

  2927. end;

  2928. 

  2929. procedure TfdRGBub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);

  2930. begin

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

  2932.   inc(aData);

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

  2934.   inc(aData);

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

  2936.   inc(aData);

  2937.   aPixel.Data.a := 0;

  2938. end;

  2939. 

  2940. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2941. //TfdBGR_UB3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2942. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2943. procedure TfdBGRub3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);

  2944. begin

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

  2946.   inc(aData);

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

  2948.   inc(aData);

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

  2950.   inc(aData);

  2951. end;

  2952. 

  2953. procedure TfdBGRub3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);

  2954. begin

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

  2956.   inc(aData);

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

  2958.   inc(aData);

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

  2960.   inc(aData);

  2961.   aPixel.Data.a := 0;

  2962. end;

  2963. 

  2964. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2965. //TfdRGBA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2966. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2967. procedure TfdRGBAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);

  2968. begin

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

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

  2971.   inc(aData);

  2972. end;

  2973. 

  2974. procedure TfdRGBAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);

  2975. begin

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

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

  2978.   inc(aData);

  2979. end;

  2980. 

  2981. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2982. //TfdBGRA_UB4//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2983. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2984. procedure TfdBGRAub4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);

  2985. begin

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

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

  2988.   inc(aData);

  2989. end;

  2990. 

  2991. procedure TfdBGRAub4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);

  2992. begin

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

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

  2995.   inc(aData);

  2996. end;

  2997. 

  2998. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  2999. //TfdAlpha_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  3001. procedure TfdAlphaUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);

  3002. begin

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

  3004.   inc(aData, 2);

  3005. end;

  3006. 

  3007. procedure TfdAlphaUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);

  3008. begin

  3009.   aPixel.Data.r := 0;

  3010.   aPixel.Data.g := 0;

  3011.   aPixel.Data.b := 0;

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

  3013.   inc(aData, 2);

  3014. end;

  3015. 

  3016. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3017. //TfdLuminance_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3018. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3019. procedure TfdLuminanceUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);

  3020. begin

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

  3022.   inc(aData, 2);

  3023. end;

  3024. 

  3025. procedure TfdLuminanceUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);

  3026. begin

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

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

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

  3030.   aPixel.Data.a := 0;

  3031.   inc(aData, 2);

  3032. end;

  3033. 

  3034. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3035. //TfdUniversal_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3036. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3037. procedure TfdUniversalUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);

  3038. var

  3039.   i: Integer;

  3040. begin

  3041.   PWord(aData)^ := 0;

  3042.   for i := 0 to 3 do

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

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

  3045.   inc(aData, 2);

  3046. end;

  3047. 

  3048. procedure TfdUniversalUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);

  3049. var

  3050.   i: Integer;

  3051. begin

  3052.   for i := 0 to 3 do

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

  3054.   inc(aData, 2);

  3055. end;

  3056. 

  3057. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3058. //TfdDepth_US1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  3060. procedure TfdDepthUS1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);

  3061. begin

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

  3063.   inc(aData, 2);

  3064. end;

  3065. 

  3066. procedure TfdDepthUS1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);

  3067. begin

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

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

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

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

  3072.   inc(aData, 2);

  3073. end;

  3074. 

  3075. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3076. //TfdLuminanceAlpha_US2///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3077. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3078. procedure TfdLuminanceAlphaUS2.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);

  3079. begin

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

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

  3082.   inc(aData, 2);

  3083. end;

  3084. 

  3085. procedure TfdLuminanceAlphaUS2.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);

  3086. begin

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

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

  3089.   inc(aData, 2);

  3090. end;

  3091. 

  3092. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3093. //TfdRGB_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3094. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3095. procedure TfdRGBus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);

  3096. begin

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

  3098.   inc(aData, 2);

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

  3100.   inc(aData, 2);

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

  3102.   inc(aData, 2);

  3103. end;

  3104. 

  3105. procedure TfdRGBus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);

  3106. begin

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

  3108.   inc(aData, 2);

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

  3110.   inc(aData, 2);

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

  3112.   inc(aData, 2);

  3113.   aPixel.Data.a := 0;

  3114. end;

  3115. 

  3116. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3117. //TfdBGR_US3//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3118. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3119. procedure TfdBGRus3.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);

  3120. begin

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

  3122.   inc(aData, 2);

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

  3124.   inc(aData, 2);

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

  3126.   inc(aData, 2);

  3127. end;

  3128. 

  3129. procedure TfdBGRus3.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);

  3130. begin

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

  3132.   inc(aData, 2);

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

  3134.   inc(aData, 2);

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

  3136.   inc(aData, 2);

  3137.   aPixel.Data.a := 0;

  3138. end;

  3139. 

  3140. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3141. //TfdRGBA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3142. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3143. procedure TfdRGBAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);

  3144. begin

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

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

  3147.   inc(aData, 2);

  3148. end;

  3149. 

  3150. procedure TfdRGBAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);

  3151. begin

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

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

  3154.   inc(aData, 2);

  3155. end;

  3156. 

  3157. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3158. //TfdARGB_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3159. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3160. procedure TfdARGBus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);

  3161. begin

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

  3163.   inc(aData, 2);

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

  3165. end;

  3166. 

  3167. procedure TfdARGBus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);

  3168. begin

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

  3170.   inc(aData, 2);

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

  3172. end;

  3173. 

  3174. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3175. //TfdBGRA_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3176. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3177. procedure TfdBGRAus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);

  3178. begin

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

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

  3181.   inc(aData, 2);

  3182. end;

  3183. 

  3184. procedure TfdBGRAus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);

  3185. begin

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

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

  3188.   inc(aData, 2);

  3189. end;

  3190. 

  3191. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3192. //TfdABGR_US4/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3193. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3194. procedure TfdABGRus4.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);

  3195. begin

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

  3197.   inc(aData, 2);

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

  3199. end;

  3200. 

  3201. procedure TfdABGRus4.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);

  3202. begin

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

  3204.   inc(aData, 2);

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

  3206. end;

  3207. 

  3208. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3209. //TfdUniversal_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3210. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3211. procedure TfdUniversalUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);

  3212. var

  3213.   i: Integer;

  3214. begin

  3215.   PCardinal(aData)^ := 0;

  3216.   for i := 0 to 3 do

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

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

  3219.   inc(aData, 4);

  3220. end;

  3221. 

  3222. procedure TfdUniversalUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);

  3223. var

  3224.   i: Integer;

  3225. begin

  3226.   for i := 0 to 3 do

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

  3228.   inc(aData, 2);

  3229. end;

  3230. 

  3231. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3232. //TfdDepth_UI1////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3233. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3234. procedure TfdDepthUI1.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);

  3235. begin

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

  3237.   inc(aData, 4);

  3238. end;

  3239. 

  3240. procedure TfdDepthUI1.Unmap(var aData: PByte; out aPixel: TglBitmapPixelData; var aMapData: Pointer);

  3241. begin

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

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

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

  3245.   aPixel.Data.a := PCardinal(aData)^;

  3246.   inc(aData, 4);

  3247. end;

  3248. 

  3249. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3250. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3251. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3252. procedure TfdAlpha4ub1.SetValues;

  3253. begin

  3254.   inherited SetValues;

  3255.   fBitsPerPixel     := 8;

  3256.   fFormat           := tfAlpha4ub1;

  3257.   fWithAlpha        := tfAlpha4ub1;

  3258.   fPrecision        := glBitmapRec4ub(0, 0, 0, 8);

  3259.   fShift            := glBitmapRec4ub(0, 0, 0, 0);

  3260. {$IFNDEF OPENGL_ES}

  3261.   fOpenGLFormat     := tfAlpha4ub1;

  3262.   fglFormat         := GL_ALPHA;

  3263.   fglInternalFormat := GL_ALPHA4;

  3264.   fglDataFormat     := GL_UNSIGNED_BYTE;

  3265. {$ELSE}

  3266.   fOpenGLFormat     := tfAlpha8ub1;

  3267. {$ENDIF}

  3268. end;

  3269. 

  3270. procedure TfdAlpha8ub1.SetValues;

  3271. begin

  3272.   inherited SetValues;

  3273.   fBitsPerPixel     := 8;

  3274.   fFormat           := tfAlpha8ub1;

  3275.   fWithAlpha        := tfAlpha8ub1;

  3276.   fPrecision        := glBitmapRec4ub(0, 0, 0, 8);

  3277.   fShift            := glBitmapRec4ub(0, 0, 0, 0);

  3278.   fOpenGLFormat     := tfAlpha8ub1;

  3279.   fglFormat         := GL_ALPHA;

  3280.   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_ALPHA8{$ELSE}GL_ALPHA{$ENDIF};

  3281.   fglDataFormat     := GL_UNSIGNED_BYTE;

  3282. end;

  3283. 

  3284. procedure TfdAlpha16us1.SetValues;

  3285. begin

  3286.   inherited SetValues;

  3287.   fBitsPerPixel     := 16;

  3288.   fFormat           := tfAlpha16us1;

  3289.   fWithAlpha        := tfAlpha16us1;

  3290.   fPrecision        := glBitmapRec4ub(0, 0, 0, 16);

  3291.   fShift            := glBitmapRec4ub(0, 0, 0,  0);

  3292. {$IFNDEF OPENGL_ES}

  3293.   fOpenGLFormat     := tfAlpha16us1;

  3294.   fglFormat         := GL_ALPHA;

  3295.   fglInternalFormat := GL_ALPHA16;

  3296.   fglDataFormat     := GL_UNSIGNED_SHORT;

  3297. {$ELSE}

  3298.   fOpenGLFormat     := tfAlpha8ub1;

  3299. {$ENDIF}

  3300. end;

  3301. 

  3302. procedure TfdLuminance4ub1.SetValues;

  3303. begin

  3304.   inherited SetValues;

  3305.   fBitsPerPixel     := 8;

  3306.   fFormat           := tfLuminance4ub1;

  3307.   fWithAlpha        := tfLuminance4Alpha4ub2;

  3308.   fWithoutAlpha     := tfLuminance4ub1;

  3309.   fPrecision        := glBitmapRec4ub(8, 8, 8, 0);

  3310.   fShift            := glBitmapRec4ub(0, 0, 0, 0);

  3311. {$IFNDEF OPENGL_ES}

  3312.   fOpenGLFormat     := tfLuminance4ub1;

  3313.   fglFormat         := GL_LUMINANCE;

  3314.   fglInternalFormat := GL_LUMINANCE4;

  3315.   fglDataFormat     := GL_UNSIGNED_BYTE;

  3316. {$ELSE}

  3317.   fOpenGLFormat     := tfLuminance8ub1;

  3318. {$ENDIF}

  3319. end;

  3320. 

  3321. procedure TfdLuminance8ub1.SetValues;

  3322. begin

  3323.   inherited SetValues;

  3324.   fBitsPerPixel     := 8;

  3325.   fFormat           := tfLuminance8ub1;

  3326.   fWithAlpha        := tfLuminance8Alpha8ub2;

  3327.   fWithoutAlpha     := tfLuminance8ub1;

  3328.   fOpenGLFormat     := tfLuminance8ub1;

  3329.   fPrecision        := glBitmapRec4ub(8, 8, 8, 0);

  3330.   fShift            := glBitmapRec4ub(0, 0, 0, 0);

  3331.   fglFormat         := GL_LUMINANCE;

  3332.   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8{$ELSE}GL_LUMINANCE{$ENDIF};

  3333.   fglDataFormat     := GL_UNSIGNED_BYTE;

  3334. end;

  3335. 

  3336. procedure TfdLuminance16us1.SetValues;

  3337. begin

  3338.   inherited SetValues;

  3339.   fBitsPerPixel     := 16;

  3340.   fFormat           := tfLuminance16us1;

  3341.   fWithAlpha        := tfLuminance16Alpha16us2;

  3342.   fWithoutAlpha     := tfLuminance16us1;

  3343.   fPrecision        := glBitmapRec4ub(16, 16, 16,  0);

  3344.   fShift            := glBitmapRec4ub( 0,  0,  0,  0);

  3345. {$IFNDEF OPENGL_ES}

  3346.   fOpenGLFormat     := tfLuminance16us1;

  3347.   fglFormat         := GL_LUMINANCE;

  3348.   fglInternalFormat := GL_LUMINANCE16;

  3349.   fglDataFormat     := GL_UNSIGNED_SHORT;

  3350. {$ELSE}

  3351.   fOpenGLFormat     := tfLuminance8ub1;

  3352. {$ENDIF}

  3353. end;

  3354. 

  3355. procedure TfdLuminance4Alpha4ub2.SetValues;

  3356. begin

  3357.   inherited SetValues;

  3358.   fBitsPerPixel     := 16;

  3359.   fFormat           := tfLuminance4Alpha4ub2;

  3360.   fWithAlpha        := tfLuminance4Alpha4ub2;

  3361.   fWithoutAlpha     := tfLuminance4ub1;

  3362.   fPrecision        := glBitmapRec4ub(8, 8, 8, 8);

  3363.   fShift            := glBitmapRec4ub(0, 0, 0, 8);

  3364. {$IFNDEF OPENGL_ES}

  3365.   fOpenGLFormat     := tfLuminance4Alpha4ub2;

  3366.   fglFormat         := GL_LUMINANCE_ALPHA;

  3367.   fglInternalFormat := GL_LUMINANCE4_ALPHA4;

  3368.   fglDataFormat     := GL_UNSIGNED_BYTE;

  3369. {$ELSE}

  3370.   fOpenGLFormat     := tfLuminance8Alpha8ub2;

  3371. {$ENDIF}

  3372. end;

  3373. 

  3374. procedure TfdLuminance6Alpha2ub2.SetValues;

  3375. begin

  3376.   inherited SetValues;

  3377.   fBitsPerPixel     := 16;

  3378.   fFormat           := tfLuminance6Alpha2ub2;

  3379.   fWithAlpha        := tfLuminance6Alpha2ub2;

  3380.   fWithoutAlpha     := tfLuminance8ub1;

  3381.   fPrecision        := glBitmapRec4ub(8, 8, 8, 8);

  3382.   fShift            := glBitmapRec4ub(0, 0, 0, 8);

  3383. {$IFNDEF OPENGL_ES}

  3384.   fOpenGLFormat     := tfLuminance6Alpha2ub2;

  3385.   fglFormat         := GL_LUMINANCE_ALPHA;

  3386.   fglInternalFormat := GL_LUMINANCE6_ALPHA2;

  3387.   fglDataFormat     := GL_UNSIGNED_BYTE;

  3388. {$ELSE}

  3389.   fOpenGLFormat     := tfLuminance8Alpha8ub2;

  3390. {$ENDIF}

  3391. end;

  3392. 

  3393. procedure TfdLuminance8Alpha8ub2.SetValues;

  3394. begin

  3395.   inherited SetValues;

  3396.   fBitsPerPixel     := 16;

  3397.   fFormat           := tfLuminance8Alpha8ub2;

  3398.   fWithAlpha        := tfLuminance8Alpha8ub2;

  3399.   fWithoutAlpha     := tfLuminance8ub1;

  3400.   fOpenGLFormat     := tfLuminance8Alpha8ub2;

  3401.   fPrecision        := glBitmapRec4ub(8, 8, 8, 8);

  3402.   fShift            := glBitmapRec4ub(0, 0, 0, 8);

  3403.   fglFormat         := GL_LUMINANCE_ALPHA;

  3404.   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_LUMINANCE8_ALPHA8{$ELSE}GL_LUMINANCE_ALPHA{$ENDIF};

  3405.   fglDataFormat     := GL_UNSIGNED_BYTE;

  3406. end;

  3407. 

  3408. procedure TfdLuminance12Alpha4us2.SetValues;

  3409. begin

  3410.   inherited SetValues;

  3411.   fBitsPerPixel     := 32;

  3412.   fFormat           := tfLuminance12Alpha4us2;

  3413.   fWithAlpha        := tfLuminance12Alpha4us2;

  3414.   fWithoutAlpha     := tfLuminance16us1;

  3415.   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);

  3416.   fShift            := glBitmapRec4ub( 0,  0,  0, 16);

  3417. {$IFNDEF OPENGL_ES}

  3418.   fOpenGLFormat     := tfLuminance12Alpha4us2;

  3419.   fglFormat         := GL_LUMINANCE_ALPHA;

  3420.   fglInternalFormat := GL_LUMINANCE12_ALPHA4;

  3421.   fglDataFormat     := GL_UNSIGNED_SHORT;

  3422. {$ELSE}

  3423.   fOpenGLFormat     := tfLuminance8Alpha8ub2;

  3424. {$ENDIF}

  3425. end;

  3426. 

  3427. procedure TfdLuminance16Alpha16us2.SetValues;

  3428. begin

  3429.   inherited SetValues;

  3430.   fBitsPerPixel     := 32;

  3431.   fFormat           := tfLuminance16Alpha16us2;

  3432.   fWithAlpha        := tfLuminance16Alpha16us2;

  3433.   fWithoutAlpha     := tfLuminance16us1;

  3434.   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);

  3435.   fShift            := glBitmapRec4ub( 0,  0,  0, 16);

  3436. {$IFNDEF OPENGL_ES}

  3437.   fOpenGLFormat     := tfLuminance16Alpha16us2;

  3438.   fglFormat         := GL_LUMINANCE_ALPHA;

  3439.   fglInternalFormat := GL_LUMINANCE16_ALPHA16;

  3440.   fglDataFormat     := GL_UNSIGNED_SHORT;

  3441. {$ELSE}

  3442.   fOpenGLFormat     := tfLuminance8Alpha8ub2;

  3443. {$ENDIF}

  3444. end;

  3445. 

  3446. procedure TfdR3G3B2ub1.SetValues;

  3447. begin

  3448.   inherited SetValues;

  3449.   fBitsPerPixel     := 8;

  3450.   fFormat           := tfR3G3B2ub1;

  3451.   fWithAlpha        := tfRGBA4us1;

  3452.   fWithoutAlpha     := tfR3G3B2ub1;

  3453.   fRGBInverted      := tfEmpty;

  3454.   fPrecision        := glBitmapRec4ub(3, 3, 2, 0);

  3455.   fShift            := glBitmapRec4ub(5, 2, 0, 0);

  3456. {$IFNDEF OPENGL_ES}

  3457.   fOpenGLFormat     := tfR3G3B2ub1;

  3458.   fglFormat         := GL_RGB;

  3459.   fglInternalFormat := GL_R3_G3_B2;

  3460.   fglDataFormat     := GL_UNSIGNED_BYTE_3_3_2;

  3461. {$ELSE}

  3462.   fOpenGLFormat     := tfR5G6B5us1;

  3463. {$ENDIF}

  3464. end;

  3465. 

  3466. procedure TfdRGBX4us1.SetValues;

  3467. begin

  3468.   inherited SetValues;

  3469.   fBitsPerPixel     := 16;

  3470.   fFormat           := tfRGBX4us1;

  3471.   fWithAlpha        := tfRGBA4us1;

  3472.   fWithoutAlpha     := tfRGBX4us1;

  3473.   fRGBInverted      := tfBGRX4us1;

  3474.   fPrecision        := glBitmapRec4ub( 4, 4, 4, 0);

  3475.   fShift            := glBitmapRec4ub(12, 8, 4, 0);

  3476. {$IFNDEF OPENGL_ES}

  3477.   fOpenGLFormat     := tfRGBX4us1;

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

  3479.   fglInternalFormat := GL_RGB4;

  3480.   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;

  3481. {$ELSE}

  3482.   fOpenGLFormat     := tfR5G6B5us1;

  3483. {$ENDIF}

  3484. end;

  3485. 

  3486. procedure TfdXRGB4us1.SetValues;

  3487. begin

  3488.   inherited SetValues;

  3489.   fBitsPerPixel     := 16;

  3490.   fFormat           := tfXRGB4us1;

  3491.   fWithAlpha        := tfARGB4us1;

  3492.   fWithoutAlpha     := tfXRGB4us1;

  3493.   fRGBInverted      := tfXBGR4us1;

  3494.   fPrecision        := glBitmapRec4ub(4, 4, 4, 0);

  3495.   fShift            := glBitmapRec4ub(8, 4, 0, 0);

  3496. {$IFNDEF OPENGL_ES}

  3497.   fOpenGLFormat     := tfXRGB4us1;

  3498.   fglFormat         := GL_BGRA;

  3499.   fglInternalFormat := GL_RGB4;

  3500.   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;

  3501. {$ELSE}

  3502.   fOpenGLFormat     := tfR5G6B5us1;

  3503. {$ENDIF}

  3504. end;

  3505. 

  3506. procedure TfdR5G6B5us1.SetValues;

  3507. begin

  3508.   inherited SetValues;

  3509.   fBitsPerPixel     := 16;

  3510.   fFormat           := tfR5G6B5us1;

  3511.   fWithAlpha        := tfRGB5A1us1;

  3512.   fWithoutAlpha     := tfR5G6B5us1;

  3513.   fRGBInverted      := tfB5G6R5us1;

  3514.   fPrecision        := glBitmapRec4ub( 5, 6, 5, 0);

  3515.   fShift            := glBitmapRec4ub(11, 5, 0, 0);

  3516. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}

  3517.   fOpenGLFormat     := tfR5G6B5us1;

  3518.   fglFormat         := GL_RGB;

  3519.   fglInternalFormat := GL_RGB565;

  3520.   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5;

  3521. {$ELSE}

  3522.   fOpenGLFormat     := tfRGB8ub3;

  3523. {$IFEND}

  3524. end;

  3525. 

  3526. procedure TfdRGB5X1us1.SetValues;

  3527. begin

  3528.   inherited SetValues;

  3529.   fBitsPerPixel     := 16;

  3530.   fFormat           := tfRGB5X1us1;

  3531.   fWithAlpha        := tfRGB5A1us1;

  3532.   fWithoutAlpha     := tfRGB5X1us1;

  3533.   fRGBInverted      := tfBGR5X1us1;

  3534.   fPrecision        := glBitmapRec4ub( 5, 5, 5, 0);

  3535.   fShift            := glBitmapRec4ub(11, 6, 1, 0);

  3536. {$IFNDEF OPENGL_ES}

  3537.   fOpenGLFormat     := tfRGB5X1us1;

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

  3539.   fglInternalFormat := GL_RGB5;

  3540.   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;

  3541. {$ELSE}

  3542.   fOpenGLFormat     := tfR5G6B5us1;

  3543. {$ENDIF}

  3544. end;

  3545. 

  3546. procedure TfdX1RGB5us1.SetValues;

  3547. begin

  3548.   inherited SetValues;

  3549.   fBitsPerPixel     := 16;

  3550.   fFormat           := tfX1RGB5us1;

  3551.   fWithAlpha        := tfA1RGB5us1;

  3552.   fWithoutAlpha     := tfX1RGB5us1;

  3553.   fRGBInverted      := tfX1BGR5us1;

  3554.   fPrecision        := glBitmapRec4ub( 5, 5, 5, 0);

  3555.   fShift            := glBitmapRec4ub(10, 5, 0, 0);

  3556. {$IFNDEF OPENGL_ES}

  3557.   fOpenGLFormat     := tfX1RGB5us1;

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

  3559.   fglInternalFormat := GL_RGB5;

  3560.   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;

  3561. {$ELSE}

  3562.   fOpenGLFormat     := tfR5G6B5us1;

  3563. {$ENDIF}

  3564. end;

  3565. 

  3566. procedure TfdRGB8ub3.SetValues;

  3567. begin

  3568.   inherited SetValues;

  3569.   fBitsPerPixel     := 24;

  3570.   fFormat           := tfRGB8ub3;

  3571.   fWithAlpha        := tfRGBA8ub4;

  3572.   fWithoutAlpha     := tfRGB8ub3;

  3573.   fRGBInverted      := tfBGR8ub3;

  3574.   fPrecision        := glBitmapRec4ub(8, 8,  8, 0);

  3575.   fShift            := glBitmapRec4ub(0, 8, 16, 0);

  3576.   fOpenGLFormat     := tfRGB8ub3;

  3577.   fglFormat         := GL_RGB;

  3578.   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGB8{$ELSE}GL_RGB{$IFEND};

  3579.   fglDataFormat     := GL_UNSIGNED_BYTE;

  3580. end;

  3581. 

  3582. procedure TfdRGBX8ui1.SetValues;

  3583. begin

  3584.   inherited SetValues;

  3585.   fBitsPerPixel     := 32;

  3586.   fFormat           := tfRGBX8ui1;

  3587.   fWithAlpha        := tfRGBA8ui1;

  3588.   fWithoutAlpha     := tfRGBX8ui1;

  3589.   fRGBInverted      := tfBGRX8ui1;

  3590.   fPrecision        := glBitmapRec4ub( 8,  8,  8, 0);

  3591.   fShift            := glBitmapRec4ub(24, 16,  8, 0);

  3592. {$IFNDEF OPENGL_ES}

  3593.   fOpenGLFormat     := tfRGBX8ui1;

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

  3595.   fglInternalFormat := GL_RGB8;

  3596.   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;

  3597. {$ELSE}

  3598.   fOpenGLFormat     := tfRGB8ub3;

  3599. {$ENDIF}

  3600. end;

  3601. 

  3602. procedure TfdXRGB8ui1.SetValues;

  3603. begin

  3604.   inherited SetValues;

  3605.   fBitsPerPixel     := 32;

  3606.   fFormat           := tfXRGB8ui1;

  3607.   fWithAlpha        := tfXRGB8ui1;

  3608.   fWithoutAlpha     := tfXRGB8ui1;

  3609.   fOpenGLFormat     := tfXRGB8ui1;

  3610.   fRGBInverted      := tfXBGR8ui1;

  3611.   fPrecision        := glBitmapRec4ub( 8,  8,  8, 0);

  3612.   fShift            := glBitmapRec4ub(16,  8,  0, 0);

  3613. {$IFNDEF OPENGL_ES}

  3614.   fOpenGLFormat     := tfXRGB8ui1;

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

  3616.   fglInternalFormat := GL_RGB8;

  3617.   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;

  3618. {$ELSE}

  3619.   fOpenGLFormat     := tfRGB8ub3;

  3620. {$ENDIF}

  3621. end;

  3622. 

  3623. procedure TfdRGB10X2ui1.SetValues;

  3624. begin

  3625.   inherited SetValues;

  3626.   fBitsPerPixel     := 32;

  3627.   fFormat           := tfRGB10X2ui1;

  3628.   fWithAlpha        := tfRGB10A2ui1;

  3629.   fWithoutAlpha     := tfRGB10X2ui1;

  3630.   fRGBInverted      := tfBGR10X2ui1;

  3631.   fPrecision        := glBitmapRec4ub(10, 10, 10, 0);

  3632.   fShift            := glBitmapRec4ub(22, 12,  2, 0);

  3633. {$IFNDEF OPENGL_ES}

  3634.   fOpenGLFormat     := tfRGB10X2ui1;

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

  3636.   fglInternalFormat := GL_RGB10;

  3637.   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;

  3638. {$ELSE}

  3639.   fOpenGLFormat     := tfRGB16us3;

  3640. {$ENDIF}

  3641. end;

  3642. 

  3643. procedure TfdX2RGB10ui1.SetValues;

  3644. begin

  3645.   inherited SetValues;

  3646.   fBitsPerPixel     := 32;

  3647.   fFormat           := tfX2RGB10ui1;

  3648.   fWithAlpha        := tfA2RGB10ui1;

  3649.   fWithoutAlpha     := tfX2RGB10ui1;

  3650.   fRGBInverted      := tfX2BGR10ui1;

  3651.   fPrecision        := glBitmapRec4ub(10, 10, 10, 0);

  3652.   fShift            := glBitmapRec4ub(20, 10,  0, 0);

  3653. {$IFNDEF OPENGL_ES}

  3654.   fOpenGLFormat     := tfX2RGB10ui1;

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

  3656.   fglInternalFormat := GL_RGB10;

  3657.   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;

  3658. {$ELSE}

  3659.   fOpenGLFormat     := tfRGB16us3;

  3660. {$ENDIF}

  3661. end;

  3662. 

  3663. procedure TfdRGB16us3.SetValues;

  3664. begin

  3665.   inherited SetValues;

  3666.   fBitsPerPixel     := 48;

  3667.   fFormat           := tfRGB16us3;

  3668.   fWithAlpha        := tfRGBA16us4;

  3669.   fWithoutAlpha     := tfRGB16us3;

  3670.   fRGBInverted      := tfBGR16us3;

  3671.   fPrecision        := glBitmapRec4ub(16, 16, 16, 0);

  3672.   fShift            := glBitmapRec4ub( 0, 16, 32, 0);

  3673. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}

  3674.   fOpenGLFormat     := tfRGB16us3;

  3675.   fglFormat         := GL_RGB;

  3676.   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGB16{$ELSE}GL_RGB16UI{$ENDIF};

  3677.   fglDataFormat     := GL_UNSIGNED_SHORT;

  3678. {$ELSE}

  3679.   fOpenGLFormat     := tfRGB8ub3;

  3680. {$IFEND}

  3681. end;

  3682. 

  3683. procedure TfdRGBA4us1.SetValues;

  3684. begin

  3685.   inherited SetValues;

  3686.   fBitsPerPixel     := 16;

  3687.   fFormat           := tfRGBA4us1;

  3688.   fWithAlpha        := tfRGBA4us1;

  3689.   fWithoutAlpha     := tfRGBX4us1;

  3690.   fOpenGLFormat     := tfRGBA4us1;

  3691.   fRGBInverted      := tfBGRA4us1;

  3692.   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);

  3693.   fShift            := glBitmapRec4ub(12,  8,  4,  0);

  3694.   fglFormat         := GL_RGBA;

  3695.   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA8{$ELSE}GL_RGBA{$IFEND};

  3696.   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;

  3697. end;

  3698. 

  3699. procedure TfdARGB4us1.SetValues;

  3700. begin

  3701.   inherited SetValues;

  3702.   fBitsPerPixel     := 16;

  3703.   fFormat           := tfARGB4us1;

  3704.   fWithAlpha        := tfARGB4us1;

  3705.   fWithoutAlpha     := tfXRGB4us1;

  3706.   fRGBInverted      := tfABGR4us1;

  3707.   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);

  3708.   fShift            := glBitmapRec4ub( 8,  4,  0, 12);

  3709. {$IFNDEF OPENGL_ES}

  3710.   fOpenGLFormat     := tfARGB4us1;

  3711.   fglFormat         := GL_BGRA;

  3712.   fglInternalFormat := GL_RGBA4;

  3713.   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;

  3714. {$ELSE}

  3715.   fOpenGLFormat     := tfRGBA4us1;

  3716. {$ENDIF}

  3717. end;

  3718. 

  3719. procedure TfdRGB5A1us1.SetValues;

  3720. begin

  3721.   inherited SetValues;

  3722.   fBitsPerPixel     := 16;

  3723.   fFormat           := tfRGB5A1us1;

  3724.   fWithAlpha        := tfRGB5A1us1;

  3725.   fWithoutAlpha     := tfRGB5X1us1;

  3726.   fOpenGLFormat     := tfRGB5A1us1;

  3727.   fRGBInverted      := tfBGR5A1us1;

  3728.   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);

  3729.   fShift            := glBitmapRec4ub(11,  6,  1,  0);

  3730.   fglFormat         := GL_RGBA;

  3731.   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}GL_RGB5_A1{$ELSE}GL_RGBA{$IFEND};

  3732.   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;

  3733. end;

  3734. 

  3735. procedure TfdA1RGB5us1.SetValues;

  3736. begin

  3737.   inherited SetValues;

  3738.   fBitsPerPixel     := 16;

  3739.   fFormat           := tfA1RGB5us1;

  3740.   fWithAlpha        := tfA1RGB5us1;

  3741.   fWithoutAlpha     := tfX1RGB5us1;

  3742.   fRGBInverted      := tfA1BGR5us1;

  3743.   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);

  3744.   fShift            := glBitmapRec4ub(10,  5,  0, 15);

  3745. {$IFNDEF OPENGL_ES}

  3746.   fOpenGLFormat     := tfA1RGB5us1;

  3747.   fglFormat         := GL_BGRA;

  3748.   fglInternalFormat := GL_RGB5_A1;

  3749.   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;

  3750. {$ELSE}

  3751.   fOpenGLFormat     := tfRGB5A1us1;

  3752. {$ENDIF}

  3753. end;

  3754. 

  3755. procedure TfdRGBA8ui1.SetValues;

  3756. begin

  3757.   inherited SetValues;

  3758.   fBitsPerPixel     := 32;

  3759.   fFormat           := tfRGBA8ui1;

  3760.   fWithAlpha        := tfRGBA8ui1;

  3761.   fWithoutAlpha     := tfRGBX8ui1;

  3762.   fRGBInverted      := tfBGRA8ui1;

  3763.   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);

  3764.   fShift            := glBitmapRec4ub(24, 16,  8,  0);

  3765. {$IFNDEF OPENGL_ES}

  3766.   fOpenGLFormat     := tfRGBA8ui1;

  3767.   fglFormat         := GL_RGBA;

  3768.   fglInternalFormat := GL_RGBA8;

  3769.   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;

  3770. {$ELSE}

  3771.   fOpenGLFormat     := tfRGBA8ub4;

  3772. {$ENDIF}

  3773. end;

  3774. 

  3775. procedure TfdARGB8ui1.SetValues;

  3776. begin

  3777.   inherited SetValues;

  3778.   fBitsPerPixel     := 32;

  3779.   fFormat           := tfARGB8ui1;

  3780.   fWithAlpha        := tfARGB8ui1;

  3781.   fWithoutAlpha     := tfXRGB8ui1;

  3782.   fRGBInverted      := tfABGR8ui1;

  3783.   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);

  3784.   fShift            := glBitmapRec4ub(16,  8,  0, 24);

  3785. {$IFNDEF OPENGL_ES}

  3786.   fOpenGLFormat     := tfARGB8ui1;

  3787.   fglFormat         := GL_BGRA;

  3788.   fglInternalFormat := GL_RGBA8;

  3789.   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;

  3790. {$ELSE}

  3791.   fOpenGLFormat     := tfRGBA8ub4;

  3792. {$ENDIF}

  3793. end;

  3794. 

  3795. procedure TfdRGBA8ub4.SetValues;

  3796. begin

  3797.   inherited SetValues;

  3798.   fBitsPerPixel     := 32;

  3799.   fFormat           := tfRGBA8ub4;

  3800.   fWithAlpha        := tfRGBA8ub4;

  3801.   fWithoutAlpha     := tfRGB8ub3;

  3802.   fOpenGLFormat     := tfRGBA8ub4;

  3803.   fRGBInverted      := tfBGRA8ub4;

  3804.   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);

  3805.   fShift            := glBitmapRec4ub( 0,  8, 16, 24);

  3806.   fglFormat         := GL_RGBA;

  3807.   fglInternalFormat := {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}GL_RGBA8{$ELSE}GL_RGBA{$IFEND};

  3808.   fglDataFormat     := GL_UNSIGNED_BYTE;

  3809. end;

  3810. 

  3811. procedure TfdRGB10A2ui1.SetValues;

  3812. begin

  3813.   inherited SetValues;

  3814.   fBitsPerPixel     := 32;

  3815.   fFormat           := tfRGB10A2ui1;

  3816.   fWithAlpha        := tfRGB10A2ui1;

  3817.   fWithoutAlpha     := tfRGB10X2ui1;

  3818.   fRGBInverted      := tfBGR10A2ui1;

  3819.   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);

  3820.   fShift            := glBitmapRec4ub(22, 12,  2,  0);

  3821. {$IFNDEF OPENGL_ES}

  3822.   fOpenGLFormat     := tfRGB10A2ui1;

  3823.   fglFormat         := GL_RGBA;

  3824.   fglInternalFormat := GL_RGB10_A2;

  3825.   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;

  3826. {$ELSE}

  3827.   fOpenGLFormat     := tfA2RGB10ui1;

  3828. {$ENDIF}

  3829. end;

  3830. 

  3831. procedure TfdA2RGB10ui1.SetValues;

  3832. begin

  3833.   inherited SetValues;

  3834.   fBitsPerPixel     := 32;

  3835.   fFormat           := tfA2RGB10ui1;

  3836.   fWithAlpha        := tfA2RGB10ui1;

  3837.   fWithoutAlpha     := tfX2RGB10ui1;

  3838.   fRGBInverted      := tfA2BGR10ui1;

  3839.   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);

  3840.   fShift            := glBitmapRec4ub(20, 10,  0, 30);

  3841. {$IF NOT DEFINED(OPENGL_ES)}

  3842.   fOpenGLFormat     := tfA2RGB10ui1;

  3843.   fglFormat         := GL_BGRA;

  3844.   fglInternalFormat := GL_RGB10_A2;

  3845.   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;

  3846. {$ELSEIF DEFINED(OPENGL_ES_3_0)}

  3847.   fOpenGLFormat     := tfA2RGB10ui1;

  3848.   fglFormat         := GL_RGBA;

  3849.   fglInternalFormat := GL_RGB10_A2;

  3850.   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;

  3851. {$ELSE}

  3852.   fOpenGLFormat     := tfRGBA8ui1;

  3853. {$IFEND}

  3854. end;

  3855. 

  3856. procedure TfdRGBA16us4.SetValues;

  3857. begin

  3858.   inherited SetValues;

  3859.   fBitsPerPixel     := 64;

  3860.   fFormat           := tfRGBA16us4;

  3861.   fWithAlpha        := tfRGBA16us4;

  3862.   fWithoutAlpha     := tfRGB16us3;

  3863.   fRGBInverted      := tfBGRA16us4;

  3864.   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);

  3865.   fShift            := glBitmapRec4ub( 0, 16, 32, 48);

  3866. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}

  3867.   fOpenGLFormat     := tfRGBA16us4;

  3868.   fglFormat         := GL_RGBA;

  3869.   fglInternalFormat := {$IFNDEF OPENGL_ES}GL_RGBA16{$ELSE}GL_RGBA16UI{$ENDIF};

  3870.   fglDataFormat     := GL_UNSIGNED_SHORT;

  3871. {$ELSE}

  3872.   fOpenGLFormat     := tfRGBA8ub4;

  3873. {$IFEND}

  3874. end;

  3875. 

  3876. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3877. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3878. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  3879. procedure TfdBGRX4us1.SetValues;

  3880. begin

  3881.   inherited SetValues;

  3882.   fBitsPerPixel     := 16;

  3883.   fFormat           := tfBGRX4us1;

  3884.   fWithAlpha        := tfBGRA4us1;

  3885.   fWithoutAlpha     := tfBGRX4us1;

  3886.   fRGBInverted      := tfRGBX4us1;

  3887.   fPrecision        := glBitmapRec4ub( 4,  4,  4,  0);

  3888.   fShift            := glBitmapRec4ub( 4,  8, 12,  0);

  3889. {$IFNDEF OPENGL_ES}

  3890.   fOpenGLFormat     := tfBGRX4us1;

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

  3892.   fglInternalFormat := GL_RGB4;

  3893.   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;

  3894. {$ELSE}

  3895.   fOpenGLFormat     := tfR5G6B5us1;

  3896. {$ENDIF}

  3897. end;

  3898. 

  3899. procedure TfdXBGR4us1.SetValues;

  3900. begin

  3901.   inherited SetValues;

  3902.   fBitsPerPixel     := 16;

  3903.   fFormat           := tfXBGR4us1;

  3904.   fWithAlpha        := tfABGR4us1;

  3905.   fWithoutAlpha     := tfXBGR4us1;

  3906.   fRGBInverted      := tfXRGB4us1;

  3907.   fPrecision        := glBitmapRec4ub( 4,  4,  4,  0);

  3908.   fShift            := glBitmapRec4ub( 0,  4,  8,  0);

  3909. {$IFNDEF OPENGL_ES}

  3910.   fOpenGLFormat     := tfXBGR4us1;

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

  3912.   fglInternalFormat := GL_RGB4;

  3913.   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;

  3914. {$ELSE}

  3915.   fOpenGLFormat     := tfR5G6B5us1;

  3916. {$ENDIF}

  3917. end;

  3918. 

  3919. procedure TfdB5G6R5us1.SetValues;

  3920. begin

  3921.   inherited SetValues;

  3922.   fBitsPerPixel     := 16;

  3923.   fFormat           := tfB5G6R5us1;

  3924.   fWithAlpha        := tfBGR5A1us1;

  3925.   fWithoutAlpha     := tfB5G6R5us1;

  3926.   fRGBInverted      := tfR5G6B5us1;

  3927.   fPrecision        := glBitmapRec4ub( 5,  6,  5,  0);

  3928.   fShift            := glBitmapRec4ub( 0,  5, 11,  0);

  3929. {$IFNDEF OPENGL_ES}

  3930.   fOpenGLFormat     := tfB5G6R5us1;

  3931.   fglFormat         := GL_RGB;

  3932.   fglInternalFormat := GL_RGB565;

  3933.   fglDataFormat     := GL_UNSIGNED_SHORT_5_6_5_REV;

  3934. {$ELSE}

  3935.   fOpenGLFormat     := tfR5G6B5us1;

  3936. {$ENDIF}

  3937. end;

  3938. 

  3939. procedure TfdBGR5X1us1.SetValues;

  3940. begin

  3941.   inherited SetValues;

  3942.   fBitsPerPixel     := 16;

  3943.   fFormat           := tfBGR5X1us1;

  3944.   fWithAlpha        := tfBGR5A1us1;

  3945.   fWithoutAlpha     := tfBGR5X1us1;

  3946.   fRGBInverted      := tfRGB5X1us1;

  3947.   fPrecision        := glBitmapRec4ub( 5,  5,  5,  0);

  3948.   fShift            := glBitmapRec4ub( 1,  6, 11,  0);

  3949. {$IFNDEF OPENGL_ES}

  3950.   fOpenGLFormat     := tfBGR5X1us1;

  3951.   fglFormat         := GL_BGRA;

  3952.   fglInternalFormat := GL_RGB5;

  3953.   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;

  3954. {$ELSE}

  3955.   fOpenGLFormat     := tfR5G6B5us1;

  3956. {$ENDIF}

  3957. end;

  3958. 

  3959. procedure TfdX1BGR5us1.SetValues;

  3960. begin

  3961.   inherited SetValues;

  3962.   fBitsPerPixel     := 16;

  3963.   fFormat           := tfX1BGR5us1;

  3964.   fWithAlpha        := tfA1BGR5us1;

  3965.   fWithoutAlpha     := tfX1BGR5us1;

  3966.   fRGBInverted      := tfX1RGB5us1;

  3967.   fPrecision        := glBitmapRec4ub( 5,  5,  5,  0);

  3968.   fShift            := glBitmapRec4ub( 0,  5, 10,  0);

  3969. {$IFNDEF OPENGL_ES}

  3970.   fOpenGLFormat     := tfX1BGR5us1;

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

  3972.   fglInternalFormat := GL_RGB5;

  3973.   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;

  3974. {$ELSE}

  3975.   fOpenGLFormat     := tfR5G6B5us1;

  3976. {$ENDIF}

  3977. end;

  3978. 

  3979. procedure TfdBGR8ub3.SetValues;

  3980. begin

  3981.   inherited SetValues;

  3982.   fBitsPerPixel     := 24;

  3983.   fFormat           := tfBGR8ub3;

  3984.   fWithAlpha        := tfBGRA8ub4;

  3985.   fWithoutAlpha     := tfBGR8ub3;

  3986.   fRGBInverted      := tfRGB8ub3;

  3987.   fPrecision        := glBitmapRec4ub( 8,  8,  8,  0);

  3988.   fShift            := glBitmapRec4ub(16,  8,  0,  0);

  3989. {$IFNDEF OPENGL_ES}

  3990.   fOpenGLFormat     := tfBGR8ub3;

  3991.   fglFormat         := GL_BGR;

  3992.   fglInternalFormat := GL_RGB8;

  3993.   fglDataFormat     := GL_UNSIGNED_BYTE;

  3994. {$ELSE}

  3995.   fOpenGLFormat     := tfRGB8ub3;

  3996. {$ENDIF}

  3997. end;

  3998. 

  3999. procedure TfdBGRX8ui1.SetValues;

  4000. begin

  4001.   inherited SetValues;

  4002.   fBitsPerPixel     := 32;

  4003.   fFormat           := tfBGRX8ui1;

  4004.   fWithAlpha        := tfBGRA8ui1;

  4005.   fWithoutAlpha     := tfBGRX8ui1;

  4006.   fRGBInverted      := tfRGBX8ui1;

  4007.   fPrecision        := glBitmapRec4ub( 8,  8,  8,  0);

  4008.   fShift            := glBitmapRec4ub( 8, 16, 24,  0);

  4009. {$IFNDEF OPENGL_ES}

  4010.   fOpenGLFormat     := tfBGRX8ui1;

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

  4012.   fglInternalFormat := GL_RGB8;

  4013.   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;

  4014. {$ELSE}

  4015.   fOpenGLFormat     := tfRGB8ub3;

  4016. {$ENDIF}

  4017. end;

  4018. 

  4019. procedure TfdXBGR8ui1.SetValues;

  4020. begin

  4021.   inherited SetValues;

  4022.   fBitsPerPixel     := 32;

  4023.   fFormat           := tfXBGR8ui1;

  4024.   fWithAlpha        := tfABGR8ui1;

  4025.   fWithoutAlpha     := tfXBGR8ui1;

  4026.   fRGBInverted      := tfXRGB8ui1;

  4027.   fPrecision        := glBitmapRec4ub( 8,  8,  8,  0);

  4028.   fShift            := glBitmapRec4ub( 0,  8, 16,  0);

  4029. {$IFNDEF OPENGL_ES}

  4030.   fOpenGLFormat     := tfXBGR8ui1;

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

  4032.   fglInternalFormat := GL_RGB8;

  4033.   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;

  4034. {$ELSE}

  4035.   fOpenGLFormat     := tfRGB8ub3;

  4036. {$ENDIF}

  4037. end;

  4038. 

  4039. procedure TfdBGR10X2ui1.SetValues;

  4040. begin

  4041.   inherited SetValues;

  4042.   fBitsPerPixel     := 32;

  4043.   fFormat           := tfBGR10X2ui1;

  4044.   fWithAlpha        := tfBGR10A2ui1;

  4045.   fWithoutAlpha     := tfBGR10X2ui1;

  4046.   fRGBInverted      := tfRGB10X2ui1;

  4047.   fPrecision        := glBitmapRec4ub(10, 10, 10,  0);

  4048.   fShift            := glBitmapRec4ub( 2, 12, 22,  0);

  4049. {$IFNDEF OPENGL_ES}

  4050.   fOpenGLFormat     := tfBGR10X2ui1;

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

  4052.   fglInternalFormat := GL_RGB10;

  4053.   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;

  4054. {$ELSE}

  4055.   fOpenGLFormat     := tfRGB16us3;

  4056. {$ENDIF}

  4057. end;

  4058. 

  4059. procedure TfdX2BGR10ui1.SetValues;

  4060. begin

  4061.   inherited SetValues;

  4062.   fBitsPerPixel     := 32;

  4063.   fFormat           := tfX2BGR10ui1;

  4064.   fWithAlpha        := tfA2BGR10ui1;

  4065.   fWithoutAlpha     := tfX2BGR10ui1;

  4066.   fRGBInverted      := tfX2RGB10ui1;

  4067.   fPrecision        := glBitmapRec4ub(10, 10, 10,  0);

  4068.   fShift            := glBitmapRec4ub( 0, 10, 20,  0);

  4069. {$IFNDEF OPENGL_ES}

  4070.   fOpenGLFormat     := tfX2BGR10ui1;

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

  4072.   fglInternalFormat := GL_RGB10;

  4073.   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;

  4074. {$ELSE}

  4075.   fOpenGLFormat     := tfRGB16us3;

  4076. {$ENDIF}

  4077. end;

  4078. 

  4079. procedure TfdBGR16us3.SetValues;

  4080. begin

  4081.   inherited SetValues;

  4082.   fBitsPerPixel     := 48;

  4083.   fFormat           := tfBGR16us3;

  4084.   fWithAlpha        := tfBGRA16us4;

  4085.   fWithoutAlpha     := tfBGR16us3;

  4086.   fRGBInverted      := tfRGB16us3;

  4087.   fPrecision        := glBitmapRec4ub(16, 16, 16,  0);

  4088.   fShift            := glBitmapRec4ub(32, 16,  0,  0);

  4089. {$IFNDEF OPENGL_ES}

  4090.   fOpenGLFormat     := tfBGR16us3;

  4091.   fglFormat         := GL_BGR;

  4092.   fglInternalFormat := GL_RGB16;

  4093.   fglDataFormat     := GL_UNSIGNED_SHORT;

  4094. {$ELSE}

  4095.   fOpenGLFormat     := tfRGB16us3;

  4096. {$ENDIF}

  4097. end;

  4098. 

  4099. procedure TfdBGRA4us1.SetValues;

  4100. begin

  4101.   inherited SetValues;

  4102.   fBitsPerPixel     := 16;

  4103.   fFormat           := tfBGRA4us1;

  4104.   fWithAlpha        := tfBGRA4us1;

  4105.   fWithoutAlpha     := tfBGRX4us1;

  4106.   fRGBInverted      := tfRGBA4us1;

  4107.   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);

  4108.   fShift            := glBitmapRec4ub( 4,  8, 12,  0);

  4109. {$IFNDEF OPENGL_ES}

  4110.   fOpenGLFormat     := tfBGRA4us1;

  4111.   fglFormat         := GL_BGRA;

  4112.   fglInternalFormat := GL_RGBA4;

  4113.   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4;

  4114. {$ELSE}

  4115.   fOpenGLFormat     := tfRGBA4us1;

  4116. {$ENDIF}

  4117. end;

  4118. 

  4119. procedure TfdABGR4us1.SetValues;

  4120. begin

  4121.   inherited SetValues;

  4122.   fBitsPerPixel     := 16;

  4123.   fFormat           := tfABGR4us1;

  4124.   fWithAlpha        := tfABGR4us1;

  4125.   fWithoutAlpha     := tfXBGR4us1;

  4126.   fRGBInverted      := tfARGB4us1;

  4127.   fPrecision        := glBitmapRec4ub( 4,  4,  4,  4);

  4128.   fShift            := glBitmapRec4ub( 0,  4,  8, 12);

  4129. {$IFNDEF OPENGL_ES}

  4130.   fOpenGLFormat     := tfABGR4us1;

  4131.   fglFormat         := GL_RGBA;

  4132.   fglInternalFormat := GL_RGBA4;

  4133.   fglDataFormat     := GL_UNSIGNED_SHORT_4_4_4_4_REV;

  4134. {$ELSE}

  4135.   fOpenGLFormat     := tfRGBA4us1;

  4136. {$ENDIF}

  4137. end;

  4138. 

  4139. procedure TfdBGR5A1us1.SetValues;

  4140. begin

  4141.   inherited SetValues;

  4142.   fBitsPerPixel     := 16;

  4143.   fFormat           := tfBGR5A1us1;

  4144.   fWithAlpha        := tfBGR5A1us1;

  4145.   fWithoutAlpha     := tfBGR5X1us1;

  4146.   fRGBInverted      := tfRGB5A1us1;

  4147.   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);

  4148.   fShift            := glBitmapRec4ub( 1,  6, 11,  0);

  4149. {$IFNDEF OPENGL_ES}

  4150.   fOpenGLFormat     := tfBGR5A1us1;

  4151.   fglFormat         := GL_BGRA;

  4152.   fglInternalFormat := GL_RGB5_A1;

  4153.   fglDataFormat     := GL_UNSIGNED_SHORT_5_5_5_1;

  4154. {$ELSE}

  4155.   fOpenGLFormat     := tfRGB5A1us1;

  4156. {$ENDIF}

  4157. end;

  4158. 

  4159. procedure TfdA1BGR5us1.SetValues;

  4160. begin

  4161.   inherited SetValues;

  4162.   fBitsPerPixel     := 16;

  4163.   fFormat           := tfA1BGR5us1;

  4164.   fWithAlpha        := tfA1BGR5us1;

  4165.   fWithoutAlpha     := tfX1BGR5us1;

  4166.   fRGBInverted      := tfA1RGB5us1;

  4167.   fPrecision        := glBitmapRec4ub( 5,  5,  5,  1);

  4168.   fShift            := glBitmapRec4ub( 0,  5, 10, 15);

  4169. {$IFNDEF OPENGL_ES}

  4170.   fOpenGLFormat     := tfA1BGR5us1;

  4171.   fglFormat         := GL_RGBA;

  4172.   fglInternalFormat := GL_RGB5_A1;

  4173.   fglDataFormat     := GL_UNSIGNED_SHORT_1_5_5_5_REV;

  4174. {$ELSE}

  4175.   fOpenGLFormat     := tfRGB5A1us1;

  4176. {$ENDIF}

  4177. end;

  4178. 

  4179. procedure TfdBGRA8ui1.SetValues;

  4180. begin

  4181.   inherited SetValues;

  4182.   fBitsPerPixel     := 32;

  4183.   fFormat           := tfBGRA8ui1;

  4184.   fWithAlpha        := tfBGRA8ui1;

  4185.   fWithoutAlpha     := tfBGRX8ui1;

  4186.   fRGBInverted      := tfRGBA8ui1;

  4187.   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);

  4188.   fShift            := glBitmapRec4ub( 8, 16, 24,  0);

  4189. {$IFNDEF OPENGL_ES}

  4190.   fOpenGLFormat     := tfBGRA8ui1;

  4191.   fglFormat         := GL_BGRA;

  4192.   fglInternalFormat := GL_RGBA8;

  4193.   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8;

  4194. {$ELSE}

  4195.   fOpenGLFormat     := tfRGBA8ub4;

  4196. {$ENDIF}

  4197. end;

  4198. 

  4199. procedure TfdABGR8ui1.SetValues;

  4200. begin

  4201.   inherited SetValues;

  4202.   fBitsPerPixel     := 32;

  4203.   fFormat           := tfABGR8ui1;

  4204.   fWithAlpha        := tfABGR8ui1;

  4205.   fWithoutAlpha     := tfXBGR8ui1;

  4206.   fRGBInverted      := tfARGB8ui1;

  4207.   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);

  4208.   fShift            := glBitmapRec4ub( 0,  8, 16, 24);

  4209. {$IFNDEF OPENGL_ES}

  4210.   fOpenGLFormat     := tfABGR8ui1;

  4211.   fglFormat         := GL_RGBA;

  4212.   fglInternalFormat := GL_RGBA8;

  4213.   fglDataFormat     := GL_UNSIGNED_INT_8_8_8_8_REV;

  4214. {$ELSE}

  4215.   fOpenGLFormat     := tfRGBA8ub4

  4216. {$ENDIF}

  4217. end;

  4218. 

  4219. procedure TfdBGRA8ub4.SetValues;

  4220. begin

  4221.   inherited SetValues;

  4222.   fBitsPerPixel     := 32;

  4223.   fFormat           := tfBGRA8ub4;

  4224.   fWithAlpha        := tfBGRA8ub4;

  4225.   fWithoutAlpha     := tfBGR8ub3;

  4226.   fRGBInverted      := tfRGBA8ub4;

  4227.   fPrecision        := glBitmapRec4ub( 8,  8,  8,  8);

  4228.   fShift            := glBitmapRec4ub(16,  8,  0, 24);

  4229. {$IFNDEF OPENGL_ES}

  4230.   fOpenGLFormat     := tfBGRA8ub4;

  4231.   fglFormat         := GL_BGRA;

  4232.   fglInternalFormat := GL_RGBA8;

  4233.   fglDataFormat     := GL_UNSIGNED_BYTE;

  4234. {$ELSE}

  4235.   fOpenGLFormat     := tfRGBA8ub4;

  4236. {$ENDIF}

  4237. end;

  4238. 

  4239. procedure TfdBGR10A2ui1.SetValues;

  4240. begin

  4241.   inherited SetValues;

  4242.   fBitsPerPixel     := 32;

  4243.   fFormat           := tfBGR10A2ui1;

  4244.   fWithAlpha        := tfBGR10A2ui1;

  4245.   fWithoutAlpha     := tfBGR10X2ui1;

  4246.   fRGBInverted      := tfRGB10A2ui1;

  4247.   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);

  4248.   fShift            := glBitmapRec4ub( 2, 12, 22,  0);

  4249. {$IFNDEF OPENGL_ES}

  4250.   fOpenGLFormat     := tfBGR10A2ui1;

  4251.   fglFormat         := GL_BGRA;

  4252.   fglInternalFormat := GL_RGB10_A2;

  4253.   fglDataFormat     := GL_UNSIGNED_INT_10_10_10_2;

  4254. {$ELSE}

  4255.   fOpenGLFormat     := tfA2RGB10ui1;

  4256. {$ENDIF}

  4257. end;

  4258. 

  4259. procedure TfdA2BGR10ui1.SetValues;

  4260. begin

  4261.   inherited SetValues;

  4262.   fBitsPerPixel     := 32;

  4263.   fFormat           := tfA2BGR10ui1;

  4264.   fWithAlpha        := tfA2BGR10ui1;

  4265.   fWithoutAlpha     := tfX2BGR10ui1;

  4266.   fRGBInverted      := tfA2RGB10ui1;

  4267.   fPrecision        := glBitmapRec4ub(10, 10, 10,  2);

  4268.   fShift            := glBitmapRec4ub( 0, 10, 20, 30);

  4269. {$IFNDEF OPENGL_ES}

  4270.   fOpenGLFormat     := tfA2BGR10ui1;

  4271.   fglFormat         := GL_RGBA;

  4272.   fglInternalFormat := GL_RGB10_A2;

  4273.   fglDataFormat     := GL_UNSIGNED_INT_2_10_10_10_REV;

  4274. {$ELSE}

  4275.   fOpenGLFormat     := tfA2RGB10ui1;

  4276. {$ENDIF}

  4277. end;

  4278. 

  4279. procedure TfdBGRA16us4.SetValues;

  4280. begin

  4281.   inherited SetValues;

  4282.   fBitsPerPixel     := 64;

  4283.   fFormat           := tfBGRA16us4;

  4284.   fWithAlpha        := tfBGRA16us4;

  4285.   fWithoutAlpha     := tfBGR16us3;

  4286.   fRGBInverted      := tfRGBA16us4;

  4287.   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);

  4288.   fShift            := glBitmapRec4ub(32, 16,  0, 48);

  4289. {$IFNDEF OPENGL_ES}

  4290.   fOpenGLFormat     := tfBGRA16us4;

  4291.   fglFormat         := GL_BGRA;

  4292.   fglInternalFormat := GL_RGBA16;

  4293.   fglDataFormat     := GL_UNSIGNED_SHORT;

  4294. {$ELSE}

  4295.   fOpenGLFormat     := tfRGBA16us4;

  4296. {$ENDIF}

  4297. end;

  4298. 

  4299. procedure TfdDepth16us1.SetValues;

  4300. begin

  4301.   inherited SetValues;

  4302.   fBitsPerPixel     := 16;

  4303.   fFormat           := tfDepth16us1;

  4304.   fWithoutAlpha     := tfDepth16us1;

  4305.   fPrecision        := glBitmapRec4ub(16, 16, 16, 16);

  4306.   fShift            := glBitmapRec4ub( 0,  0,  0,  0);

  4307. {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}

  4308.   fOpenGLFormat     := tfDepth16us1;

  4309.   fglFormat         := GL_DEPTH_COMPONENT;

  4310.   fglInternalFormat := GL_DEPTH_COMPONENT16;

  4311.   fglDataFormat     := GL_UNSIGNED_SHORT;

  4312. {$IFEND}

  4313. end;

  4314. 

  4315. procedure TfdDepth24ui1.SetValues;

  4316. begin

  4317.   inherited SetValues;

  4318.   fBitsPerPixel     := 32;

  4319.   fFormat           := tfDepth24ui1;

  4320.   fWithoutAlpha     := tfDepth24ui1;

  4321.   fOpenGLFormat     := tfDepth24ui1;

  4322.   fPrecision        := glBitmapRec4ub(32, 32, 32, 32);

  4323.   fShift            := glBitmapRec4ub( 0,  0,  0,  0);

  4324. {$IF NOT DEFINED (OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}

  4325.   fOpenGLFormat     := tfDepth24ui1;

  4326.   fglFormat         := GL_DEPTH_COMPONENT;

  4327.   fglInternalFormat := GL_DEPTH_COMPONENT24;

  4328.   fglDataFormat     := GL_UNSIGNED_INT;

  4329. {$IFEND}

  4330. end;

  4331. 

  4332. procedure TfdDepth32ui1.SetValues;

  4333. begin

  4334.   inherited SetValues;

  4335.   fBitsPerPixel     := 32;

  4336.   fFormat           := tfDepth32ui1;

  4337.   fWithoutAlpha     := tfDepth32ui1;

  4338.   fPrecision        := glBitmapRec4ub(32, 32, 32, 32);

  4339.   fShift            := glBitmapRec4ub( 0,  0,  0,  0);

  4340. {$IF NOT DEFINED(OPENGL_ES)}

  4341.   fOpenGLFormat     := tfDepth32ui1;

  4342.   fglFormat         := GL_DEPTH_COMPONENT;

  4343.   fglInternalFormat := GL_DEPTH_COMPONENT32;

  4344.   fglDataFormat     := GL_UNSIGNED_INT;

  4345. {$ELSEIF DEFINED(OPENGL_ES_3_0)}

  4346.   fOpenGLFormat     := tfDepth24ui1;

  4347. {$ELSEIF DEFINED(OPENGL_ES_2_0)}

  4348.   fOpenGLFormat     := tfDepth16us1;

  4349. {$IFEND}

  4350. end;

  4351. 

  4352. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4353. //TfdS3tcDtx1RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4354. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  4356. begin

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

  4358. end;

  4359. 

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

  4361. begin

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

  4363. end;

  4364. 

  4365. procedure TfdS3tcDtx1RGBA.SetValues;

  4366. begin

  4367.   inherited SetValues;

  4368.   fFormat           := tfS3tcDtx1RGBA;

  4369.   fWithAlpha        := tfS3tcDtx1RGBA;

  4370.   fUncompressed     := tfRGB5A1us1;

  4371.   fBitsPerPixel     := 4;

  4372.   fIsCompressed     := true;

  4373. {$IFNDEF OPENGL_ES}

  4374.   fOpenGLFormat     := tfS3tcDtx1RGBA;

  4375.   fglFormat         := GL_COMPRESSED_RGBA;

  4376.   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;

  4377.   fglDataFormat     := GL_UNSIGNED_BYTE;

  4378. {$ELSE}

  4379.   fOpenGLFormat     := fUncompressed;

  4380. {$ENDIF}

  4381. end;

  4382. 

  4383. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4384. //TfdS3tcDtx3RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4385. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  4387. begin

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

  4389. end;

  4390. 

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

  4392. begin

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

  4394. end;

  4395. 

  4396. procedure TfdS3tcDtx3RGBA.SetValues;

  4397. begin

  4398.   inherited SetValues;

  4399.   fFormat           := tfS3tcDtx3RGBA;

  4400.   fWithAlpha        := tfS3tcDtx3RGBA;

  4401.   fUncompressed     := tfRGBA8ub4;

  4402.   fBitsPerPixel     := 8;

  4403.   fIsCompressed     := true;

  4404. {$IFNDEF OPENGL_ES}

  4405.   fOpenGLFormat     := tfS3tcDtx3RGBA;

  4406.   fglFormat         := GL_COMPRESSED_RGBA;

  4407.   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;

  4408.   fglDataFormat     := GL_UNSIGNED_BYTE;

  4409. {$ELSE}

  4410.   fOpenGLFormat     := fUncompressed;

  4411. {$ENDIF}

  4412. end;

  4413. 

  4414. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4415. //TfdS3tcDtx5RGBA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4416. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  4418. begin

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

  4420. end;

  4421. 

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

  4423. begin

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

  4425. end;

  4426. 

  4427. procedure TfdS3tcDtx5RGBA.SetValues;

  4428. begin

  4429.   inherited SetValues;

  4430.   fFormat           := tfS3tcDtx3RGBA;

  4431.   fWithAlpha        := tfS3tcDtx3RGBA;

  4432.   fUncompressed     := tfRGBA8ub4;

  4433.   fBitsPerPixel     := 8;

  4434.   fIsCompressed     := true;

  4435. {$IFNDEF OPENGL_ES}

  4436.   fOpenGLFormat     := tfS3tcDtx3RGBA;

  4437.   fglFormat         := GL_COMPRESSED_RGBA;

  4438.   fglInternalFormat := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;

  4439.   fglDataFormat     := GL_UNSIGNED_BYTE;

  4440. {$ELSE}

  4441.   fOpenGLFormat     := fUncompressed;

  4442. {$ENDIF}

  4443. end;

  4444. 

  4445. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4446. //TglBitmapFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4447. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4448. function TglBitmapFormatDescriptor.GetHasRed: Boolean;

  4449. begin

  4450.   result := (fPrecision.r > 0);

  4451. end;

  4452. 

  4453. function TglBitmapFormatDescriptor.GetHasGreen: Boolean;

  4454. begin

  4455.   result := (fPrecision.g > 0);

  4456. end;

  4457. 

  4458. function TglBitmapFormatDescriptor.GetHasBlue: Boolean;

  4459. begin

  4460.   result := (fPrecision.b > 0);

  4461. end;

  4462. 

  4463. function TglBitmapFormatDescriptor.GetHasAlpha: Boolean;

  4464. begin

  4465.   result := (fPrecision.a > 0);

  4466. end;

  4467. 

  4468. function TglBitmapFormatDescriptor.GetHasColor: Boolean;

  4469. begin

  4470.   result := HasRed or HasGreen or HasBlue;

  4471. end;

  4472. 

  4473. function TglBitmapFormatDescriptor.GetIsGrayscale: Boolean;

  4474. begin

  4475.   result := (Mask.r = Mask.g) and (Mask.g = Mask.b) and (Mask.r > 0);

  4476. end;

  4477. 

  4478. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4479. procedure TglBitmapFormatDescriptor.SetValues;

  4480. begin

  4481.   fFormat       := tfEmpty;

  4482.   fWithAlpha    := tfEmpty;

  4483.   fWithoutAlpha := tfEmpty;

  4484.   fOpenGLFormat := tfEmpty;

  4485.   fRGBInverted  := tfEmpty;

  4486.   fUncompressed := tfEmpty;

  4487. 

  4488.   fBitsPerPixel := 0;

  4489.   fIsCompressed := false;

  4490. 

  4491.   fglFormat         := 0;

  4492.   fglInternalFormat := 0;

  4493.   fglDataFormat     := 0;

  4494. 

  4495.   FillChar(fPrecision, 0, SizeOf(fPrecision));

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

  4497. end;

  4498. 

  4499. procedure TglBitmapFormatDescriptor.CalcValues;

  4500. var

  4501.   i: Integer;

  4502. begin

  4503.   fBytesPerPixel := fBitsPerPixel / 8;

  4504.   fChannelCount  := 0;

  4505.   for i := 0 to 3 do begin

  4506.     if (fPrecision.arr[i] > 0) then

  4507.       inc(fChannelCount);

  4508.     fRange.arr[i] := (1 shl fPrecision.arr[i]) - 1;

  4509.     fMask.arr[i]  := fRange.arr[i] shl fShift.arr[i];

  4510.   end;

  4511. end;

  4512. 

  4513. constructor TglBitmapFormatDescriptor.Create;

  4514. begin

  4515.   inherited Create;

  4516.   SetValues;

  4517.   CalcValues;

  4518. end;

  4519. 

  4520. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4521. class function TglBitmapFormatDescriptor.GetByFormat(const aInternalFormat: GLenum): TglBitmapFormatDescriptor;

  4522. var

  4523.   f: TglBitmapFormat;

  4524. begin

  4525.   for f := Low(TglBitmapFormat) to High(TglBitmapFormat) do begin

  4526.     result := TFormatDescriptor.Get(f);

  4527.     if (result.glInternalFormat = aInternalFormat) then

  4528.       exit;

  4529.   end;

  4530.   result := TFormatDescriptor.Get(tfEmpty);

  4531. end;

  4532. 

  4533. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4534. //TFormatDescriptor///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4535. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4536. class procedure TFormatDescriptor.Init;

  4537. begin

  4538.   if not Assigned(FormatDescriptorCS) then

  4539.     FormatDescriptorCS := TCriticalSection.Create;

  4540. end;

  4541. 

  4542. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  4544. begin

  4545.   FormatDescriptorCS.Enter;

  4546.   try

  4547.     result := FormatDescriptors[aFormat];

  4548.     if not Assigned(result) then begin

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

  4550.       FormatDescriptors[aFormat] := result;

  4551.     end;

  4552.   finally

  4553.     FormatDescriptorCS.Leave;

  4554.   end;

  4555. end;

  4556. 

  4557. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4558. class function TFormatDescriptor.GetAlpha(const aFormat: TglBitmapFormat): TFormatDescriptor;

  4559. begin

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

  4561. end;

  4562. 

  4563. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4564. class function TFormatDescriptor.GetFromMask(const aMask: TglBitmapRec4ul; const aBitCount: Integer): TFormatDescriptor;

  4565. var

  4566.   ft: TglBitmapFormat;

  4567. begin

  4568.   // find matching format with OpenGL support

  4569.   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin

  4570.     result := Get(ft);

  4571.     if (result.MaskMatch(aMask))      and

  4572.        (result.glFormat <> 0)         and

  4573.        (result.glInternalFormat <> 0) and

  4574.        ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))

  4575.     then

  4576.       exit;

  4577.   end;

  4578. 

  4579.   // find matching format without OpenGL Support

  4580.   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin

  4581.     result := Get(ft);

  4582.     if result.MaskMatch(aMask) and ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then

  4583.       exit;

  4584.   end;

  4585. 

  4586.   result := TFormatDescriptor.Get(tfEmpty);

  4587. end;

  4588. 

  4589. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4590. class function TFormatDescriptor.GetFromPrecShift(const aPrec, aShift: TglBitmapRec4ub; const aBitCount: Integer): TFormatDescriptor;

  4591. var

  4592.   ft: TglBitmapFormat;

  4593. begin

  4594.   // find matching format with OpenGL support

  4595.   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin

  4596.     result := Get(ft);

  4597.     if glBitmapRec4ubCompare(result.Shift,     aShift) and

  4598.        glBitmapRec4ubCompare(result.Precision, aPrec) and

  4599.        (result.glFormat <> 0)         and

  4600.        (result.glInternalFormat <> 0) and

  4601.        ((aBitCount = 0) or (aBitCount = result.BitsPerPixel))

  4602.     then

  4603.       exit;

  4604.   end;

  4605. 

  4606.   // find matching format without OpenGL Support

  4607.   for ft := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin

  4608.     result := Get(ft);

  4609.     if glBitmapRec4ubCompare(result.Shift,     aShift) and

  4610.        glBitmapRec4ubCompare(result.Precision, aPrec)  and

  4611.        ((aBitCount = 0) or (aBitCount = result.BitsPerPixel)) then

  4612.       exit;

  4613.   end;

  4614. 

  4615.   result := TFormatDescriptor.Get(tfEmpty);

  4616. end;

  4617. 

  4618. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4619. class procedure TFormatDescriptor.Clear;

  4620. var

  4621.   f: TglBitmapFormat;

  4622. begin

  4623.   FormatDescriptorCS.Enter;

  4624.   try

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

  4626.       FreeAndNil(FormatDescriptors[f]);

  4627.   finally

  4628.     FormatDescriptorCS.Leave;

  4629.   end;

  4630. end;

  4631. 

  4632. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4633. class procedure TFormatDescriptor.Finalize;

  4634. begin

  4635.   Clear;

  4636.   FreeAndNil(FormatDescriptorCS);

  4637. end;

  4638. 

  4639. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4640. //TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4641. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4642. procedure TbmpBitfieldFormat.SetCustomValues(const aBPP: Integer; aMask: TglBitmapRec4ul);

  4643. var

  4644.   i: Integer;

  4645. begin

  4646.   for i := 0 to 3 do begin

  4647.     fShift.arr[i] := 0;

  4648.     while (aMask.arr[i] > 0) and (aMask.arr[i] and 1 > 0) do begin

  4649.       aMask.arr[i] := aMask.arr[i] shr 1;

  4650.       inc(fShift.arr[i]);

  4651.     end;

  4652.     fPrecision.arr[i] := CountSetBits(aMask.arr[i]);

  4653.   end;

  4654.   CalcValues;

  4655. end;

  4656. 

  4657. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4658. procedure TbmpBitfieldFormat.SetCustomValues(const aBBP: Integer; const aPrec, aShift: TglBitmapRec4ub);

  4659. begin

  4660.   fBitsPerPixel := aBBP;

  4661.   fPrecision    := aPrec;

  4662.   fShift        := aShift;

  4663.   CalcValues;

  4664. end;

  4665. 

  4666. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  4668. var

  4669.   data: QWord;

  4670. begin

  4671.   data :=

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

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

  4674.     ((aPixel.Data.b and Range.b) shl Shift.b) or

  4675.     ((aPixel.Data.a and Range.a) shl Shift.a);

  4676.   case BitsPerPixel of

  4677.     8:           aData^  := data;

  4678.    16:     PWord(aData)^ := data;

  4679.    32: PCardinal(aData)^ := data;

  4680.    64:    PQWord(aData)^ := data;

  4681.   else

  4682.     raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);

  4683.   end;

  4684.   inc(aData, Round(BytesPerPixel));

  4685. end;

  4686. 

  4687. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  4689. var

  4690.   data: QWord;

  4691.   i: Integer;

  4692. begin

  4693.   case BitsPerPixel of

  4694.      8: data :=           aData^;

  4695.     16: data :=     PWord(aData)^;

  4696.     32: data := PCardinal(aData)^;

  4697.     64: data :=    PQWord(aData)^;

  4698.   else

  4699.     raise EglBitmap.CreateFmt('invalid pixel size: %d', [BitsPerPixel]);

  4700.   end;

  4701.   for i := 0 to 3 do

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

  4703.   inc(aData, Round(BytesPerPixel));

  4704. end;

  4705. 

  4706. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4707. //TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4708. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4709. procedure TbmpColorTableFormat.SetValues;

  4710. begin

  4711.   inherited SetValues;

  4712.   fShift := glBitmapRec4ub(8, 8, 8, 0);

  4713. end;

  4714. 

  4715. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4716. procedure TbmpColorTableFormat.SetCustomValues(const aFormat: TglBitmapFormat; const aBPP: Integer; const aPrec, aShift: TglBitmapRec4ub);

  4717. begin

  4718.   fFormat       := aFormat;

  4719.   fBitsPerPixel := aBPP;

  4720.   fPrecision    := aPrec;

  4721.   fShift        := aShift;

  4722.   CalcValues;

  4723. end;

  4724. 

  4725. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4726. procedure TbmpColorTableFormat.CalcValues;

  4727. begin

  4728.   inherited CalcValues;

  4729. end;

  4730. 

  4731. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4732. procedure TbmpColorTableFormat.CreateColorTable;

  4733. var

  4734.   i: Integer;

  4735. begin

  4736.   SetLength(fColorTable, 256);

  4737.   if not HasColor then begin

  4738.     // alpha

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

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

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

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

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

  4744.     end;

  4745.   end else begin

  4746.     // normal

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

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

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

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

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

  4752.     end;

  4753.   end;

  4754. end;

  4755. 

  4756. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  4758. begin

  4759.   if (BitsPerPixel <> 8) then

  4760.     raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');

  4761.   if not HasColor then

  4762.     // alpha

  4763.     aData^ := aPixel.Data.a

  4764.   else

  4765.     // normal

  4766.     aData^ := Round(

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

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

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

  4770.   inc(aData);

  4771. end;

  4772. 

  4773. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  4775. begin

  4776.   if (BitsPerPixel <> 8) then

  4777.     raise EglBitmapUnsupportedFormat.Create('color table are only supported for 8bit formats');

  4778.   with fColorTable[aData^] do begin

  4779.     aPixel.Data.r := r;

  4780.     aPixel.Data.g := g;

  4781.     aPixel.Data.b := b;

  4782.     aPixel.Data.a := a;

  4783.   end;

  4784.   inc(aData, 1);

  4785. end;

  4786. 

  4787. destructor TbmpColorTableFormat.Destroy;

  4788. begin

  4789.   SetLength(fColorTable, 0);

  4790.   inherited Destroy;

  4791. end;

  4792. 

  4793. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4794. //TglBitmap - Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4795. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  4797. var

  4798.   i: Integer;

  4799. begin

  4800.   for i := 0 to 3 do begin

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

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

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

  4804.       else

  4805.         aPixel.Data.arr[i] := 0;

  4806.     end;

  4807.   end;

  4808. end;

  4809. 

  4810. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4811. procedure glBitmapConvertCopyFunc(var aFuncRec: TglBitmapFunctionRec);

  4812. begin

  4813.   with aFuncRec do begin

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

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

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

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

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

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

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

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

  4822.   end;

  4823. end;

  4824. 

  4825. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4826. procedure glBitmapConvertCalculateRGBAFunc(var aFuncRec: TglBitmapFunctionRec);

  4827. var

  4828.   i: Integer;

  4829. begin

  4830.   with aFuncRec do begin

  4831.     for i := 0 to 3 do

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

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

  4834.   end;

  4835. end;

  4836. 

  4837. type

  4838.   TShiftData = packed record

  4839.     case Integer of

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

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

  4842.   end;

  4843.   PShiftData = ^TShiftData;

  4844. 

  4845. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4846. procedure glBitmapConvertShiftRGBAFunc(var aFuncRec: TglBitmapFunctionRec);

  4847. var

  4848.   i: Integer;

  4849. begin

  4850.   with aFuncRec do

  4851.     for i := 0 to 3 do

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

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

  4854. end;

  4855. 

  4856. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4857. procedure glBitmapInvertFunc(var aFuncRec: TglBitmapFunctionRec);

  4858. begin

  4859.   with aFuncRec do begin

  4860.     Dest.Data := Source.Data;

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

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

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

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

  4865.     end;

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

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

  4868.     end;

  4869.   end;

  4870. end;

  4871. 

  4872. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4873. procedure glBitmapFillWithColorFunc(var aFuncRec: TglBitmapFunctionRec);

  4874. var

  4875.   i: Integer;

  4876. begin

  4877.   with aFuncRec do begin

  4878.     for i := 0 to 3 do

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

  4880.   end;

  4881. end;

  4882. 

  4883. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4884. procedure glBitmapAlphaFunc(var FuncRec: TglBitmapFunctionRec);

  4885. var

  4886.   Temp: Single;

  4887. begin

  4888.   with FuncRec do begin

  4889.     if (FuncRec.Args = nil) then begin //source has no alpha

  4890.       Temp :=

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

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

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

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

  4895.     end else

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

  4897.   end;

  4898. end;

  4899. 

  4900. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4901. procedure glBitmapColorKeyAlphaFunc(var FuncRec: TglBitmapFunctionRec);

  4902. type

  4903.   PglBitmapPixelData = ^TglBitmapPixelData;

  4904. begin

  4905.   with FuncRec do begin

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

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

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

  4909. 

  4910.     with PglBitmapPixelData(Args)^ do

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

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

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

  4914.         Dest.Data.a := 0

  4915.       else

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

  4917.   end;

  4918. end;

  4919. 

  4920. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4921. procedure glBitmapValueAlphaFunc(var FuncRec: TglBitmapFunctionRec);

  4922. begin

  4923.   with FuncRec do begin

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

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

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

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

  4928.   end;

  4929. end;

  4930. 

  4931. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  4933. type

  4934.   PRGBPix = ^TRGBPix;

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

  4936. var

  4937.   Temp: Byte;

  4938. begin

  4939.   while aWidth > 0 do begin

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

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

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

  4943. 

  4944.     if aHasAlpha then

  4945.       Inc(aData, 4)

  4946.     else

  4947.       Inc(aData, 3);

  4948.     dec(aWidth);

  4949.   end;

  4950. end;

  4951. 

  4952. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4953. //TglBitmap - PROTECTED///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4954. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4955. function TglBitmap.GetFormatDesc: TglBitmapFormatDescriptor;

  4956. begin

  4957.   result := TFormatDescriptor.Get(Format);

  4958. end;

  4959. 

  4960. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4961. function TglBitmap.GetWidth: Integer;

  4962. begin

  4963.   if (ffX in fDimension.Fields) then

  4964.     result := fDimension.X

  4965.   else

  4966.     result := -1;

  4967. end;

  4968. 

  4969. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4970. function TglBitmap.GetHeight: Integer;

  4971. begin

  4972.   if (ffY in fDimension.Fields) then

  4973.     result := fDimension.Y

  4974.   else

  4975.     result := -1;

  4976. end;

  4977. 

  4978. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4979. function TglBitmap.GetFileWidth: Integer;

  4980. begin

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

  4982. end;

  4983. 

  4984. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  4985. function TglBitmap.GetFileHeight: Integer;

  4986. begin

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

  4988. end;

  4989. 

  4990. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  4992. begin

  4993.   if fCustomData = aValue then

  4994.     exit;

  4995.   fCustomData := aValue;

  4996. end;

  4997. 

  4998. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  5000. begin

  5001.   if fCustomName = aValue then

  5002.     exit;

  5003.   fCustomName := aValue;

  5004. end;

  5005. 

  5006. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  5008. begin

  5009.   if fCustomNameW = aValue then

  5010.     exit;

  5011.   fCustomNameW := aValue;

  5012. end;

  5013. 

  5014. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5015. procedure TglBitmap.SetFreeDataOnDestroy(const aValue: Boolean);

  5016. begin

  5017.   if fFreeDataOnDestroy = aValue then

  5018.     exit;

  5019.   fFreeDataOnDestroy := aValue;

  5020. end;

  5021. 

  5022. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5023. procedure TglBitmap.SetDeleteTextureOnFree(const aValue: Boolean);

  5024. begin

  5025.   if fDeleteTextureOnFree = aValue then

  5026.     exit;

  5027.   fDeleteTextureOnFree := aValue;

  5028. end;

  5029. 

  5030. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5031. procedure TglBitmap.SetFormat(const aValue: TglBitmapFormat);

  5032. begin

  5033.   if fFormat = aValue then

  5034.     exit;

  5035.   if TFormatDescriptor.Get(Format).BitsPerPixel <> TFormatDescriptor.Get(aValue).BitsPerPixel then

  5036.     raise EglBitmapUnsupportedFormat.Create(Format);

  5037.   SetDataPointer(fData, aValue, Width, Height); //be careful, Data could be freed by this method

  5038. end;

  5039. 

  5040. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5041. procedure TglBitmap.SetFreeDataAfterGenTexture(const aValue: Boolean);

  5042. begin

  5043.   if fFreeDataAfterGenTexture = aValue then

  5044.     exit;

  5045.   fFreeDataAfterGenTexture := aValue;

  5046. end;

  5047. 

  5048. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5049. procedure TglBitmap.SetID(const aValue: Cardinal);

  5050. begin

  5051.   if fID = aValue then

  5052.     exit;

  5053.   fID := aValue;

  5054. end;

  5055. 

  5056. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5057. procedure TglBitmap.SetMipMap(const aValue: TglBitmapMipMap);

  5058. begin

  5059.   if fMipMap = aValue then

  5060.     exit;

  5061.   fMipMap := aValue;

  5062. end;

  5063. 

  5064. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5065. procedure TglBitmap.SetTarget(const aValue: Cardinal);

  5066. begin

  5067.   if fTarget = aValue then

  5068.     exit;

  5069.   fTarget := aValue;

  5070. end;

  5071. 

  5072. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5073. procedure TglBitmap.SetAnisotropic(const aValue: Integer);

  5074. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)}

  5075. var

  5076.   MaxAnisotropic: Integer;

  5077. {$IFEND}

  5078. begin

  5079.   fAnisotropic := aValue;

  5080.   if (ID > 0) then begin

  5081. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_EXT)}

  5082.     if GL_EXT_texture_filter_anisotropic then begin

  5083.       if fAnisotropic > 0 then begin

  5084.         Bind(false);

  5085.         glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @MaxAnisotropic);

  5086.         if aValue > MaxAnisotropic then

  5087.           fAnisotropic := MaxAnisotropic;

  5088.         glTexParameteri(Target, GL_TEXTURE_MAX_ANISOTROPY_EXT, fAnisotropic);

  5089.       end;

  5090.     end else begin

  5091.       fAnisotropic := 0;

  5092.     end;

  5093. {$ELSE}

  5094.     fAnisotropic := 0;

  5095. {$IFEND}

  5096.   end;

  5097. end;

  5098. 

  5099. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5100. procedure TglBitmap.CreateID;

  5101. begin

  5102.   if (ID <> 0) then

  5103.     glDeleteTextures(1, @fID);

  5104.   glGenTextures(1, @fID);

  5105.   Bind(false);

  5106. end;

  5107. 

  5108. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5109. procedure TglBitmap.SetupParameters({$IFNDEF OPENGL_ES}out aBuildWithGlu: Boolean{$ENDIF});

  5110. begin

  5111.   // Set Up Parameters

  5112.   SetWrap(fWrapS, fWrapT, fWrapR);

  5113.   SetFilter(fFilterMin, fFilterMag);

  5114.   SetAnisotropic(fAnisotropic);

  5115. 

  5116. {$IFNDEF OPENGL_ES}

  5117.   SetBorderColor(fBorderColor[0], fBorderColor[1], fBorderColor[2], fBorderColor[3]);

  5118.   if (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then

  5119.     SetSwizzle(fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);

  5120. {$ENDIF}

  5121. 

  5122. {$IFNDEF OPENGL_ES}

  5123.   // Mip Maps Generation Mode

  5124.   aBuildWithGlu := false;

  5125.   if (MipMap = mmMipmap) then begin

  5126.     if (GL_VERSION_1_4 or GL_SGIS_generate_mipmap) then

  5127.       glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE)

  5128.     else

  5129.       aBuildWithGlu := true;

  5130.   end else if (MipMap = mmMipmapGlu) then

  5131.     aBuildWithGlu := true;

  5132. {$ELSE}

  5133.   if (MipMap = mmMipmap) then

  5134.     glTexParameteri(Target, GL_GENERATE_MIPMAP, GL_TRUE);

  5135. {$ENDIF}

  5136. end;

  5137. 

  5138. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  5140.   const aWidth: Integer; const aHeight: Integer);

  5141. var

  5142.   s: Single;

  5143. begin

  5144.   if (Data <> aData) then begin

  5145.     if (Assigned(Data)) then

  5146.       FreeMem(Data);

  5147.     fData := aData;

  5148.   end;

  5149. 

  5150.   if not Assigned(fData) then begin

  5151.     fPixelSize := 0;

  5152.     fRowSize   := 0;

  5153.   end else begin

  5154.     FillChar(fDimension, SizeOf(fDimension), 0);

  5155.     if aWidth <> -1 then begin

  5156.       fDimension.Fields := fDimension.Fields + [ffX];

  5157.       fDimension.X := aWidth;

  5158.     end;

  5159. 

  5160.     if aHeight <> -1 then begin

  5161.       fDimension.Fields := fDimension.Fields + [ffY];

  5162.       fDimension.Y := aHeight;

  5163.     end;

  5164. 

  5165.     s := TFormatDescriptor.Get(aFormat).BytesPerPixel;

  5166.     fFormat    := aFormat;

  5167.     fPixelSize := Ceil(s);

  5168.     fRowSize   := Ceil(s * aWidth);

  5169.   end;

  5170. end;

  5171. 

  5172. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5173. function TglBitmap.FlipHorz: Boolean;

  5174. begin

  5175.   result := false;

  5176. end;

  5177. 

  5178. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5179. function TglBitmap.FlipVert: Boolean;

  5180. begin

  5181.   result := false;

  5182. end;

  5183. 

  5184. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5185. //TglBitmap - PUBLIC//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5186. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5187. procedure TglBitmap.AfterConstruction;

  5188. begin

  5189.   inherited AfterConstruction;

  5190. 

  5191.   fID         := 0;

  5192.   fTarget     := 0;

  5193. {$IFNDEF OPENGL_ES}

  5194.   fIsResident := false;

  5195. {$ENDIF}

  5196. 

  5197.   fMipMap                  := glBitmapDefaultMipmap;

  5198.   fFreeDataAfterGenTexture := glBitmapGetDefaultFreeDataAfterGenTexture;

  5199.   fDeleteTextureOnFree     := glBitmapGetDefaultDeleteTextureOnFree;

  5200. 

  5201.   glBitmapGetDefaultFilter     (fFilterMin, fFilterMag);

  5202.   glBitmapGetDefaultTextureWrap(fWrapS, fWrapT, fWrapR);

  5203. {$IFNDEF OPENGL_ES}

  5204.   glBitmapGetDefaultSwizzle    (fSwizzle[0], fSwizzle[1], fSwizzle[2], fSwizzle[3]);

  5205. {$ENDIF}

  5206. end;

  5207. 

  5208. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5209. procedure TglBitmap.BeforeDestruction;

  5210. var

  5211.   NewData: PByte;

  5212. begin

  5213.   if fFreeDataOnDestroy then begin

  5214.     NewData := nil;

  5215.     SetDataPointer(NewData, tfEmpty); //be careful, Data could be freed by this method

  5216.   end;

  5217.   if (fID > 0) and fDeleteTextureOnFree then

  5218.     glDeleteTextures(1, @fID);

  5219.   inherited BeforeDestruction;

  5220. end;

  5221. 

  5222. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  5224. var

  5225.   TempPos: Integer;

  5226. begin

  5227.   if not Assigned(aResType) then begin

  5228.     TempPos   := Pos('.', aResource);

  5229.     aResType  := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));

  5230.     aResource := UpperCase(Copy(aResource, 0, TempPos -1));

  5231.   end;

  5232. end;

  5233. 

  5234. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5235. procedure TglBitmap.LoadFromFile(const aFilename: String);

  5236. var

  5237.   fs: TFileStream;

  5238. begin

  5239.   if not FileExists(aFilename) then

  5240.     raise EglBitmap.Create('file does not exist: ' + aFilename);

  5241.   fFilename := aFilename;

  5242.   fs := TFileStream.Create(fFilename, fmOpenRead);

  5243.   try

  5244.     fs.Position := 0;

  5245.     LoadFromStream(fs);

  5246.   finally

  5247.     fs.Free;

  5248.   end;

  5249. end;

  5250. 

  5251. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5252. procedure TglBitmap.LoadFromStream(const aStream: TStream);

  5253. begin

  5254.   {$IFDEF GLB_SUPPORT_PNG_READ}

  5255.   if not LoadPNG(aStream) then

  5256.   {$ENDIF}

  5257.   {$IFDEF GLB_SUPPORT_JPEG_READ}

  5258.   if not LoadJPEG(aStream) then

  5259.   {$ENDIF}

  5260.   if not LoadDDS(aStream) then

  5261.   if not LoadTGA(aStream) then

  5262.   if not LoadBMP(aStream) then

  5263.   if not LoadRAW(aStream) then

  5264.     raise EglBitmap.Create('LoadFromStream - Couldn''t load Stream. It''s possible to be an unknow Streamtype.');

  5265. end;

  5266. 

  5267. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5268. procedure TglBitmap.LoadFromFunc(const aSize: TglBitmapSize; const aFunc: TglBitmapFunction;

  5269.   const aFormat: TglBitmapFormat; const aArgs: Pointer);

  5270. var

  5271.   tmpData: PByte;

  5272.   size: Integer;

  5273. begin

  5274.   size := TFormatDescriptor.Get(aFormat).GetSize(aSize);

  5275.   GetMem(tmpData, size);

  5276.   try

  5277.     FillChar(tmpData^, size, #$FF);

  5278.     SetDataPointer(tmpData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method

  5279.   except

  5280.     if Assigned(tmpData) then

  5281.       FreeMem(tmpData);

  5282.     raise;

  5283.   end;

  5284.   Convert(Self, aFunc, false, aFormat, aArgs);

  5285. end;

  5286. 

  5287. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5288. procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);

  5289. var

  5290.   rs: TResourceStream;

  5291. begin

  5292.   PrepareResType(aResource, aResType);

  5293.   rs := TResourceStream.Create(aInstance, aResource, aResType);

  5294.   try

  5295.     LoadFromStream(rs);

  5296.   finally

  5297.     rs.Free;

  5298.   end;

  5299. end;

  5300. 

  5301. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  5303. var

  5304.   rs: TResourceStream;

  5305. begin

  5306.   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);

  5307.   try

  5308.     LoadFromStream(rs);

  5309.   finally

  5310.     rs.Free;

  5311.   end;

  5312. end;

  5313. 

  5314. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5315. procedure TglBitmap.SaveToFile(const aFilename: String; const aFileType: TglBitmapFileType);

  5316. var

  5317.   fs: TFileStream;

  5318. begin

  5319.   fs := TFileStream.Create(aFileName, fmCreate);

  5320.   try

  5321.     fs.Position := 0;

  5322.     SaveToStream(fs, aFileType);

  5323.   finally

  5324.     fs.Free;

  5325.   end;

  5326. end;

  5327. 

  5328. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5329. procedure TglBitmap.SaveToStream(const aStream: TStream; const aFileType: TglBitmapFileType);

  5330. begin

  5331.   case aFileType of

  5332.     {$IFDEF GLB_SUPPORT_PNG_WRITE}

  5333.     ftPNG:  SavePNG(aStream);

  5334.     {$ENDIF}

  5335.     {$IFDEF GLB_SUPPORT_JPEG_WRITE}

  5336.     ftJPEG: SaveJPEG(aStream);

  5337.     {$ENDIF}

  5338.     ftDDS:  SaveDDS(aStream);

  5339.     ftTGA:  SaveTGA(aStream);

  5340.     ftBMP:  SaveBMP(aStream);

  5341.     ftRAW:  SaveRAW(aStream);

  5342.   end;

  5343. end;

  5344. 

  5345. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5346. function TglBitmap.Convert(const aFunc: TglBitmapFunction; const aCreateTemp: Boolean; const aArgs: Pointer): Boolean;

  5347. begin

  5348.   result := Convert(Self, aFunc, aCreateTemp, Format, aArgs);

  5349. end;

  5350. 

  5351. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5352. function TglBitmap.Convert(const aSource: TglBitmap; const aFunc: TglBitmapFunction; aCreateTemp: Boolean;

  5353.   const aFormat: TglBitmapFormat; const aArgs: Pointer): Boolean;

  5354. var

  5355.   DestData, TmpData, SourceData: pByte;

  5356.   TempHeight, TempWidth: Integer;

  5357.   SourceFD, DestFD: TFormatDescriptor;

  5358.   SourceMD, DestMD: Pointer;

  5359. 

  5360.   FuncRec: TglBitmapFunctionRec;

  5361. begin

  5362.   Assert(Assigned(Data));

  5363.   Assert(Assigned(aSource));

  5364.   Assert(Assigned(aSource.Data));

  5365. 

  5366.   result := false;

  5367.   if Assigned(aSource.Data) and ((aSource.Height > 0) or (aSource.Width > 0)) then begin

  5368.     SourceFD := TFormatDescriptor.Get(aSource.Format);

  5369.     DestFD   := TFormatDescriptor.Get(aFormat);

  5370. 

  5371.     if (SourceFD.IsCompressed) then

  5372.       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);

  5373.     if (DestFD.IsCompressed) then

  5374.       raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);

  5375. 

  5376.     // inkompatible Formats so CreateTemp

  5377.     if (SourceFD.BitsPerPixel <> DestFD.BitsPerPixel) then

  5378.       aCreateTemp := true;

  5379. 

  5380.     // Values

  5381.     TempHeight := Max(1, aSource.Height);

  5382.     TempWidth  := Max(1, aSource.Width);

  5383. 

  5384.     FuncRec.Sender := Self;

  5385.     FuncRec.Args   := aArgs;

  5386. 

  5387.     TmpData := nil;

  5388.     if aCreateTemp then begin

  5389.       GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));

  5390.       DestData := TmpData;

  5391.     end else

  5392.       DestData := Data;

  5393. 

  5394.     try

  5395.       SourceFD.PreparePixel(FuncRec.Source);

  5396.       DestFD.PreparePixel  (FuncRec.Dest);

  5397. 

  5398.       SourceMD := SourceFD.CreateMappingData;

  5399.       DestMD   := DestFD.CreateMappingData;

  5400. 

  5401.       FuncRec.Size            := aSource.Dimension;

  5402.       FuncRec.Position.Fields := FuncRec.Size.Fields;

  5403. 

  5404.       try

  5405.         SourceData := aSource.Data;

  5406.         FuncRec.Position.Y := 0;

  5407.         while FuncRec.Position.Y < TempHeight do begin

  5408.           FuncRec.Position.X := 0;

  5409.           while FuncRec.Position.X < TempWidth do begin

  5410.             SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);

  5411.             aFunc(FuncRec);

  5412.             DestFD.Map(FuncRec.Dest, DestData, DestMD);

  5413.             inc(FuncRec.Position.X);

  5414.           end;

  5415.           inc(FuncRec.Position.Y);

  5416.         end;

  5417. 

  5418.         // Updating Image or InternalFormat

  5419.         if aCreateTemp then

  5420.           SetDataPointer(TmpData, aFormat, aSource.Width, aSource.Height) //be careful, Data could be freed by this method

  5421.         else if (aFormat <> fFormat) then

  5422.           Format := aFormat;

  5423. 

  5424.         result := true;

  5425.       finally

  5426.         SourceFD.FreeMappingData(SourceMD);

  5427.         DestFD.FreeMappingData(DestMD);

  5428.       end;

  5429.     except

  5430.       if aCreateTemp and Assigned(TmpData) then

  5431.         FreeMem(TmpData);

  5432.       raise;

  5433.     end;

  5434.   end;

  5435. end;

  5436. 

  5437. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5438. function TglBitmap.ConvertTo(const aFormat: TglBitmapFormat): Boolean;

  5439. var

  5440.   SourceFD, DestFD: TFormatDescriptor;

  5441.   SourcePD, DestPD: TglBitmapPixelData;

  5442.   ShiftData: TShiftData;

  5443. 

  5444.   function DataIsIdentical: Boolean;

  5445.   begin

  5446.     result := SourceFD.MaskMatch(DestFD.Mask);

  5447.   end;

  5448. 

  5449.   function CanCopyDirect: Boolean;

  5450.   begin

  5451.     result :=

  5452.       ((SourcePD.Range.r = DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and

  5453.       ((SourcePD.Range.g = DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and

  5454.       ((SourcePD.Range.b = DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and

  5455.       ((SourcePD.Range.a = DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));

  5456.   end;

  5457. 

  5458.   function CanShift: Boolean;

  5459.   begin

  5460.     result :=

  5461.       ((SourcePD.Range.r >= DestPD.Range.r) or (SourcePD.Range.r = 0) or (DestPD.Range.r = 0)) and

  5462.       ((SourcePD.Range.g >= DestPD.Range.g) or (SourcePD.Range.g = 0) or (DestPD.Range.g = 0)) and

  5463.       ((SourcePD.Range.b >= DestPD.Range.b) or (SourcePD.Range.b = 0) or (DestPD.Range.b = 0)) and

  5464.       ((SourcePD.Range.a >= DestPD.Range.a) or (SourcePD.Range.a = 0) or (DestPD.Range.a = 0));

  5465.   end;

  5466. 

  5467.   function GetShift(aSource, aDest: Cardinal) : ShortInt;

  5468.   begin

  5469.     result := 0;

  5470.     while (aSource > aDest) and (aSource > 0) do begin

  5471.       inc(result);

  5472.       aSource := aSource shr 1;

  5473.     end;

  5474.   end;

  5475. 

  5476. begin

  5477.   if (aFormat <> fFormat) and (aFormat <> tfEmpty) then begin

  5478.     SourceFD := TFormatDescriptor.Get(Format);

  5479.     DestFD   := TFormatDescriptor.Get(aFormat);

  5480. 

  5481.     if DataIsIdentical then begin

  5482.       result := true;

  5483.       Format := aFormat;

  5484.       exit;

  5485.     end;

  5486. 

  5487.     SourceFD.PreparePixel(SourcePD);

  5488.     DestFD.PreparePixel  (DestPD);

  5489. 

  5490.     if CanCopyDirect then

  5491.       result := Convert(Self, glBitmapConvertCopyFunc, false, aFormat)

  5492.     else if CanShift then begin

  5493.       ShiftData.r := GetShift(SourcePD.Range.r, DestPD.Range.r);

  5494.       ShiftData.g := GetShift(SourcePD.Range.g, DestPD.Range.g);

  5495.       ShiftData.b := GetShift(SourcePD.Range.b, DestPD.Range.b);

  5496.       ShiftData.a := GetShift(SourcePD.Range.a, DestPD.Range.a);

  5497.       result := Convert(Self, glBitmapConvertShiftRGBAFunc, false, aFormat, @ShiftData);

  5498.     end else

  5499.       result := Convert(Self, glBitmapConvertCalculateRGBAFunc, false, aFormat);

  5500.   end else

  5501.     result := true;

  5502. end;

  5503. 

  5504. {$IFDEF GLB_SDL}

  5505. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5506. function TglBitmap.AssignToSurface(out aSurface: PSDL_Surface): Boolean;

  5507. var

  5508.   Row, RowSize: Integer;

  5509.   SourceData, TmpData: PByte;

  5510.   TempDepth: Integer;

  5511.   FormatDesc: TFormatDescriptor;

  5512. 

  5513.   function GetRowPointer(Row: Integer): pByte;

  5514.   begin

  5515.     result := aSurface.pixels;

  5516.     Inc(result, Row * RowSize);

  5517.   end;

  5518. 

  5519. begin

  5520.   result := false;

  5521. 

  5522.   FormatDesc := TFormatDescriptor.Get(Format);

  5523.   if FormatDesc.IsCompressed then

  5524.     raise EglBitmapUnsupportedFormat.Create(Format);

  5525. 

  5526.   if Assigned(Data) then begin

  5527.     case Trunc(FormatDesc.PixelSize) of

  5528.       1: TempDepth :=  8;

  5529.       2: TempDepth := 16;

  5530.       3: TempDepth := 24;

  5531.       4: TempDepth := 32;

  5532.     else

  5533.       raise EglBitmapUnsupportedFormat.Create(Format);

  5534.     end;

  5535. 

  5536.     aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, TempDepth,

  5537.       FormatDesc.RedMask, FormatDesc.GreenMask, FormatDesc.BlueMask, FormatDesc.AlphaMask);

  5538.     SourceData := Data;

  5539.     RowSize    := FormatDesc.GetSize(FileWidth, 1);

  5540. 

  5541.     for Row := 0 to FileHeight-1 do begin

  5542.       TmpData := GetRowPointer(Row);

  5543.       if Assigned(TmpData) then begin

  5544.         Move(SourceData^, TmpData^, RowSize);

  5545.         inc(SourceData, RowSize);

  5546.       end;

  5547.     end;

  5548.     result := true;

  5549.   end;

  5550. end;

  5551. 

  5552. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5553. function TglBitmap.AssignFromSurface(const aSurface: PSDL_Surface): Boolean;

  5554. var

  5555.   pSource, pData, pTempData: PByte;

  5556.   Row, RowSize, TempWidth, TempHeight: Integer;

  5557.   IntFormat: TglBitmapFormat;

  5558.   fd: TFormatDescriptor;

  5559.   Mask: TglBitmapMask;

  5560. 

  5561.   function GetRowPointer(Row: Integer): pByte;

  5562.   begin

  5563.     result := aSurface^.pixels;

  5564.     Inc(result, Row * RowSize);

  5565.   end;

  5566. 

  5567. begin

  5568.   result := false;

  5569.   if (Assigned(aSurface)) then begin

  5570.     with aSurface^.format^ do begin

  5571.       Mask.r := RMask;

  5572.       Mask.g := GMask;

  5573.       Mask.b := BMask;

  5574.       Mask.a := AMask;

  5575.       IntFormat := TFormatDescriptor.GetFromMask(Mask).Format;

  5576.       if (IntFormat = tfEmpty) then

  5577.         raise EglBitmap.Create('AssignFromSurface - Invalid Pixelformat.');

  5578.     end;

  5579. 

  5580.     fd := TFormatDescriptor.Get(IntFormat);

  5581.     TempWidth  := aSurface^.w;

  5582.     TempHeight := aSurface^.h;

  5583.     RowSize := fd.GetSize(TempWidth, 1);

  5584.     GetMem(pData, TempHeight * RowSize);

  5585.     try

  5586.       pTempData := pData;

  5587.       for Row := 0 to TempHeight -1 do begin

  5588.         pSource := GetRowPointer(Row);

  5589.         if (Assigned(pSource)) then begin

  5590.           Move(pSource^, pTempData^, RowSize);

  5591.           Inc(pTempData, RowSize);

  5592.         end;

  5593.       end;

  5594.       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method

  5595.       result := true;

  5596.     except

  5597.       if Assigned(pData) then

  5598.         FreeMem(pData);

  5599.       raise;

  5600.     end;

  5601.   end;

  5602. end;

  5603. 

  5604. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5605. function TglBitmap.AssignAlphaToSurface(out aSurface: PSDL_Surface): Boolean;

  5606. var

  5607.   Row, Col, AlphaInterleave: Integer;

  5608.   pSource, pDest: PByte;

  5609. 

  5610.   function GetRowPointer(Row: Integer): pByte;

  5611.   begin

  5612.     result := aSurface.pixels;

  5613.     Inc(result, Row * Width);

  5614.   end;

  5615. 

  5616. begin

  5617.   result := false;

  5618.   if Assigned(Data) then begin

  5619.     if Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfBGRA8ub4, tfRGBA8ub4] then begin

  5620.       aSurface := SDL_CreateRGBSurface(SDL_SWSURFACE, Width, Height, 8, $FF, $FF, $FF, 0);

  5621. 

  5622.       AlphaInterleave := 0;

  5623.       case Format of

  5624.         tfLuminance8Alpha8ub2:

  5625.           AlphaInterleave := 1;

  5626.         tfBGRA8ub4, tfRGBA8ub4:

  5627.           AlphaInterleave := 3;

  5628.       end;

  5629. 

  5630.       pSource := Data;

  5631.       for Row := 0 to Height -1 do begin

  5632.         pDest := GetRowPointer(Row);

  5633.         if Assigned(pDest) then begin

  5634.           for Col := 0 to Width -1 do begin

  5635.             Inc(pSource, AlphaInterleave);

  5636.             pDest^ := pSource^;

  5637.             Inc(pDest);

  5638.             Inc(pSource);

  5639.           end;

  5640.         end;

  5641.       end;

  5642.       result := true;

  5643.     end;

  5644.   end;

  5645. end;

  5646. 

  5647. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5648. function TglBitmap.AddAlphaFromSurface(const aSurface: PSDL_Surface; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;

  5649. var

  5650.   bmp: TglBitmap2D;

  5651. begin

  5652.   bmp := TglBitmap2D.Create;

  5653.   try

  5654.     bmp.AssignFromSurface(aSurface);

  5655.     result := AddAlphaFromGlBitmap(bmp, aFunc, aArgs);

  5656.   finally

  5657.     bmp.Free;

  5658.   end;

  5659. end;

  5660. {$ENDIF}

  5661. 

  5662. {$IFDEF GLB_DELPHI}

  5663. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5664. function CreateGrayPalette: HPALETTE;

  5665. var

  5666.   Idx: Integer;

  5667.   Pal: PLogPalette;

  5668. begin

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

  5670. 

  5671.   Pal.palVersion := $300;

  5672.   Pal.palNumEntries := 256;

  5673. 

  5674.   for Idx := 0 to Pal.palNumEntries - 1 do begin

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

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

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

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

  5679.   end;

  5680.   Result := CreatePalette(Pal^);

  5681.   FreeMem(Pal);

  5682. end;

  5683. 

  5684. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5685. function TglBitmap.AssignToBitmap(const aBitmap: TBitmap): Boolean;

  5686. var

  5687.   Row: Integer;

  5688.   pSource, pData: PByte;

  5689. begin

  5690.   result := false;

  5691.   if Assigned(Data) then begin

  5692.     if Assigned(aBitmap) then begin

  5693.       aBitmap.Width  := Width;

  5694.       aBitmap.Height := Height;

  5695. 

  5696.       case Format of

  5697.         tfAlpha8ub1, tfLuminance8ub1: begin

  5698.           aBitmap.PixelFormat := pf8bit;

  5699.           aBitmap.Palette     := CreateGrayPalette;

  5700.         end;

  5701.         tfRGB5A1us1:

  5702.           aBitmap.PixelFormat := pf15bit;

  5703.         tfR5G6B5us1:

  5704.           aBitmap.PixelFormat := pf16bit;

  5705.         tfRGB8ub3, tfBGR8ub3:

  5706.           aBitmap.PixelFormat := pf24bit;

  5707.         tfRGBA8ub4, tfBGRA8ub4:

  5708.           aBitmap.PixelFormat := pf32bit;

  5709.       else

  5710.         raise EglBitmap.Create('AssignToBitmap - Invalid Pixelformat.');

  5711.       end;

  5712. 

  5713.       pSource := Data;

  5714.       for Row := 0 to FileHeight -1 do begin

  5715.         pData := aBitmap.Scanline[Row];

  5716.         Move(pSource^, pData^, fRowSize);

  5717.         Inc(pSource, fRowSize);

  5718.         if (Format in [tfRGB8ub3, tfRGBA8ub4]) then        // swap RGB(A) to BGR(A)

  5719.           SwapRGB(pData, FileWidth, Format = tfRGBA8ub4);

  5720.       end;

  5721.       result := true;

  5722.     end;

  5723.   end;

  5724. end;

  5725. 

  5726. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5727. function TglBitmap.AssignFromBitmap(const aBitmap: TBitmap): Boolean;

  5728. var

  5729.   pSource, pData, pTempData: PByte;

  5730.   Row, RowSize, TempWidth, TempHeight: Integer;

  5731.   IntFormat: TglBitmapFormat;

  5732. begin

  5733.   result := false;

  5734. 

  5735.   if (Assigned(aBitmap)) then begin

  5736.     case aBitmap.PixelFormat of

  5737.       pf8bit:

  5738.         IntFormat := tfLuminance8ub1;

  5739.       pf15bit:

  5740.         IntFormat := tfRGB5A1us1;

  5741.       pf16bit:

  5742.         IntFormat := tfR5G6B5us1;

  5743.       pf24bit:

  5744.         IntFormat := tfBGR8ub3;

  5745.       pf32bit:

  5746.         IntFormat := tfBGRA8ub4;

  5747.     else

  5748.       raise EglBitmap.Create('AssignFromBitmap - Invalid Pixelformat.');

  5749.     end;

  5750. 

  5751.     TempWidth  := aBitmap.Width;

  5752.     TempHeight := aBitmap.Height;

  5753.     RowSize    := TFormatDescriptor.Get(IntFormat).GetSize(TempWidth, 1);

  5754.     GetMem(pData, TempHeight * RowSize);

  5755.     try

  5756.       pTempData := pData;

  5757.       for Row := 0 to TempHeight -1 do begin

  5758.         pSource := aBitmap.Scanline[Row];

  5759.         if (Assigned(pSource)) then begin

  5760.           Move(pSource^, pTempData^, RowSize);

  5761.           Inc(pTempData, RowSize);

  5762.         end;

  5763.       end;

  5764.       SetDataPointer(pData, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method

  5765.       result := true;

  5766.     except

  5767.       if Assigned(pData) then

  5768.         FreeMem(pData);

  5769.       raise;

  5770.     end;

  5771.   end;

  5772. end;

  5773. 

  5774. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5775. function TglBitmap.AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;

  5776. var

  5777.   Row, Col, AlphaInterleave: Integer;

  5778.   pSource, pDest: PByte;

  5779. begin

  5780.   result := false;

  5781. 

  5782.   if Assigned(Data) then begin

  5783.     if (Format in [tfAlpha8ub1, tfLuminance8Alpha8ub2, tfRGBA8ub4, tfBGRA8ub4]) then begin

  5784.       if Assigned(aBitmap) then begin

  5785.         aBitmap.PixelFormat := pf8bit;

  5786.         aBitmap.Palette     := CreateGrayPalette;

  5787.         aBitmap.Width       := Width;

  5788.         aBitmap.Height      := Height;

  5789. 

  5790.         case Format of

  5791.           tfLuminance8Alpha8ub2:

  5792.             AlphaInterleave := 1;

  5793.           tfRGBA8ub4, tfBGRA8ub4:

  5794.             AlphaInterleave := 3;

  5795.           else

  5796.             AlphaInterleave := 0;

  5797.         end;

  5798. 

  5799.         // Copy Data

  5800.         pSource := Data;

  5801. 

  5802.         for Row := 0 to Height -1 do begin

  5803.           pDest := aBitmap.Scanline[Row];

  5804.           if Assigned(pDest) then begin

  5805.             for Col := 0 to Width -1 do begin

  5806.               Inc(pSource, AlphaInterleave);

  5807.               pDest^ := pSource^;

  5808.               Inc(pDest);

  5809.               Inc(pSource);

  5810.             end;

  5811.           end;

  5812.         end;

  5813.         result := true;

  5814.       end;

  5815.     end;

  5816.   end;

  5817. end;

  5818. 

  5819. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5820. function TglBitmap.AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;

  5821. var

  5822.   tex: TglBitmap2D;

  5823. begin

  5824.   tex := TglBitmap2D.Create;

  5825.   try

  5826.     tex.AssignFromBitmap(ABitmap);

  5827.     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);

  5828.   finally

  5829.     tex.Free;

  5830.   end;

  5831. end;

  5832. {$ENDIF}

  5833. 

  5834. {$IFDEF GLB_LAZARUS}

  5835. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5836. function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;

  5837. var

  5838.   rid: TRawImageDescription;

  5839.   FormatDesc: TFormatDescriptor;

  5840. begin

  5841.   if not Assigned(Data) then

  5842.     raise EglBitmap.Create('no pixel data assigned. load data before save');

  5843. 

  5844.   result := false;

  5845.   if not Assigned(aImage) or (Format = tfEmpty) then

  5846.     exit;

  5847.   FormatDesc := TFormatDescriptor.Get(Format);

  5848.   if FormatDesc.IsCompressed then

  5849.     exit;

  5850. 

  5851.   FillChar(rid{%H-}, SizeOf(rid), 0);

  5852.   if FormatDesc.IsGrayscale then

  5853.     rid.Format := ricfGray

  5854.   else

  5855.     rid.Format := ricfRGBA;

  5856. 

  5857.   rid.Width        := Width;

  5858.   rid.Height       := Height;

  5859.   rid.Depth        := FormatDesc.BitsPerPixel;

  5860.   rid.BitOrder     := riboBitsInOrder;

  5861.   rid.ByteOrder    := riboLSBFirst;

  5862.   rid.LineOrder    := riloTopToBottom;

  5863.   rid.LineEnd      := rileTight;

  5864.   rid.BitsPerPixel := FormatDesc.BitsPerPixel;

  5865.   rid.RedPrec      := CountSetBits(FormatDesc.Range.r);

  5866.   rid.GreenPrec    := CountSetBits(FormatDesc.Range.g);

  5867.   rid.BluePrec     := CountSetBits(FormatDesc.Range.b);

  5868.   rid.AlphaPrec    := CountSetBits(FormatDesc.Range.a);

  5869.   rid.RedShift     := FormatDesc.Shift.r;

  5870.   rid.GreenShift   := FormatDesc.Shift.g;

  5871.   rid.BlueShift    := FormatDesc.Shift.b;

  5872.   rid.AlphaShift   := FormatDesc.Shift.a;

  5873. 

  5874.   rid.MaskBitsPerPixel  := 0;

  5875.   rid.PaletteColorCount := 0;

  5876. 

  5877.   aImage.DataDescription := rid;

  5878.   aImage.CreateData;

  5879. 

  5880.   if not Assigned(aImage.PixelData) then

  5881.     raise EglBitmap.Create('error while creating LazIntfImage');

  5882.   Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));

  5883. 

  5884.   result := true;

  5885. end;

  5886. 

  5887. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5888. function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;

  5889. var

  5890.   f: TglBitmapFormat;

  5891.   FormatDesc: TFormatDescriptor;

  5892.   ImageData: PByte;

  5893.   ImageSize: Integer;

  5894.   CanCopy: Boolean;

  5895.   Mask: TglBitmapRec4ul;

  5896. 

  5897.   procedure CopyConvert;

  5898.   var

  5899.     bfFormat: TbmpBitfieldFormat;

  5900.     pSourceLine, pDestLine: PByte;

  5901.     pSourceMD, pDestMD: Pointer;

  5902.     Shift, Prec: TglBitmapRec4ub;

  5903.     x, y: Integer;

  5904.     pixel: TglBitmapPixelData;

  5905.   begin

  5906.     bfFormat  := TbmpBitfieldFormat.Create;

  5907.     with aImage.DataDescription do begin

  5908.       Prec.r := RedPrec;

  5909.       Prec.g := GreenPrec;

  5910.       Prec.b := BluePrec;

  5911.       Prec.a := AlphaPrec;

  5912.       Shift.r := RedShift;

  5913.       Shift.g := GreenShift;

  5914.       Shift.b := BlueShift;

  5915.       Shift.a := AlphaShift;

  5916.       bfFormat.SetCustomValues(BitsPerPixel, Prec, Shift);

  5917.     end;

  5918.     pSourceMD := bfFormat.CreateMappingData;

  5919.     pDestMD   := FormatDesc.CreateMappingData;

  5920.     try

  5921.       for y := 0 to aImage.Height-1 do begin

  5922.         pSourceLine := aImage.PixelData + y {%H-}* aImage.DataDescription.BytesPerLine;

  5923.         pDestLine   := ImageData        + y * Round(FormatDesc.BytesPerPixel * aImage.Width);

  5924.         for x := 0 to aImage.Width-1 do begin

  5925.           bfFormat.Unmap(pSourceLine, pixel, pSourceMD);

  5926.           FormatDesc.Map(pixel, pDestLine, pDestMD);

  5927.         end;

  5928.       end;

  5929.     finally

  5930.       FormatDesc.FreeMappingData(pDestMD);

  5931.       bfFormat.FreeMappingData(pSourceMD);

  5932.       bfFormat.Free;

  5933.     end;

  5934.   end;

  5935. 

  5936. begin

  5937.   result := false;

  5938.   if not Assigned(aImage) then

  5939.     exit;

  5940. 

  5941.   with aImage.DataDescription do begin

  5942.     Mask.r := (QWord(1 shl RedPrec  )-1) shl RedShift;

  5943.     Mask.g := (QWord(1 shl GreenPrec)-1) shl GreenShift;

  5944.     Mask.b := (QWord(1 shl BluePrec )-1) shl BlueShift;

  5945.     Mask.a := (QWord(1 shl AlphaPrec)-1) shl AlphaShift;

  5946.   end;

  5947.   FormatDesc := TFormatDescriptor.GetFromMask(Mask);

  5948.   f          := FormatDesc.Format;

  5949.   if (f = tfEmpty) then

  5950.     exit;

  5951. 

  5952.   CanCopy :=

  5953.     (FormatDesc.BitsPerPixel             = aImage.DataDescription.Depth) and

  5954.     (aImage.DataDescription.BitsPerPixel = aImage.DataDescription.Depth);

  5955. 

  5956.   ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);

  5957.   ImageData := GetMem(ImageSize);

  5958.   try

  5959.     if CanCopy then

  5960.       Move(aImage.PixelData^, ImageData^, ImageSize)

  5961.     else

  5962.       CopyConvert;

  5963.     SetDataPointer(ImageData, f, aImage.Width, aImage.Height); //be careful, Data could be freed by this method

  5964.   except

  5965.     if Assigned(ImageData) then

  5966.       FreeMem(ImageData);

  5967.     raise;

  5968.   end;

  5969. 

  5970.   result := true;

  5971. end;

  5972. 

  5973. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  5974. function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;

  5975. var

  5976.   rid: TRawImageDescription;

  5977.   FormatDesc: TFormatDescriptor;

  5978.   Pixel: TglBitmapPixelData;

  5979.   x, y: Integer;

  5980.   srcMD: Pointer;

  5981.   src, dst: PByte;

  5982. begin

  5983.   result := false;

  5984.   if not Assigned(aImage) or (Format = tfEmpty) then

  5985.     exit;

  5986.   FormatDesc := TFormatDescriptor.Get(Format);

  5987.   if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then

  5988.     exit;

  5989. 

  5990.   FillChar(rid{%H-}, SizeOf(rid), 0);

  5991.   rid.Format       := ricfGray;

  5992.   rid.Width        := Width;

  5993.   rid.Height       := Height;

  5994.   rid.Depth        := CountSetBits(FormatDesc.Range.a);

  5995.   rid.BitOrder     := riboBitsInOrder;

  5996.   rid.ByteOrder    := riboLSBFirst;

  5997.   rid.LineOrder    := riloTopToBottom;

  5998.   rid.LineEnd      := rileTight;

  5999.   rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);

  6000.   rid.RedPrec      := CountSetBits(FormatDesc.Range.a);

  6001.   rid.GreenPrec    := 0;

  6002.   rid.BluePrec     := 0;

  6003.   rid.AlphaPrec    := 0;

  6004.   rid.RedShift     := 0;

  6005.   rid.GreenShift   := 0;

  6006.   rid.BlueShift    := 0;

  6007.   rid.AlphaShift   := 0;

  6008. 

  6009.   rid.MaskBitsPerPixel  := 0;

  6010.   rid.PaletteColorCount := 0;

  6011. 

  6012.   aImage.DataDescription := rid;

  6013.   aImage.CreateData;

  6014. 

  6015.   srcMD := FormatDesc.CreateMappingData;

  6016.   try

  6017.     FormatDesc.PreparePixel(Pixel);

  6018.     src := Data;

  6019.     dst := aImage.PixelData;

  6020.     for y := 0 to Height-1 do

  6021.       for x := 0 to Width-1 do begin

  6022.         FormatDesc.Unmap(src, Pixel, srcMD);

  6023.         case rid.BitsPerPixel of

  6024.            8: begin

  6025.             dst^ := Pixel.Data.a;

  6026.             inc(dst);

  6027.           end;

  6028.           16: begin

  6029.             PWord(dst)^ := Pixel.Data.a;

  6030.             inc(dst, 2);

  6031.           end;

  6032.           24: begin

  6033.             PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];

  6034.             PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];

  6035.             PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];

  6036.             inc(dst, 3);

  6037.           end;

  6038.           32: begin

  6039.             PCardinal(dst)^ := Pixel.Data.a;

  6040.             inc(dst, 4);

  6041.           end;

  6042.         else

  6043.           raise EglBitmapUnsupportedFormat.Create(Format);

  6044.         end;

  6045.       end;

  6046.   finally

  6047.     FormatDesc.FreeMappingData(srcMD);

  6048.   end;

  6049.   result := true;

  6050. end;

  6051. 

  6052. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6053. function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;

  6054. var

  6055.   tex: TglBitmap2D;

  6056. begin

  6057.   tex := TglBitmap2D.Create;

  6058.   try

  6059.     tex.AssignFromLazIntfImage(aImage);

  6060.     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);

  6061.   finally

  6062.     tex.Free;

  6063.   end;

  6064. end;

  6065. {$ENDIF}

  6066. 

  6067. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6068. function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;

  6069.   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;

  6070. var

  6071.   rs: TResourceStream;

  6072. begin

  6073.   PrepareResType(aResource, aResType);

  6074.   rs := TResourceStream.Create(aInstance, aResource, aResType);

  6075.   try

  6076.     result := AddAlphaFromStream(rs, aFunc, aArgs);

  6077.   finally

  6078.     rs.Free;

  6079.   end;

  6080. end;

  6081. 

  6082. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  6084.   const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;

  6085. var

  6086.   rs: TResourceStream;

  6087. begin

  6088.   rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);

  6089.   try

  6090.     result := AddAlphaFromStream(rs, aFunc, aArgs);

  6091.   finally

  6092.     rs.Free;

  6093.   end;

  6094. end;

  6095. 

  6096. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6097. function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;

  6098. begin

  6099.   if TFormatDescriptor.Get(Format).IsCompressed then

  6100.     raise EglBitmapUnsupportedFormat.Create(Format);

  6101.   result := Convert(Self, aFunc, false, TFormatDescriptor.Get(Format).WithAlpha, aArgs);

  6102. end;

  6103. 

  6104. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6105. function TglBitmap.AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;

  6106. var

  6107.   FS: TFileStream;

  6108. begin

  6109.   FS := TFileStream.Create(aFileName, fmOpenRead);

  6110.   try

  6111.     result := AddAlphaFromStream(FS, aFunc, aArgs);

  6112.   finally

  6113.     FS.Free;

  6114.   end;

  6115. end;

  6116. 

  6117. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6118. function TglBitmap.AddAlphaFromStream(const aStream: TStream; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;

  6119. var

  6120.   tex: TglBitmap2D;

  6121. begin

  6122.   tex := TglBitmap2D.Create(aStream);

  6123.   try

  6124.     result := AddAlphaFromglBitmap(tex, aFunc, aArgs);

  6125.   finally

  6126.     tex.Free;

  6127.   end;

  6128. end;

  6129. 

  6130. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6131. function TglBitmap.AddAlphaFromGlBitmap(const aBitmap: TglBitmap; aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;

  6132. var

  6133.   DestData, DestData2, SourceData: pByte;

  6134.   TempHeight, TempWidth: Integer;

  6135.   SourceFD, DestFD: TFormatDescriptor;

  6136.   SourceMD, DestMD, DestMD2: Pointer;

  6137. 

  6138.   FuncRec: TglBitmapFunctionRec;

  6139. begin

  6140.   result := false;

  6141. 

  6142.   Assert(Assigned(Data));

  6143.   Assert(Assigned(aBitmap));

  6144.   Assert(Assigned(aBitmap.Data));

  6145. 

  6146.   if ((aBitmap.Width = Width) and (aBitmap.Height = Height)) then begin

  6147.     result := ConvertTo(TFormatDescriptor.Get(Format).WithAlpha);

  6148. 

  6149.     SourceFD := TFormatDescriptor.Get(aBitmap.Format);

  6150.     DestFD   := TFormatDescriptor.Get(Format);

  6151. 

  6152.     if not Assigned(aFunc) then begin

  6153.       aFunc        := glBitmapAlphaFunc;

  6154.       FuncRec.Args := {%H-}Pointer(SourceFD.HasAlpha);

  6155.     end else

  6156.       FuncRec.Args := aArgs;

  6157. 

  6158.     // Values

  6159.     TempHeight := aBitmap.FileHeight;

  6160.     TempWidth  := aBitmap.FileWidth;

  6161. 

  6162.     FuncRec.Sender          := Self;

  6163.     FuncRec.Size            := Dimension;

  6164.     FuncRec.Position.Fields := FuncRec.Size.Fields;

  6165. 

  6166.     DestData   := Data;

  6167.     DestData2  := Data;

  6168.     SourceData := aBitmap.Data;

  6169. 

  6170.     // Mapping

  6171.     SourceFD.PreparePixel(FuncRec.Source);

  6172.     DestFD.PreparePixel  (FuncRec.Dest);

  6173. 

  6174.     SourceMD := SourceFD.CreateMappingData;

  6175.     DestMD   := DestFD.CreateMappingData;

  6176.     DestMD2  := DestFD.CreateMappingData;

  6177.     try

  6178.       FuncRec.Position.Y := 0;

  6179.       while FuncRec.Position.Y < TempHeight do begin

  6180.         FuncRec.Position.X := 0;

  6181.         while FuncRec.Position.X < TempWidth do begin

  6182.           SourceFD.Unmap(SourceData, FuncRec.Source, SourceMD);

  6183.           DestFD.Unmap  (DestData,   FuncRec.Dest,   DestMD);

  6184.           aFunc(FuncRec);

  6185.           DestFD.Map(FuncRec.Dest, DestData2, DestMD2);

  6186.           inc(FuncRec.Position.X);

  6187.         end;

  6188.         inc(FuncRec.Position.Y);

  6189.       end;

  6190.     finally

  6191.       SourceFD.FreeMappingData(SourceMD);

  6192.       DestFD.FreeMappingData(DestMD);

  6193.       DestFD.FreeMappingData(DestMD2);

  6194.     end;

  6195.   end;

  6196. end;

  6197. 

  6198. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6199. function TglBitmap.AddAlphaFromColorKey(const aRed, aGreen, aBlue: Byte; const aDeviation: Byte): Boolean;

  6200. begin

  6201.   result := AddAlphaFromColorKeyFloat(aRed / $FF, aGreen / $FF, aBlue / $FF, aDeviation / $FF);

  6202. end;

  6203. 

  6204. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6205. function TglBitmap.AddAlphaFromColorKeyRange(const aRed, aGreen, aBlue: Cardinal; const aDeviation: Cardinal): Boolean;

  6206. var

  6207.   PixelData: TglBitmapPixelData;

  6208. begin

  6209.   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);

  6210.   result := AddAlphaFromColorKeyFloat(

  6211.     aRed   / PixelData.Range.r,

  6212.     aGreen / PixelData.Range.g,

  6213.     aBlue  / PixelData.Range.b,

  6214.     aDeviation / Max(PixelData.Range.r, Max(PixelData.Range.g, PixelData.Range.b)));

  6215. end;

  6216. 

  6217. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6218. function TglBitmap.AddAlphaFromColorKeyFloat(const aRed, aGreen, aBlue: Single; const aDeviation: Single): Boolean;

  6219. var

  6220.   values: array[0..2] of Single;

  6221.   tmp: Cardinal;

  6222.   i: Integer;

  6223.   PixelData: TglBitmapPixelData;

  6224. begin

  6225.   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);

  6226.   with PixelData do begin

  6227.     values[0] := aRed;

  6228.     values[1] := aGreen;

  6229.     values[2] := aBlue;

  6230. 

  6231.     for i := 0 to 2 do begin

  6232.       tmp          := Trunc(Range.arr[i] * aDeviation);

  6233.       Data.arr[i]  := Min(Range.arr[i], Trunc(Range.arr[i] * values[i] + tmp));

  6234.       Range.arr[i] := Max(0,            Trunc(Range.arr[i] * values[i] - tmp));

  6235.     end;

  6236.     Data.a  := 0;

  6237.     Range.a := 0;

  6238.   end;

  6239.   result := AddAlphaFromFunc(glBitmapColorKeyAlphaFunc, @PixelData);

  6240. end;

  6241. 

  6242. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6243. function TglBitmap.AddAlphaFromValue(const aAlpha: Byte): Boolean;

  6244. begin

  6245.   result := AddAlphaFromValueFloat(aAlpha / $FF);

  6246. end;

  6247. 

  6248. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6249. function TglBitmap.AddAlphaFromValueRange(const aAlpha: Cardinal): Boolean;

  6250. var

  6251.   PixelData: TglBitmapPixelData;

  6252. begin

  6253.   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);

  6254.   result := AddAlphaFromValueFloat(aAlpha / PixelData.Range.a);

  6255. end;

  6256. 

  6257. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6258. function TglBitmap.AddAlphaFromValueFloat(const aAlpha: Single): Boolean;

  6259. var

  6260.   PixelData: TglBitmapPixelData;

  6261. begin

  6262.   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);

  6263.   with PixelData do

  6264.     Data.a := Min(Range.a, Max(0, Round(Range.a * aAlpha)));

  6265.   result := AddAlphaFromFunc(glBitmapValueAlphaFunc, @PixelData.Data.a);

  6266. end;

  6267. 

  6268. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6269. function TglBitmap.RemoveAlpha: Boolean;

  6270. var

  6271.   FormatDesc: TFormatDescriptor;

  6272. begin

  6273.   result := false;

  6274.   FormatDesc := TFormatDescriptor.Get(Format);

  6275.   if Assigned(Data) then begin

  6276.     if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then

  6277.       raise EglBitmapUnsupportedFormat.Create(Format);

  6278.     result := ConvertTo(FormatDesc.WithoutAlpha);

  6279.   end;

  6280. end;

  6281. 

  6282. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6283. function TglBitmap.Clone: TglBitmap;

  6284. var

  6285.   Temp: TglBitmap;

  6286.   TempPtr: PByte;

  6287.   Size: Integer;

  6288. begin

  6289.   result := nil;

  6290.   Temp := (ClassType.Create as TglBitmap);

  6291.   try

  6292.     // copy texture data if assigned

  6293.     if Assigned(Data) then begin

  6294.       Size := TFormatDescriptor.Get(Format).GetSize(fDimension);

  6295.       GetMem(TempPtr, Size);

  6296.       try

  6297.         Move(Data^, TempPtr^, Size);

  6298.         Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method

  6299.       except

  6300.         if Assigned(TempPtr) then

  6301.           FreeMem(TempPtr);

  6302.         raise;

  6303.       end;

  6304.     end else begin

  6305.       TempPtr := nil;

  6306.       Temp.SetDataPointer(TempPtr, Format, Width, Height); //be careful, Data could be freed by this method

  6307.     end;

  6308. 

  6309. 	// copy properties

  6310.     Temp.fID                      := ID;

  6311.     Temp.fTarget                  := Target;

  6312.     Temp.fFormat                  := Format;

  6313.     Temp.fMipMap                  := MipMap;

  6314.     Temp.fAnisotropic             := Anisotropic;

  6315.     Temp.fBorderColor             := fBorderColor;

  6316.     Temp.fDeleteTextureOnFree     := DeleteTextureOnFree;

  6317.     Temp.fFreeDataAfterGenTexture := FreeDataAfterGenTexture;

  6318.     Temp.fFilterMin               := fFilterMin;

  6319.     Temp.fFilterMag               := fFilterMag;

  6320.     Temp.fWrapS                   := fWrapS;

  6321.     Temp.fWrapT                   := fWrapT;

  6322.     Temp.fWrapR                   := fWrapR;

  6323.     Temp.fFilename                := fFilename;

  6324.     Temp.fCustomName              := fCustomName;

  6325.     Temp.fCustomNameW             := fCustomNameW;

  6326.     Temp.fCustomData              := fCustomData;

  6327. 

  6328.     result := Temp;

  6329.   except

  6330.     FreeAndNil(Temp);

  6331.     raise;

  6332.   end;

  6333. end;

  6334. 

  6335. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6336. procedure TglBitmap.Invert(const aUseRGB: Boolean; const aUseAlpha: Boolean);

  6337. begin

  6338.   if aUseRGB or aUseAlpha then

  6339.     Convert(glBitmapInvertFunc, false, {%H-}Pointer(

  6340.       ((Byte(aUseAlpha) and 1) shl 1) or

  6341.        (Byte(aUseRGB)   and 1)      ));

  6342. end;

  6343. 

  6344. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6345. procedure TglBitmap.FreeData;

  6346. var

  6347.   TempPtr: PByte;

  6348. begin

  6349.   TempPtr := nil;

  6350.   SetDataPointer(TempPtr, tfEmpty); //be careful, Data could be freed by this method

  6351. end;

  6352. 

  6353. {$IFNDEF OPENGL_ES}

  6354. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  6356. begin

  6357.   fBorderColor[0] := aRed;

  6358.   fBorderColor[1] := aGreen;

  6359.   fBorderColor[2] := aBlue;

  6360.   fBorderColor[3] := aAlpha;

  6361.   if (ID > 0) then begin

  6362.     Bind(false);

  6363.     glTexParameterfv(Target, GL_TEXTURE_BORDER_COLOR, @fBorderColor[0]);

  6364.   end;

  6365. end;

  6366. {$ENDIF}

  6367. 

  6368. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6369. procedure TglBitmap.FillWithColor(const aRed, aGreen, aBlue: Byte;

  6370.   const aAlpha: Byte);

  6371. begin

  6372.   FillWithColorFloat(aRed/$FF, aGreen/$FF, aBlue/$FF, aAlpha/$FF);

  6373. end;

  6374. 

  6375. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6376. procedure TglBitmap.FillWithColorRange(const aRed, aGreen, aBlue: Cardinal; const aAlpha: Cardinal);

  6377. var

  6378.   PixelData: TglBitmapPixelData;

  6379. begin

  6380.   TFormatDescriptor.GetAlpha(Format).PreparePixel(PixelData);

  6381.   FillWithColorFloat(

  6382.     aRed   / PixelData.Range.r,

  6383.     aGreen / PixelData.Range.g,

  6384.     aBlue  / PixelData.Range.b,

  6385.     aAlpha / PixelData.Range.a);

  6386. end;

  6387. 

  6388. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6389. procedure TglBitmap.FillWithColorFloat(const aRed, aGreen, aBlue: Single; const aAlpha: Single);

  6390. var

  6391.   PixelData: TglBitmapPixelData;

  6392. begin

  6393.   TFormatDescriptor.Get(Format).PreparePixel(PixelData);

  6394.   with PixelData do begin

  6395.     Data.r := Max(0, Min(Range.r, Trunc(Range.r * aRed)));

  6396.     Data.g := Max(0, Min(Range.g, Trunc(Range.g * aGreen)));

  6397.     Data.b := Max(0, Min(Range.b, Trunc(Range.b * aBlue)));

  6398.     Data.a := Max(0, Min(Range.a, Trunc(Range.a * aAlpha)));

  6399.   end;

  6400.   Convert(glBitmapFillWithColorFunc, false, @PixelData);

  6401. end;

  6402. 

  6403. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  6405. begin

  6406.   //check MIN filter

  6407.   case aMin of

  6408.     GL_NEAREST:

  6409.       fFilterMin := GL_NEAREST;

  6410.     GL_LINEAR:

  6411.       fFilterMin := GL_LINEAR;

  6412.     GL_NEAREST_MIPMAP_NEAREST:

  6413.       fFilterMin := GL_NEAREST_MIPMAP_NEAREST;

  6414.     GL_LINEAR_MIPMAP_NEAREST:

  6415.       fFilterMin := GL_LINEAR_MIPMAP_NEAREST;

  6416.     GL_NEAREST_MIPMAP_LINEAR:

  6417.       fFilterMin := GL_NEAREST_MIPMAP_LINEAR;

  6418.     GL_LINEAR_MIPMAP_LINEAR:

  6419.       fFilterMin := GL_LINEAR_MIPMAP_LINEAR;

  6420.     else

  6421.       raise EglBitmap.Create('SetFilter - Unknow MIN filter.');

  6422.   end;

  6423. 

  6424.   //check MAG filter

  6425.   case aMag of

  6426.     GL_NEAREST:

  6427.       fFilterMag := GL_NEAREST;

  6428.     GL_LINEAR:

  6429.       fFilterMag := GL_LINEAR;

  6430.     else

  6431.       raise EglBitmap.Create('SetFilter - Unknow MAG filter.');

  6432.   end;

  6433. 

  6434.   //apply filter

  6435.   if (ID > 0) then begin

  6436.     Bind(false);

  6437.     glTexParameteri(Target, GL_TEXTURE_MAG_FILTER, fFilterMag);

  6438. 

  6439.     if (MipMap = mmNone) {$IFNDEF OPENGL_ES}or (Target = GL_TEXTURE_RECTANGLE){$ENDIF} then begin

  6440.       case fFilterMin of

  6441.         GL_NEAREST, GL_LINEAR:

  6442.           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);

  6443.         GL_NEAREST_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR:

  6444.           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_NEAREST);

  6445.         GL_LINEAR_MIPMAP_NEAREST, GL_LINEAR_MIPMAP_LINEAR:

  6446.           glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, GL_LINEAR);

  6447.       end;

  6448.     end else

  6449.       glTexParameteri(Target, GL_TEXTURE_MIN_FILTER, fFilterMin);

  6450.   end;

  6451. end;

  6452. 

  6453. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6454. procedure TglBitmap.SetWrap(const S: GLenum; const T: GLenum; const R: GLenum);

  6455. 

  6456.   procedure CheckAndSetWrap(const aValue: Cardinal; var aTarget: Cardinal);

  6457.   begin

  6458.     case aValue of

  6459. {$IFNDEF OPENGL_ES}

  6460.       GL_CLAMP:

  6461.         aTarget := GL_CLAMP;

  6462. {$ENDIF}

  6463. 

  6464.       GL_REPEAT:

  6465.         aTarget := GL_REPEAT;

  6466. 

  6467.       GL_CLAMP_TO_EDGE: begin

  6468. {$IFNDEF OPENGL_ES}

  6469.         if not GL_VERSION_1_2 and not GL_EXT_texture_edge_clamp then

  6470.           aTarget := GL_CLAMP

  6471.         else

  6472. {$ENDIF}

  6473.           aTarget := GL_CLAMP_TO_EDGE;

  6474.       end;

  6475. 

  6476. {$IFNDEF OPENGL_ES}

  6477.       GL_CLAMP_TO_BORDER: begin

  6478.         if GL_VERSION_1_3 or GL_ARB_texture_border_clamp then

  6479.           aTarget := GL_CLAMP_TO_BORDER

  6480.         else

  6481.           aTarget := GL_CLAMP;

  6482.       end;

  6483. {$ENDIF}

  6484. 

  6485. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}

  6486.       GL_MIRRORED_REPEAT: begin

  6487.   {$IFNDEF OPENGL_ES}

  6488.         if GL_VERSION_1_4 or GL_ARB_texture_mirrored_repeat or GL_IBM_texture_mirrored_repeat then

  6489.   {$ELSE}

  6490.         if GL_VERSION_2_0 then

  6491.   {$ENDIF}

  6492.           aTarget := GL_MIRRORED_REPEAT

  6493.         else

  6494.           raise EglBitmap.Create('SetWrap - Unsupported Texturewrap GL_MIRRORED_REPEAT (S).');

  6495.       end;

  6496. {$IFEND}

  6497.     else

  6498.       raise EglBitmap.Create('SetWrap - Unknow Texturewrap');

  6499.     end;

  6500.   end;

  6501. 

  6502. begin

  6503.   CheckAndSetWrap(S, fWrapS);

  6504.   CheckAndSetWrap(T, fWrapT);

  6505.   CheckAndSetWrap(R, fWrapR);

  6506. 

  6507.   if (ID > 0) then begin

  6508.     Bind(false);

  6509.     glTexParameteri(Target, GL_TEXTURE_WRAP_S, fWrapS);

  6510.     glTexParameteri(Target, GL_TEXTURE_WRAP_T, fWrapT);

  6511. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}

  6512.     {$IFDEF OPENGL_ES} if GL_VERSION_3_0 then{$ENDIF}

  6513.     glTexParameteri(Target, GL_TEXTURE_WRAP_R, fWrapR);

  6514. {$IFEND}

  6515.   end;

  6516. end;

  6517. 

  6518. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}

  6519. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  6521. 

  6522.   procedure CheckAndSetValue(const aValue: GLenum; const aIndex: Integer);

  6523.   begin

  6524.     if (aValue = GL_ZERO) or (aValue =   GL_ONE) or (aValue = GL_ALPHA) or

  6525.        (aValue =  GL_RED) or (aValue = GL_GREEN) or (aValue =  GL_BLUE) then

  6526.       fSwizzle[aIndex] := aValue

  6527.     else

  6528.       raise EglBitmap.Create('SetSwizzle - Unknow Swizle Value');

  6529.   end;

  6530. 

  6531. begin

  6532. {$IFNDEF OPENGL_ES}

  6533.   if not (GL_ARB_texture_swizzle or GL_EXT_texture_swizzle or GL_VERSION_3_3) then

  6534.     raise EglBitmapNotSupported.Create('texture swizzle is not supported');

  6535. {$ELSE}

  6536.   if not GL_VERSION_3_0 then

  6537.     raise EglBitmapNotSupported.Create('texture swizzle is not supported');

  6538. {$ENDIF}

  6539.   CheckAndSetValue(r, 0);

  6540.   CheckAndSetValue(g, 1);

  6541.   CheckAndSetValue(b, 2);

  6542.   CheckAndSetValue(a, 3);

  6543. 

  6544.   if (ID > 0) then begin

  6545.     Bind(false);

  6546. {$IFNDEF OPENGL_ES}

  6547.     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_RGBA, PGLint(@fSwizzle[0]));

  6548. {$ELSE}

  6549.     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_R, PGLint(@fSwizzle[0]));

  6550.     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_G, PGLint(@fSwizzle[1]));

  6551.     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_B, PGLint(@fSwizzle[2]));

  6552.     glTexParameteriv(Target, GL_TEXTURE_SWIZZLE_A, PGLint(@fSwizzle[3]));

  6553. {$ENDIF}

  6554.   end;

  6555. end;

  6556. {$IFEND}

  6557. 

  6558. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6559. procedure TglBitmap.Bind(const aEnableTextureUnit: Boolean);

  6560. begin

  6561.   if aEnableTextureUnit then

  6562.     glEnable(Target);

  6563.   if (ID > 0) then

  6564.     glBindTexture(Target, ID);

  6565. end;

  6566. 

  6567. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6568. procedure TglBitmap.Unbind(const aDisableTextureUnit: Boolean);

  6569. begin

  6570.   if aDisableTextureUnit then

  6571.     glDisable(Target);

  6572.   glBindTexture(Target, 0);

  6573. end;

  6574. 

  6575. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6576. constructor TglBitmap.Create;

  6577. begin

  6578.   if (ClassType = TglBitmap) then

  6579.     raise EglBitmap.Create('Don''t create TglBitmap directly. Use one of the deviated classes (TglBitmap2D) instead.');

  6580. {$IFDEF GLB_NATIVE_OGL}

  6581.   glbReadOpenGLExtensions;

  6582. {$ENDIF}

  6583.   inherited Create;

  6584.   fFormat            := glBitmapGetDefaultFormat;

  6585.   fFreeDataOnDestroy := true;

  6586. end;

  6587. 

  6588. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6589. constructor TglBitmap.Create(const aFileName: String);

  6590. begin

  6591.   Create;

  6592.   LoadFromFile(aFileName);

  6593. end;

  6594. 

  6595. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6596. constructor TglBitmap.Create(const aStream: TStream);

  6597. begin

  6598.   Create;

  6599.   LoadFromStream(aStream);

  6600. end;

  6601. 

  6602. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6603. constructor TglBitmap.Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; aData: PByte);

  6604. var

  6605.   ImageSize: Integer;

  6606. begin

  6607.   Create;

  6608.   if not Assigned(aData) then begin

  6609.     ImageSize := TFormatDescriptor.Get(aFormat).GetSize(aSize);

  6610.     GetMem(aData, ImageSize);

  6611.     try

  6612.       FillChar(aData^, ImageSize, #$FF);

  6613.       SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method

  6614.     except

  6615.       if Assigned(aData) then

  6616.         FreeMem(aData);

  6617.       raise;

  6618.     end;

  6619.   end else begin

  6620.     SetDataPointer(aData, aFormat, aSize.X, aSize.Y); //be careful, Data could be freed by this method

  6621.   end;

  6622. end;

  6623. 

  6624. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6625. constructor TglBitmap.Create(const aSize: TglBitmapSize; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer);

  6626. begin

  6627.   Create;

  6628.   LoadFromFunc(aSize, aFunc, aFormat, aArgs);

  6629. end;

  6630. 

  6631. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6632. constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);

  6633. begin

  6634.   Create;

  6635.   LoadFromResource(aInstance, aResource, aResType);

  6636. end;

  6637. 

  6638. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6639. constructor TglBitmap.Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);

  6640. begin

  6641.   Create;

  6642.   LoadFromResourceID(aInstance, aResourceID, aResType);

  6643. end;

  6644. 

  6645. {$IFDEF GLB_SUPPORT_PNG_READ}

  6646. {$IF DEFINED(GLB_LAZ_PNG)}

  6647. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6648. //PNG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6649. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6650. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;

  6651. const

  6652.   MAGIC_LEN = 8;

  6653.   PNG_MAGIC: String[MAGIC_LEN] = #$89#$50#$4E#$47#$0D#$0A#$1A#$0A;

  6654. var

  6655.   reader: TLazReaderPNG;

  6656.   intf: TLazIntfImage;

  6657.   StreamPos: Int64;

  6658.   magic: String[MAGIC_LEN];

  6659. begin

  6660.   result := true;

  6661.   StreamPos := aStream.Position;

  6662. 

  6663.   SetLength(magic, MAGIC_LEN);

  6664.   aStream.Read(magic[1], MAGIC_LEN);

  6665.   aStream.Position := StreamPos;

  6666.   if (magic <> PNG_MAGIC) then begin

  6667.     result := false;

  6668.     exit;

  6669.   end;

  6670. 

  6671.   intf   := TLazIntfImage.Create(0, 0);

  6672.   reader := TLazReaderPNG.Create;

  6673.   try try

  6674.     reader.UpdateDescription := true;

  6675.     reader.ImageRead(aStream, intf);

  6676.     AssignFromLazIntfImage(intf);

  6677.   except

  6678.     result := false;

  6679.     aStream.Position := StreamPos;

  6680.     exit;

  6681.   end;

  6682.   finally

  6683.     reader.Free;

  6684.     intf.Free;

  6685.   end;

  6686. end;

  6687. 

  6688. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}

  6689. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6690. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;

  6691. var

  6692.   Surface: PSDL_Surface;

  6693.   RWops: PSDL_RWops;

  6694. begin

  6695.   result := false;

  6696.   RWops := glBitmapCreateRWops(aStream);

  6697.   try

  6698.     if IMG_isPNG(RWops) > 0 then begin

  6699.       Surface := IMG_LoadPNG_RW(RWops);

  6700.       try

  6701.         AssignFromSurface(Surface);

  6702.         result := true;

  6703.       finally

  6704.         SDL_FreeSurface(Surface);

  6705.       end;

  6706.     end;

  6707.   finally

  6708.     SDL_FreeRW(RWops);

  6709.   end;

  6710. end;

  6711. 

  6712. {$ELSEIF DEFINED(GLB_LIB_PNG)}

  6713. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6714. procedure glBitmap_libPNG_read_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;

  6715. begin

  6716.   TStream(png_get_io_ptr(png)).Read(buffer^, size);

  6717. end;

  6718. 

  6719. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6720. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;

  6721. var

  6722.   StreamPos: Int64;

  6723.   signature: array [0..7] of byte;

  6724.   png: png_structp;

  6725.   png_info: png_infop;

  6726. 

  6727.   TempHeight, TempWidth: Integer;

  6728.   Format: TglBitmapFormat;

  6729. 

  6730.   png_data: pByte;

  6731.   png_rows: array of pByte;

  6732.   Row, LineSize: Integer;

  6733. begin

  6734.   result := false;

  6735. 

  6736.   if not init_libPNG then

  6737.     raise Exception.Create('LoadPNG - unable to initialize libPNG.');

  6738. 

  6739.   try

  6740.     // signature

  6741.     StreamPos := aStream.Position;

  6742.     aStream.Read(signature{%H-}, 8);

  6743.     aStream.Position := StreamPos;

  6744. 

  6745.     if png_check_sig(@signature, 8) <> 0 then begin

  6746.       // png read struct

  6747.       png := png_create_read_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);

  6748.       if png = nil then

  6749.         raise EglBitmapException.Create('LoadPng - couldn''t create read struct.');

  6750. 

  6751.       // png info

  6752.       png_info := png_create_info_struct(png);

  6753.       if png_info = nil then begin

  6754.         png_destroy_read_struct(@png, nil, nil);

  6755.         raise EglBitmapException.Create('LoadPng - couldn''t create info struct.');

  6756.       end;

  6757. 

  6758.       // set read callback

  6759.       png_set_read_fn(png, aStream, glBitmap_libPNG_read_func);

  6760. 

  6761.       // read informations

  6762.       png_read_info(png, png_info);

  6763. 

  6764.       // size

  6765.       TempHeight := png_get_image_height(png, png_info);

  6766.       TempWidth := png_get_image_width(png, png_info);

  6767. 

  6768.       // format

  6769.       case png_get_color_type(png, png_info) of

  6770.         PNG_COLOR_TYPE_GRAY:

  6771.           Format := tfLuminance8ub1;

  6772.         PNG_COLOR_TYPE_GRAY_ALPHA:

  6773.           Format := tfLuminance8Alpha8us1;

  6774.         PNG_COLOR_TYPE_RGB:

  6775.           Format := tfRGB8ub3;

  6776.         PNG_COLOR_TYPE_RGB_ALPHA:

  6777.           Format := tfRGBA8ub4;

  6778.         else

  6779.           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');

  6780.       end;

  6781. 

  6782.       // cut upper 8 bit from 16 bit formats

  6783.       if png_get_bit_depth(png, png_info) > 8 then

  6784.         png_set_strip_16(png);

  6785. 

  6786.       // expand bitdepth smaller than 8

  6787.       if png_get_bit_depth(png, png_info) < 8 then

  6788.         png_set_expand(png);

  6789. 

  6790.       // allocating mem for scanlines

  6791.       LineSize := png_get_rowbytes(png, png_info);

  6792.       GetMem(png_data, TempHeight * LineSize);

  6793.       try

  6794.         SetLength(png_rows, TempHeight);

  6795.         for Row := Low(png_rows) to High(png_rows) do begin

  6796.           png_rows[Row] := png_data;

  6797.           Inc(png_rows[Row], Row * LineSize);

  6798.         end;

  6799. 

  6800.         // read complete image into scanlines

  6801.         png_read_image(png, @png_rows[0]);

  6802. 

  6803.         // read end

  6804.         png_read_end(png, png_info);

  6805. 

  6806.         // destroy read struct

  6807.         png_destroy_read_struct(@png, @png_info, nil);

  6808. 

  6809.         SetLength(png_rows, 0);

  6810. 

  6811.         // set new data

  6812.         SetDataPointer(png_data, Format, TempWidth, TempHeight); //be careful, Data could be freed by this method

  6813. 

  6814.         result := true;

  6815.       except

  6816.         if Assigned(png_data) then

  6817.           FreeMem(png_data);

  6818.         raise;

  6819.       end;

  6820.     end;

  6821.   finally

  6822.     quit_libPNG;

  6823.   end;

  6824. end;

  6825. 

  6826. {$ELSEIF DEFINED(GLB_PNGIMAGE)}

  6827. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6828. function TglBitmap.LoadPNG(const aStream: TStream): Boolean;

  6829. var

  6830.   StreamPos: Int64;

  6831.   Png: TPNGObject;

  6832.   Header: String[8];

  6833.   Row, Col, PixSize, LineSize: Integer;

  6834.   NewImage, pSource, pDest, pAlpha: pByte;

  6835.   PngFormat: TglBitmapFormat;

  6836.   FormatDesc: TFormatDescriptor;

  6837. 

  6838. const

  6839.   PngHeader: String[8] = #137#80#78#71#13#10#26#10;

  6840. 

  6841. begin

  6842.   result := false;

  6843. 

  6844.   StreamPos := aStream.Position;

  6845.   aStream.Read(Header[0], SizeOf(Header));

  6846.   aStream.Position := StreamPos;

  6847. 

  6848.   {Test if the header matches}

  6849.   if Header = PngHeader then begin

  6850.     Png := TPNGObject.Create;

  6851.     try

  6852.       Png.LoadFromStream(aStream);

  6853. 

  6854.       case Png.Header.ColorType of

  6855.         COLOR_GRAYSCALE:

  6856.           PngFormat := tfLuminance8ub1;

  6857.         COLOR_GRAYSCALEALPHA:

  6858.           PngFormat := tfLuminance8Alpha8us1;

  6859.         COLOR_RGB:

  6860.           PngFormat := tfBGR8ub3;

  6861.         COLOR_RGBALPHA:

  6862.           PngFormat := tfBGRA8ub4;

  6863.         else

  6864.           raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');

  6865.       end;

  6866. 

  6867.       FormatDesc := TFormatDescriptor.Get(PngFormat);

  6868.       PixSize    := Round(FormatDesc.PixelSize);

  6869.       LineSize   := FormatDesc.GetSize(Png.Header.Width, 1);

  6870. 

  6871.       GetMem(NewImage, LineSize * Integer(Png.Header.Height));

  6872.       try

  6873.         pDest := NewImage;

  6874. 

  6875.         case Png.Header.ColorType of

  6876.           COLOR_RGB, COLOR_GRAYSCALE:

  6877.             begin

  6878.               for Row := 0 to Png.Height -1 do begin

  6879.                 Move (Png.Scanline[Row]^, pDest^, LineSize);

  6880.                 Inc(pDest, LineSize);

  6881.               end;

  6882.             end;

  6883.           COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:

  6884.             begin

  6885.               PixSize := PixSize -1;

  6886. 

  6887.               for Row := 0 to Png.Height -1 do begin

  6888.                 pSource := Png.Scanline[Row];

  6889.                 pAlpha := pByte(Png.AlphaScanline[Row]);

  6890. 

  6891.                 for Col := 0 to Png.Width -1 do begin

  6892.                   Move (pSource^, pDest^, PixSize);

  6893.                   Inc(pSource, PixSize);

  6894.                   Inc(pDest, PixSize);

  6895. 

  6896.                   pDest^ := pAlpha^;

  6897.                   inc(pAlpha);

  6898.                   Inc(pDest);

  6899.                 end;

  6900.               end;

  6901.             end;

  6902.           else

  6903.             raise EglBitmapException.Create ('LoadPng - Unsupported Colortype found.');

  6904.         end;

  6905. 

  6906.         SetDataPointer(NewImage, PngFormat, Png.Header.Width, Png.Header.Height); //be careful, Data could be freed by this method

  6907. 

  6908.         result := true;

  6909.       except

  6910.         if Assigned(NewImage) then

  6911.           FreeMem(NewImage);

  6912.         raise;

  6913.       end;

  6914.     finally

  6915.       Png.Free;

  6916.     end;

  6917.   end;

  6918. end;

  6919. {$IFEND}

  6920. {$ENDIF}

  6921. 

  6922. {$IFDEF GLB_SUPPORT_PNG_WRITE}

  6923. {$IFDEF GLB_LIB_PNG}

  6924. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6925. procedure glBitmap_libPNG_write_func(png: png_structp; buffer: png_bytep; size: cardinal); cdecl;

  6926. begin

  6927.   TStream(png_get_io_ptr(png)).Write(buffer^, size);

  6928. end;

  6929. {$ENDIF}

  6930. 

  6931. {$IF DEFINED(GLB_LAZ_PNG)}

  6932. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6933. procedure TglBitmap.SavePNG(const aStream: TStream);

  6934. var

  6935.   png: TPortableNetworkGraphic;

  6936.   intf: TLazIntfImage;

  6937.   raw: TRawImage;

  6938. begin

  6939.   png  := TPortableNetworkGraphic.Create;

  6940.   intf := TLazIntfImage.Create(0, 0);

  6941.   try

  6942.     if not AssignToLazIntfImage(intf) then

  6943.       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');

  6944.     intf.GetRawImage(raw);

  6945.     png.LoadFromRawImage(raw, false);

  6946.     png.SaveToStream(aStream);

  6947.   finally

  6948.     png.Free;

  6949.     intf.Free;

  6950.   end;

  6951. end;

  6952. 

  6953. {$ELSEIF DEFINED(GLB_LIB_PNG)}

  6954. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  6955. procedure TglBitmap.SavePNG(const aStream: TStream);

  6956. var

  6957.   png: png_structp;

  6958.   png_info: png_infop;

  6959.   png_rows: array of pByte;

  6960.   LineSize: Integer;

  6961.   ColorType: Integer;

  6962.   Row: Integer;

  6963.   FormatDesc: TFormatDescriptor;

  6964. begin

  6965.   if not (ftPNG in FormatGetSupportedFiles(Format)) then

  6966.     raise EglBitmapUnsupportedFormat.Create(Format);

  6967. 

  6968.   if not init_libPNG then

  6969.     raise Exception.Create('unable to initialize libPNG.');

  6970. 

  6971.   try

  6972.     case Format of

  6973.       tfAlpha8ub1, tfLuminance8ub1:

  6974.         ColorType := PNG_COLOR_TYPE_GRAY;

  6975.       tfLuminance8Alpha8us1:

  6976.         ColorType := PNG_COLOR_TYPE_GRAY_ALPHA;

  6977.       tfBGR8ub3, tfRGB8ub3:

  6978.         ColorType := PNG_COLOR_TYPE_RGB;

  6979.       tfBGRA8ub4, tfRGBA8ub4:

  6980.         ColorType := PNG_COLOR_TYPE_RGBA;

  6981.       else

  6982.         raise EglBitmapUnsupportedFormat.Create(Format);

  6983.     end;

  6984. 

  6985.     FormatDesc := TFormatDescriptor.Get(Format);

  6986.     LineSize := FormatDesc.GetSize(Width, 1);

  6987. 

  6988.     // creating array for scanline

  6989.     SetLength(png_rows, Height);

  6990.     try

  6991.       for Row := 0 to Height - 1 do begin

  6992.         png_rows[Row] := Data;

  6993.         Inc(png_rows[Row], Row * LineSize)

  6994.       end;

  6995. 

  6996.       // write struct

  6997.       png := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, nil, nil);

  6998.       if png = nil then

  6999.         raise EglBitmapException.Create('SavePng - couldn''t create write struct.');

  7000. 

  7001.       // create png info

  7002.       png_info := png_create_info_struct(png);

  7003.       if png_info = nil then begin

  7004.         png_destroy_write_struct(@png, nil);

  7005.         raise EglBitmapException.Create('SavePng - couldn''t create info struct.');

  7006.       end;

  7007. 

  7008.       // set read callback

  7009.       png_set_write_fn(png, aStream, glBitmap_libPNG_write_func, nil);

  7010. 

  7011.       // set compression

  7012.       png_set_compression_level(png, 6);

  7013. 

  7014.       if Format in [tfBGR8ub3, tfBGRA8ub4] then

  7015.         png_set_bgr(png);

  7016. 

  7017.       png_set_IHDR(png, png_info, Width, Height, 8, ColorType, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);

  7018.       png_write_info(png, png_info);

  7019.       png_write_image(png, @png_rows[0]);

  7020.       png_write_end(png, png_info);

  7021.       png_destroy_write_struct(@png, @png_info);

  7022.     finally

  7023.       SetLength(png_rows, 0);

  7024.     end;

  7025.   finally

  7026.     quit_libPNG;

  7027.   end;

  7028. end;

  7029. 

  7030. {$ELSEIF DEFINED(GLB_PNGIMAGE)}

  7031. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7032. procedure TglBitmap.SavePNG(const aStream: TStream);

  7033. var

  7034.   Png: TPNGObject;

  7035. 

  7036.   pSource, pDest: pByte;

  7037.   X, Y, PixSize: Integer;

  7038.   ColorType: Cardinal;

  7039.   Alpha: Boolean;

  7040. 

  7041.   pTemp: pByte;

  7042.   Temp: Byte;

  7043. begin

  7044.   if not (ftPNG in FormatGetSupportedFiles (Format)) then

  7045.     raise EglBitmapUnsupportedFormat.Create(Format);

  7046. 

  7047.   case Format of

  7048.     tfAlpha8ub1, tfLuminance8ub1: begin

  7049.       ColorType := COLOR_GRAYSCALE;

  7050.       PixSize   := 1;

  7051.       Alpha     := false;

  7052.     end;

  7053.     tfLuminance8Alpha8us1: begin

  7054.       ColorType := COLOR_GRAYSCALEALPHA;

  7055.       PixSize   := 1;

  7056.       Alpha     := true;

  7057.     end;

  7058.     tfBGR8ub3, tfRGB8ub3: begin

  7059.       ColorType := COLOR_RGB;

  7060.       PixSize   := 3;

  7061.       Alpha     := false;

  7062.     end;

  7063.     tfBGRA8ub4, tfRGBA8ub4: begin

  7064.       ColorType := COLOR_RGBALPHA;

  7065.       PixSize   := 3;

  7066.       Alpha     := true

  7067.     end;

  7068.   else

  7069.     raise EglBitmapUnsupportedFormat.Create(Format);

  7070.   end;

  7071. 

  7072.   Png := TPNGObject.CreateBlank(ColorType, 8, Width, Height);

  7073.   try

  7074.     // Copy ImageData

  7075.     pSource := Data;

  7076.     for Y := 0 to Height -1 do begin

  7077.       pDest := png.ScanLine[Y];

  7078.       for X := 0 to Width -1 do begin

  7079.         Move(pSource^, pDest^, PixSize);

  7080.         Inc(pDest, PixSize);

  7081.         Inc(pSource, PixSize);

  7082.         if Alpha then begin

  7083.           png.AlphaScanline[Y]^[X] := pSource^;

  7084.           Inc(pSource);

  7085.         end;

  7086.       end;

  7087. 

  7088.       // convert RGB line to BGR

  7089.       if Format in [tfRGB8ub3, tfRGBA8ub4] then begin

  7090.         pTemp := png.ScanLine[Y];

  7091.         for X := 0 to Width -1 do begin

  7092.           Temp := pByteArray(pTemp)^[0];

  7093.           pByteArray(pTemp)^[0] := pByteArray(pTemp)^[2];

  7094.           pByteArray(pTemp)^[2] := Temp;

  7095.           Inc(pTemp, 3);

  7096.         end;

  7097.       end;

  7098.     end;

  7099. 

  7100.     // Save to Stream

  7101.     Png.CompressionLevel := 6;

  7102.     Png.SaveToStream(aStream);

  7103.   finally

  7104.     FreeAndNil(Png);

  7105.   end;

  7106. end;

  7107. {$IFEND}

  7108. {$ENDIF}

  7109. 

  7110. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7111. //JPEG////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7112. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7113. {$IFDEF GLB_LIB_JPEG}

  7114. type

  7115.   glBitmap_libJPEG_source_mgr_ptr = ^glBitmap_libJPEG_source_mgr;

  7116.   glBitmap_libJPEG_source_mgr = record

  7117.     pub: jpeg_source_mgr;

  7118. 

  7119.     SrcStream: TStream;

  7120.     SrcBuffer: array [1..4096] of byte;

  7121.   end;

  7122. 

  7123.   glBitmap_libJPEG_dest_mgr_ptr = ^glBitmap_libJPEG_dest_mgr;

  7124.   glBitmap_libJPEG_dest_mgr = record

  7125.     pub: jpeg_destination_mgr;

  7126. 

  7127.     DestStream: TStream;

  7128.     DestBuffer: array [1..4096] of byte;

  7129.   end;

  7130. 

  7131. procedure glBitmap_libJPEG_error_exit(cinfo: j_common_ptr); cdecl;

  7132. begin

  7133.   //DUMMY

  7134. end;

  7135. 

  7136. 

  7137. procedure glBitmap_libJPEG_output_message(cinfo: j_common_ptr); cdecl;

  7138. begin

  7139.   //DUMMY

  7140. end;

  7141. 

  7142. 

  7143. procedure glBitmap_libJPEG_init_source(cinfo: j_decompress_ptr); cdecl;

  7144. begin

  7145.   //DUMMY

  7146. end;

  7147. 

  7148. procedure glBitmap_libJPEG_term_source(cinfo: j_decompress_ptr); cdecl;

  7149. begin

  7150.   //DUMMY

  7151. end;

  7152. 

  7153. 

  7154. procedure glBitmap_libJPEG_init_destination(cinfo: j_compress_ptr); cdecl;

  7155. begin

  7156.   //DUMMY

  7157. end;

  7158. 

  7159. 

  7160. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7161. function glBitmap_libJPEG_fill_input_buffer(cinfo: j_decompress_ptr): boolean; cdecl;

  7162. var

  7163.   src: glBitmap_libJPEG_source_mgr_ptr;

  7164.   bytes: integer;

  7165. begin

  7166.   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);

  7167. 

  7168.   bytes := src^.SrcStream.Read(src^.SrcBuffer[1], 4096);

  7169. 	if (bytes <= 0) then begin

  7170. 		src^.SrcBuffer[1] := $FF;

  7171. 		src^.SrcBuffer[2] := JPEG_EOI;

  7172. 		bytes := 2;

  7173. 	end;

  7174. 

  7175. 	src^.pub.next_input_byte := @(src^.SrcBuffer[1]);

  7176. 	src^.pub.bytes_in_buffer := bytes;

  7177. 

  7178.   result := true;

  7179. end;

  7180. 

  7181. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7182. procedure glBitmap_libJPEG_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Longint); cdecl;

  7183. var

  7184.   src: glBitmap_libJPEG_source_mgr_ptr;

  7185. begin

  7186.   src := glBitmap_libJPEG_source_mgr_ptr(cinfo^.src);

  7187. 

  7188.   if num_bytes > 0 then begin

  7189.     // wanted byte isn't in buffer so set stream position and read buffer

  7190.     if num_bytes > src^.pub.bytes_in_buffer then begin

  7191.       src^.SrcStream.Position := src^.SrcStream.Position + num_bytes - src^.pub.bytes_in_buffer;

  7192.       src^.pub.fill_input_buffer(cinfo);

  7193.     end else begin

  7194.       // wanted byte is in buffer so only skip

  7195.   		inc(src^.pub.next_input_byte, num_bytes);

  7196. 	  	dec(src^.pub.bytes_in_buffer, num_bytes);

  7197.     end;

  7198.   end;

  7199. end;

  7200. 

  7201. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7202. function glBitmap_libJPEG_empty_output_buffer(cinfo: j_compress_ptr): boolean; cdecl;

  7203. var

  7204.   dest: glBitmap_libJPEG_dest_mgr_ptr;

  7205. begin

  7206.   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);

  7207. 

  7208.   if dest^.pub.free_in_buffer < Cardinal(Length(dest^.DestBuffer)) then begin

  7209.     // write complete buffer

  7210.     dest^.DestStream.Write(dest^.DestBuffer[1], SizeOf(dest^.DestBuffer));

  7211. 

  7212.     // reset buffer

  7213.     dest^.pub.next_output_byte := @dest^.DestBuffer[1];

  7214.     dest^.pub.free_in_buffer := Length(dest^.DestBuffer);

  7215.   end;

  7216. 

  7217.   result := true;

  7218. end;

  7219. 

  7220. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7221. procedure glBitmap_libJPEG_term_destination(cinfo: j_compress_ptr); cdecl;

  7222. var

  7223.   Idx: Integer;

  7224.   dest: glBitmap_libJPEG_dest_mgr_ptr;

  7225. begin

  7226.   dest := glBitmap_libJPEG_dest_mgr_ptr(cinfo^.dest);

  7227. 

  7228.   for Idx := Low(dest^.DestBuffer) to High(dest^.DestBuffer) do begin

  7229.     // check for endblock

  7230.     if (Idx < High(dest^.DestBuffer)) and (dest^.DestBuffer[Idx] = $FF) and (dest^.DestBuffer[Idx +1] = JPEG_EOI) then begin

  7231.       // write endblock

  7232.       dest^.DestStream.Write(dest^.DestBuffer[Idx], 2);

  7233. 

  7234.       // leave

  7235.       break;

  7236.     end else

  7237.       dest^.DestStream.Write(dest^.DestBuffer[Idx], 1);

  7238.   end;

  7239. end;

  7240. {$ENDIF}

  7241. 

  7242. {$IFDEF GLB_SUPPORT_JPEG_READ}

  7243. {$IF DEFINED(GLB_LAZ_JPEG)}

  7244. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7245. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;

  7246. const

  7247.   MAGIC_LEN = 2;

  7248.   JPEG_MAGIC: String[MAGIC_LEN] = #$FF#$D8;

  7249. var

  7250.   intf: TLazIntfImage;

  7251.   reader: TFPReaderJPEG;

  7252.   StreamPos: Int64;

  7253.   magic: String[MAGIC_LEN];

  7254. begin

  7255.   result := true;

  7256.   StreamPos := aStream.Position;

  7257. 

  7258.   SetLength(magic, MAGIC_LEN);

  7259.   aStream.Read(magic[1], MAGIC_LEN);

  7260.   aStream.Position := StreamPos;

  7261.   if (magic <> JPEG_MAGIC) then begin

  7262.     result := false;

  7263.     exit;

  7264.   end;

  7265. 

  7266.   reader := TFPReaderJPEG.Create;

  7267.   intf := TLazIntfImage.Create(0, 0);

  7268.   try try

  7269.     intf.DataDescription := GetDescriptionFromDevice(0, 0, 0);

  7270.     reader.ImageRead(aStream, intf);

  7271.     AssignFromLazIntfImage(intf);

  7272.   except

  7273.     result := false;

  7274.     aStream.Position := StreamPos;

  7275.     exit;

  7276.   end;

  7277.   finally

  7278.     reader.Free;

  7279.     intf.Free;

  7280.   end;

  7281. end;

  7282. 

  7283. {$ELSEIF DEFINED(GLB_SDL_IMAGE)}

  7284. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7285. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;

  7286. var

  7287.   Surface: PSDL_Surface;

  7288.   RWops: PSDL_RWops;

  7289. begin

  7290.   result := false;

  7291. 

  7292.   RWops := glBitmapCreateRWops(aStream);

  7293.   try

  7294.     if IMG_isJPG(RWops) > 0 then begin

  7295.       Surface := IMG_LoadJPG_RW(RWops);

  7296.       try

  7297.         AssignFromSurface(Surface);

  7298.         result := true;

  7299.       finally

  7300.         SDL_FreeSurface(Surface);

  7301.       end;

  7302.     end;

  7303.   finally

  7304.     SDL_FreeRW(RWops);

  7305.   end;

  7306. end;

  7307. 

  7308. {$ELSEIF DEFINED(GLB_LIB_JPEG)}

  7309. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7310. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;

  7311. var

  7312.   StreamPos: Int64;

  7313.   Temp: array[0..1]of Byte;

  7314. 

  7315.   jpeg: jpeg_decompress_struct;

  7316.   jpeg_err: jpeg_error_mgr;

  7317. 

  7318.   IntFormat: TglBitmapFormat;

  7319.   pImage: pByte;

  7320.   TempHeight, TempWidth: Integer;

  7321. 

  7322.   pTemp: pByte;

  7323.   Row: Integer;

  7324. 

  7325.   FormatDesc: TFormatDescriptor;

  7326. begin

  7327.   result := false;

  7328. 

  7329.   if not init_libJPEG then

  7330.     raise Exception.Create('LoadJPG - unable to initialize libJPEG.');

  7331. 

  7332.   try

  7333.     // reading first two bytes to test file and set cursor back to begin

  7334.     StreamPos := aStream.Position;

  7335.     aStream.Read({%H-}Temp[0], 2);

  7336.     aStream.Position := StreamPos;

  7337. 

  7338.     // if Bitmap then read file.

  7339.     if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin

  7340.       FillChar(jpeg{%H-}, SizeOf(jpeg_decompress_struct), $00);

  7341.       FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);

  7342. 

  7343.       // error managment

  7344.       jpeg.err := jpeg_std_error(@jpeg_err);

  7345.       jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;

  7346.       jpeg_err.output_message := glBitmap_libJPEG_output_message;

  7347. 

  7348.       // decompression struct

  7349.       jpeg_create_decompress(@jpeg);

  7350. 

  7351.       // allocation space for streaming methods

  7352.       jpeg.src := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_source_mgr));

  7353. 

  7354.       // seeting up custom functions

  7355.       with glBitmap_libJPEG_source_mgr_ptr(jpeg.src)^ do begin

  7356.         pub.init_source       := glBitmap_libJPEG_init_source;

  7357.         pub.fill_input_buffer := glBitmap_libJPEG_fill_input_buffer;

  7358.         pub.skip_input_data   := glBitmap_libJPEG_skip_input_data;

  7359.         pub.resync_to_restart := jpeg_resync_to_restart; // use default method

  7360.         pub.term_source       := glBitmap_libJPEG_term_source;

  7361. 

  7362.         pub.bytes_in_buffer := 0;     // forces fill_input_buffer on first read

  7363.         pub.next_input_byte := nil;   // until buffer loaded

  7364. 

  7365.         SrcStream := aStream;

  7366.       end;

  7367. 

  7368.       // set global decoding state

  7369.       jpeg.global_state := DSTATE_START;

  7370. 

  7371.       // read header of jpeg

  7372.       jpeg_read_header(@jpeg, false);

  7373. 

  7374.       // setting output parameter

  7375.       case jpeg.jpeg_color_space of

  7376.         JCS_GRAYSCALE:

  7377.           begin

  7378.             jpeg.out_color_space := JCS_GRAYSCALE;

  7379.             IntFormat := tfLuminance8ub1;

  7380.           end;

  7381.         else

  7382.           jpeg.out_color_space := JCS_RGB;

  7383.           IntFormat := tfRGB8ub3;

  7384.       end;

  7385. 

  7386.       // reading image

  7387.       jpeg_start_decompress(@jpeg);

  7388. 

  7389.       TempHeight := jpeg.output_height;

  7390.       TempWidth := jpeg.output_width;

  7391. 

  7392.       FormatDesc := TFormatDescriptor.Get(IntFormat);

  7393. 

  7394.       // creating new image

  7395.       GetMem(pImage, FormatDesc.GetSize(TempWidth, TempHeight));

  7396.       try

  7397.         pTemp := pImage;

  7398. 

  7399.         for Row := 0 to TempHeight -1 do begin

  7400.           jpeg_read_scanlines(@jpeg, @pTemp, 1);

  7401.           Inc(pTemp, FormatDesc.GetSize(TempWidth, 1));

  7402.         end;

  7403. 

  7404.         // finish decompression

  7405.         jpeg_finish_decompress(@jpeg);

  7406. 

  7407.         // destroy decompression

  7408.         jpeg_destroy_decompress(@jpeg);

  7409. 

  7410.         SetDataPointer(pImage, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method

  7411. 

  7412.         result := true;

  7413.       except

  7414.         if Assigned(pImage) then

  7415.           FreeMem(pImage);

  7416.         raise;

  7417.       end;

  7418.     end;

  7419.   finally

  7420.     quit_libJPEG;

  7421.   end;

  7422. end;

  7423. 

  7424. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}

  7425. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7426. function TglBitmap.LoadJPEG(const aStream: TStream): Boolean;

  7427. var

  7428.   bmp: TBitmap;

  7429.   jpg: TJPEGImage;

  7430.   StreamPos: Int64;

  7431.   Temp: array[0..1]of Byte;

  7432. begin

  7433.   result := false;

  7434. 

  7435.   // reading first two bytes to test file and set cursor back to begin

  7436.   StreamPos := aStream.Position;

  7437.   aStream.Read(Temp[0], 2);

  7438.   aStream.Position := StreamPos;

  7439. 

  7440.   // if Bitmap then read file.

  7441.   if ((Temp[0] = $FF) and (Temp[1] = $D8)) then begin

  7442.     bmp := TBitmap.Create;

  7443.     try

  7444.       jpg := TJPEGImage.Create;

  7445.       try

  7446.         jpg.LoadFromStream(aStream);

  7447.         bmp.Assign(jpg);

  7448.         result := AssignFromBitmap(bmp);

  7449.       finally

  7450.         jpg.Free;

  7451.       end;

  7452.     finally

  7453.       bmp.Free;

  7454.     end;

  7455.   end;

  7456. end;

  7457. {$IFEND}

  7458. {$ENDIF}

  7459. 

  7460. {$IFDEF GLB_SUPPORT_JPEG_WRITE}

  7461. {$IF DEFINED(GLB_LAZ_JPEG)}

  7462. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7463. procedure TglBitmap.SaveJPEG(const aStream: TStream);

  7464. var

  7465.   jpeg: TJPEGImage;

  7466.   intf: TLazIntfImage;

  7467.   raw: TRawImage;

  7468. begin

  7469.   jpeg := TJPEGImage.Create;

  7470.   intf := TLazIntfImage.Create(0, 0);

  7471.   try

  7472.     if not AssignToLazIntfImage(intf) then

  7473.       raise EglBitmap.Create('unable to create LazIntfImage from glBitmap');

  7474.     intf.GetRawImage(raw);

  7475.     jpeg.LoadFromRawImage(raw, false);

  7476.     jpeg.SaveToStream(aStream);

  7477.   finally

  7478.     intf.Free;

  7479.     jpeg.Free;

  7480.   end;

  7481. end;

  7482. 

  7483. {$ELSEIF DEFINED(GLB_LIB_JPEG)}

  7484. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7485. procedure TglBitmap.SaveJPEG(const aStream: TStream);

  7486. var

  7487.   jpeg: jpeg_compress_struct;

  7488.   jpeg_err: jpeg_error_mgr;

  7489.   Row: Integer;

  7490.   pTemp, pTemp2: pByte;

  7491. 

  7492.   procedure CopyRow(pDest, pSource: pByte);

  7493.   var

  7494.     X: Integer;

  7495.   begin

  7496.     for X := 0 to Width - 1 do begin

  7497.       pByteArray(pDest)^[0] := pByteArray(pSource)^[2];

  7498.       pByteArray(pDest)^[1] := pByteArray(pSource)^[1];

  7499.       pByteArray(pDest)^[2] := pByteArray(pSource)^[0];

  7500.       Inc(pDest, 3);

  7501.       Inc(pSource, 3);

  7502.     end;

  7503.   end;

  7504. 

  7505. begin

  7506.   if not (ftJPEG in FormatGetSupportedFiles(Format)) then

  7507.     raise EglBitmapUnsupportedFormat.Create(Format);

  7508. 

  7509.   if not init_libJPEG then

  7510.     raise Exception.Create('SaveJPG - unable to initialize libJPEG.');

  7511. 

  7512.   try

  7513.     FillChar(jpeg{%H-}, SizeOf(jpeg_compress_struct), $00);

  7514.     FillChar(jpeg_err{%H-}, SizeOf(jpeg_error_mgr), $00);

  7515. 

  7516.     // error managment

  7517.     jpeg.err := jpeg_std_error(@jpeg_err);

  7518.     jpeg_err.error_exit     := glBitmap_libJPEG_error_exit;

  7519.     jpeg_err.output_message := glBitmap_libJPEG_output_message;

  7520. 

  7521.     // compression struct

  7522.     jpeg_create_compress(@jpeg);

  7523. 

  7524.     // allocation space for streaming methods

  7525.     jpeg.dest := jpeg.mem^.alloc_small(@jpeg, JPOOL_PERMANENT, SizeOf(glBitmap_libJPEG_dest_mgr));

  7526. 

  7527.     // seeting up custom functions

  7528.     with glBitmap_libJPEG_dest_mgr_ptr(jpeg.dest)^ do begin

  7529.       pub.init_destination    := glBitmap_libJPEG_init_destination;

  7530.       pub.empty_output_buffer := glBitmap_libJPEG_empty_output_buffer;

  7531.       pub.term_destination    := glBitmap_libJPEG_term_destination;

  7532. 

  7533.       pub.next_output_byte  := @DestBuffer[1];

  7534.       pub.free_in_buffer    := Length(DestBuffer);

  7535. 

  7536.       DestStream := aStream;

  7537.     end;

  7538. 

  7539.     // very important state

  7540.     jpeg.global_state := CSTATE_START;

  7541.     jpeg.image_width  := Width;

  7542.     jpeg.image_height := Height;

  7543.     case Format of

  7544.       tfAlpha8ub1, tfLuminance8ub1: begin

  7545.         jpeg.input_components := 1;

  7546.         jpeg.in_color_space   := JCS_GRAYSCALE;

  7547.       end;

  7548.       tfRGB8ub3, tfBGR8ub3: begin

  7549.         jpeg.input_components := 3;

  7550.         jpeg.in_color_space   := JCS_RGB;

  7551.       end;

  7552.     end;

  7553. 

  7554.     jpeg_set_defaults(@jpeg);

  7555.     jpeg_set_quality(@jpeg, 95, true);

  7556.     jpeg_start_compress(@jpeg, true);

  7557.     pTemp := Data;

  7558. 

  7559.     if Format = tfBGR8ub3 then

  7560.       GetMem(pTemp2, fRowSize)

  7561.     else

  7562.       pTemp2 := pTemp;

  7563. 

  7564.     try

  7565.       for Row := 0 to jpeg.image_height -1 do begin

  7566.         // prepare row

  7567.         if Format = tfBGR8ub3 then

  7568.           CopyRow(pTemp2, pTemp)

  7569.         else

  7570.           pTemp2 := pTemp;

  7571. 

  7572.         // write row

  7573.         jpeg_write_scanlines(@jpeg, @pTemp2, 1);

  7574.         inc(pTemp, fRowSize);

  7575.       end;

  7576.     finally

  7577.       // free memory

  7578.       if Format = tfBGR8ub3 then

  7579.         FreeMem(pTemp2);

  7580.     end;

  7581.     jpeg_finish_compress(@jpeg);

  7582.     jpeg_destroy_compress(@jpeg);

  7583.   finally

  7584.     quit_libJPEG;

  7585.   end;

  7586. end;

  7587. 

  7588. {$ELSEIF DEFINED(GLB_DELPHI_JPEG)}

  7589. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7590. procedure TglBitmap.SaveJPEG(const aStream: TStream);

  7591. var

  7592.   Bmp: TBitmap;

  7593.   Jpg: TJPEGImage;

  7594. begin

  7595.   if not (ftJPEG in FormatGetSupportedFiles(Format)) then

  7596.     raise EglBitmapUnsupportedFormat.Create(Format);

  7597. 

  7598.   Bmp := TBitmap.Create;

  7599.   try

  7600.     Jpg := TJPEGImage.Create;

  7601.     try

  7602.       AssignToBitmap(Bmp);

  7603.       if (Format in [tfAlpha8ub1, tfLuminance8ub1]) then begin

  7604.         Jpg.Grayscale   := true;

  7605.         Jpg.PixelFormat := jf8Bit;

  7606.       end;

  7607.       Jpg.Assign(Bmp);

  7608.       Jpg.SaveToStream(aStream);

  7609.     finally

  7610.       FreeAndNil(Jpg);

  7611.     end;

  7612.   finally

  7613.     FreeAndNil(Bmp);

  7614.   end;

  7615. end;

  7616. {$IFEND}

  7617. {$ENDIF}

  7618. 

  7619. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7620. //RAW/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7621. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7622. type

  7623.   RawHeader = packed record

  7624.     Magic:        String[5];

  7625.     Version:      Byte;

  7626.     Width:        Integer;

  7627.     Height:       Integer;

  7628.     DataSize:     Integer;

  7629.     BitsPerPixel: Integer;

  7630.     Precision:    TglBitmapRec4ub;

  7631.     Shift:        TglBitmapRec4ub;

  7632.   end;

  7633. 

  7634. function TglBitmap.LoadRAW(const aStream: TStream): Boolean;

  7635. var

  7636.   header: RawHeader;

  7637.   StartPos: Int64;

  7638.   fd: TFormatDescriptor;

  7639.   buf: PByte;

  7640. begin

  7641.   result := false;

  7642.   StartPos := aStream.Position;

  7643.   aStream.Read(header{%H-}, SizeOf(header));

  7644.   if (header.Magic <> 'glBMP') then begin

  7645.     aStream.Position := StartPos;

  7646.     exit;

  7647.   end;

  7648. 

  7649.   fd := TFormatDescriptor.GetFromPrecShift(header.Precision, header.Shift, header.BitsPerPixel);

  7650.   if (fd.Format = tfEmpty) then

  7651.     raise EglBitmapUnsupportedFormat.Create('no supported format found');

  7652. 

  7653.   buf := GetMemory(header.DataSize);

  7654.   aStream.Read(buf^, header.DataSize);

  7655.   SetDataPointer(buf, fd.Format, header.Width, header.Height);

  7656. 

  7657.   result := true;

  7658. end;

  7659. 

  7660. procedure TglBitmap.SaveRAW(const aStream: TStream);

  7661. var

  7662.   header: RawHeader;

  7663.   fd: TFormatDescriptor;

  7664. begin

  7665.   fd := TFormatDescriptor.Get(Format);

  7666.   header.Magic        := 'glBMP';

  7667.   header.Version      := 1;

  7668.   header.Width        := Width;

  7669.   header.Height       := Height;

  7670.   header.DataSize     := fd.GetSize(fDimension);

  7671.   header.BitsPerPixel := fd.BitsPerPixel;

  7672.   header.Precision    := fd.Precision;

  7673.   header.Shift        := fd.Shift;

  7674.   aStream.Write(header, SizeOf(header));

  7675.   aStream.Write(Data^,  header.DataSize);

  7676. end;

  7677. 

  7678. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7679. //BMP/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7680. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7681. const

  7682.   BMP_MAGIC          = $4D42;

  7683. 

  7684.   BMP_COMP_RGB       = 0;

  7685.   BMP_COMP_RLE8      = 1;

  7686.   BMP_COMP_RLE4      = 2;

  7687.   BMP_COMP_BITFIELDS = 3;

  7688. 

  7689. type

  7690.   TBMPHeader = packed record

  7691.     bfType: Word;

  7692.     bfSize: Cardinal;

  7693.     bfReserved1: Word;

  7694.     bfReserved2: Word;

  7695.     bfOffBits: Cardinal;

  7696.   end;

  7697. 

  7698.   TBMPInfo = packed record

  7699.     biSize: Cardinal;

  7700.     biWidth: Longint;

  7701.     biHeight: Longint;

  7702.     biPlanes: Word;

  7703.     biBitCount: Word;

  7704.     biCompression: Cardinal;

  7705.     biSizeImage: Cardinal;

  7706.     biXPelsPerMeter: Longint;

  7707.     biYPelsPerMeter: Longint;

  7708.     biClrUsed: Cardinal;

  7709.     biClrImportant: Cardinal;

  7710.   end;

  7711. 

  7712. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7713. function TglBitmap.LoadBMP(const aStream: TStream): Boolean;

  7714. 

  7715.   //////////////////////////////////////////////////////////////////////////////////////////////////

  7716.   function ReadInfo(out aInfo: TBMPInfo; out aMask: TglBitmapRec4ul): TglBitmapFormat;

  7717.   begin

  7718.     result := tfEmpty;

  7719.     aStream.Read(aInfo{%H-}, SizeOf(aInfo));

  7720.     FillChar(aMask{%H-}, SizeOf(aMask), 0);

  7721. 

  7722.     //Read Compression

  7723.     case aInfo.biCompression of

  7724.       BMP_COMP_RLE4,

  7725.       BMP_COMP_RLE8: begin

  7726.         raise EglBitmap.Create('RLE compression is not supported');

  7727.       end;

  7728.       BMP_COMP_BITFIELDS: begin

  7729.         if (aInfo.biBitCount = 16) or (aInfo.biBitCount = 32) then begin

  7730.           aStream.Read(aMask.r, SizeOf(aMask.r));

  7731.           aStream.Read(aMask.g, SizeOf(aMask.g));

  7732.           aStream.Read(aMask.b, SizeOf(aMask.b));

  7733.           aStream.Read(aMask.a, SizeOf(aMask.a));

  7734.         end else

  7735.           raise EglBitmap.Create('Bitfields are only supported for 16bit and 32bit formats');

  7736.       end;

  7737.     end;

  7738. 

  7739.     //get suitable format

  7740.     case aInfo.biBitCount of

  7741.        8: result := tfLuminance8ub1;

  7742.       16: result := tfX1RGB5us1;

  7743.       24: result := tfBGR8ub3;

  7744.       32: result := tfXRGB8ui1;

  7745.     end;

  7746.   end;

  7747. 

  7748.   function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;

  7749.   var

  7750.     i, c: Integer;

  7751.     ColorTable: TbmpColorTable;

  7752.   begin

  7753.     result := nil;

  7754.     if (aInfo.biBitCount >= 16) then

  7755.       exit;

  7756.     aFormat := tfLuminance8ub1;

  7757.     c := aInfo.biClrUsed;

  7758.     if (c = 0) then

  7759.       c := 1 shl aInfo.biBitCount;

  7760.     SetLength(ColorTable, c);

  7761.     for i := 0 to c-1 do begin

  7762.       aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));

  7763.       if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then

  7764.         aFormat := tfRGB8ub3;

  7765.     end;

  7766. 

  7767.     result := TbmpColorTableFormat.Create;

  7768.     result.BitsPerPixel := aInfo.biBitCount;

  7769.     result.ColorTable   := ColorTable;

  7770.     result.CalcValues;

  7771.   end;

  7772. 

  7773.   //////////////////////////////////////////////////////////////////////////////////////////////////

  7774.   function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapRec4ul; const aInfo: TBMPInfo): TbmpBitfieldFormat;

  7775.   var

  7776.     FormatDesc: TFormatDescriptor;

  7777.   begin

  7778.     result := nil;

  7779.     if (aMask.r <> 0) or (aMask.g <> 0) or (aMask.b <> 0) or (aMask.a <> 0) then begin

  7780.       FormatDesc := TFormatDescriptor.GetFromMask(aMask);

  7781.       if (FormatDesc.Format = tfEmpty) then

  7782.         exit;

  7783.       aFormat := FormatDesc.Format;

  7784.       if (aMask.a = 0) and TFormatDescriptor.Get(aFormat).HasAlpha then

  7785.         aFormat := TFormatDescriptor.Get(aFormat).WithoutAlpha;

  7786.       if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then

  7787.         aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;

  7788. 

  7789.       result := TbmpBitfieldFormat.Create;

  7790.       result.SetCustomValues(aInfo.biBitCount, aMask);

  7791.     end;

  7792.   end;

  7793. 

  7794. var

  7795.   //simple types

  7796.   StartPos: Int64;

  7797.   ImageSize, rbLineSize, wbLineSize, Padding, i: Integer;

  7798.   PaddingBuff: Cardinal;

  7799.   LineBuf, ImageData, TmpData: PByte;

  7800.   SourceMD, DestMD: Pointer;

  7801.   BmpFormat: TglBitmapFormat;

  7802. 

  7803.   //records

  7804.   Mask: TglBitmapRec4ul;

  7805.   Header: TBMPHeader;

  7806.   Info: TBMPInfo;

  7807. 

  7808.   //classes

  7809.   SpecialFormat: TFormatDescriptor;

  7810.   FormatDesc: TFormatDescriptor;

  7811. 

  7812.   //////////////////////////////////////////////////////////////////////////////////////////////////

  7813.   procedure SpecialFormatReadLine(aData: PByte; aLineBuf: PByte);

  7814.   var

  7815.     i: Integer;

  7816.     Pixel: TglBitmapPixelData;

  7817.   begin

  7818.     aStream.Read(aLineBuf^, rbLineSize);

  7819.     SpecialFormat.PreparePixel(Pixel);

  7820.     for i := 0 to Info.biWidth-1 do begin

  7821.       SpecialFormat.Unmap(aLineBuf, Pixel, SourceMD);

  7822.       glBitmapConvertPixel(Pixel, SpecialFormat, FormatDesc);

  7823.       FormatDesc.Map(Pixel, aData, DestMD);

  7824.     end;

  7825.   end;

  7826. 

  7827. begin

  7828.   result        := false;

  7829.   BmpFormat     := tfEmpty;

  7830.   SpecialFormat := nil;

  7831.   LineBuf       := nil;

  7832.   SourceMD      := nil;

  7833.   DestMD        := nil;

  7834. 

  7835.   // Header

  7836.   StartPos := aStream.Position;

  7837.   aStream.Read(Header{%H-}, SizeOf(Header));

  7838. 

  7839.   if Header.bfType = BMP_MAGIC then begin

  7840.     try try

  7841.       BmpFormat        := ReadInfo(Info, Mask);

  7842.       SpecialFormat    := ReadColorTable(BmpFormat, Info);

  7843.       if not Assigned(SpecialFormat) then

  7844.         SpecialFormat  := CheckBitfields(BmpFormat, Mask, Info);

  7845.       aStream.Position := StartPos + Header.bfOffBits;

  7846. 

  7847.       if (BmpFormat <> tfEmpty) then begin

  7848.         FormatDesc := TFormatDescriptor.Get(BmpFormat);

  7849.         rbLineSize := Round(Info.biWidth * Info.biBitCount / 8); //ReadBuffer LineSize

  7850.         wbLineSize := Trunc(Info.biWidth * FormatDesc.BytesPerPixel);

  7851.         Padding    := (((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3) - rbLineSize;

  7852. 

  7853.         //get Memory

  7854.         DestMD    := FormatDesc.CreateMappingData;

  7855.         ImageSize := FormatDesc.GetSize(Info.biWidth, abs(Info.biHeight));

  7856.         GetMem(ImageData, ImageSize);

  7857.         if Assigned(SpecialFormat) then begin

  7858.           GetMem(LineBuf, rbLineSize); //tmp Memory for converting Bitfields

  7859.           SourceMD := SpecialFormat.CreateMappingData;

  7860.         end;

  7861. 

  7862.         //read Data

  7863.         try try

  7864.           FillChar(ImageData^, ImageSize, $FF);

  7865.           TmpData := ImageData;

  7866.           if (Info.biHeight > 0) then

  7867.             Inc(TmpData, wbLineSize * (Info.biHeight-1));

  7868.           for i := 0 to Abs(Info.biHeight)-1 do begin

  7869.             if Assigned(SpecialFormat) then

  7870.               SpecialFormatReadLine(TmpData, LineBuf)  //if is special format read and convert data

  7871.             else

  7872.               aStream.Read(TmpData^, wbLineSize);   //else only read data

  7873.             if (Info.biHeight > 0) then

  7874.               dec(TmpData, wbLineSize)

  7875.             else

  7876.               inc(TmpData, wbLineSize);

  7877.             aStream.Read(PaddingBuff{%H-}, Padding);

  7878.           end;

  7879.           SetDataPointer(ImageData, BmpFormat, Info.biWidth, abs(Info.biHeight)); //be careful, Data could be freed by this method

  7880.           result := true;

  7881.         finally

  7882.           if Assigned(LineBuf) then

  7883.             FreeMem(LineBuf);

  7884.           if Assigned(SourceMD) then

  7885.             SpecialFormat.FreeMappingData(SourceMD);

  7886.           FormatDesc.FreeMappingData(DestMD);

  7887.         end;

  7888.         except

  7889.           if Assigned(ImageData) then

  7890.             FreeMem(ImageData);

  7891.           raise;

  7892.         end;

  7893.       end else

  7894.         raise EglBitmap.Create('LoadBMP - No suitable format found');

  7895.     except

  7896.       aStream.Position := StartPos;

  7897.       raise;

  7898.     end;

  7899.     finally

  7900.       FreeAndNil(SpecialFormat);

  7901.     end;

  7902.   end

  7903.     else aStream.Position := StartPos;

  7904. end;

  7905. 

  7906. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  7907. procedure TglBitmap.SaveBMP(const aStream: TStream);

  7908. var

  7909.   Header: TBMPHeader;

  7910.   Info: TBMPInfo;

  7911.   Converter: TFormatDescriptor;

  7912.   FormatDesc: TFormatDescriptor;

  7913.   SourceFD, DestFD: Pointer;

  7914.   pData, srcData, dstData, ConvertBuffer: pByte;

  7915. 

  7916.   Pixel: TglBitmapPixelData;

  7917.   ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx: Integer;

  7918.   RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;

  7919. 

  7920.   PaddingBuff: Cardinal;

  7921. 

  7922.   function GetLineWidth : Integer;

  7923.   begin

  7924.     result := ((Info.biWidth * Info.biBitCount + 31) and - 32) shr 3;

  7925.   end;

  7926. 

  7927. begin

  7928.   if not (ftBMP in FormatGetSupportedFiles(Format)) then

  7929.     raise EglBitmapUnsupportedFormat.Create(Format);

  7930. 

  7931.   Converter  := nil;

  7932.   FormatDesc := TFormatDescriptor.Get(Format);

  7933.   ImageSize  := FormatDesc.GetSize(Dimension);

  7934. 

  7935.   FillChar(Header{%H-}, SizeOf(Header), 0);

  7936.   Header.bfType      := BMP_MAGIC;

  7937.   Header.bfSize      := SizeOf(Header) + SizeOf(Info) + ImageSize;

  7938.   Header.bfReserved1 := 0;

  7939.   Header.bfReserved2 := 0;

  7940.   Header.bfOffBits   := SizeOf(Header) + SizeOf(Info);

  7941. 

  7942.   FillChar(Info{%H-}, SizeOf(Info), 0);

  7943.   Info.biSize        := SizeOf(Info);

  7944.   Info.biWidth       := Width;

  7945.   Info.biHeight      := Height;

  7946.   Info.biPlanes      := 1;

  7947.   Info.biCompression := BMP_COMP_RGB;

  7948.   Info.biSizeImage   := ImageSize;

  7949. 

  7950.   try

  7951.     case Format of

  7952.       tfAlpha4ub1, tfAlpha8ub1, tfLuminance4ub1, tfLuminance8ub1, tfR3G3B2ub1:

  7953.       begin

  7954.         Info.biBitCount  :=  8;

  7955.         Header.bfSize    := Header.bfSize    + 256 * SizeOf(Cardinal);

  7956.         Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries

  7957.         Converter := TbmpColorTableFormat.Create;

  7958.         with (Converter as TbmpColorTableFormat) do begin

  7959.           SetCustomValues(fFormat, 1, FormatDesc.Precision, FormatDesc.Shift);

  7960.           CreateColorTable;

  7961.         end;

  7962.       end;

  7963. 

  7964.       tfLuminance4Alpha4ub2, tfLuminance6Alpha2ub2, tfLuminance8Alpha8ub2,

  7965.       tfRGBX4us1, tfXRGB4us1, tfRGB5X1us1, tfX1RGB5us1, tfR5G6B5us1, tfRGB5A1us1, tfA1RGB5us1, tfRGBA4us1, tfARGB4us1,

  7966.       tfBGRX4us1, tfXBGR4us1, tfBGR5X1us1, tfX1BGR5us1, tfB5G6R5us1, tfBGR5A1us1, tfA1BGR5us1, tfBGRA4us1, tfABGR4us1:

  7967.       begin

  7968.         Info.biBitCount    := 16;

  7969.         Info.biCompression := BMP_COMP_BITFIELDS;

  7970.       end;

  7971. 

  7972.       tfBGR8ub3, tfRGB8ub3:

  7973.       begin

  7974.         Info.biBitCount := 24;

  7975.         if (Format = tfRGB8ub3) then

  7976.           Converter := TfdBGR8ub3.Create; //use BGR8 Format Descriptor to Swap RGB Values

  7977.       end;

  7978. 

  7979.       tfRGBX8ui1, tfXRGB8ui1, tfRGB10X2ui1, tfX2RGB10ui1, tfRGBA8ui1, tfARGB8ui1, tfRGBA8ub4, tfRGB10A2ui1, tfA2RGB10ui1,

  7980.       tfBGRX8ui1, tfXBGR8ui1, tfBGR10X2ui1, tfX2BGR10ui1, tfBGRA8ui1, tfABGR8ui1, tfBGRA8ub4, tfBGR10A2ui1, tfA2BGR10ui1:

  7981.       begin

  7982.         Info.biBitCount    := 32;

  7983.         Info.biCompression := BMP_COMP_BITFIELDS;

  7984.       end;

  7985.     else

  7986.       raise EglBitmapUnsupportedFormat.Create(Format);

  7987.     end;

  7988.     Info.biXPelsPerMeter := 2835;

  7989.     Info.biYPelsPerMeter := 2835;

  7990. 

  7991.     // prepare bitmasks

  7992.     if Info.biCompression = BMP_COMP_BITFIELDS then begin

  7993.       Header.bfSize    := Header.bfSize    + 4 * SizeOf(Cardinal);

  7994.       Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);

  7995. 

  7996.       RedMask    := FormatDesc.Mask.r;

  7997.       GreenMask  := FormatDesc.Mask.g;

  7998.       BlueMask   := FormatDesc.Mask.b;

  7999.       AlphaMask  := FormatDesc.Mask.a;

  8000.     end;

  8001. 

  8002.     // headers

  8003.     aStream.Write(Header, SizeOf(Header));

  8004.     aStream.Write(Info, SizeOf(Info));

  8005. 

  8006.     // colortable

  8007.     if Assigned(Converter) and (Converter is TbmpColorTableFormat) then

  8008.       with (Converter as TbmpColorTableFormat) do

  8009.         aStream.Write(ColorTable[0].b,

  8010.           SizeOf(TbmpColorTableEnty) * Length(ColorTable));

  8011. 

  8012.     // bitmasks

  8013.     if Info.biCompression = BMP_COMP_BITFIELDS then begin

  8014.       aStream.Write(RedMask,   SizeOf(Cardinal));

  8015.       aStream.Write(GreenMask, SizeOf(Cardinal));

  8016.       aStream.Write(BlueMask,  SizeOf(Cardinal));

  8017.       aStream.Write(AlphaMask, SizeOf(Cardinal));

  8018.     end;

  8019. 

  8020.     // image data

  8021.     rbLineSize  := Round(Info.biWidth * FormatDesc.BytesPerPixel);

  8022.     wbLineSize  := Round(Info.biWidth * Info.biBitCount / 8);

  8023.     Padding     := GetLineWidth - wbLineSize;

  8024.     PaddingBuff := 0;

  8025. 

  8026.     pData := Data;

  8027.     inc(pData, (Height-1) * rbLineSize);

  8028. 

  8029.     // prepare row buffer. But only for RGB because RGBA supports color masks

  8030.     // so it's possible to change color within the image.

  8031.     if Assigned(Converter) then begin

  8032.       FormatDesc.PreparePixel(Pixel);

  8033.       GetMem(ConvertBuffer, wbLineSize);

  8034.       SourceFD := FormatDesc.CreateMappingData;

  8035.       DestFD   := Converter.CreateMappingData;

  8036.     end else

  8037.       ConvertBuffer := nil;

  8038. 

  8039.     try

  8040.       for LineIdx := 0 to Height - 1 do begin

  8041.         // preparing row

  8042.         if Assigned(Converter) then begin

  8043.           srcData := pData;

  8044.           dstData := ConvertBuffer;

  8045.           for PixelIdx := 0 to Info.biWidth-1 do begin

  8046.             FormatDesc.Unmap(srcData, Pixel, SourceFD);

  8047.             glBitmapConvertPixel(Pixel, FormatDesc, Converter);

  8048.             Converter.Map(Pixel, dstData, DestFD);

  8049.           end;

  8050.           aStream.Write(ConvertBuffer^, wbLineSize);

  8051.         end else begin

  8052.           aStream.Write(pData^, rbLineSize);

  8053.         end;

  8054.         dec(pData, rbLineSize);

  8055.         if (Padding > 0) then

  8056.           aStream.Write(PaddingBuff, Padding);

  8057.       end;

  8058.     finally

  8059.       // destroy row buffer

  8060.       if Assigned(ConvertBuffer) then begin

  8061.         FormatDesc.FreeMappingData(SourceFD);

  8062.         Converter.FreeMappingData(DestFD);

  8063.         FreeMem(ConvertBuffer);

  8064.       end;

  8065.     end;

  8066.   finally

  8067.     if Assigned(Converter) then

  8068.       Converter.Free;

  8069.   end;

  8070. end;

  8071. 

  8072. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  8073. //TGA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  8074. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  8075. type

  8076.   TTGAHeader = packed record

  8077.     ImageID: Byte;

  8078.     ColorMapType: Byte;

  8079.     ImageType: Byte;

  8080.     //ColorMapSpec: Array[0..4] of Byte;

  8081.     ColorMapStart: Word;

  8082.     ColorMapLength: Word;

  8083.     ColorMapEntrySize: Byte;

  8084.     OrigX: Word;

  8085.     OrigY: Word;

  8086.     Width: Word;

  8087.     Height: Word;

  8088.     Bpp: Byte;

  8089.     ImageDesc: Byte;

  8090.   end;

  8091. 

  8092. const

  8093.   TGA_UNCOMPRESSED_RGB  =  2;

  8094.   TGA_UNCOMPRESSED_GRAY =  3;

  8095.   TGA_COMPRESSED_RGB    = 10;

  8096.   TGA_COMPRESSED_GRAY   = 11;

  8097. 

  8098.   TGA_NONE_COLOR_TABLE  = 0;

  8099. 

  8100. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  8101. function TglBitmap.LoadTGA(const aStream: TStream): Boolean;

  8102. var

  8103.   Header: TTGAHeader;

  8104.   ImageData: System.PByte;

  8105.   StartPosition: Int64;

  8106.   PixelSize, LineSize: Integer;

  8107.   tgaFormat: TglBitmapFormat;

  8108.   FormatDesc: TFormatDescriptor;

  8109.   Counter: packed record

  8110.     X, Y: packed record

  8111.       low, high, dir: Integer;

  8112.     end;

  8113.   end;

  8114. 

  8115. const

  8116.   CACHE_SIZE = $4000;

  8117. 

  8118.   ////////////////////////////////////////////////////////////////////////////////////////

  8119.   procedure ReadUncompressed;

  8120.   var

  8121.     i, j: Integer;

  8122.     buf, tmp1, tmp2: System.PByte;

  8123.   begin

  8124.     buf := nil;

  8125.     if (Counter.X.dir < 0) then

  8126.       GetMem(buf, LineSize);

  8127.     try

  8128.       while (Counter.Y.low <> Counter.Y.high + counter.Y.dir) do begin

  8129.         tmp1 := ImageData;

  8130.         inc(tmp1, (Counter.Y.low * LineSize));          //pointer to LineStart

  8131.         if (Counter.X.dir < 0) then begin               //flip X

  8132.           aStream.Read(buf^, LineSize);

  8133.           tmp2 := buf;

  8134.           inc(tmp2, LineSize - PixelSize);              //pointer to last pixel in line

  8135.           for i := 0 to Header.Width-1 do begin         //for all pixels in line

  8136.             for j := 0 to PixelSize-1 do begin          //for all bytes in pixel

  8137.               tmp1^ := tmp2^;

  8138.               inc(tmp1);

  8139.               inc(tmp2);

  8140.             end;

  8141.             dec(tmp2, 2*PixelSize);                     //move 2 backwards, because j-loop moved 1 forward

  8142.           end;

  8143.         end else

  8144.           aStream.Read(tmp1^, LineSize);

  8145.         inc(Counter.Y.low, Counter.Y.dir);              //move to next line index

  8146.       end;

  8147.     finally

  8148.       if Assigned(buf) then

  8149.         FreeMem(buf);

  8150.     end;

  8151.   end;

  8152. 

  8153.   ////////////////////////////////////////////////////////////////////////////////////////

  8154.   procedure ReadCompressed;

  8155. 

  8156.     /////////////////////////////////////////////////////////////////

  8157.     var

  8158.       TmpData: System.PByte;

  8159.       LinePixelsRead: Integer;

  8160.     procedure CheckLine;

  8161.     begin

  8162.       if (LinePixelsRead >= Header.Width) then begin

  8163.         LinePixelsRead := 0;

  8164.         inc(Counter.Y.low, Counter.Y.dir);                //next line index

  8165.         TmpData := ImageData;

  8166.         inc(TmpData, Counter.Y.low * LineSize);           //set line

  8167.         if (Counter.X.dir < 0) then                       //if x flipped then

  8168.           inc(TmpData, LineSize - PixelSize);             //set last pixel

  8169.       end;

  8170.     end;

  8171. 

  8172.     /////////////////////////////////////////////////////////////////

  8173.     var

  8174.       Cache: PByte;

  8175.       CacheSize, CachePos: Integer;

  8176.     procedure CachedRead(out Buffer; Count: Integer);

  8177.     var

  8178.       BytesRead: Integer;

  8179.     begin

  8180.       if (CachePos + Count > CacheSize) then begin

  8181.         //if buffer overflow save non read bytes

  8182.         BytesRead := 0;

  8183.         if (CacheSize - CachePos > 0) then begin

  8184.           BytesRead := CacheSize - CachePos;

  8185.           Move(PByteArray(Cache)^[CachePos], Buffer{%H-}, BytesRead);

  8186.           inc(CachePos, BytesRead);

  8187.         end;

  8188. 

  8189.         //load cache from file

  8190.         CacheSize := Min(CACHE_SIZE, aStream.Size - aStream.Position);

  8191.         aStream.Read(Cache^, CacheSize);

  8192.         CachePos := 0;

  8193. 

  8194.         //read rest of requested bytes

  8195.         if (Count - BytesRead > 0) then begin

  8196.           Move(PByteArray(Cache)^[CachePos], TByteArray(Buffer)[BytesRead], Count - BytesRead);

  8197.           inc(CachePos, Count - BytesRead);

  8198.         end;

  8199.       end else begin

  8200.         //if no buffer overflow just read the data

  8201.         Move(PByteArray(Cache)^[CachePos], Buffer, Count);

  8202.         inc(CachePos, Count);

  8203.       end;

  8204.     end;

  8205. 

  8206.     procedure PixelToBuffer(const aData: PByte; var aBuffer: PByte);

  8207.     begin

  8208.       case PixelSize of

  8209.         1: begin

  8210.           aBuffer^ := aData^;

  8211.           inc(aBuffer, Counter.X.dir);

  8212.         end;

  8213.         2: begin

  8214.           PWord(aBuffer)^ := PWord(aData)^;

  8215.           inc(aBuffer, 2 * Counter.X.dir);

  8216.         end;

  8217.         3: begin

  8218.           PByteArray(aBuffer)^[0] := PByteArray(aData)^[0];

  8219.           PByteArray(aBuffer)^[1] := PByteArray(aData)^[1];

  8220.           PByteArray(aBuffer)^[2] := PByteArray(aData)^[2];

  8221.           inc(aBuffer, 3 * Counter.X.dir);

  8222.         end;

  8223.         4: begin

  8224.           PCardinal(aBuffer)^ := PCardinal(aData)^;

  8225.           inc(aBuffer, 4 * Counter.X.dir);

  8226.         end;

  8227.       end;

  8228.     end;

  8229. 

  8230.   var

  8231.     TotalPixelsToRead, TotalPixelsRead: Integer;

  8232.     Temp: Byte;

  8233.     buf: array [0..3] of Byte; //1 pixel is max 32bit long

  8234.     PixelRepeat: Boolean;

  8235.     PixelsToRead, PixelCount: Integer;

  8236.   begin

  8237.     CacheSize := 0;

  8238.     CachePos  := 0;

  8239. 

  8240.     TotalPixelsToRead := Header.Width * Header.Height;

  8241.     TotalPixelsRead   := 0;

  8242.     LinePixelsRead    := 0;

  8243. 

  8244.     GetMem(Cache, CACHE_SIZE);

  8245.     try

  8246.       TmpData := ImageData;

  8247.       inc(TmpData, Counter.Y.low * LineSize);           //set line

  8248.       if (Counter.X.dir < 0) then                       //if x flipped then

  8249.         inc(TmpData, LineSize - PixelSize);             //set last pixel

  8250. 

  8251.       repeat

  8252.         //read CommandByte

  8253.         CachedRead(Temp, 1);

  8254.         PixelRepeat  := (Temp and $80) > 0;

  8255.         PixelsToRead := (Temp and $7F) + 1;

  8256.         inc(TotalPixelsRead, PixelsToRead);

  8257. 

  8258.         if PixelRepeat then

  8259.           CachedRead(buf[0], PixelSize);

  8260.         while (PixelsToRead > 0) do begin

  8261.           CheckLine;

  8262.           PixelCount := Min(Header.Width - LinePixelsRead, PixelsToRead); //max read to EOL or EOF

  8263.           while (PixelCount > 0) do begin

  8264.             if not PixelRepeat then

  8265.               CachedRead(buf[0], PixelSize);

  8266.             PixelToBuffer(@buf[0], TmpData);

  8267.             inc(LinePixelsRead);

  8268.             dec(PixelsToRead);

  8269.             dec(PixelCount);

  8270.           end;

  8271.         end;

  8272.       until (TotalPixelsRead >= TotalPixelsToRead);

  8273.     finally

  8274.       FreeMem(Cache);

  8275.     end;

  8276.   end;

  8277. 

  8278.   function IsGrayFormat: Boolean;

  8279.   begin

  8280.     result := Header.ImageType in [TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_GRAY];

  8281.   end;

  8282. 

  8283. begin

  8284.   result := false;

  8285. 

  8286.   // reading header to test file and set cursor back to begin

  8287.   StartPosition := aStream.Position;

  8288.   aStream.Read(Header{%H-}, SizeOf(Header));

  8289. 

  8290.   // no colormapped files

  8291.   if (Header.ColorMapType = TGA_NONE_COLOR_TABLE) and (Header.ImageType in [

  8292.     TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY, TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY]) then

  8293.   begin

  8294.     try

  8295.       if Header.ImageID <> 0 then       // skip image ID

  8296.         aStream.Position := aStream.Position + Header.ImageID;

  8297. 

  8298.       tgaFormat := tfEmpty;

  8299.       case Header.Bpp of

  8300.          8: if IsGrayFormat then case (Header.ImageDesc and $F) of

  8301.                0: tgaFormat := tfLuminance8ub1;

  8302.                8: tgaFormat := tfAlpha8ub1;

  8303.             end;

  8304. 

  8305.         16: if IsGrayFormat then case (Header.ImageDesc and $F) of

  8306.                0: tgaFormat := tfLuminance16us1;

  8307.                8: tgaFormat := tfLuminance8Alpha8ub2;

  8308.             end else case (Header.ImageDesc and $F) of

  8309.                0: tgaFormat := tfX1RGB5us1;

  8310.                1: tgaFormat := tfA1RGB5us1;

  8311.                4: tgaFormat := tfARGB4us1;

  8312.             end;

  8313. 

  8314.         24: if not IsGrayFormat then case (Header.ImageDesc and $F) of

  8315.                0: tgaFormat := tfBGR8ub3;

  8316.             end;

  8317. 

  8318.         32: if IsGrayFormat then case (Header.ImageDesc and $F) of

  8319.                0: tgaFormat := tfDepth32ui1;

  8320.             end else case (Header.ImageDesc and $F) of

  8321.                0: tgaFormat := tfX2RGB10ui1;

  8322.                2: tgaFormat := tfA2RGB10ui1;

  8323.                8: tgaFormat := tfARGB8ui1;

  8324.             end;

  8325.       end;

  8326. 

  8327.       if (tgaFormat = tfEmpty) then

  8328.         raise EglBitmap.Create('LoadTga - unsupported format');

  8329. 

  8330.       FormatDesc := TFormatDescriptor.Get(tgaFormat);

  8331.       PixelSize  := FormatDesc.GetSize(1, 1);

  8332.       LineSize   := FormatDesc.GetSize(Header.Width, 1);

  8333. 

  8334.       GetMem(ImageData, LineSize * Header.Height);

  8335.       try

  8336.         //column direction

  8337.         if ((Header.ImageDesc and (1 shl 4)) > 0) then begin

  8338.           Counter.X.low  := Header.Height-1;;

  8339.           Counter.X.high := 0;

  8340.           Counter.X.dir  := -1;

  8341.         end else begin

  8342.           Counter.X.low  := 0;

  8343.           Counter.X.high := Header.Height-1;

  8344.           Counter.X.dir  := 1;

  8345.         end;

  8346. 

  8347.         // Row direction

  8348.         if ((Header.ImageDesc and (1 shl 5)) > 0) then begin

  8349.           Counter.Y.low  := 0;

  8350.           Counter.Y.high := Header.Height-1;

  8351.           Counter.Y.dir  := 1;

  8352.         end else begin

  8353.           Counter.Y.low  := Header.Height-1;;

  8354.           Counter.Y.high := 0;

  8355.           Counter.Y.dir  := -1;

  8356.         end;

  8357. 

  8358.         // Read Image

  8359.         case Header.ImageType of

  8360.           TGA_UNCOMPRESSED_RGB, TGA_UNCOMPRESSED_GRAY:

  8361.             ReadUncompressed;

  8362.           TGA_COMPRESSED_RGB, TGA_COMPRESSED_GRAY:

  8363.             ReadCompressed;

  8364.         end;

  8365. 

  8366.         SetDataPointer(ImageData, tgaFormat, Header.Width, Header.Height); //be careful, Data could be freed by this method

  8367.         result := true;

  8368.       except

  8369.         if Assigned(ImageData) then

  8370.           FreeMem(ImageData);

  8371.         raise;

  8372.       end;

  8373.     finally

  8374.       aStream.Position := StartPosition;

  8375.     end;

  8376.   end

  8377.     else aStream.Position := StartPosition;

  8378. end;

  8379. 

  8380. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  8381. procedure TglBitmap.SaveTGA(const aStream: TStream);

  8382. var

  8383.   Header: TTGAHeader;

  8384.   Size: Integer;

  8385.   FormatDesc: TFormatDescriptor;

  8386. begin

  8387.   if not (ftTGA in FormatGetSupportedFiles(Format)) then

  8388.     raise EglBitmapUnsupportedFormat.Create(Format);

  8389. 

  8390.   //prepare header

  8391.   FormatDesc := TFormatDescriptor.Get(Format);

  8392.   FillChar(Header{%H-}, SizeOf(Header), 0);

  8393.   Header.ImageDesc := CountSetBits(FormatDesc.Range.a) and $F;

  8394.   Header.Bpp       := FormatDesc.BitsPerPixel;

  8395.   Header.Width     := Width;

  8396.   Header.Height    := Height;

  8397.   Header.ImageDesc := Header.ImageDesc or $20; //flip y

  8398.   if FormatDesc.IsGrayscale or (not FormatDesc.IsGrayscale and not FormatDesc.HasRed and FormatDesc.HasAlpha) then

  8399.     Header.ImageType := TGA_UNCOMPRESSED_GRAY

  8400.   else

  8401.     Header.ImageType := TGA_UNCOMPRESSED_RGB;

  8402.   aStream.Write(Header, SizeOf(Header));

  8403. 

  8404.   // write Data

  8405.   Size := FormatDesc.GetSize(Dimension);

  8406.   aStream.Write(Data^, Size);

  8407. end;

  8408. 

  8409. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  8410. //DDS/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  8411. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  8412. const

  8413.   DDS_MAGIC: Cardinal         = $20534444;

  8414. 

  8415.   // DDS_header.dwFlags

  8416.   DDSD_CAPS                   = $00000001;

  8417.   DDSD_HEIGHT                 = $00000002;

  8418.   DDSD_WIDTH                  = $00000004;

  8419.   DDSD_PIXELFORMAT            = $00001000;

  8420. 

  8421.   // DDS_header.sPixelFormat.dwFlags

  8422.   DDPF_ALPHAPIXELS            = $00000001;

  8423.   DDPF_ALPHA                  = $00000002;

  8424.   DDPF_FOURCC                 = $00000004;

  8425.   DDPF_RGB                    = $00000040;

  8426.   DDPF_LUMINANCE              = $00020000;

  8427. 

  8428.   // DDS_header.sCaps.dwCaps1

  8429.   DDSCAPS_TEXTURE             = $00001000;

  8430. 

  8431.   // DDS_header.sCaps.dwCaps2

  8432.   DDSCAPS2_CUBEMAP            = $00000200;

  8433. 

  8434.   D3DFMT_DXT1                 = $31545844;

  8435.   D3DFMT_DXT3                 = $33545844;

  8436.   D3DFMT_DXT5                 = $35545844;

  8437. 

  8438. type

  8439.   TDDSPixelFormat = packed record

  8440.     dwSize: Cardinal;

  8441.     dwFlags: Cardinal;

  8442.     dwFourCC: Cardinal;

  8443.     dwRGBBitCount: Cardinal;

  8444.     dwRBitMask: Cardinal;

  8445.     dwGBitMask: Cardinal;

  8446.     dwBBitMask: Cardinal;

  8447.     dwABitMask: Cardinal;

  8448.   end;

  8449. 

  8450.   TDDSCaps = packed record

  8451.     dwCaps1: Cardinal;

  8452.     dwCaps2: Cardinal;

  8453.     dwDDSX: Cardinal;

  8454.     dwReserved: Cardinal;

  8455.   end;

  8456. 

  8457.   TDDSHeader = packed record

  8458.     dwSize: Cardinal;

  8459.     dwFlags: Cardinal;

  8460.     dwHeight: Cardinal;

  8461.     dwWidth: Cardinal;

  8462.     dwPitchOrLinearSize: Cardinal;

  8463.     dwDepth: Cardinal;

  8464.     dwMipMapCount: Cardinal;

  8465.     dwReserved: array[0..10] of Cardinal;

  8466.     PixelFormat: TDDSPixelFormat;

  8467.     Caps: TDDSCaps;

  8468.     dwReserved2: Cardinal;

  8469.   end;

  8470. 

  8471. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  8472. function TglBitmap.LoadDDS(const aStream: TStream): Boolean;

  8473. var

  8474.   Header: TDDSHeader;

  8475.   Converter: TbmpBitfieldFormat;

  8476. 

  8477.   function GetDDSFormat: TglBitmapFormat;

  8478.   var

  8479.     fd: TFormatDescriptor;

  8480.     i: Integer;

  8481.     Mask: TglBitmapRec4ul;

  8482.     Range: TglBitmapRec4ui;

  8483.     match: Boolean;

  8484.   begin

  8485.     result := tfEmpty;

  8486.     with Header.PixelFormat do begin

  8487.       // Compresses

  8488.       if ((dwFlags and DDPF_FOURCC) > 0) then begin

  8489.         case Header.PixelFormat.dwFourCC of

  8490.           D3DFMT_DXT1: result := tfS3tcDtx1RGBA;

  8491.           D3DFMT_DXT3: result := tfS3tcDtx3RGBA;

  8492.           D3DFMT_DXT5: result := tfS3tcDtx5RGBA;

  8493.         end;

  8494.       end else if ((dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE or DDPF_ALPHA)) > 0) then begin

  8495.         // prepare masks

  8496.         if ((dwFlags and DDPF_LUMINANCE) = 0) then begin

  8497.           Mask.r := dwRBitMask;

  8498.           Mask.g := dwGBitMask;

  8499.           Mask.b := dwBBitMask;

  8500.         end else begin

  8501.           Mask.r := dwRBitMask;

  8502.           Mask.g := dwRBitMask;

  8503.           Mask.b := dwRBitMask;

  8504.         end;

  8505.         if (dwFlags and DDPF_ALPHAPIXELS > 0) then

  8506.           Mask.a := dwABitMask

  8507.         else

  8508.           Mask.a := 0;;

  8509. 

  8510.         //find matching format

  8511.         fd     := TFormatDescriptor.GetFromMask(Mask, dwRGBBitCount);

  8512.         result := fd.Format;

  8513.         if (result <> tfEmpty) then

  8514.           exit;

  8515. 

  8516.         //find format with same Range

  8517.         for i := 0 to 3 do

  8518.           Range.arr[i] := (2 shl CountSetBits(Mask.arr[i])) - 1;

  8519.         for result := High(TglBitmapFormat) downto Low(TglBitmapFormat) do begin

  8520.           fd := TFormatDescriptor.Get(result);

  8521.           match := true;

  8522.           for i := 0 to 3 do

  8523.             if (fd.Range.arr[i] <> Range.arr[i]) then begin

  8524.               match := false;

  8525.               break;

  8526.             end;

  8527.           if match then

  8528.             break;

  8529.         end;

  8530. 

  8531.         //no format with same range found -> use default

  8532.         if (result = tfEmpty) then begin

  8533.           if (dwABitMask > 0) then

  8534.             result := tfRGBA8ui1

  8535.           else

  8536.             result := tfRGB8ub3;

  8537.         end;

  8538. 

  8539.         Converter := TbmpBitfieldFormat.Create;

  8540.         Converter.SetCustomValues(dwRGBBitCount, glBitmapRec4ul(dwRBitMask, dwGBitMask, dwBBitMask, dwABitMask));

  8541.       end;

  8542.     end;

  8543.   end;

  8544. 

  8545. var

  8546.   StreamPos: Int64;

  8547.   x, y, LineSize, RowSize, Magic: Cardinal;

  8548.   NewImage, TmpData, RowData, SrcData: System.PByte;

  8549.   SourceMD, DestMD: Pointer;

  8550.   Pixel: TglBitmapPixelData;

  8551.   ddsFormat: TglBitmapFormat;

  8552.   FormatDesc: TFormatDescriptor;

  8553. 

  8554. begin

  8555.   result    := false;

  8556.   Converter := nil;

  8557.   StreamPos := aStream.Position;

  8558. 

  8559.   // Magic

  8560.   aStream.Read(Magic{%H-}, sizeof(Magic));

  8561.   if (Magic <> DDS_MAGIC) then begin

  8562.     aStream.Position := StreamPos;

  8563.     exit;

  8564.   end;

  8565. 

  8566.   //Header

  8567.   aStream.Read(Header{%H-}, sizeof(Header));

  8568.   if (Header.dwSize <> SizeOf(Header)) or

  8569.      ((Header.dwFlags and (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) <>

  8570.         (DDSD_PIXELFORMAT or DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT)) then

  8571.   begin

  8572.     aStream.Position := StreamPos;

  8573.     exit;

  8574.   end;

  8575. 

  8576.   if ((Header.Caps.dwCaps1 and DDSCAPS2_CUBEMAP) > 0) then

  8577.     raise EglBitmap.Create('LoadDDS - CubeMaps are not supported');

  8578. 

  8579.   ddsFormat := GetDDSFormat;

  8580.   try

  8581.     if (ddsFormat = tfEmpty) then

  8582.       raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');

  8583. 

  8584.     FormatDesc := TFormatDescriptor.Get(ddsFormat);

  8585.     LineSize   := Trunc(Header.dwWidth * FormatDesc.BytesPerPixel);

  8586.     GetMem(NewImage, Header.dwHeight * LineSize);

  8587.     try

  8588.       TmpData := NewImage;

  8589. 

  8590.       //Converter needed

  8591.       if Assigned(Converter) then begin

  8592.         RowSize := Round(Header.dwWidth * Header.PixelFormat.dwRGBBitCount / 8);

  8593.         GetMem(RowData, RowSize);

  8594.         SourceMD := Converter.CreateMappingData;

  8595.         DestMD   := FormatDesc.CreateMappingData;

  8596.         try

  8597.           for y := 0 to Header.dwHeight-1 do begin

  8598.             TmpData := NewImage;

  8599.             inc(TmpData, y * LineSize);

  8600.             SrcData := RowData;

  8601.             aStream.Read(SrcData^, RowSize);

  8602.             for x := 0 to Header.dwWidth-1 do begin

  8603.               Converter.Unmap(SrcData, Pixel, SourceMD);

  8604.               glBitmapConvertPixel(Pixel, Converter, FormatDesc);

  8605.               FormatDesc.Map(Pixel, TmpData, DestMD);

  8606.             end;

  8607.           end;

  8608.         finally

  8609.           Converter.FreeMappingData(SourceMD);

  8610.           FormatDesc.FreeMappingData(DestMD);

  8611.           FreeMem(RowData);

  8612.         end;

  8613.       end else

  8614. 

  8615.       // Compressed

  8616.       if ((Header.PixelFormat.dwFlags and DDPF_FOURCC) > 0) then begin

  8617.         RowSize := Header.dwPitchOrLinearSize div Header.dwWidth;

  8618.         for Y := 0 to Header.dwHeight-1 do begin

  8619.           aStream.Read(TmpData^, RowSize);

  8620.           Inc(TmpData, LineSize);

  8621.         end;

  8622.       end else

  8623. 

  8624.       // Uncompressed

  8625.       if (Header.PixelFormat.dwFlags and (DDPF_RGB or DDPF_ALPHAPIXELS or DDPF_LUMINANCE)) > 0 then begin

  8626.         RowSize := (Header.PixelFormat.dwRGBBitCount * Header.dwWidth) shr 3;

  8627.         for Y := 0 to Header.dwHeight-1 do begin

  8628.           aStream.Read(TmpData^, RowSize);

  8629.           Inc(TmpData, LineSize);

  8630.         end;

  8631.       end else

  8632.         raise EglBitmap.Create('LoadDDS - unsupported Pixelformat found.');

  8633. 

  8634.       SetDataPointer(NewImage, ddsFormat, Header.dwWidth, Header.dwHeight); //be careful, Data could be freed by this method

  8635.       result := true;

  8636.     except

  8637.       if Assigned(NewImage) then

  8638.         FreeMem(NewImage);

  8639.       raise;

  8640.     end;

  8641.   finally

  8642.     FreeAndNil(Converter);

  8643.   end;

  8644. end;

  8645. 

  8646. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  8647. procedure TglBitmap.SaveDDS(const aStream: TStream);

  8648. var

  8649.   Header: TDDSHeader;

  8650.   FormatDesc: TFormatDescriptor;

  8651. begin

  8652.   if not (ftDDS in FormatGetSupportedFiles(Format)) then

  8653.     raise EglBitmapUnsupportedFormat.Create(Format);

  8654. 

  8655.   FormatDesc := TFormatDescriptor.Get(Format);

  8656. 

  8657.   // Generell

  8658.   FillChar(Header{%H-}, SizeOf(Header), 0);

  8659.   Header.dwSize  := SizeOf(Header);

  8660.   Header.dwFlags := DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS or DDSD_PIXELFORMAT;

  8661. 

  8662.   Header.dwWidth  := Max(1, Width);

  8663.   Header.dwHeight := Max(1, Height);

  8664. 

  8665.   // Caps

  8666.   Header.Caps.dwCaps1 := DDSCAPS_TEXTURE;

  8667. 

  8668.   // Pixelformat

  8669.   Header.PixelFormat.dwSize := sizeof(Header);

  8670.   if (FormatDesc.IsCompressed) then begin

  8671.     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_FOURCC;

  8672.     case Format of

  8673.       tfS3tcDtx1RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT1;

  8674.       tfS3tcDtx3RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT3;

  8675.       tfS3tcDtx5RGBA: Header.PixelFormat.dwFourCC := D3DFMT_DXT5;

  8676.     end;

  8677.   end else if not FormatDesc.HasColor and FormatDesc.HasAlpha then begin

  8678.     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_ALPHA;

  8679.     Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;

  8680.     Header.PixelFormat.dwABitMask    := FormatDesc.Mask.a;

  8681.   end else if FormatDesc.IsGrayscale then begin

  8682.     Header.PixelFormat.dwFlags       := Header.PixelFormat.dwFlags or DDPF_LUMINANCE;

  8683.     Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;

  8684.     Header.PixelFormat.dwRBitMask    := FormatDesc.Mask.r;

  8685.     Header.PixelFormat.dwABitMask    := FormatDesc.Mask.a;

  8686.   end else begin

  8687.     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_RGB;

  8688.     Header.PixelFormat.dwRGBBitCount := FormatDesc.BitsPerPixel;

  8689.     Header.PixelFormat.dwRBitMask    := FormatDesc.Mask.r;

  8690.     Header.PixelFormat.dwGBitMask    := FormatDesc.Mask.g;

  8691.     Header.PixelFormat.dwBBitMask    := FormatDesc.Mask.b;

  8692.     Header.PixelFormat.dwABitMask    := FormatDesc.Mask.a;

  8693.   end;

  8694. 

  8695.   if (FormatDesc.HasAlpha) then

  8696.     Header.PixelFormat.dwFlags := Header.PixelFormat.dwFlags or DDPF_ALPHAPIXELS;

  8697. 

  8698.   aStream.Write(DDS_MAGIC, sizeof(DDS_MAGIC));

  8699.   aStream.Write(Header, SizeOf(Header));

  8700.   aStream.Write(Data^, FormatDesc.GetSize(Dimension));

  8701. end;

  8702. 

  8703. {$IFNDEF OPENGL_ES}

  8704. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  8705. //TglBitmap1D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  8706. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  8708.   const aWidth: Integer; const aHeight: Integer);

  8709. var

  8710.   pTemp: pByte;

  8711.   Size: Integer;

  8712. begin

  8713.   if (aHeight > 1) then begin

  8714.     Size := TFormatDescriptor.Get(aFormat).GetSize(aWidth, 1);

  8715.     GetMem(pTemp, Size);

  8716.     try

  8717.       Move(aData^, pTemp^, Size);

  8718.       FreeMem(aData);

  8719.       aData := nil;

  8720.     except

  8721.       FreeMem(pTemp);

  8722.       raise;

  8723.     end;

  8724.   end else

  8725.     pTemp := aData;

  8726.   inherited SetDataPointer(pTemp, aFormat, aWidth);

  8727. end;

  8728. 

  8729. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  8730. function TglBitmap1D.FlipHorz: Boolean;

  8731. var

  8732.   Col: Integer;

  8733.   pTempDest, pDest, pSource: PByte;

  8734. begin

  8735.   result := inherited FlipHorz;

  8736.   if Assigned(Data) and not TFormatDescriptor.Get(Format).IsCompressed then begin

  8737.     pSource := Data;

  8738.     GetMem(pDest, fRowSize);

  8739.     try

  8740.       pTempDest := pDest;

  8741.       Inc(pTempDest, fRowSize);

  8742.       for Col := 0 to Width-1 do begin

  8743.         dec(pTempDest, fPixelSize); //dec before, because ptr is behind last byte of data

  8744.         Move(pSource^, pTempDest^, fPixelSize);

  8745.         Inc(pSource, fPixelSize);

  8746.       end;

  8747.       SetDataPointer(pDest, Format, Width); //be careful, Data could be freed by this method

  8748.       result := true;

  8749.     except

  8750.       if Assigned(pDest) then

  8751.         FreeMem(pDest);

  8752.       raise;

  8753.     end;

  8754.   end;

  8755. end;

  8756. 

  8757. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  8758. procedure TglBitmap1D.UploadData(const aBuildWithGlu: Boolean);

  8759. var

  8760.   FormatDesc: TFormatDescriptor;

  8761. begin

  8762.   // Upload data

  8763.   FormatDesc := TFormatDescriptor.Get(Format);

  8764.   if (FormatDesc.glInternalFormat = 0) or (FormatDesc.glDataFormat = 0) then

  8765.     raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data');

  8766. 

  8767.   if FormatDesc.IsCompressed then begin

  8768.     if not Assigned(glCompressedTexImage1D) then

  8769.       raise EglBitmap.Create('compressed formats not supported by video adapter');

  8770.     glCompressedTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.GetSize(Width, 1), Data)

  8771.   end else if aBuildWithGlu then

  8772.     gluBuild1DMipmaps(Target, FormatDesc.glInternalFormat, Width, FormatDesc.glFormat, FormatDesc.glDataFormat, Data)

  8773.   else

  8774.     glTexImage1D(Target, 0, FormatDesc.glInternalFormat, Width, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Data);

  8775. 

  8776.   // Free Data

  8777.   if (FreeDataAfterGenTexture) then

  8778.     FreeData;

  8779. end;

  8780. 

  8781. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  8782. procedure TglBitmap1D.GenTexture(const aTestTextureSize: Boolean);

  8783. var

  8784.   BuildWithGlu, TexRec: Boolean;

  8785.   TexSize: Integer;

  8786. begin

  8787.   if Assigned(Data) then begin

  8788.     // Check Texture Size

  8789.     if (aTestTextureSize) then begin

  8790.       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);

  8791. 

  8792.       if (Width > TexSize) then

  8793.         raise EglBitmapSizeToLarge.Create('TglBitmap1D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');

  8794. 

  8795.       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and

  8796.                 (Target = GL_TEXTURE_RECTANGLE);

  8797.       if not (IsPowerOfTwo(Width) or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then

  8798.         raise EglBitmapNonPowerOfTwo.Create('TglBitmap1D.GenTexture - Rendercontex dosn''t support non power of two texture.');

  8799.     end;

  8800. 

  8801.     CreateId;

  8802.     SetupParameters(BuildWithGlu);

  8803.     UploadData(BuildWithGlu);

  8804.     glAreTexturesResident(1, @fID, @fIsResident);

  8805.   end;

  8806. end;

  8807. 

  8808. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  8809. procedure TglBitmap1D.AfterConstruction;

  8810. begin

  8811.   inherited;

  8812.   Target := GL_TEXTURE_1D;

  8813. end;

  8814. {$ENDIF}

  8815. 

  8816. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  8817. //TglBitmap2D/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  8818. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  8819. function TglBitmap2D.GetScanline(const aIndex: Integer): Pointer;

  8820. begin

  8821.   if (aIndex >= Low(fLines)) and (aIndex <= High(fLines)) then

  8822.     result := fLines[aIndex]

  8823.   else

  8824.     result := nil;

  8825. end;

  8826. 

  8827. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  8829.   const aWidth: Integer; const aHeight: Integer);

  8830. var

  8831.   Idx, LineWidth: Integer;

  8832. begin

  8833.   inherited SetDataPointer(aData, aFormat, aWidth, aHeight);

  8834. 

  8835.   if not TFormatDescriptor.Get(aFormat).IsCompressed then begin

  8836.     // Assigning Data

  8837.     if Assigned(Data) then begin

  8838.       SetLength(fLines, GetHeight);

  8839.       LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).BytesPerPixel);

  8840. 

  8841.       for Idx := 0 to GetHeight-1 do begin

  8842.         fLines[Idx] := Data;

  8843.         Inc(fLines[Idx], Idx * LineWidth);

  8844.       end;

  8845.     end

  8846.       else SetLength(fLines, 0);

  8847.   end else begin

  8848.     SetLength(fLines, 0);

  8849.   end;

  8850. end;

  8851. 

  8852. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  8853. procedure TglBitmap2D.UploadData(const aTarget: GLenum{$IFNDEF OPENGL_ES}; const aBuildWithGlu: Boolean{$ENDIF});

  8854. var

  8855.   FormatDesc: TFormatDescriptor;

  8856. begin

  8857.   FormatDesc := TFormatDescriptor.Get(Format);

  8858.   if (FormatDesc.glInternalFormat = 0) or (FormatDesc.glDataFormat = 0) then

  8859.     raise EglBitmap.Create('format is not supported by video adapter, please convert before uploading data');

  8860. 

  8861.   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);

  8862. 

  8863.   if FormatDesc.IsCompressed then begin

  8864.     if not Assigned(glCompressedTexImage2D) then

  8865.       raise EglBitmap.Create('compressed formats not supported by video adapter');

  8866.     glCompressedTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0, FormatDesc.GetSize(fDimension), Data)

  8867. {$IFNDEF OPENGL_ES}

  8868.   end else if aBuildWithGlu then begin

  8869.     gluBuild2DMipmaps(aTarget, FormatDesc.ChannelCount, Width, Height,

  8870.       FormatDesc.glFormat, FormatDesc.glDataFormat, Data)

  8871. {$ENDIF}

  8872.   end else begin

  8873.     glTexImage2D(aTarget, 0, FormatDesc.glInternalFormat, Width, Height, 0,

  8874.       FormatDesc.glFormat, FormatDesc.glDataFormat, Data);

  8875.   end;

  8876. 

  8877.   // Freigeben

  8878.   if (FreeDataAfterGenTexture) then

  8879.     FreeData;

  8880. end;

  8881. 

  8882. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  8883. procedure TglBitmap2D.AfterConstruction;

  8884. begin

  8885.   inherited;

  8886.   Target := GL_TEXTURE_2D;

  8887. end;

  8888. 

  8889. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

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

  8891. var

  8892.   Temp: pByte;

  8893.   Size, w, h: Integer;

  8894.   FormatDesc: TFormatDescriptor;

  8895. begin

  8896.   FormatDesc := TFormatDescriptor.Get(aFormat);

  8897.   if FormatDesc.IsCompressed then

  8898.     raise EglBitmapUnsupportedFormat.Create(aFormat);

  8899. 

  8900.   w    := aRight  - aLeft;

  8901.   h    := aBottom - aTop;

  8902.   Size := FormatDesc.GetSize(w, h);

  8903.   GetMem(Temp, Size);

  8904.   try

  8905.     glPixelStorei(GL_PACK_ALIGNMENT, 1);

  8906.     glReadPixels(aLeft, aTop, w, h, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);

  8907.     SetDataPointer(Temp, aFormat, w, h); //be careful, Data could be freed by this method

  8908.     FlipVert;

  8909.   except

  8910.     if Assigned(Temp) then

  8911.       FreeMem(Temp);

  8912.     raise;

  8913.   end;

  8914. end;

  8915. 

  8916. {$IFNDEF OPENGL_ES}

  8917. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  8918. procedure TglBitmap2D.GetDataFromTexture;

  8919. var

  8920.   Temp: PByte;

  8921.   TempWidth, TempHeight: Integer;

  8922.   TempIntFormat: GLint;

  8923.   IntFormat: TglBitmapFormat;

  8924.   FormatDesc: TFormatDescriptor;

  8925. begin

  8926.   Bind;

  8927. 

  8928.   // Request Data

  8929.   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_WIDTH,           @TempWidth);

  8930.   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_HEIGHT,          @TempHeight);

  8931.   glGetTexLevelParameteriv(Target, 0, GL_TEXTURE_INTERNAL_FORMAT, @TempIntFormat);

  8932. 

  8933.   FormatDesc := (TglBitmapFormatDescriptor.GetByFormat(TempIntFormat) as TFormatDescriptor);

  8934.   IntFormat  := FormatDesc.Format;

  8935. 

  8936.   // Getting data from OpenGL

  8937.   FormatDesc := TFormatDescriptor.Get(IntFormat);

  8938.   GetMem(Temp, FormatDesc.GetSize(TempWidth, TempHeight));

  8939.   try

  8940.     if FormatDesc.IsCompressed then begin

  8941.       if not Assigned(glGetCompressedTexImage) then

  8942.         raise EglBitmap.Create('compressed formats not supported by video adapter');

  8943.       glGetCompressedTexImage(Target, 0, Temp)

  8944.     end else

  8945.       glGetTexImage(Target, 0, FormatDesc.glFormat, FormatDesc.glDataFormat, Temp);

  8946.     SetDataPointer(Temp, IntFormat, TempWidth, TempHeight); //be careful, Data could be freed by this method

  8947.   except

  8948.     if Assigned(Temp) then

  8949.       FreeMem(Temp);

  8950.     raise;

  8951.   end;

  8952. end;

  8953. {$ENDIF}

  8954. 

  8955. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  8956. procedure TglBitmap2D.GenTexture(const aTestTextureSize: Boolean);

  8957. var

  8958.   {$IFNDEF OPENGL_ES}

  8959.   BuildWithGlu, TexRec: Boolean;

  8960.   {$ENDIF}

  8961.   PotTex: Boolean;

  8962.   TexSize: Integer;

  8963. begin

  8964.   if Assigned(Data) then begin

  8965.     // Check Texture Size

  8966.     if (aTestTextureSize) then begin

  8967.       glGetIntegerv(GL_MAX_TEXTURE_SIZE, @TexSize);

  8968. 

  8969.       if ((Height > TexSize) or (Width > TexSize)) then

  8970.         raise EglBitmapSizeToLarge.Create('TglBitmap2D.GenTexture - The size for the texture is to large. It''s may be not conform with the Hardware.');

  8971. 

  8972.       PotTex := IsPowerOfTwo(Height) and IsPowerOfTwo(Width);

  8973. {$IF NOT DEFINED(OPENGL_ES)}

  8974.       TexRec := (GL_ARB_texture_rectangle or GL_EXT_texture_rectangle or GL_NV_texture_rectangle) and (Target = GL_TEXTURE_RECTANGLE);

  8975.       if not (PotTex or GL_ARB_texture_non_power_of_two or GL_VERSION_2_0 or TexRec) then

  8976.         raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');

  8977. {$ELSEIF DEFINED(OPENGL_ES_EXT)}

  8978.       if not PotTex and not GL_OES_texture_npot then

  8979.         raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');

  8980. {$ELSE}

  8981.       if not PotTex then

  8982.         raise EglBitmapNonPowerOfTwo.Create('TglBitmap2D.GenTexture - Rendercontex dosn''t support non power of two texture.');

  8983. {$IFEND}

  8984.     end;

  8985. 

  8986.     CreateId;

  8987.     SetupParameters({$IFNDEF OPENGL_ES}BuildWithGlu{$ENDIF});

  8988.     UploadData(Target{$IFNDEF OPENGL_ES}, BuildWithGlu{$ENDIF});

  8989. {$IFNDEF OPENGL_ES}

  8990.     glAreTexturesResident(1, @fID, @fIsResident);

  8991. {$ENDIF}

  8992.   end;

  8993. end;

  8994. 

  8995. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  8996. function TglBitmap2D.FlipHorz: Boolean;

  8997. var

  8998.   Col, Row: Integer;

  8999.   TempDestData, DestData, SourceData: PByte;

  9000.   ImgSize: Integer;

  9001. begin

  9002.   result := inherited FlipHorz;

  9003.   if Assigned(Data) then begin

  9004.     SourceData := Data;

  9005.     ImgSize := Height * fRowSize;

  9006.     GetMem(DestData, ImgSize);

  9007.     try

  9008.       TempDestData := DestData;

  9009.       Dec(TempDestData, fRowSize + fPixelSize);

  9010.       for Row := 0 to Height -1 do begin

  9011.         Inc(TempDestData, fRowSize * 2);

  9012.         for Col := 0 to Width -1 do begin

  9013.           Move(SourceData^, TempDestData^, fPixelSize);

  9014.           Inc(SourceData, fPixelSize);

  9015.           Dec(TempDestData, fPixelSize);

  9016.         end;

  9017.       end;

  9018.       SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method

  9019.       result := true;

  9020.     except

  9021.       if Assigned(DestData) then

  9022.         FreeMem(DestData);

  9023.       raise;

  9024.     end;

  9025.   end;

  9026. end;

  9027. 

  9028. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  9029. function TglBitmap2D.FlipVert: Boolean;

  9030. var

  9031.   Row: Integer;

  9032.   TempDestData, DestData, SourceData: PByte;

  9033. begin

  9034.   result := inherited FlipVert;

  9035.   if Assigned(Data) then begin

  9036.     SourceData := Data;

  9037.     GetMem(DestData, Height * fRowSize);

  9038.     try

  9039.       TempDestData := DestData;

  9040.       Inc(TempDestData, Width * (Height -1) * fPixelSize);

  9041.       for Row := 0 to Height -1 do begin

  9042.         Move(SourceData^, TempDestData^, fRowSize);

  9043.         Dec(TempDestData, fRowSize);

  9044.         Inc(SourceData, fRowSize);

  9045.       end;

  9046.       SetDataPointer(DestData, Format, Width, Height); //be careful, Data could be freed by this method

  9047.       result := true;

  9048.     except

  9049.       if Assigned(DestData) then

  9050.         FreeMem(DestData);

  9051.       raise;

  9052.     end;

  9053.   end;

  9054. end;

  9055. 

  9056. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  9057. //TglBitmap2D - ToNormalMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  9058. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  9059. type

  9060.   TMatrixItem = record

  9061.     X, Y: Integer;

  9062.     W: Single;

  9063.   end;

  9064. 

  9065.   PglBitmapToNormalMapRec = ^TglBitmapToNormalMapRec;

  9066.   TglBitmapToNormalMapRec = Record

  9067.     Scale: Single;

  9068.     Heights: array of Single;

  9069.     MatrixU : array of TMatrixItem;

  9070.     MatrixV : array of TMatrixItem;

  9071.   end;

  9072. 

  9073. const

  9074.   ONE_OVER_255 = 1 / 255;

  9075. 

  9076.   //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  9077. procedure glBitmapToNormalMapPrepareFunc(var FuncRec: TglBitmapFunctionRec);

  9078. var

  9079.   Val: Single;

  9080. begin

  9081.   with FuncRec do begin

  9082.     Val :=

  9083.       Source.Data.r * LUMINANCE_WEIGHT_R +

  9084.       Source.Data.g * LUMINANCE_WEIGHT_G +

  9085.       Source.Data.b * LUMINANCE_WEIGHT_B;

  9086.     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Val * ONE_OVER_255;

  9087.   end;

  9088. end;

  9089. 

  9090. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  9091. procedure glBitmapToNormalMapPrepareAlphaFunc(var FuncRec: TglBitmapFunctionRec);

  9092. begin

  9093.   with FuncRec do

  9094.     PglBitmapToNormalMapRec(Args)^.Heights[Position.Y * Size.X + Position.X] := Source.Data.a * ONE_OVER_255;

  9095. end;

  9096. 

  9097. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  9098. procedure glBitmapToNormalMapFunc (var FuncRec: TglBitmapFunctionRec);

  9099. type

  9100.   TVec = Array[0..2] of Single;

  9101. var

  9102.   Idx: Integer;

  9103.   du, dv: Double;

  9104.   Len: Single;

  9105.   Vec: TVec;

  9106. 

  9107.   function GetHeight(X, Y: Integer): Single;

  9108.   begin

  9109.     with FuncRec do begin

  9110.       X := Max(0, Min(Size.X -1, X));

  9111.       Y := Max(0, Min(Size.Y -1, Y));

  9112.       result := PglBitmapToNormalMapRec(Args)^.Heights[Y * Size.X + X];

  9113.     end;

  9114.   end;

  9115. 

  9116. begin

  9117.   with FuncRec do begin

  9118.     with PglBitmapToNormalMapRec(Args)^ do begin

  9119.       du := 0;

  9120.       for Idx := Low(MatrixU) to High(MatrixU) do

  9121.         du := du + GetHeight(Position.X + MatrixU[Idx].X, Position.Y + MatrixU[Idx].Y) * MatrixU[Idx].W;

  9122. 

  9123.       dv := 0;

  9124.       for Idx := Low(MatrixU) to High(MatrixU) do

  9125.         dv := dv + GetHeight(Position.X + MatrixV[Idx].X, Position.Y + MatrixV[Idx].Y) * MatrixV[Idx].W;

  9126. 

  9127.       Vec[0] := -du * Scale;

  9128.       Vec[1] := -dv * Scale;

  9129.       Vec[2] := 1;

  9130.     end;

  9131. 

  9132.     // Normalize

  9133.     Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));

  9134.     if Len <> 0 then begin

  9135.       Vec[0] := Vec[0] * Len;

  9136.       Vec[1] := Vec[1] * Len;

  9137.       Vec[2] := Vec[2] * Len;

  9138.     end;

  9139. 

  9140.     // Farbe zuweisem

  9141.     Dest.Data.r := Trunc((Vec[0] + 1) * 127.5);

  9142.     Dest.Data.g := Trunc((Vec[1] + 1) * 127.5);

  9143.     Dest.Data.b := Trunc((Vec[2] + 1) * 127.5);

  9144.   end;

  9145. end;

  9146. 

  9147. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  9148. procedure TglBitmap2D.GenerateNormalMap(const aFunc: TglBitmapNormalMapFunc; const aScale: Single; const aUseAlpha: Boolean);

  9149. var

  9150.   Rec: TglBitmapToNormalMapRec;

  9151. 

  9152.   procedure SetEntry (var Matrix: array of TMatrixItem; Index, X, Y: Integer; W: Single);

  9153.   begin

  9154.     if (Index >= Low(Matrix)) and (Index <= High(Matrix)) then begin

  9155.       Matrix[Index].X := X;

  9156.       Matrix[Index].Y := Y;

  9157.       Matrix[Index].W := W;

  9158.     end;

  9159.   end;

  9160. 

  9161. begin

  9162.   if TFormatDescriptor.Get(Format).IsCompressed then

  9163.     raise EglBitmapUnsupportedFormat.Create(Format);

  9164. 

  9165.   if aScale > 100 then

  9166.     Rec.Scale := 100

  9167.   else if aScale < -100 then

  9168.     Rec.Scale := -100

  9169.   else

  9170.     Rec.Scale := aScale;

  9171. 

  9172.   SetLength(Rec.Heights, Width * Height);

  9173.   try

  9174.     case aFunc of

  9175.       nm4Samples: begin

  9176.         SetLength(Rec.MatrixU, 2);

  9177.         SetEntry(Rec.MatrixU, 0, -1,  0, -0.5);

  9178.         SetEntry(Rec.MatrixU, 1,  1,  0,  0.5);

  9179. 

  9180.         SetLength(Rec.MatrixV, 2);

  9181.         SetEntry(Rec.MatrixV, 0,  0,  1,  0.5);

  9182.         SetEntry(Rec.MatrixV, 1,  0, -1, -0.5);

  9183.       end;

  9184. 

  9185.       nmSobel: begin

  9186.         SetLength(Rec.MatrixU, 6);

  9187.         SetEntry(Rec.MatrixU, 0, -1,  1, -1.0);

  9188.         SetEntry(Rec.MatrixU, 1, -1,  0, -2.0);

  9189.         SetEntry(Rec.MatrixU, 2, -1, -1, -1.0);

  9190.         SetEntry(Rec.MatrixU, 3,  1,  1,  1.0);

  9191.         SetEntry(Rec.MatrixU, 4,  1,  0,  2.0);

  9192.         SetEntry(Rec.MatrixU, 5,  1, -1,  1.0);

  9193. 

  9194.         SetLength(Rec.MatrixV, 6);

  9195.         SetEntry(Rec.MatrixV, 0, -1,  1,  1.0);

  9196.         SetEntry(Rec.MatrixV, 1,  0,  1,  2.0);

  9197.         SetEntry(Rec.MatrixV, 2,  1,  1,  1.0);

  9198.         SetEntry(Rec.MatrixV, 3, -1, -1, -1.0);

  9199.         SetEntry(Rec.MatrixV, 4,  0, -1, -2.0);

  9200.         SetEntry(Rec.MatrixV, 5,  1, -1, -1.0);

  9201.       end;

  9202. 

  9203.       nm3x3: begin

  9204.         SetLength(Rec.MatrixU, 6);

  9205.         SetEntry(Rec.MatrixU, 0, -1,  1, -1/6);

  9206.         SetEntry(Rec.MatrixU, 1, -1,  0, -1/6);

  9207.         SetEntry(Rec.MatrixU, 2, -1, -1, -1/6);

  9208.         SetEntry(Rec.MatrixU, 3,  1,  1,  1/6);

  9209.         SetEntry(Rec.MatrixU, 4,  1,  0,  1/6);

  9210.         SetEntry(Rec.MatrixU, 5,  1, -1,  1/6);

  9211. 

  9212.         SetLength(Rec.MatrixV, 6);

  9213.         SetEntry(Rec.MatrixV, 0, -1,  1,  1/6);

  9214.         SetEntry(Rec.MatrixV, 1,  0,  1,  1/6);

  9215.         SetEntry(Rec.MatrixV, 2,  1,  1,  1/6);

  9216.         SetEntry(Rec.MatrixV, 3, -1, -1, -1/6);

  9217.         SetEntry(Rec.MatrixV, 4,  0, -1, -1/6);

  9218.         SetEntry(Rec.MatrixV, 5,  1, -1, -1/6);

  9219.       end;

  9220. 

  9221.       nm5x5: begin

  9222.         SetLength(Rec.MatrixU, 20);

  9223.         SetEntry(Rec.MatrixU,  0, -2,  2, -1 / 16);

  9224.         SetEntry(Rec.MatrixU,  1, -1,  2, -1 / 10);

  9225.         SetEntry(Rec.MatrixU,  2,  1,  2,  1 / 10);

  9226.         SetEntry(Rec.MatrixU,  3,  2,  2,  1 / 16);

  9227.         SetEntry(Rec.MatrixU,  4, -2,  1, -1 / 10);

  9228.         SetEntry(Rec.MatrixU,  5, -1,  1, -1 /  8);

  9229.         SetEntry(Rec.MatrixU,  6,  1,  1,  1 /  8);

  9230.         SetEntry(Rec.MatrixU,  7,  2,  1,  1 / 10);

  9231.         SetEntry(Rec.MatrixU,  8, -2,  0, -1 / 2.8);

  9232.         SetEntry(Rec.MatrixU,  9, -1,  0, -0.5);

  9233.         SetEntry(Rec.MatrixU, 10,  1,  0,  0.5);

  9234.         SetEntry(Rec.MatrixU, 11,  2,  0,  1 / 2.8);

  9235.         SetEntry(Rec.MatrixU, 12, -2, -1, -1 / 10);

  9236.         SetEntry(Rec.MatrixU, 13, -1, -1, -1 /  8);

  9237.         SetEntry(Rec.MatrixU, 14,  1, -1,  1 /  8);

  9238.         SetEntry(Rec.MatrixU, 15,  2, -1,  1 / 10);

  9239.         SetEntry(Rec.MatrixU, 16, -2, -2, -1 / 16);

  9240.         SetEntry(Rec.MatrixU, 17, -1, -2, -1 / 10);

  9241.         SetEntry(Rec.MatrixU, 18,  1, -2,  1 / 10);

  9242.         SetEntry(Rec.MatrixU, 19,  2, -2,  1 / 16);

  9243. 

  9244.         SetLength(Rec.MatrixV, 20);

  9245.         SetEntry(Rec.MatrixV,  0, -2,  2,  1 / 16);

  9246.         SetEntry(Rec.MatrixV,  1, -1,  2,  1 / 10);

  9247.         SetEntry(Rec.MatrixV,  2,  0,  2,  0.25);

  9248.         SetEntry(Rec.MatrixV,  3,  1,  2,  1 / 10);

  9249.         SetEntry(Rec.MatrixV,  4,  2,  2,  1 / 16);

  9250.         SetEntry(Rec.MatrixV,  5, -2,  1,  1 / 10);

  9251.         SetEntry(Rec.MatrixV,  6, -1,  1,  1 /  8);

  9252.         SetEntry(Rec.MatrixV,  7,  0,  1,  0.5);

  9253.         SetEntry(Rec.MatrixV,  8,  1,  1,  1 /  8);

  9254.         SetEntry(Rec.MatrixV,  9,  2,  1,  1 / 16);

  9255.         SetEntry(Rec.MatrixV, 10, -2, -1, -1 / 16);

  9256.         SetEntry(Rec.MatrixV, 11, -1, -1, -1 /  8);

  9257.         SetEntry(Rec.MatrixV, 12,  0, -1, -0.5);

  9258.         SetEntry(Rec.MatrixV, 13,  1, -1, -1 /  8);

  9259.         SetEntry(Rec.MatrixV, 14,  2, -1, -1 / 10);

  9260.         SetEntry(Rec.MatrixV, 15, -2, -2, -1 / 16);

  9261.         SetEntry(Rec.MatrixV, 16, -1, -2, -1 / 10);

  9262.         SetEntry(Rec.MatrixV, 17,  0, -2, -0.25);

  9263.         SetEntry(Rec.MatrixV, 18,  1, -2, -1 / 10);

  9264.         SetEntry(Rec.MatrixV, 19,  2, -2, -1 / 16);

  9265.       end;

  9266.     end;

  9267. 

  9268.     // Daten Sammeln

  9269.     if aUseAlpha and TFormatDescriptor.Get(Format).HasAlpha then

  9270.       Convert(glBitmapToNormalMapPrepareAlphaFunc, false, @Rec)

  9271.     else

  9272.       Convert(glBitmapToNormalMapPrepareFunc, false, @Rec);

  9273.     Convert(glBitmapToNormalMapFunc, false, @Rec);

  9274.   finally

  9275.     SetLength(Rec.Heights, 0);

  9276.   end;

  9277. end;

  9278. 

  9279. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}

  9280. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  9281. //TglBitmapCubeMap////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  9282. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  9283. procedure TglBitmapCubeMap.GenTexture(const aTestTextureSize: Boolean);

  9284. begin

  9285.   Assert(false, 'TglBitmapCubeMap.GenTexture - Don''t call GenTextures directly.');

  9286. end;

  9287. 

  9288. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  9289. procedure TglBitmapCubeMap.AfterConstruction;

  9290. begin

  9291.   inherited;

  9292. 

  9293. {$IFNDEF OPENGL_ES}

  9294.   if not (GL_VERSION_1_3 or GL_ARB_texture_cube_map or GL_EXT_texture_cube_map) then

  9295.     raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');

  9296. {$ELSE}

  9297.   if not (GL_VERSION_2_0) then

  9298.     raise EglBitmap.Create('TglBitmapCubeMap.AfterConstruction - CubeMaps are unsupported.');

  9299. {$ENDIF}

  9300. 

  9301.   SetWrap;

  9302.   Target   := GL_TEXTURE_CUBE_MAP;

  9303. {$IFNDEF OPENGL_ES}

  9304.   fGenMode := GL_REFLECTION_MAP;

  9305. {$ENDIF}

  9306. end;

  9307. 

  9308. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  9309. procedure TglBitmapCubeMap.GenerateCubeMap(const aCubeTarget: Cardinal; const aTestTextureSize: Boolean);

  9310. var

  9311.   {$IFNDEF OPENGL_ES}

  9312.   BuildWithGlu: Boolean;

  9313.   {$ENDIF}

  9314.   TexSize: Integer;

  9315. begin

  9316.   if (aTestTextureSize) then begin

  9317.     glGetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @TexSize);

  9318. 

  9319.     if (Height > TexSize) or (Width > TexSize) then

  9320.       raise EglBitmapSizeToLarge.Create('TglBitmapCubeMap.GenerateCubeMap - The size for the Cubemap is to large. It''s may be not conform with the Hardware.');

  9321. 

  9322. {$IF NOT DEFINED(OPENGL_ES)}

  9323.     if not ((IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) or GL_VERSION_2_0 or GL_ARB_texture_non_power_of_two) then

  9324.       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');

  9325. {$ELSEIF DEFINED(OPENGL_ES_EXT)}

  9326.     if not (IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) and not GL_OES_texture_npot then

  9327.       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');

  9328. {$ELSE}

  9329.     if not (IsPowerOfTwo(Height) and IsPowerOfTwo(Width)) then

  9330.       raise EglBitmapNonPowerOfTwo.Create('TglBitmapCubeMap.GenerateCubeMap - Cubemaps dosn''t support non power of two texture.');

  9331. {$IFEND}

  9332.   end;

  9333. 

  9334.   if (ID = 0) then

  9335.     CreateID;

  9336.   SetupParameters({$IFNDEF OPENGL_ES}BuildWithGlu{$ENDIF});

  9337.   UploadData(aCubeTarget{$IFNDEF OPENGL_ES}, BuildWithGlu{$ENDIF});

  9338. end;

  9339. 

  9340. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  9341. procedure TglBitmapCubeMap.Bind({$IFNDEF OPENGL_ES}const aEnableTexCoordsGen: Boolean;{$ENDIF} const aEnableTextureUnit: Boolean);

  9342. begin

  9343.   inherited Bind (aEnableTextureUnit);

  9344. {$IFNDEF OPENGL_ES}

  9345.   if aEnableTexCoordsGen then begin

  9346.     glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, fGenMode);

  9347.     glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, fGenMode);

  9348.     glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, fGenMode);

  9349.     glEnable(GL_TEXTURE_GEN_S);

  9350.     glEnable(GL_TEXTURE_GEN_T);

  9351.     glEnable(GL_TEXTURE_GEN_R);

  9352.   end;

  9353. {$ENDIF}

  9354. end;

  9355. 

  9356. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  9357. procedure TglBitmapCubeMap.Unbind({$IFNDEF OPENGL_ES}const aDisableTexCoordsGen: Boolean;{$ENDIF} const aDisableTextureUnit: Boolean);

  9358. begin

  9359.   inherited Unbind(aDisableTextureUnit);

  9360. {$IFNDEF OPENGL_ES}

  9361.   if aDisableTexCoordsGen then begin

  9362.     glDisable(GL_TEXTURE_GEN_S);

  9363.     glDisable(GL_TEXTURE_GEN_T);

  9364.     glDisable(GL_TEXTURE_GEN_R);

  9365.   end;

  9366. {$ENDIF}

  9367. end;

  9368. {$IFEND}

  9369. 

  9370. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_2_0)}

  9371. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  9372. //TglBitmapNormalMap//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  9373. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  9374. type

  9375.   TVec = Array[0..2] of Single;

  9376.   TglBitmapNormalMapGetVectorFunc = procedure (out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);

  9377. 

  9378.   PglBitmapNormalMapRec = ^TglBitmapNormalMapRec;

  9379.   TglBitmapNormalMapRec = record

  9380.     HalfSize : Integer;

  9381.     Func: TglBitmapNormalMapGetVectorFunc;

  9382.   end;

  9383. 

  9384. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  9385. procedure glBitmapNormalMapPosX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);

  9386. begin

  9387.   aVec[0] := aHalfSize;

  9388.   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);

  9389.   aVec[2] := - (aPosition.X + 0.5 - aHalfSize);

  9390. end;

  9391. 

  9392. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  9393. procedure glBitmapNormalMapNegX(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);

  9394. begin

  9395.   aVec[0] := - aHalfSize;

  9396.   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);

  9397.   aVec[2] := aPosition.X + 0.5 - aHalfSize;

  9398. end;

  9399. 

  9400. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  9401. procedure glBitmapNormalMapPosY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);

  9402. begin

  9403.   aVec[0] := aPosition.X + 0.5 - aHalfSize;

  9404.   aVec[1] := aHalfSize;

  9405.   aVec[2] := aPosition.Y + 0.5 - aHalfSize;

  9406. end;

  9407. 

  9408. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  9409. procedure glBitmapNormalMapNegY(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);

  9410. begin

  9411.   aVec[0] := aPosition.X + 0.5 - aHalfSize;

  9412.   aVec[1] := - aHalfSize;

  9413.   aVec[2] := - (aPosition.Y + 0.5 - aHalfSize);

  9414. end;

  9415. 

  9416. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  9417. procedure glBitmapNormalMapPosZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);

  9418. begin

  9419.   aVec[0] := aPosition.X + 0.5 - aHalfSize;

  9420.   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);

  9421.   aVec[2] := aHalfSize;

  9422. end;

  9423. 

  9424. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  9425. procedure glBitmapNormalMapNegZ(out aVec: TVec; const aPosition: TglBitmapPixelPosition; const aHalfSize: Integer);

  9426. begin

  9427.   aVec[0] := - (aPosition.X + 0.5 - aHalfSize);

  9428.   aVec[1] := - (aPosition.Y + 0.5 - aHalfSize);

  9429.   aVec[2] := - aHalfSize;

  9430. end;

  9431. 

  9432. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  9433. procedure glBitmapNormalMapFunc(var FuncRec: TglBitmapFunctionRec);

  9434. var

  9435.   i: Integer;

  9436.   Vec: TVec;

  9437.   Len: Single;

  9438. begin

  9439.   with FuncRec do begin

  9440.     with PglBitmapNormalMapRec(Args)^ do begin

  9441.       Func(Vec, Position, HalfSize);

  9442. 

  9443.       // Normalize

  9444.       Len := 1 / Sqrt(Sqr(Vec[0]) + Sqr(Vec[1]) + Sqr(Vec[2]));

  9445.       if Len <> 0 then begin

  9446.         Vec[0] := Vec[0] * Len;

  9447.         Vec[1] := Vec[1] * Len;

  9448.         Vec[2] := Vec[2] * Len;

  9449.       end;

  9450. 

  9451.       // Scale Vector and AddVectro

  9452.       Vec[0] := Vec[0] * 0.5 + 0.5;

  9453.       Vec[1] := Vec[1] * 0.5 + 0.5;

  9454.       Vec[2] := Vec[2] * 0.5 + 0.5;

  9455.     end;

  9456. 

  9457.     // Set Color

  9458.     for i := 0 to 2 do

  9459.       Dest.Data.arr[i] := Round(Vec[i] * 255);

  9460.   end;

  9461. end;

  9462. 

  9463. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  9464. procedure TglBitmapNormalMap.AfterConstruction;

  9465. begin

  9466.   inherited;

  9467. {$IFNDEF OPENGL_ES}

  9468.   fGenMode := GL_NORMAL_MAP;

  9469. {$ENDIF}

  9470. end;

  9471. 

  9472. //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

  9473. procedure TglBitmapNormalMap.GenerateNormalMap(const aSize: Integer; const aTestTextureSize: Boolean);

  9474. var

  9475.   Rec: TglBitmapNormalMapRec;

  9476.   SizeRec: TglBitmapSize;

  9477. begin

  9478.   Rec.HalfSize := aSize div 2;

  9479.   FreeDataAfterGenTexture := false;

  9480. 

  9481.   SizeRec.Fields := [ffX, ffY];

  9482.   SizeRec.X := aSize;

  9483.   SizeRec.Y := aSize;

  9484. 

  9485.   // Positive X

  9486.   Rec.Func := glBitmapNormalMapPosX;

  9487.   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);

  9488.   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X, aTestTextureSize);

  9489. 

  9490.   // Negative X

  9491.   Rec.Func := glBitmapNormalMapNegX;

  9492.   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);

  9493.   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X, aTestTextureSize);

  9494. 

  9495.   // Positive Y

  9496.   Rec.Func := glBitmapNormalMapPosY;

  9497.   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);

  9498.   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y, aTestTextureSize);

  9499. 

  9500.   // Negative Y

  9501.   Rec.Func := glBitmapNormalMapNegY;

  9502.   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);

  9503.   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y, aTestTextureSize);

  9504. 

  9505.   // Positive Z

  9506.   Rec.Func := glBitmapNormalMapPosZ;

  9507.   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);

  9508.   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z, aTestTextureSize);

  9509. 

  9510.   // Negative Z

  9511.   Rec.Func := glBitmapNormalMapNegZ;

  9512.   LoadFromFunc(SizeRec, glBitmapNormalMapFunc, tfBGR8ub3, @Rec);

  9513.   GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z, aTestTextureSize);

  9514. end;

  9515. {$IFEND}

  9516. 

  9517. initialization

  9518.   glBitmapSetDefaultFormat (tfEmpty);

  9519.   glBitmapSetDefaultMipmap (mmMipmap);

  9520.   glBitmapSetDefaultFilter (GL_LINEAR_MIPMAP_LINEAR, GL_LINEAR);

  9521.   glBitmapSetDefaultWrap   (GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);

  9522. {$IF NOT DEFINED(OPENGL_ES) OR DEFINED(OPENGL_ES_3_0)}

  9523.   glBitmapSetDefaultSwizzle(GL_RED, GL_GREEN, GL_BLUE, GL_ALPHA);

  9524. {$IFEND}

  9525. 

  9526.   glBitmapSetDefaultFreeDataAfterGenTexture(true);

  9527.   glBitmapSetDefaultDeleteTextureOnFree    (true);

  9528. 

  9529.   TFormatDescriptor.Init;

  9530. 

  9531. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}

  9532.   OpenGLInitialized := false;

  9533.   InitOpenGLCS := TCriticalSection.Create;

  9534. {$ENDIF}

  9535. 

  9536. finalization

  9537.   TFormatDescriptor.Finalize;

  9538. 

  9539. {$IFDEF GLB_NATIVE_OGL}

  9540.   if Assigned(GL_LibHandle) then

  9541.     glbFreeLibrary(GL_LibHandle);

  9542. 

  9543. {$IFDEF GLB_NATIVE_OGL_DYNAMIC}

  9544.   if Assigned(GLU_LibHandle) then

  9545.     glbFreeLibrary(GLU_LibHandle);

  9546.   FreeAndNil(InitOpenGLCS);

  9547. {$ENDIF}

  9548. {$ENDIF}

  9549. 

  9550. end.