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.