//----------------------------------------------------------------------------------------------------------------------------------
// Grundbildschirm
//----------------------------------------------------------------------------------------------------------------------------------
unit pB_main;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Viewport3D, System.Math.Vectors, FMX.Controls3D, FMX.Objects3D,
FMX.Controls.Presentation, FMX.StdCtrls;
type
THaupt_Form =
class(TForm)
Viewport_3D : TViewport3D;
Model_3D : TModel3D;
Grundraster : TGrid3D;
Status_Zeile : TStatusBar;
Panel_XY : TPanel;
Text_XY_Pos : TLabel;
Zoom_panel : TPanel;
Zoom_Label : TLabel;
TrackBar_Zoom: TTrackBar;
procedure Viewport_3DMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
procedure Viewport_3DMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
procedure Viewport_3DMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
procedure FormActivate(Sender: TObject);
procedure TrackBar_ZoomTracking(Sender: TObject);
procedure Viewport_3DMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer;
var Handled: Boolean);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
Down_Pos : TPointF;
Mouse_Down: Boolean;
end;
type kugel =
record
huelle : TSphere;
name :
string;
end;
var
Haupt_Form : THaupt_Form;
kugel_feld :
array of kugel;
implementation
{$R *.fmx}
// Initialisierung
procedure THaupt_Form.FormActivate(Sender: TObject);
var i : integer;
begin
Grundraster.HitTest := false;
// Kugeln setzen
Viewport_3D.BeginUpdate;
for i := 0
to 9
do
begin
setlength(kugel_feld, succ(length(kugel_feld)));
kugel_feld[pred(length(kugel_feld))].huelle := tsphere.Create(self);
kugel_feld[pred(length(kugel_feld))].huelle.Parent := grundraster;
kugel_feld[pred(length(kugel_feld))].huelle.Position.x := 1;
kugel_feld[pred(length(kugel_feld))].huelle.Position.y := i;
kugel_feld[pred(length(kugel_feld))].huelle.Width := 1;
kugel_feld[pred(length(kugel_feld))].huelle.Height := 1;
kugel_feld[pred(length(kugel_feld))].huelle.Repaint;
kugel_feld[pred(length(kugel_feld))].
name := inttostr(i);
end;
Viewport_3D.endUpdate;
Viewport_3D.Repaint;
end;
procedure THaupt_Form.FormClose(Sender: TObject;
var Action: TCloseAction);
var i : integer;
begin
for i := 0
to pred(length(kugel_feld))
do kugel_feld[i].huelle.Free;
end;
procedure THaupt_Form.TrackBar_ZoomTracking(Sender: TObject);
begin
Model_3D.Scale.X := TrackBar_Zoom.value;
Model_3D.Scale.Y := TrackBar_Zoom.value;
Model_3D.Scale.Z := TrackBar_Zoom.value;
end;
procedure THaupt_Form.Viewport_3DMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
Down_Pos := PointF(X, Y);
Mouse_Down := True;
end;
procedure THaupt_Form.Viewport_3DMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
begin
if (ssLeft
in Shift)
and (Mouse_Down)
then
begin
Model_3D.RotationAngle.X := Model_3D.RotationAngle.X - ((Y - Down_Pos.Y) * 0.25);
Model_3D.RotationAngle.Y := Model_3D.RotationAngle.Y + ((X - Down_Pos.X) * 0.25);
Down_Pos := PointF(X, Y);
end;
Text_XY_Pos.Text := '
XY Pos ' + floattostr(X) + '
/' + floattostr(y);
end;
procedure THaupt_Form.Viewport_3DMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
Mouse_Down := false;
end;
procedure THaupt_Form.Viewport_3DMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer;
var Handled: Boolean);
begin
begin
if WheelDelta < 0
then TrackBar_Zoom.value := TrackBar_Zoom.value - 0.1
else TrackBar_Zoom.value := TrackBar_Zoom.value + 0.1;
Model_3D.Scale.X := TrackBar_Zoom.value;
Model_3D.Scale.Y := TrackBar_Zoom.value;
Model_3D.Scale.Z := TrackBar_Zoom.value;
end;
end;
end.