unit uMain;
interface
uses
System.SysUtils,
System.Types,
System.UITypes,
System.Classes,
System.Variants,
FMX.Types,
FMX.Controls,
FMX.Forms3D,
FMX.Forms,
FMX.Dialogs,
FMX.Sensors,
FMX.Controls3D,
FMX.Objects3D,
System.Sensors,
FMX.StdCtrls,
FMX.Layers3D,
FMX.MaterialSources,
FMX.Layouts,
FMX.Memo,
FMX.ListBox
{$IFDEF MSWINDOWS},
ComObj,
ActiveX,
System.Win.Sensors,
Winapi.Sensors,
Winapi.Sensorsapi
{$ENDIF};
{$IFnDEF MSWINDOWS}
{$DEFINE USEGYROSCOPETHREAD}
{$ENDIF}
const
SENSOR_INTERVAL = 100;
type
TGyroscopeThread =
class{$IFDEF USEGYROSCOPETHREAD}(TThread)
{$ENDIF}
protected
{$IFnDEF USEGYROSCOPETHREAD}
fHandle : TTimer;
{$ENDIF}
fSensors : TSensorArray;
fSensorManager : TSensorManager;
fAvailable : Boolean;
fIterations : Int64;
fState : TSensorState;
fRotation :
Array[0..2]
of Double;
fDistance :
Array[0..2]
of Double;
fHeading :
Array[0..2]
of Double;
fMagHeading : Double;
fTrueHeading : Double;
fCompMagHeading : Double;
fCompTrueHeading : Double;
fMessage :
String;
{$IFDEF MSWINDOWS}
fIntf : ISensor;
{$ENDIF}
procedure handleOrientationSensor(
const ASensor : TCustomOrientationSensor);
procedure SyncOutputMessage();
procedure SyncCamera();
procedure SynchronizeOutputMessage(
const AMessage :
String);
procedure Execute();
{$IFDEF USEGYROSCOPETHREAD}override;
{$ENDIF}
{$IFnDEF USEGYROSCOPETHREAD}
procedure doOnExecute(Sender : TObject);
{$ENDIF}
public
property available : Boolean
read fAvailable
write fAvailable;
constructor Create();
reintroduce;
virtual;
destructor Destroy;
override;
{$IFnDEF USEGYROSCOPETHREAD}
procedure Start();
procedure Terminate();
{$ENDIF}
end;
TGyroscopeForm =
class(TForm3D)
LightMaterialSource1: TLightMaterialSource;
Light1: TLight;
Layer3D1: TLayer3D;
Label1: TLabel;
Cube1: TCube;
Camera1: TCamera;
Timer1: TTimer;
Layer3D2: TLayer3D;
Lbl_Iterations: TLabel;
Memo1: TMemo;
CkBx_Active: TCheckBox;
procedure Form3DCreate(Sender: TObject);
procedure Form3DDestroy(Sender: TObject);
procedure CkBx_ActiveChange(Sender: TObject);
private
fGyroscope : TGyroscopeThread;
public
{ Public declarations }
end;
var
GyroscopeForm: TGyroscopeForm;
implementation
{$R *.fmx}
function getOrientationSensorType(
const ASensor : TCustomOrientationSensor) :
String;
begin
with ASensor
do
case SensorType
of
TOrientationSensorType.Compass1D : result := '
Compass1D';
TOrientationSensorType.Compass2D : result := '
Compass2D';
TOrientationSensorType.Compass3D : result := '
Compass3D';
TOrientationSensorType.Inclinometer1D : result := '
Inclinometer1D';
TOrientationSensorType.Inclinometer2D : result := '
Inclinometer2D';
TOrientationSensorType.Inclinometer3D : result := '
Inclinometer3D';
TOrientationSensorType.Distance1D : result := '
Distance1D';
TOrientationSensorType.Distance2D : result := '
Distance2D';
TOrientationSensorType.Distance3D : result := '
Distance3D';
else result := '
Unknown';
end;
end;
constructor TGyroscopeThread.Create();
var lSensor : TCustomSensor;
lOrientationSensor : TCustomOrientationSensor;
lSensorType :
String;
begin
inherited {$IFDEF USEGYROSCOPETHREAD}Create(true)
{$ENDIF};
{$IFnDEF USEGYROSCOPETHREAD}
fHandle := TTimer.Create(
nil);
with fHandle
do
begin
OnTimer := doOnExecute;
Interval := SENSOR_INTERVAL;
Enabled := false;
end;
{$ELSE}
FreeOnTerminate := true;
{$ENDIF}
fIterations := 0;
fSensorManager := TSensorManager.Current;
fSensorManager.Activate;
fSensors := TSensorManager.Current.GetSensorsByCategory(TSensorCategory.Orientation);
if (System.Length(fSensors) = 0)
then
begin
SynchronizeOutputMessage('
no sensors available');
exit;
end;
if not (fSensors[0]
is TCustomOrientationSensor)
then
begin
SynchronizeOutputMessage('
default orientation sensor not available');
exit;
end;
for lSensor
in fSensors
do
begin
lOrientationSensor := lSensor
as TCustomOrientationSensor;
with lOrientationSensor
do
begin
if not Started
then
begin
Start();
if not Started
then
raise Exception.Create('
failed to start orientation sensor');
lSensorType := getOrientationSensorType(lOrientationSensor);
SynchronizeOutputMessage('
Sensor started: ' +
Name + '
(' + Model + '
::' +
SerialNo + '
) - ' + lSensorType);
end
else
begin
lSensorType := getOrientationSensorType(lOrientationSensor);
SynchronizeOutputMessage('
Sensor already started: ' +
Name + '
(' + Model + '
::' +
SerialNo + '
) - ' + lSensorType);
end;
end;
end;
fAvailable := true;
end;
destructor TGyroscopeThread.Destroy;
var lSensor : TCustomSensor;
lOrientationSensor : TCustomOrientationSensor;
lSensorType :
String;
begin
for lSensor
in fSensors
do
begin
lOrientationSensor := lSensor
as TCustomOrientationSensor;
with lOrientationSensor
do
begin
Stop();
lSensorType := getOrientationSensorType(lOrientationSensor);
SynchronizeOutputMessage('
Sensor stopped: ' +
Name + '
(' + Model + '
::' +
SerialNo + '
) - ' + lSensorType);
end;
end;
fSensorManager.Deactivate;
inherited;
end;
procedure TGyroscopeThread.SyncOutputMessage();
begin
if (fMessage > '
')
then
with GyroscopeForm
do
begin
Memo1.Lines.Insert(0, fMessage);
fMessage := '
';
end;
end;
procedure TGyroscopeThread.SyncCamera();
begin
with GyroscopeForm
do
begin
Label1.Text := Format('
Rotation: %3.1f %3.1f %3.1f',
[fRotation[0],
fRotation[1],
fRotation[2]]);
with GyroscopeForm.Camera.RotationAngle
do
begin
X := fRotation[0];
Y := fRotation[1];
Z := fRotation[2];
end;
Lbl_Iterations.Text := '
Iterations: ' + IntToStr(fIterations);
end;
end;
procedure TGyroscopeThread.SynchronizeOutputMessage(
const AMessage :
String);
begin
fMessage := AMessage;
{$IFDEF USEGYROSCOPETHREAD}
Synchronize(SyncOutputMessage);
{$ELSE}
SyncOutputMessage();
{$ENDIF}
end;
procedure TGyroscopeThread.handleOrientationSensor(
const ASensor : TCustomOrientationSensor);
var lSensorType :
String;
function ready() : Boolean;
var lMsg :
String;
begin
case ASensor.State
of
TSensorState.Added : lMsg := '
sensor - added';
TSensorState.Removed : lMsg := '
sensor - removed';
TSensorState.Initializing : lMsg := '
sensor - initializing';
TSensorState.Ready :
begin
result := true;
exit;
end;
TSensorState.NoData : lMsg := '
sensor - no data';
TSensorState.AccessDenied : lMsg := '
sensor - access denied';
TSensorState.Error : lMsg := '
sensor error';
end;
SynchronizeOutputMessage(lSensorType + '
: ' + lMsg);
result := false;
end;
begin
inc(fIterations);
with ASensor
do
begin
lSensorType := getOrientationSensorType(ASensor);
if ready()
then
begin
if (TCustomOrientationSensor.TProperty.TiltX
in AvailableProperties)
then
begin
fRotation[0] := TiltX;
fRotation[1] := TiltY;
fRotation[2] := TiltZ;
SynchronizeOutputMessage(lSensorType + '
: ' +
Format('
Rotation: %3.1f %3.1f %3.1f',
[TiltX, TiltY, TiltZ]));
end;
if (TCustomOrientationSensor.TProperty.DistanceX
in AvailableProperties)
then
begin
fDistance[0] := DistanceX;
fDistance[1] := DistanceY;
fDistance[2] := DistanceZ;
SynchronizeOutputMessage(lSensorType + '
: ' +
Format('
Distance: %3.1f %3.1f %3.1f',
[DistanceX, DistanceY, DistanceZ]));
end;
if (TCustomOrientationSensor.TProperty.HeadingX
in AvailableProperties)
then
begin
fHeading[0] := HeadingX;
fHeading[1] := HeadingY;
fHeading[2] := HeadingZ;
SynchronizeOutputMessage(lSensorType + '
: ' +
Format('
Heading: %3.1f %3.1f %3.1f',
[HeadingX, HeadingY, HeadingZ]));
end;
if (TCustomOrientationSensor.TProperty.MagHeading
in AvailableProperties)
then
begin
fMagHeading := MagHeading;
SynchronizeOutputMessage(lSensorType + '
: ' +
Format('
MagHeading: %3.1f',
[MagHeading]));
end;
if (TCustomOrientationSensor.TProperty.TrueHeading
in AvailableProperties)
then
begin
fTrueHeading := TrueHeading;
SynchronizeOutputMessage(lSensorType + '
: ' +
Format('
TrueHeading: %3.1f',
[TrueHeading]));
end;
if (TCustomOrientationSensor.TProperty.CompMagHeading
in AvailableProperties)
then
begin
fCompMagHeading := CompMagHeading;
SynchronizeOutputMessage(lSensorType + '
: ' +
Format('
CompMagHeading: %3.1f',
[CompMagHeading]));
end;
if (TCustomOrientationSensor.TProperty.CompTrueHeading
in AvailableProperties)
then
begin
fCompTrueHeading := CompTrueHeading;
SynchronizeOutputMessage(lSensorType + '
: ' +
Format('
CompTrueHeading: %3.1f',
[CompTrueHeading]));
end;
fState := State;
end;
end;
end;
procedure TGyroscopeThread.Execute();
var lSensor : TCustomSensor;
lOrientationSensor : TCustomOrientationSensor;
begin
{$IFDEF USEGYROSCOPETHREAD}
while not terminated
do
begin
{$ENDIF}
// iterate through all orientation sensors
if fAvailable
then
begin
for lSensor
in fSensors
do
begin
lOrientationSensor := lSensor
as TCustomOrientationSensor;
handleOrientationSensor(lOrientationSensor);
end;
{$IFDEF USEGYROSCOPETHREAD}
Synchronize(SyncCamera);
sleep(SENSOR_INTERVAL);
end;
end;
{$ELSE}
SyncCamera();
end;
{$ENDIF}
end;
{$IFnDEF USEGYROSCOPETHREAD}
procedure TGyroscopeThread.doOnExecute(Sender : TObject);
begin
execute();
end;
procedure TGyroscopeThread.Start();
begin
fHandle.Enabled := true;
end;
procedure TGyroscopeThread.Terminate();
begin
fHandle.Enabled := false;
end;
{$ENDIF}
procedure TGyroscopeForm.CkBx_ActiveChange(Sender: TObject);
begin
fGyroscope.available := CkBx_Active.IsChecked;
end;
procedure TGyroscopeForm.Form3DCreate(Sender: TObject);
begin
fGyroscope := TGyroscopeThread.Create();
fGyroscope.Start();
end;
procedure TGyroscopeForm.Form3DDestroy(Sender: TObject);
begin
fGyroscope.Terminate();
{$IFnDEF USEGYROSCOPETHREAD}
fGyroscope.Free();
{$ENDIF}
end;
end.