GLScene/Examples/AdvDemos/PanoramViewer/fdPanoViewer.pas

unit fdPanoViewer;

interface

uses
  Winapi.OpenGL,
  Winapi.Windows,
  System.SysUtils,
  System.Classes,
  System.Math,
  Vcl.Graphics,
  Vcl.Controls,
  Vcl.Forms,
  Vcl.Dialogs,
  Vcl.ComCtrls,
  Vcl.StdCtrls,
  Vcl.ExtCtrls,
  Vcl.ExtDlgs,
  Vcl.Imaging.Jpeg,

  GLS.Coordinates,
  GLS.BaseClasses,
  Stage.VectorGeometry,
  Stage.Keyboard,
  GLS.XCollection,

  GLS.Scene,
  GLS.Objects,
  GLS.Texture,
  GLS.Cadencer,
  GLS.SceneViewer,
  GLS.Material,
  Stage.Utils;

type
  TFormPamorama = class(TForm)
    GLSceneViewer1: TGLSceneViewer;
    GLScene1: TGLScene;
    Panel1: TPanel;
    Camera: TGLCamera;
    BtnLoad: TButton;
    TrackBarFocal: TTrackBar;
    LabelYaw: TLabel;
    LabelPitch: TLabel;
    OpenPictureDialog1: TOpenPictureDialog;
    Label1: TLabel;
    SpherePano: TGLSphere;
    GLMaterialLibrary1: TGLMaterialLibrary;
    Label2: TLabel;
    GLCadencer1: TGLCadencer;
    procedure GLSceneViewer1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure GLSceneViewer1MouseMove(Sender: TObject; Shift: TShiftState;
      X, Y: Integer);
    procedure BtnLoadClick(Sender: TObject);
    procedure TrackBarFocalChange(Sender: TObject);
    procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure GLCadencer1Progress(Sender: TObject;
      const deltaTime, newTime: Double);
    procedure FormCreate(Sender: TObject);
  private
    Path: TFileName;
    mx, my: Integer;
    pitch, yaw: single; // in degrees
    procedure PanCameraAround(dx, dy: single);
  public

  end;

var
  FormPamorama: TFormPamorama;

implementation //============================================================

{$R *.DFM}

//---------------------------------------------------------------------------
procedure TFormPamorama.FormCreate(Sender: TObject);
begin
  Path := GetCurrentAssetPath(); // or Path := ExtractFilePath(ParamStr(0));
  SetCurrentDir(Path + '\panorana'); // GetDir(0, Path);
  OpenPictureDialog1.InitialDir := Path + '\panorama';
  OpenPictureDialog1.FileName := 'sejourstmathieu2048.jpg';
end;

//---------------------------------------------------------------------------
procedure TFormPamorama.GLSceneViewer1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  mx := X;
  my := Y;
end;

//---------------------------------------------------------------------------
procedure TFormPamorama.GLSceneViewer1MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var
  dx, dy, f: single;
begin
  if Shift = [ssLeft] then
  begin
    f := 0.2 * 40 / Camera.FocalLength;
    dx := (X - mx) * f;
    dy := (Y - my) * f;
    PanCameraAround(dx, dy);
  end;
  mx := X;
  my := Y;
end;

//---------------------------------------------------------------------------
procedure TFormPamorama.BtnLoadClick(Sender: TObject);
begin
  with OpenPictureDialog1 do
  if Execute then
    GLMaterialLibrary1.Materials[0].Material.Texture.Image.LoadFromFile
      (FileName);
end;

//---------------------------------------------------------------------------
procedure TFormPamorama.TrackBarFocalChange(Sender: TObject);
begin
  Camera.FocalLength := TrackBarFocal.Position;
end;

//---------------------------------------------------------------------------
procedure TFormPamorama.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
  TrackBarFocal.Position := TrackBarFocal.Position + Round(2 * WheelDelta / 120);
end;

//---------------------------------------------------------------------------
procedure TFormPamorama.GLCadencer1Progress(Sender: TObject;
  const deltaTime, newTime: Double);
const
  step_size = 20;
var
  delta: single;
  dx, dy: single;
begin
  delta := step_size * 40 / Camera.FocalLength * deltaTime;
  dx := 0;
  dy := 0;
  if IsKeyDown(VK_LEFT) then
    dx := dx + delta;
  if IsKeyDown(VK_UP) then
    dy := dy + delta;
  if IsKeyDown(VK_RIGHT) then
    dx := dx - delta;
  if IsKeyDown(VK_DOWN) then
    dy := dy - delta;
  PanCameraAround(dx, dy);
end;

//---------------------------------------------------------------------------
procedure TFormPamorama.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  Key := 0; // all keys handled by Form1
end;

//---------------------------------------------------------------------------
procedure TFormPamorama.PanCameraAround(dx, dy: single);
begin
  pitch := pitch + dy;
  yaw := yaw - dx;

  if pitch > 90 then
    pitch := 90;
  if pitch < -90 then
    pitch := -90;
  if yaw > 360 then
    yaw := yaw - 360;
  if yaw < 0 then
    yaw := yaw + 360;

  Camera.Up.SetVector(0, 1, 0);
  Camera.Direction.SetVector(sin(DegToRad(yaw)), sin(DegToRad(pitch)),
    -cos(DegToRad(yaw)));

  LabelPitch.caption := format('Pitch: %3f', [pitch]);
  LabelYaw.caption := format('Yaw: %3f', [yaw]);
end;

end.