fPanoViewerD.pas 4.1 KB

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