fPanoViewerD.pas 4.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180
  1. unit fPanoViewerD;
  2. interface
  3. uses
  4. Winapi.OpenGL,
  5. Winapi.Windows,
  6. System.SysUtils,
  7. System.Classes,
  8. System.Math,
  9. Vcl.Graphics,
  10. Vcl.Controls,
  11. Vcl.Forms,
  12. Vcl.Dialogs,
  13. Vcl.ComCtrls,
  14. Vcl.StdCtrls,
  15. Vcl.ExtCtrls,
  16. Vcl.ExtDlgs,
  17. Vcl.Imaging.Jpeg,
  18. GLS.Coordinates,
  19. GLS.BaseClasses,
  20. GLScene.VectorGeometry,
  21. GLScene.Keyboard,
  22. GLS.XCollection,
  23. GLS.Scene,
  24. GLS.Objects,
  25. GLS.Texture,
  26. GLS.Cadencer,
  27. GLS.SceneViewer,
  28. GLS.Material,
  29. GLScene.Utils;
  30. type
  31. TForm1 = class(TForm)
  32. GLSceneViewer1: TGLSceneViewer;
  33. GLScene1: TGLScene;
  34. Panel1: TPanel;
  35. GLCamera1: TGLCamera;
  36. BtnLoad: TButton;
  37. TrackBar1: TTrackBar;
  38. LabelYaw: TLabel;
  39. LabelPitch: TLabel;
  40. OpenPictureDialog1: TOpenPictureDialog;
  41. Label1: TLabel;
  42. Sphere1: TGLSphere;
  43. GLMaterialLibrary1: TGLMaterialLibrary;
  44. Label2: TLabel;
  45. GLCadencer1: TGLCadencer;
  46. procedure GLSceneViewer1MouseDown(Sender: TObject; Button: TMouseButton;
  47. Shift: TShiftState; X, Y: Integer);
  48. procedure GLSceneViewer1MouseMove(Sender: TObject; Shift: TShiftState;
  49. X, Y: Integer);
  50. procedure BtnLoadClick(Sender: TObject);
  51. procedure TrackBar1Change(Sender: TObject);
  52. procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
  53. WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
  54. procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  55. procedure GLCadencer1Progress(Sender: TObject;
  56. const deltaTime, newTime: Double);
  57. procedure FormCreate(Sender: TObject);
  58. private
  59. Path: TFileName;
  60. mx, my: Integer;
  61. pitch, yaw: single; // in degrees
  62. procedure PanCameraAround(dx, dy: single);
  63. public
  64. end;
  65. var
  66. Form1: TForm1;
  67. implementation //------------------------------------------------------------
  68. {$R *.DFM}
  69. procedure TForm1.FormCreate(Sender: TObject);
  70. begin
  71. Path := GetCurrentAssetPath(); // or Path := ExtractFilePath(ParamStr(0));
  72. SetCurrentDir(Path + '\panorana'); // GetDir(0, Path);
  73. OpenPictureDialog1.InitialDir := Path + '\panorama';
  74. OpenPictureDialog1.FileName := 'sejourstmathieu2048.jpg';
  75. end;
  76. procedure TForm1.GLSceneViewer1MouseDown(Sender: TObject; Button: TMouseButton;
  77. Shift: TShiftState; X, Y: Integer);
  78. begin
  79. mx := X;
  80. my := Y;
  81. end;
  82. procedure TForm1.GLSceneViewer1MouseMove(Sender: TObject; Shift: TShiftState;
  83. X, Y: Integer);
  84. var
  85. dx, dy, f: single;
  86. begin
  87. if Shift = [ssLeft] then
  88. begin
  89. f := 0.2 * 40 / GLCamera1.FocalLength;
  90. dx := (X - mx) * f;
  91. dy := (Y - my) * f;
  92. PanCameraAround(dx, dy);
  93. end;
  94. mx := X;
  95. my := Y;
  96. end;
  97. procedure TForm1.BtnLoadClick(Sender: TObject);
  98. begin
  99. with OpenPictureDialog1 do
  100. if Execute then
  101. GLMaterialLibrary1.Materials[0].Material.Texture.Image.LoadFromFile
  102. (FileName);
  103. end;
  104. procedure TForm1.TrackBar1Change(Sender: TObject);
  105. begin
  106. GLCamera1.FocalLength := TrackBar1.Position;
  107. end;
  108. procedure TForm1.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  109. WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
  110. begin
  111. TrackBar1.Position := TrackBar1.Position + Round(2 * WheelDelta / 120);
  112. end;
  113. procedure TForm1.GLCadencer1Progress(Sender: TObject;
  114. const deltaTime, newTime: Double);
  115. const
  116. step_size = 20;
  117. var
  118. delta: single;
  119. dx, dy: single;
  120. begin
  121. delta := step_size * 40 / GLCamera1.FocalLength * deltaTime;
  122. dx := 0;
  123. dy := 0;
  124. if IsKeyDown(VK_LEFT) then
  125. dx := dx + delta;
  126. if IsKeyDown(VK_UP) then
  127. dy := dy + delta;
  128. if IsKeyDown(VK_RIGHT) then
  129. dx := dx - delta;
  130. if IsKeyDown(VK_DOWN) then
  131. dy := dy - delta;
  132. PanCameraAround(dx, dy);
  133. end;
  134. procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  135. Shift: TShiftState);
  136. begin
  137. Key := 0; // all keys handled by Form1
  138. end;
  139. procedure TForm1.PanCameraAround(dx, dy: single);
  140. begin
  141. pitch := pitch + dy;
  142. yaw := yaw - dx;
  143. if pitch > 90 then
  144. pitch := 90;
  145. if pitch < -90 then
  146. pitch := -90;
  147. if yaw > 360 then
  148. yaw := yaw - 360;
  149. if yaw < 0 then
  150. yaw := yaw + 360;
  151. GLCamera1.Up.SetVector(0, 1, 0);
  152. GLCamera1.Direction.SetVector(sin(DegToRad(yaw)), sin(DegToRad(pitch)),
  153. -cos(DegToRad(yaw)));
  154. LabelPitch.caption := format('Pitch: %3f', [pitch]);
  155. LabelYaw.caption := format('Yaw: %3f', [yaw]);
  156. end;
  157. end.