1 year ago
#274620
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;
delphi
firemonkey
viewport
0 Answers
Your Answer