fDynCubemapD.pas 3.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130
  1. unit fDynCubemapD;
  2. interface
  3. uses
  4. Winapi.OpenGL,
  5. System.SysUtils,
  6. System.Classes,
  7. Vcl.Graphics,
  8. Vcl.Controls,
  9. Vcl.Forms,
  10. Vcl.Dialogs,
  11. Vcl.ExtCtrls,
  12. Vcl.StdCtrls,
  13. GLS.Objects,
  14. GLS.Scene,
  15. Stage.VectorTypes,
  16. GLS.SceneViewer,
  17. GLS.SkyDome,
  18. GLS.Cadencer,
  19. GLS.GeomObjects,
  20. GLS.Context,
  21. GLS.Coordinates,
  22. GLS.BaseClasses;
  23. type
  24. TFormDynCubeMap = class(TForm)
  25. GLScene1: TGLScene;
  26. GLSceneViewer1: TGLSceneViewer;
  27. GLMemoryViewer1: TGLMemoryViewer;
  28. GLCamera1: TGLCamera;
  29. GLLightSource1: TGLLightSource;
  30. Torus1: TGLTorus;
  31. CubeMapCamera: TGLCamera;
  32. Sphere1: TGLSphere;
  33. Cylinder1: TGLCylinder;
  34. Teapot1: TGLTeapot;
  35. SkyDome1: TGLSkyDome;
  36. Cube1: TGLCube;
  37. GLCadencer1: TGLCadencer;
  38. Timer1: TTimer;
  39. Panel1: TPanel;
  40. CBDynamic: TCheckBox;
  41. LabelFPS: TLabel;
  42. procedure GLSceneViewer1MouseDown(Sender: TObject;
  43. Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  44. procedure GLSceneViewer1MouseMove(Sender: TObject; Shift: TShiftState;
  45. X, Y: Integer);
  46. procedure Timer1Timer(Sender: TObject);
  47. procedure GLCadencer1Progress(Sender: TObject; const deltaTime,
  48. newTime: Double);
  49. procedure GLSceneViewer1BeforeRender(Sender: TObject);
  50. private
  51. procedure GenerateCubeMap;
  52. public
  53. mx, my : Integer;
  54. CubmapSupported : Boolean;
  55. cubeMapWarnDone : Boolean;
  56. end;
  57. var
  58. FormDynCubeMap: TFormDynCubeMap;
  59. //===================================
  60. implementation
  61. //===================================
  62. {$R *.dfm}
  63. procedure TFormDynCubeMap.GenerateCubeMap;
  64. begin
  65. // teapot in the scene hierarchy)
  66. with Teapot1 do begin
  67. // hide the teapot while rendering the cube map
  68. Visible:=False;
  69. // render cube map to the teapot's texture
  70. GLMemoryViewer1.RenderCubeMapTextures(Material.Texture);
  71. // teapot visible again
  72. Material.Texture.Disabled:=False;
  73. Visible:=True;
  74. end;
  75. end;
  76. procedure TFormDynCubeMap.GLCadencer1Progress(Sender: TObject; const deltaTime,
  77. newTime: Double);
  78. begin
  79. if CBDynamic.Checked then begin
  80. // make things move
  81. Teapot1.Position.Y:=2*Sin(newTime);
  82. Torus1.RollAngle:=newTime*15;
  83. // generate the cube map
  84. GenerateCubeMap;
  85. end;
  86. GLSceneViewer1.Invalidate;
  87. end;
  88. // Standard issue mouse movement
  89. procedure TFormDynCubeMap.GLSceneViewer1MouseDown(Sender: TObject;
  90. Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  91. begin
  92. mx:=x;
  93. my:=y;
  94. end;
  95. procedure TFormDynCubeMap.GLSceneViewer1MouseMove(Sender: TObject;
  96. Shift: TShiftState; X, Y: Integer);
  97. begin
  98. if Shift<>[] then begin
  99. GLCamera1.MoveAroundTarget(my-y, mx-x);
  100. mx:=x;
  101. my:=y;
  102. end;
  103. end;
  104. procedure TFormDynCubeMap.Timer1Timer(Sender: TObject);
  105. begin
  106. LabelFPS.Caption:=Format('%.1f FPS', [GLSceneViewer1.FramesPerSecond]);
  107. GLSceneViewer1.ResetPerformanceMonitor;
  108. end;
  109. procedure TFormDynCubeMap.GLSceneViewer1BeforeRender(Sender: TObject);
  110. begin
  111. CubmapSupported := GL.ARB_texture_cube_map;
  112. GLSceneViewer1.BeforeRender := nil;
  113. end;
  114. end.