Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Library: Grafik / Sound / Multimedia (https://www.delphipraxis.net/21-library-grafik-sound-multimedia/)
-   -   Delphi Gamepad/Joystick abfragen (https://www.delphipraxis.net/71569-gamepad-joystick-abfragen.html)

igel457 17. Jun 2006 11:08


Gamepad/Joystick abfragen
 
Gamepad oder Joystick über die Windows-API abfragen

Für Spiele möchte man oft Gamepads oder Joysticks verwenden. Viele verwenden dafür die DXInput Komponente die DelphiX beiliegt. Allerdings funktioniert diese oftmals nicht richtig. Eine Alternative ist das direkte Abfragen des Joysticks über die Windows-API. Die dazu erforderlichen Funktionen sind in der Unit MMSystem.

Nun muss man nur noch eine Klasse schreiben, die diese Funktionen kapselt. Die hier vorgestellte Klasse ist Statusgebunden. Für Ereignisbindung findet man auch Beispiele im Web.

Hier ist ersteinmal der Komplette Quellcode:

Delphi-Quellcode:
interface

uses ..., MMSystem;

  TPOVControl = record
    up,down,left,right:boolean;
  end;

  { TGamepad - A wrapper class for the Windows-Joystick-API}
  TGamepad = class
    private
      FRange:integer;
      FDeadZone:integer;
      function GetButton(index:integer):boolean;
      function GetX:integer;
      function GetY:integer;
      function GetZ:integer;
      function GetR:integer;
      function GetU:integer;
      function GetV:integer;
      function GetPOV:TPOVControl;
      procedure UpdateDeviceNr(nr:cardinal);
    protected
      Device:TJoyInfoEx;
      DeviceInfo:TJoyCaps;
      FDeviceNr:Cardinal;
      CenterX,CenterY,CenterZ:Integer;
      CenterR,CenterU,CenterV:Integer;
    public
      property DeviceNr:Cardinal read FDeviceNr write UpdateDeviceNr;
      procedure Update;
      procedure Calibrate;
      constructor Create;
      property X:integer read GetX;
      property Y:integer read GetY;
      property Z:integer read GetZ;
      property R:integer read GetR;
      property U:integer read GetU;
      property V:integer read GetV;
      property Range:integer read FRange write FRange;
      property DeadZone:integer read FDeadZone write FDeadZone;
      property POV:TPOVControl read GetPov;
      property Buttons[index:integer]:boolean read GetButton;
  end;

implementation

{ TGamepad }

function TGamepad.GetX:integer;
begin
  result := round(range/32767*(Device.wXpos-CenterX));
  if abs(result) <= deadzone then result := 0;
end;

function TGamepad.GetY:integer;
begin
  result := round(range/32767*(Device.wYpos-CenterY));
  if abs(result) <= deadzone then result := 0;
end;

function TGamepad.GetZ:integer;
begin
  result := round(range/32767*(Device.wZpos-CenterZ));
  if abs(result) <= deadzone then result := 0;
end;

function TGamepad.GetR:integer;
begin
  result := round(range/32767*(Device.dwRpos-CenterR));
  if abs(result) <= deadzone then result := 0;
end;

function TGamepad.GetU:integer;
begin
  result := round(range/32767*(Device.dwUpos-CenterU));
  if abs(result) <= deadzone then result := 0;
end;

function TGamepad.GetV:integer;
begin
  result := round(range/32767*(Device.dwVpos-CenterV));
  if abs(result) <= deadzone then result := 0;
end;

function TGamepad.GetPOV:TPOVControl;
begin
  //Verarbeitet die Daten des Steuerkreuzes
  result.up := false;
  result.left := false;
  result.down := false;
  result.right := false;
  if Device.dwPOV = 0 then begin result.up := true; end;
  if Device.dwPOV = 4500 then begin result.up := true; result.right := true end;
  if Device.dwPOV = 9000 then begin result.right := true; end;
  if Device.dwPOV = 13500 then begin result.down := true; result.right := true end;
  if Device.dwPOV = 18000 then begin result.down := true; end;
  if Device.dwPOV = 22500 then begin result.down := true; result.left := true; end;
  if Device.dwPOV = 27000 then begin result.left := true; end;
  if Device.dwPOV = 31500 then begin result.left := true; result.up := true; end;
end;

procedure TGamepad.Update;
begin
  //Liest die Joystick-Daten ein und schreibt sie in die "Device" Variable
  if (DeviceInfo.wCaps and JOYCAPS_HASZ) <> 0 then Device.dwSize := sizeof(tjoyInfoEx);
  Device.dwFlags:=JOY_RETURNALL;
  JoygetposEx(DeviceNr,@device);
end;

procedure TGamepad.UpdateDeviceNr(nr:cardinal);
begin
  //0...15 Devices/Gampads/Joysticks
  FDeviceNr := nr;
  joyGetDevCaps(FDeviceNr, @DeviceInfo, sizeof(DeviceInfo));
end;

constructor TGamepad.Create;
begin
  inherited Create;
  DeviceNr := 0;
  Range := 1000;
  DeadZone := 400;
  Calibrate;
end;

procedure TGamepad.Calibrate;
begin
  //Liest die Nullstellung der Achsen ein
  if (DeviceInfo.wCaps and JOYCAPS_HASZ) <> 0 then Device.dwSize := sizeof(tjoyInfoEx);
  Device.dwFlags:=JOY_RETURNCENTERED;
  JoygetposEx(DeviceNr,@device);
  CenterX := device.wXpos;
  CenterY := device.wYpos;
  CenterZ := device.wZpos;
  CenterU := device.dwUpos;
  CenterV := device.dwVpos;
  CenterR := device.dwRpos;
end;

function TGamepad.GetButton(index:integer):boolean;
begin
  //Liest die Position der Buttons ein.
  result := false;
  if index in [0..31] then
  begin
    result := device.wbuttons and (1 shl (index)) > 0;
  end;
end;
Ein kleines Beispiel:

Delphi-Quellcode:

var Joy:TGamepad;

procedure TForm1.FormCreate(Sender: TObject);
begin  
  //Klasse erzeugen
  joy := TGamepad.Create;
end;

procedure TForm1.DXTimer1Timer(Sender: TObject; LagCount: Integer);
var i:integer;
begin
  //Den Joystick updaten
  joy.update;

  //Daten ausgeben
  //Achse 1
  Label3.Caption := 'Joystick-X '+inttostr(joy.X);
  Label4.Caption := 'Joystick-Y '+inttostr(joy.Y);
 
  //Achse 2
  Label5.Caption := 'Joystick-Z '+inttostr(joy.Z);
  Label9.Caption := 'Joystick-R '+inttostr(joy.R);

  //Achse 3
  Label7.Caption := 'Joystick-U '+inttostr(joy.U);
  Label8.Caption := 'Joystick-V '+inttostr(joy.V);

  //POV (Point of View Control/Steuerkreuz)
  if joy.POV.up then shape1.Brush.Color := clRed else shape1.Brush.Color := clWhite;
  if joy.POV.right then shape2.Brush.Color := clRed else shape2.Brush.Color := clWhite;
  if joy.POV.down then shape3.Brush.Color := clRed else shape3.Brush.Color := clWhite;
  if joy.POV.left then shape4.Brush.Color := clRed else shape4.Brush.Color := clWhite;

  //Gedrückte Buttons anzeigen
  Label6.Caption := '';
  for i := 0 to 31 do
  begin
    if joy.buttons[i] then Label6.Caption := Label6.Caption + inttostr(i+1)+' ';
  end;
end;
Viel Spaß mit dem Code!
Igel457


Alle Zeitangaben in WEZ +1. Es ist jetzt 02:55 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz