Created
September 22, 2022 22:45
-
-
Save DelphiWorlds/4c26a774497f65e90e9feaf31b89350a to your computer and use it in GitHub Desktop.
Example of how to implement iOS shake gesture in Delphi
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
unit Unit1; | |
// Form just has a button and a label on it | |
interface | |
uses | |
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, | |
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls, FMX.Controls.Presentation, | |
System.TypInfo, | |
Macapi.ObjectiveC, Macapi.Helpers, | |
iOSapi.UIKit, iOSapi.Foundation; | |
type | |
IShakeView = interface(UIView) | |
['{21B0BCE6-8D07-40BA-943C-DC4B1A99D3CA}'] | |
function canBecomeFirstResponder: Boolean; cdecl; | |
procedure motionBegan(motion: UIEventSubtype; withEvent: UIEvent); cdecl; | |
procedure motionEnded(motion: UIEventSubtype; withEvent: UIEvent); cdecl; | |
end; | |
TShakeView = class(TOCLocal) | |
private | |
FOnShake: TNotifyEvent; | |
procedure DoShake; | |
function GetView: UIView; | |
procedure InitView; | |
protected | |
function GetObjectiveCClass: PTypeInfo; override; | |
public | |
{ IShakeView } | |
function canBecomeFirstResponder: Boolean; cdecl; | |
procedure motionBegan(motion: UIEventSubtype; withEvent: UIEvent); cdecl; | |
procedure motionEnded(motion: UIEventSubtype; withEvent: UIEvent); cdecl; | |
public | |
constructor Create; | |
procedure BecomeFirstResponder; | |
property View: UIView read GetView; | |
property OnShake: TNotifyEvent read FOnShake write FOnShake; | |
end; | |
TForm1 = class(TForm) | |
Label1: TLabel; | |
Button1: TButton; | |
procedure Button1Click(Sender: TObject); | |
private | |
FShakeView: TShakeView; | |
procedure ShakeViewShakeHandler(Sender: TObject); | |
public | |
constructor Create(AOwner: TComponent); override; | |
destructor Destroy; override; | |
end; | |
var | |
Form1: TForm1; | |
implementation | |
{$R *.fmx} | |
uses | |
FMX.Platform.iOS; | |
{ TShakeView } | |
constructor TShakeView.Create; | |
begin | |
inherited; | |
InitView; | |
end; | |
procedure TShakeView.InitView; | |
var | |
LView: Pointer; | |
begin | |
// Using a zero-sized rect because this view won't actually be seen | |
LView := GetView.initWithFrame(CGRectFromRect(TRectF.Empty)); | |
if GetObjectID <> LView then | |
UpdateObjectID(LView); | |
end; | |
procedure TShakeView.BecomeFirstResponder; | |
begin | |
GetView.becomeFirstResponder; | |
end; | |
function TShakeView.canBecomeFirstResponder: Boolean; | |
begin | |
Result := True; | |
end; | |
procedure TShakeView.DoShake; | |
begin | |
if Assigned(FOnShake) then | |
FOnShake(Self); | |
end; | |
function TShakeView.GetObjectiveCClass: PTypeInfo; | |
begin | |
Result := TypeInfo(IShakeView); | |
end; | |
function TShakeView.GetView: UIView; | |
begin | |
Result := UIView(Super); | |
end; | |
procedure TShakeView.motionBegan(motion: UIEventSubtype; withEvent: UIEvent); | |
begin | |
// | |
end; | |
procedure TShakeView.motionEnded(motion: UIEventSubtype; withEvent: UIEvent); | |
begin | |
if withEvent.subtype = UIEventSubtypeMotionShake then | |
DoShake; | |
end; | |
{ TForm1 } | |
constructor TForm1.Create(AOwner: TComponent); | |
begin | |
inherited; | |
FShakeView := TShakeView.Create; | |
FShakeView.OnShake := ShakeViewShakeHandler; | |
WindowHandleToPlatform(Handle).View.addSubview(FShakeView.View); | |
Button1Click(Button1); | |
end; | |
destructor TForm1.Destroy; | |
begin | |
FShakeView.Free; | |
inherited; | |
end; | |
procedure TForm1.Button1Click(Sender: TObject); | |
begin | |
// This may be necessary only once? | |
FShakeView.BecomeFirstResponder; | |
Label1.Text := 'Waiting for shake'; | |
end; | |
procedure TForm1.ShakeViewShakeHandler(Sender: TObject); | |
begin | |
Label1.Text := 'Shaked me!'; | |
end; | |
end. |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment