Jump to content
azrael_11

MMsystem and Joystick

By azrael_11, in Windows API

Recommended Posts

azrael_11    0

azrael_11
Posted

i have this unit found a long time ago.

it is a joystick unit using the mmsystem.

  

unit joy;

interface

uses
  System.SysUtils,
  FMX.Types,
  WinTypes,
  WinProcs,
  Messages,
  Classes,
  MMSystem;

type
  TGamePort = (One, Two, None);
  TJoyMoveEvent = procedure(Sender: TObject; var X, Y: Integer) of object;
  TButtonNotifyEvent = procedure(Sender: TObject; Pushed: Boolean) of object;

type
  TJoystick = class(TComponent)
  private

    { Internal private uses }
    CenterX: LongInt;
    CenterY: LongInt;
    DeltaPosX, DeltaNegX: LongInt;
    DeltaPosY, DeltaNegY: LongInt;

    JoyId: Word;
    JoyCaps: TJoyCaps;
    JoyInfo: TJoyInfo;

    { Published Private declarations }
    FActive: Boolean; { runtime only....enables joystick polling }
    FGamePort: TGamePort; { which game port to monitor }
    FEnabled: Boolean; { tells whether event is enabled }
    FNotifyRange: Integer; { percentage joystick move notify }
    FPollRate: Integer; { tells how often to check joystick in miliseconds }
    FRepeatPosition: Boolean; { call joymove event if same as before }
    FRepeatButton1: Boolean;
    FRepeatButton2: Boolean;
    FRepeatButton3: Boolean;
    FRepeatButton4: Boolean;

    FOnButton1: TButtonNotifyEvent;
    FOnButton2: TButtonNotifyEvent;
    FOnButton3: TButtonNotifyEvent;
    FOnButton4: TButtonNotifyEvent;
    FOnJoyMove: TJoyMoveEvent;

    LastJoyX, LastJoyY: LongInt; { remembers last joystick position }
    LastButton1, LastButton2: Boolean; { remebers last button positions }
    LastButton3, LastButton4: Boolean;

    FTimer: TTimer;

    procedure SetNotifyRange(value: Integer);
    procedure SetGamePort(value: TGamePort);
    procedure SetPollRate(value: Integer);

    procedure SetDefaults; { sets the default values for variables }
    procedure MakeTimer; { initialization of TTimer }
    procedure Translate(Sender: TObject); { THE routine...for joystick }

    procedure DoButton1;
    procedure DoButton2;
    procedure DoButton3;
    procedure DoButton4;
    procedure DoJoystick;
  protected
    { Protected declarations }

  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure Activate; { during runtime...enables interrupt }
    procedure DeActivate; { during runtime...disables interrupt }

    procedure Devices(var value: Word); { returns # of devices }
    procedure Buttons(Port: Integer; var value: Word);
    procedure CalibrateCenter; { current joystick position as center }
    procedure CalibrateUpLeft;
    procedure CalibrateDownRight;
  published
    { Published declarations }
    property Active: Boolean read FActive;
    property Enabled: Boolean read FEnabled write FEnabled;
    property GamePort: TGamePort read FGamePort write SetGamePort;
    property NotifyRange: Integer read FNotifyRange write SetNotifyRange default 20;
    property PollRate: Integer read FPollRate write SetPollRate default 50;
    property RepeatPosition: Boolean read FRepeatPosition write FRepeatPosition;
    property RepeatButton1: Boolean read FRepeatButton1 write FRepeatButton1;
    property RepeatButton2: Boolean read FRepeatButton2 write FRepeatButton2;
    property RepeatButton3: Boolean read FRepeatButton3 write FRepeatButton3;
    property RepeatButton4: Boolean read FRepeatButton4 write FRepeatButton4;

    property OnButton1: TButtonNotifyEvent read FOnButton1 write FOnButton1;
    property OnButton2: TButtonNotifyEvent read FOnButton2 write FOnButton2;
    property OnButton3: TButtonNotifyEvent read FOnButton3 write FOnButton3;
    property OnButton4: TButtonNotifyEvent read FOnButton4 write FOnButton4;
    property OnJoyMove: TJoyMoveEvent read FOnJoyMove write FOnJoyMove;

  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Addons', [TJoystick]);
end;

constructor TJoystick.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  SetDefaults;
  MakeTimer;
end;

destructor TJoystick.Destroy;
begin
  DeActivate;
  FTimer.Free;
  inherited Destroy;
end;

procedure TJoystick.SetDefaults;
begin
  FActive := False;
  Enabled := True;
  PollRate := 50;
  NotifyRange := 20;
  GamePort := One;
  RepeatPosition := True;
  RepeatButton1 := False;
  RepeatButton2 := False;
  RepeatButton3 := False;
  RepeatButton4 := False;

  CenterX := 32768;
  CenterY := 32768;
  DeltaNegX := 8192;
  DeltaPosX := 8192;
  DeltaNegY := 8192;
  DeltaPosY := 8192;

end;

procedure TJoystick.MakeTimer;
begin
  FTimer := TTimer.Create(Self);
  FTimer.Enabled := False;
  FTimer.Interval := 50;
  FTimer.OnTimer := Translate;
end;

procedure TJoystick.SetNotifyRange(value: Integer);
begin
  if FActive = False then
    FNotifyRange := value;
end;

procedure TJoystick.SetGamePort(value: TGamePort);
begin
  if FActive = False then
  begin
    FGamePort := value;
    case value of
      One:
        JoyId := JOYSTICKID1;
      Two:
        JoyId := JOYSTICKID2;
    else
      JoyId := 0;
    end;
  end;
end;

procedure TJoystick.SetPollRate(value: Integer);
begin
  if FActive = False then
    FPollRate := value;
end;

procedure TJoystick.Devices(var value: Word);
begin
  value := joyGetNumDevs;
  if value > 2 then
    value := 2;
end;

procedure TJoystick.Buttons(Port: Integer; var value: Word);
var
  JID: Word;
  JCaps: TJoyCaps;
  rvalue: Word;
begin
  case Port of
    1:
      JID := JOYSTICKID1;
    2:
      JID := JOYSTICKID2;
  else
    JID := 0;
  end;

  rvalue := joyGetDevCaps(JID, @JCaps, SizeOf(JCaps));

  if rvalue = JOYERR_NOERROR then
    value := JCaps.wNumButtons
  else
    value := 0;

end;

procedure TJoystick.CalibrateCenter;
var
  rvalue: Word;
  JoyInfo: TJoyInfo;
begin
  rvalue := joyGetPos(JoyId, @JoyInfo);
  if rvalue = JOYERR_NOERROR then
  begin
    CenterX := JoyInfo.wXpos;
    CenterY := JoyInfo.wYpos;
  end
  else
  begin
    CenterX := (JoyCaps.wXmax - JoyCaps.wXmin) div 2;
    CenterY := (JoyCaps.wYmax - JoyCaps.wYmin) div 2;
  end;
end;

procedure TJoystick.CalibrateUpLeft;
var
  rvalue: Word;
  JoyInfo: TJoyInfo;
begin
  rvalue := joyGetPos(JoyId, @JoyInfo);
  if rvalue = JOYERR_NOERROR then
  begin
    DeltaNegX := (CenterX - JoyInfo.wXpos) div FNotifyRange;
    DeltaNegY := (CenterY - JoyInfo.wYpos) div FNotifyRange;
  end
  else
  begin
    DeltaNegX := CenterX div FNotifyRange;
    DeltaNegY := CenterY div FNotifyRange;
  end;
end;

procedure TJoystick.CalibrateDownRight;
var
  rvalue: Word;
  JoyInfo: TJoyInfo;
begin
  rvalue := joyGetPos(JoyId, @JoyInfo);
  if rvalue = JOYERR_NOERROR then
  begin
    DeltaPosX := (JoyInfo.wXpos - CenterX) div FNotifyRange;
    DeltaPosY := (JoyInfo.wYpos - CenterY) div FNotifyRange;
  end
  else
  begin
    DeltaPosX := CenterX div FNotifyRange;
    DeltaPosY := CenterY div FNotifyRange;
  end;
end;

procedure TJoystick.Activate;
var
  rvalue: Word;
begin

  DeActivate;
  rvalue := joyGetDevCaps(JoyId, @JoyCaps, SizeOf(JoyCaps));
  if rvalue = JOYERR_NOERROR then
  begin
    rvalue := joyGetPos(JoyId, @JoyInfo);
    { only activate if no errors returned }
    if rvalue = JOYERR_NOERROR then
    begin
      FTimer.Interval := PollRate;
      FTimer.Enabled := True;
      FActive := True;
    end;
  end;
  { if there is no device, it will remain InActive }

end;

procedure TJoystick.DeActivate;
begin
  if FActive = True then
    FTimer.Enabled := False;
  FActive := False;
end;

procedure TJoystick.Translate(Sender: TObject);
var
  rvalue: Word;
begin
  { only check joystick if the component is enabled and active }
  if (FEnabled = True) and (FActive = True) then
  begin
    rvalue := joyGetPos(JoyId, @JoyInfo);
    { only evaluate if no errors returned }
    if rvalue = JOYERR_NOERROR then
    begin
      DoButton1;
      DoButton2;
      DoButton3;
      DoButton4;
      DoJoystick;
    end;
  end;

end;

procedure TJoystick.DoButton1;
var
  Pushed: Boolean;
begin

  if (JoyInfo.wButtons and JOY_BUTTON1) = JOY_BUTTON1 then
    Pushed := True
  else
    Pushed := False;

  if FRepeatButton1 = True then
  begin
    if (Assigned(FOnButton1)) then
      FOnButton1(Self, Pushed)
  end
  else { logic to NOT call button if same as last }
    if (Assigned(FOnButton1)) and not(Pushed = LastButton1) then
      FOnButton1(Self, Pushed);

  LastButton1 := Pushed;
end;

procedure TJoystick.DoButton2;
var
  Pushed: Boolean;
begin
  if (JoyInfo.wButtons and JOY_BUTTON2) = JOY_BUTTON2 then
    Pushed := True
  else
    Pushed := False;

  if FRepeatButton2 = True then
  begin
    if (Assigned(FOnButton2)) then
      FOnButton2(Self, Pushed)
  end
  else { logic to NOT call button if same as last }
    if (Assigned(FOnButton2)) and not(Pushed = LastButton2) then
      FOnButton2(Self, Pushed);

  LastButton2 := Pushed;
end;

procedure TJoystick.DoButton3;
var
  Pushed: Boolean;
begin
  if (JoyInfo.wButtons and JOY_BUTTON3) = JOY_BUTTON3 then
    Pushed := True
  else
    Pushed := False;

  if FRepeatButton3 = True then
  begin
    if (Assigned(FOnButton3)) then
      FOnButton3(Self, Pushed)
  end
  else { logic to NOT call button if same as last }
    if (Assigned(FOnButton3)) and not(Pushed = LastButton3) then
      FOnButton3(Self, Pushed);

  LastButton3 := Pushed;
end;

procedure TJoystick.DoButton4;
var
  Pushed: Boolean;
begin
  if (JoyInfo.wButtons and JOY_BUTTON4) = JOY_BUTTON4 then
    Pushed := True
  else
    Pushed := False;

  if FRepeatButton4 = True then
  begin
    if (Assigned(FOnButton4)) then
      FOnButton4(Self, Pushed)
  end
  else { logic to NOT call button if same as last }
    if (Assigned(FOnButton4)) and not(Pushed = LastButton4) then
      FOnButton4(Self, Pushed);

  LastButton4 := Pushed;
end;

procedure TJoystick.DoJoystick;
var
  LocX, LocY: Integer;
begin
  LocX := 0;
  LocY := 0;

  if (JoyInfo.wXpos < CenterX) then
    LocX := (JoyInfo.wXpos - CenterX) div DeltaNegX
  else
    LocX := (JoyInfo.wXpos - CenterX) div DeltaPosX;

  if (JoyInfo.wYpos < CenterY) then
    LocY := (CenterY - JoyInfo.wYpos) div DeltaNegY
  else
    LocY := (CenterY - JoyInfo.wYpos) div DeltaPosY;

  if FRepeatPosition = True then
  begin
    if (Assigned(FOnJoyMove)) then
      FOnJoyMove(Self, LocX, LocY)
  end
  else if (Assigned(FOnJoyMove)) and ((LocX <> LastJoyX) or (LocY <> LastJoyY)) then
    OnJoyMove(Self, LocX, LocY);

  LastJoyX := LocX;
  LastJoyY := LocY;

end;

end.

i know how to activate it and how to setup in the right port

That i cant handle is how to get the move option the unit have

 

so i create a

var

  myJoy : Tjoystick;

 

begin

  myJoy := Tjoystick.Create(form1);

  myJoy.OnJoyMove <---- that how can i handle?

end;

 

thank you

Share this post

Link to post

Attila Kovacs    629

Attila Kovacs
Posted 
procedure TForm1.MyOnMoveHandler(Sender: TObject; var X, Y: Integer);
begin
 DoSomething(x, y);
end;

procedure TForm1.X;
begin
  myJoy := Tjoystick.Create(Form1);
  myJoy.OnJoyMove := MyOnMoveHandler;
end;

 

Share this post

Link to post

azrael_11    0

azrael_11
Posted
1 hour ago, Attila Kovacs said: 

procedure TForm1.MyOnMoveHandler(Sender: TObject; var X, Y: Integer);
begin
 DoSomething(x, y);
end;

procedure TForm1.X;
begin
  myJoy := Tjoystick.Create(Form1);
  myJoy.OnJoyMove := MyOnMoveHandler;
end;

 

Thank you very much now i have the x and y for one time

Now how can i handle x and y every time the program is on.

Is it a good practice to put a timer and every x seconds runs the MyOnMoveHandler ?

Share this post

Link to post

Attila Kovacs    629

Attila Kovacs
Posted (edited)

No. The event OnJoyMove should be triggered every time you move the joystick, not just one time. There must be something else.

Edited by Attila Kovacs

Share this post

Link to post

azrael_11    0

azrael_11
Posted (edited)
3 minutes ago, Attila Kovacs said:

No. The event OnJoyMove should triggered every time you move the joystick, not just one time. There must be something else.

 

Yes it triggered only one time  hmmm

 

Is there a change to have problem that i use FMX platform.

Edited by azrael_11

Share this post

Link to post

Remy Lebeau    1396

Remy Lebeau
Posted (edited)
39 minutes ago, azrael_11 said:

Yes it triggered only one time  hmmm

Then you are just going to have to debug the code at runtime to find out what is really happening.  The OnJoyMove event is fired by an internal TTimer that calls joyGetPos() at regular intervals and then compares the latest coordinates and button states for any changes from the previous call.  The fact that you get the OnJoyMove event fired at least once means the timer is running and polling correctly.  So either you are doing something to block that timer from firing again, or maybe you are deactivating the TJoystick without realizing it, or maybe joyGetPos() itself is failing.  We can't debug for you, because we can't see your real code.

 

FWIW, manually polling the hardware at regular intervals is not the best way to go.  Makes me wonder why TJoystick was not written from the beginning to use joySetCapture() instead to allow the OS to send its own event notifications to the app.

Quote

Is there a change to have problem that i use FMX platform.

No, this is likely not related to FMX at all - unless FMX's TTimer is broken.  Although, do note that TJoystick is using Windows-specific APIs, so it won't work on any non-Windows platforms that FMX supports.

Edited by Remy Lebeau

Share this post

Link to post

azrael_11    0

azrael_11
Posted
9 minutes ago, Remy Lebeau said:

Then you are just going to have to debug the code at runtime to find out what is really happening.  The OnJoyMove event is fired by an internal TTimer that calls joyGetPos() at regular intervals and then compares the latest coordinates and button states for any changes from the previous call.  The fact that you get the OnJoyMove event fired at least once means the timer is running and polling correctly.  So either you are doing something to block that timer from firing again, or maybe you are deactivating the TJoystick without realizing it, or maybe joyGetPos() itself is failing.  We can't debug for you, because we can't see your real code.

 

FWIW, manually polling the hardware at regular intervals is not the best way to go.  Makes me wonder why TJoystick was not written from the beginning to use joySetCapture() instead to allow the OS to send its own event notifications to the app.

No, this is likely not related to FMX at all - unless FMX TTimer is broken.

Thank you remy i'll check it out. Btw do you know any good components or header for joystick either mmsystem or  DInput or  Xinput... Thank you again

 

Share this post

Link to post

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
Go To Topic Listing Windows API
×