Tijdens de kerst een beetje aan het stoeien geweest met Firemonkey XE2
Aangezien ik niet veel code kan vinden rondom 3D en Firemonkey dump ik hier graag een voorbeeld voor één ieder die er wellicht ook eens iets mee wil rommelen.
Het is vast niet optimaal maar bollen in 3D renderen en dan met een lijn verbinden is gelukt!
Pas File:
Code:
unit uMain;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.Types3D, FMX.Objects3D, codesitelogging, FMX.Edit, FMX.Layers3D,
FMX.Objects, FMX.Layouts, FMX.Memo;
type
TForm1 = class(TForm3D)
Light1: TLight;
Sphere1: TSphere;
Text3D1: TText3D;
Camera1: TCamera;
Layer3D1: TLayer3D;
Button1: TButton;
Edit1: TEdit;
Memo1: TMemo;
procedure SphereRender(Sender: TObject; Context: TContext3D);
procedure Form3DCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Form3DRender(Sender: TObject; Context: TContext3D);
procedure Form3DMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
private
PriorPos: TPoint3d;
{ Private declarations }
public
mySphere3: TSphere;
mySphere1: TSphere;
mySphere2: TSphere;
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.fmx}
procedure TForm1.Button1Click(Sender: TObject);
begin
if not assigned(mySphere3) then
begin
mySphere3 := TSphere.Create(Form1);
mySphere3.Parent := Form1;
mySphere3.Name := 'MySphere3';
mySphere3.Position.point := Point3D(0, 0, 0);
mySphere3.Width := 2;
mySphere3.Height := 2;
mySphere3.Depth := 2;
mySphere3.OnRender := SphereRender;
// mySphere3.OnMouseDown := SphereMouseDown;
// mySphere3.OnMouseMove := SphereMouseMove;
mySphere3.RotationCenter.point := Point3D(Vector3DSubtract(Vector3D(0, 0, 0), Vector3D(mySphere3.Position.point)));
end;
end;
procedure TForm1.Form3DCreate(Sender: TObject);
begin
mySphere1 := TSphere.Create(self);
mySphere1.Parent := self;
mySphere1.Name := 'MySphere1';
mySphere1.OnRender := SphereRender;
mySphere1.Position.point := Point3D(-10, 2, 0);
// mySphere1.OnMouseDown := SphereMouseDown;
// mySphere1.OnMouseMove := SphereMouseMove;
mySphere1.Width := 2;
mySphere1.Height := 2;
mySphere1.Depth := 2;
mySphere2 := TSphere.Create(self);
mySphere2.Parent := self;
mySphere2.Name := 'MySphere2';
mySphere2.Position.point := Point3D(-5, 5.5, 0);
mySphere2.OnRender := SphereRender;
// mySphere2.OnMouseDown := SphereMouseDown;
// mySphere2.OnMouseMove := SphereMouseMove;
mySphere2.Width := 1;
mySphere2.Height := 1;
mySphere2.Depth := 1;
end;
procedure TForm1.Form3DMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
Const
step: Integer = -4;
begin
if ssctrl in Shift then
begin
if assigned(mySphere3) then
begin
if WheelDelta > 0 then
mySphere3.Position.z := mySphere3.Position.z + step
else
mySphere3.Position.z := mySphere3.Position.z - step
end;
if WheelDelta > 0 then
begin
mySphere1.Position.z := mySphere1.Position.z + step;
mySphere2.Position.z := mySphere2.Position.z + step;
end
else
begin
mySphere1.Position.z := mySphere1.Position.z - step;
mySphere2.Position.z := mySphere2.Position.z - step;
end;
end
else if ssShift in Shift then
begin
if assigned(mySphere3) then
begin
if WheelDelta > 0 then
mySphere3.Position.X := mySphere3.Position.X + step
else
mySphere3.Position.X := mySphere3.Position.X - step
end;
if WheelDelta > 0 then
begin
mySphere1.Position.X := mySphere1.Position.X + step;
mySphere2.Position.X := mySphere2.Position.X + step;
end
else
begin
mySphere1.Position.X := mySphere1.Position.X - step;
mySphere2.Position.X := mySphere2.Position.X - step;
end;
end
else
begin
if assigned(mySphere3) then
begin
if WheelDelta > 0 then
mySphere3.Position.Y := mySphere3.Position.Y + step
else
mySphere3.Position.Y := mySphere3.Position.Y - step
end;
if WheelDelta > 0 then
begin
mySphere1.Position.Y := mySphere1.Position.Y + step;
mySphere2.Position.Y := mySphere2.Position.Y + step;
end
else
begin
mySphere1.Position.Y := mySphere1.Position.Y - step;
mySphere2.Position.Y := mySphere2.Position.Y - step;
end;
end;
end;
procedure TForm1.Form3DRender(Sender: TObject; Context: TContext3D);
var
W: Extended;
begin
{ Geen idee waar de W voor dient }
if not TryStrToFloat(Edit1.text, W) then
W := 1.0;
end;
procedure TForm1.SphereRender(Sender: TObject; Context: TContext3D);
var
p1, p2: TPoint3d;
Dir: TVector3D;
tmpSphere: TSphere;
Factor: Extended;
idx1: TIndexBuffer;
ver1: TVertexBuffer;
i: Integer;
Y: Integer;
begin
if TSphere(Sender).Name = 'MySphere1' then
exit;
if TSphere(Sender).Name = 'MySphere2' then
tmpSphere := mySphere1
else if TSphere(Sender).Name = 'MySphere3' then
tmpSphere := mySphere2;
p1 := TSphere(Sender).Position.point;
p2 := tmpSphere.Position.point;
Factor := 1 / TSphere(Sender).Height;
Dir := Vector3DSubtract(Vector3D(p2), Vector3D(p1));
Dir := Vector3DScale(Dir, Factor);
Context.DrawLine(Vector3D(0, 0, 0), Dir, 1);
{ Demo hoe je 500 individuele punten in de 3d ruimte krijgt }
ver1 := TVertexBuffer.Create([TVertexFormat.vfVertex], 500);
idx1 := TIndexBuffer.Create(500);
try
for i := 0 to 500 do
idx1[i] := i;
for i := 0 to 250 do
begin
ver1.Vertices[i] := Point3D(i * 0.05, i * 0.01, 0);
end;
Y := 250;
for i := 251 to 500 do
begin
ver1.Vertices[i] := Point3D(i * 0.05, ver1.Vertices[Y].Y, 0);
Y := Y - 1;
end;
Context.DrawPointsList(ver1, idx1, 1);
finally
FreeAndNil(idx1);
FreeAndNil(ver1);
end;
end;
end.
DFM file:
Code:
object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClientHeight = 401
ClientWidth = 910
Visible = False
OnCreate = Form3DCreate
OnMouseWheel = Form3DMouseWheel
Camera = Camera1
OnRender = Form3DRender
object Light1: TLight
Position.Point = '(-9.88584995269775,2.13471555709839,0)'
RotationAngle.Point = '(-13.3279266357422,4.84241104125977,0)'
Width = 1.000000000000000000
Height = 1.000000000000000000
Depth = 1.000000000000000000
Opacity = 1.000000000000000000
Ambient = xFF202020
Diffuse = xFFA0A0A0
ConstantAttenuation = 1.000000000000000000
LightType = ltDirectional
Specular = claWhite
SpotCutOff = 180.000000000000000000
Quanternion =
'(-0.115942277014256,0.0419601984322071,0.00490236887708306,0.992' +
'355585098267)'
end
object Sphere1: TSphere
Position.Point = '(-4.39738941192627,-5.19587326049805,0)'
RotationAngle.Point = '(166.364059448242,0,0)'
Width = 1.000000000000000000
Height = 1.000000000000000000
Depth = 1.000000000000000000
Opacity = 1.000000000000000000
Quanternion = '(0.992928266525269,0,0,0.118715420365334)'
end
object Text3D1: TText3D
Width = 6.399355888366699000
Height = 3.365466117858887000
Depth = 0.300000011920929000
Opacity = 1.000000000000000000
Flatness = 1.000000000000000000
Sides = [esFront, esBack, esShaft]
Font.Size = 1.000000000000000000
Text = 'Hallo wereld'
Quanternion = '(0,0,0,1)'
end
object Camera1: TCamera
Position.Point = '(0,0,-5)'
Width = 1.000000000000000000
Height = 1.000000000000000000
Depth = 1.000000000000000000
Opacity = 1.000000000000000000
Quanternion = '(0,0,0,1)'
end
object Layer3D1: TLayer3D
Position.Point = '(821,200.5,0)'
Width = 178.000000000000000000
Height = 401.000000000000000000
Depth = 0.009999999776482582
Opacity = 1.000000000000000000
Projection = pjScreen
Align = alRight
StyleLookup = 'backgroundstyle'
Quanternion = '(0,0,0,1)'
object Button1: TButton
Position.Point = '(56,32)'
Width = 80.000000000000000000
Height = 22.000000000000000000
OnClick = Button1Click
TabOrder = 0
Text = 'Nog een bol'
end
object Edit1: TEdit
Position.Point = '(40,64)'
Width = 100.000000000000000000
Height = 22.000000000000000000
TabOrder = 1
KeyboardType = vktDefault
Password = False
end
object Memo1: TMemo
Position.Point = '(8,104)'
Width = 169.000000000000000000
Height = 225.000000000000000000
TabOrder = 3
Lines.Strings = (
'Probeer :'
'1) CTRL + Scroll wheel (ZOOM)'
'2) SHIFT + Scroll wheel (L+R)'
'3) Scroll wheel (UP + DOWN)'
'')
KeyboardType = vktDefault
end
end
end
Bookmarks