FireMonkey ViewPort 程序在 Mac 上计算不同的世界和屏幕

Question

我使用 Delphi 11 和 FireMonkey 通过 ViewPort 显示 3D 对象。创建简单的项目来展示我的问题。一部分通过 ViewPort 显示简单的 TCube，其他部分使用相同的 TCube 数据顶点通过函数 WorldToScreen 绘制点和标签。在 Windows 和 Virtual Box Mac 上可以正常工作，但在真实 Mac 上运行时，它会转换为与 ViewPort 不同的位置。

Unit2.fmx

object Form2: TForm2
      Left = 0
      Top = 0
      Caption = 'Form2'
      ClientHeight = 480
      ClientWidth = 640
      FormFactor.Width = 320
      FormFactor.Height = 480
      FormFactor.Devices = [Desktop]
      DesignerMasterStyle = 0
      object Viewport3D1: TViewport3D
        Align = Client
        Camera = Camera1
        Size.Width = 640.000000000000000000
        Size.Height = 480.000000000000000000
        Size.PlatformDefault = False
        UsingDesignCamera = False
        OnMouseDown = Viewport3D1MouseDown
        OnMouseMove = Viewport3D1MouseMove
        OnMouseWheel = Viewport3D1MouseWheel
        object Dummy1: TDummy
          Width = 1.000000000000000000
          Height = 1.000000000000000000
          Depth = 1.000000000000000000
          object Camera1: TCamera
            AngleOfView = 45.000000000000000000
            Position.Z = -5.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
        object Cube1: TCube
          Width = 1.000000000000000000
          Height = 1.000000000000000000
          Depth = 1.000000000000000000
        end
      end
      object PaintBox1: TPaintBox
        Align = Client
        Size.Width = 640.000000000000000000
        Size.Height = 480.000000000000000000
        Size.PlatformDefault = False
        OnMouseDown = Viewport3D1MouseDown
        OnMouseMove = Viewport3D1MouseMove
        OnMouseWheel = Viewport3D1MouseWheel
        OnPaint = PaintBox1Paint
      end
    end

Unit2.pas

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, System.Math,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
  System.Math.Vectors, FMX.Objects3D, FMX.Controls3D, FMX.Objects,
  FMX.Viewport3D, FMX.Types3D, FMX.MaterialSources, FMX.Ani;

type
  TForm2 = class(TForm)
    Viewport3D1: TViewport3D;
    PaintBox1: TPaintBox;
    Camera1: TCamera;
    Cube1: TCube;
    Dummy1: TDummy;
    Light1: TLight;
    procedure Viewport3D1MouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: Integer; var Handled: Boolean);
    procedure Viewport3D1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
    procedure Viewport3D1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Single);
    procedure PaintBox1Paint(Sender: TObject; Canvas: TCanvas);
  private
    FDown: TPointF;
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.fmx}

type
  TFakeCube = class(TCube);

var
  ZOOM_STEP: Single;

procedure PaintElements(ABmp: TBitmap; AVP: TViewport3D; ACube: TCube);
const
  DRAW_STRING_NEW_LINE = 16;
var
  iI, FSize: Integer;
  FLabl: String;
  tmpsp: TPoint3D;
  tmpr: TRectF;
begin
  FSize := 3;
  ABMP.Canvas.Fill.Color := TAlphaColorRec.Green;
  ABMP.Canvas.Stroke.Color := ABMP.Canvas.Fill.Color;
  ABMP.Canvas.Stroke.Kind := TBrushKind.Solid;
  ABMP.Canvas.Stroke.Thickness := 1;
  for iI := 0 to TFakeCube(ACube).Data.VertexBuffer.Length -1 do begin
    tmpsp := TFakeCube(ACube).Data.VertexBuffer.Vertices[iI]+ACube.Position.Point;
    FLabl := Format('X:%0.2f Y:%0.2f Z:%0.2f',[tmpsp.X,tmpsp.Y,tmpsp.Z]);
    tmpsp := AVP.Context.WorldToScreen(TProjection.Camera,tmpsp);
    tmpr := RectF(tmpsp.X -FSize,tmpsp.Y -FSize,tmpsp.X +FSize,tmpsp.Y +FSize);
    ABMP.Canvas.FillEllipse(tmpr,100);
    ABMP.Canvas.DrawEllipse(tmpr,100);
    tmpsp.Offset(FSize+3,-FSize,0);
    tmpr := TRectF.Create(tmpsp.X, tmpsp.Y -Min(DRAW_STRING_NEW_LINE, ABMP.Canvas.TextHeight(FLabl)), tmpsp.X +ABMP.Canvas.TextWidth(FLabl), tmpsp.Y);
    ABMP.Canvas.FillText(tmpr, FLabl, false, 100, [], TTextAlign.Leading, TTextAlign.Leading);
  end;
end;

procedure TForm2.PaintBox1Paint(Sender: TObject; Canvas: TCanvas);
var
  tmpBmp: TBitmap;
begin
  tmpBmp := TBitmap.Create(Trunc(Viewport3D1.Width), Trunc(Viewport3D1.Height));
  try
    tmpBmp.Resize(Trunc(PaintBox1.Width), Trunc(PaintBox1.Height));
    if tmpBmp.Canvas.BeginScene then begin
      tmpBmp.Canvas.Clear(TAlphaColorRec.Null);
      PaintElements(tmpBmp,Viewport3D1,Cube1);
      tmpBmp.Canvas.EndScene;
    end;
    PaintBox1.Canvas.DrawBitmap(tmpBmp, tmpBmp.BoundsF, tmpBmp.BoundsF.CenterAt(PaintBox1.BoundsRect), 1);
  finally
    tmpBmp.Free;
  end;
end;

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

procedure TForm2.Viewport3D1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Single);
var
  dX,dY: Single;
begin
  dX := X - FDown.X;
  dY := Y - FDown.Y;
  if (ssLeft in Shift) then begin
    Dummy1.RotationAngle.X := Dummy1.RotationAngle.X - (dY * 0.3);
    Dummy1.RotationAngle.Y := Dummy1.RotationAngle.Y + (dX * 0.3);
    FDown := PointF(X, Y);
  end;
end;

procedure TForm2.Viewport3D1MouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
var
  newZ: Single;
begin
  if WheelDelta > 0 then
    newZ := Viewport3D1.Camera.Position.Z + ZOOM_STEP
  else
    newZ := Viewport3D1.Camera.Position.Z - ZOOM_STEP;

//  if (newZ < CAMERA_MAX_Z) and (newZ > CAMERA_MIN_Z) then
    Viewport3D1.Camera.Position.Z := newZ;

  newZ := Abs(newZ);
  if newZ <= 2 then
    ZOOM_STEP := 0.5
  else if newZ <= 1 then
    ZOOM_STEP := 0.01
  else
    ZOOM_STEP := 2;
end;

看起来像这样