Embarcadero FireMonkey 3D вращение и масштабирование камеры

В следующей форме показана простая демонстрация этого, просто сохраните файлы .fmx и .pas и добавьте форму в приложение FMX. Ключевыми частями являются камера и вложенный световой объект на отдельных осях X и Y по отношению к DummyObject, который является целью камеры. Наличие X и Y в качестве отдельных фиктивных объектов делает вращение вертикальным и горизонтальным, что желательно в некоторых ситуациях. Вы также можете объединить объекты DummyX и DummyY в один объект DummyXY, который даст более реалистичный стиль вращения, но будет зависеть от ваших потребностей относительно того, что предпочтительнее.

MainForm.pas:

unit MainForm;

interface

uses
  FMX.Forms, FMX.Materials, System.Math.Vectors, FMX.Types3D, FMX.Objects3D, FMX.Controls3D, FMX.Viewport3D,
  System.Classes, FMX.Types, FMX.Controls, FMX.Layouts, FMX.MaterialSources, System.Types, System.UITypes;

type

  TForm1 = class(TForm)
    Viewport3D: TViewport3D;
    DummyX: TDummy;
    DummyObject: TDummy;
    CameraZ: TCamera;
    Light1: TLight;
    LayoutMain: TLayout;
    DummyY: TDummy;
    Cone1: TCone;
    LightMaterialSource1: TLightMaterialSource;
    procedure Viewport3DMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
    procedure Viewport3DMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
    procedure Viewport3DMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
  private
    FDown: TPointF;
    procedure DoZoom(aIn: Boolean);
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

const
  CAMERA_MAX_Z = -2;
  CAMERA_MIN_Z = -200;
  ZOOM_STEP = 2;

procedure TForm1.DoZoom(aIn: Boolean);
var
  newZ: Single;
begin
  if aIn then
    newZ := CameraZ.Position.Z + ZOOM_STEP
  else
    newZ := CameraZ.Position.Z - ZOOM_STEP;

  if (newZ < CAMERA_MAX_Z) and (newZ > CAMERA_MIN_Z) then
    CameraZ.Position.Z := newZ;
end;

procedure TForm1.Viewport3DMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
  FDown := PointF(X, Y);
end;

procedure TForm1.Viewport3DMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
begin
  if (ssLeft in Shift) then
  begin
    DummyX.RotationAngle.X := DummyX.RotationAngle.X - ((Y - FDown.Y) * 0.3);
    DummyY.RotationAngle.Y := DummyY.RotationAngle.Y + ((X - FDown.X) * 0.3);
    FDown := PointF(X, Y);
  end;
end;

procedure TForm1.Viewport3DMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
begin
  DoZoom(WheelDelta > 0);
end;

end.

MainForm.fmx:

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 592
  ClientWidth = 713
  FormFactor.Width = 320
  FormFactor.Height = 480
  FormFactor.Devices = [Desktop]
  DesignerMasterStyle = 0
  object LayoutMain: TLayout
    Align = Client
    Size.Width = 713.000000000000000000
    Size.Height = 592.000000000000000000
    Size.PlatformDefault = False
    TabOrder = 2
    object Viewport3D: TViewport3D
      Align = Client
      Camera = CameraZ
      Size.Width = 713.000000000000000000
      Size.Height = 592.000000000000000000
      Size.PlatformDefault = False
      UsingDesignCamera = False
      OnMouseDown = Viewport3DMouseDown
      OnMouseMove = Viewport3DMouseMove
      OnMouseWheel = Viewport3DMouseWheel
      object DummyX: TDummy
        Width = 1.000000000000000000
        Height = 1.000000000000000000
        Depth = 1.000000000000000000
        object DummyY: TDummy
          Width = 1.000000000000000000
          Height = 1.000000000000000000
          Depth = 1.000000000000000000
          object CameraZ: TCamera
            AngleOfView = 45.000000000000000000
            Target = DummyObject
            Position.Z = -20.000000000000000000
            Width = 1.000000000000000000
            Height = 1.000000000000000000
            Depth = 1.000000000000000000
            object Light1: TLight
              Color = claWhite
              LightType = Directional
              SpotCutOff = 180.000000000000000000
              Width = 1.000000000000000000
              Height = 1.000000000000000000
              Depth = 1.000000000000000000
            end
          end
        end
      end
      object DummyObject: TDummy
        Width = 1.000000000000000000
        Height = 1.000000000000000000
        Depth = 1.000000000000000000
        object Cone1: TCone
          Width = 1.000000000000000000
          Height = 1.000000000000000000
          Depth = 1.000000000000000000
          SubdivisionsCap = 3
          MaterialSource = LightMaterialSource1
        end
      end
    end
  end
  object LightMaterialSource1: TLightMaterialSource
    Diffuse = claWhite
    Ambient = xFF202020
    Emissive = claNull
    Specular = xFF606060
    Shininess = 30
    Left = 436
    Top = 56
  end
end

Я вытащил это из демонстрации где-то, но отлично работает для моих нужд. Должен работать с Delphi XE5 и выше.

Вы можете вращать камеру перетаскиванием и масштабировать колесиком. Важно то, что вращение по разным осям должно обрабатываться на разных вложенных объектах, чтобы расчет вращения влиял друг на друга, как мы ожидаем в реальном мире.