1 year ago

#274620

test-img

Ride

FireMonkey ViewPort procedure calculated differently world to screen on Mac

I use Delphi 11 and FireMonkey to frough ViewPort show 3D objects. Created simple project to show my problem. One part frough ViewPort show simple TCube and other use same TCube data vertexes to paint point and labels frough function WorldToScreen. On windows and virtual box mac work corrent, but then runing on real mac it's convert to differnete location then 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;

It's look like thisenter image description here

delphi

firemonkey

viewport

0 Answers

Your Answer

Accepted video resources