unit1.pas

一个可以控制游戏遥杆、鼠标、键盘的程序。能够得到相关设备的响应值。

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DirectInput, DXErr9, StdCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    procedure AppIdle(Sender: TObject; var Done: Boolean);
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
  private
    { Private declarations }
    keyboard_state   : array[0..255] of UCHAR;
    mouse_state      : DIMOUSESTATE;
    joy_state        : DIJOYSTATE2;
    DInput           : IDirectInput8;
    DInputKeyBoard,
    DInputMouse,
    DInputJoy        : IDirectInputDevice8;
    DInputEffect     : IDirectInputEffect;
    DXLog,
    DXEnumDev        : TStringList;
    DXResult         : HRESULT;
    bKeyBoard,
    bMouse,
    bJoy             : Boolean;
    NumFFBAxis       : DWORD;   //Numbers of Force Feed Back Axis
    nXForce,
    nYForce          : Integer;
    procedure SetFFB;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

function EnumJoyCallback(var lpddi: DIDeviceInstance; pvRef: Pointer): BOOL; stdcall;
function EnumObjCallback(var lpddoi: DIDeviceObjectInstance; pvRef : Pointer): BOOL; stdcall;
function EnumAxesCallback(var lpddoi: DIDeviceObjectInstance; pvRef : Pointer): BOOL; stdcall;

implementation

{$R *.dfm}

procedure TForm1.AppIdle(Sender: TObject; var Done: Boolean);
var
  i             : Byte;
  bGetKeyBoard,
  bGetMouse,
  bGetJoy       : Boolean;
begin
  Done := False;

  bGetKeyBoard := False;
  bGetMouse    := False;
  bGetJoy      := False;

  if bKeyBoard then
  begin
//键盘消息
    DXResult := DInputKeyBoard.GetDeviceState(256, @keyboard_state);
//在设备丢失时重新获取设备
    if DXResult <> DI_OK then
    begin
      DXResult := DInputKeyBoard.Acquire;
      if DXResult <> DI_OK then
        Exit;
    end;
    bGetKeyBoard := True;
  end;

  if bMouse then
  begin
//鼠标消息
    DXResult := DInputMouse.GetDeviceState(SizeOf(DIMOUSESTATE), @mouse_state);
//在设备丢失时重新获取设备
    if DXResult <> DI_OK then
    begin
      DXResult := DInputMouse.Acquire;
      if DXResult <> DI_OK then
        Exit;
    end;
    bGetMouse := True;
  end;

  if bJoy then
  begin
//有些游戏控制器不需要Poll，所以不在这里检测设备是否丢失
    DXResult := DInputJoy.Poll;
//    Self.Canvas.TextOut(0, 0, DXGetErrorString9(DXResult));
//    Self.Canvas.TextOut(0, 20, DXGetErrorDescription9(DXResult));
//在这里检测比较好
    DXResult := DInputJoy.GetDeviceState(SizeOf(DIJOYSTATE2), @joy_state);
//    Self.Canvas.TextOut(0, 40, DXGetErrorString9(DXResult));
//    Self.Canvas.TextOut(0, 60, DXGetErrorDescription9(DXResult));
    if DXResult <> DI_OK then
    begin
      DXResult := DInputJoy.Acquire;
      if DXResult <> DI_OK then
        Exit;
    end;
    bGetJoy := True;
  end;

  if bGetKeyBoard then
  begin
    if keyboard_state[DIK_ESCAPE] <> 0 then
      Close;
    for i := 0 to 255 do
    begin
      if keyboard_state[i] <> 0 then
        Self.Canvas.TextOut(0, 0, '你按了一个键，它的代码是：' + IntToStr(i) + '          ');
    end;
  end;

  if bGetMouse then
  begin
    if (mouse_state.lX <> 0) or (mouse_state.lY <> 0) then
    begin
      Self.Canvas.TextOut(0, 20, '鼠标的X坐标移动量：' + IntToStr(mouse_state.lX) + '          ');
      Self.Canvas.TextOut(0, 40, '鼠标的Y坐标移动量：' + IntToStr(mouse_state.lY) + '          ');
    end;
    if mouse_state.rgbButtons[0] <> 0 then
      Self.Canvas.TextOut(0, 60, '你按了鼠标的左键');
  end;

  if bGetJoy then
  begin
    Self.Canvas.TextOut(0, 80, 'Joy-X: ' + IntToStr(joy_state.lX) + '          ');
    Self.Canvas.TextOut(100, 80, 'Joy-Y: ' + IntToStr(joy_state.lY) + '          ');
    Self.Canvas.TextOut(200, 80, 'Joy-Z: ' + IntToStr(joy_state.lZ) + '          ');
    Self.Canvas.TextOut(0, 100, 'Joy-Rx: ' + IntToStr(joy_state.lRx) + '          ');
    Self.Canvas.TextOut(100, 100, 'Joy-Rx: ' + IntToStr(joy_state.lRy) + '          ');
    Self.Canvas.TextOut(200, 100, 'Joy-Rx: ' + IntToStr(joy_state.lRz) + '          ');
    Self.Canvas.TextOut(0, 120, 'Joy-POV0: ' + IntToStr(joy_state.rgdwPOV[0]) + '                    ');
    nXForce := ABS(joy_state.lX) * 30 div 1000;
    nYForce := ABS(joy_state.lY) * 30 div 1000;
    for i := 0 to 127 do
    begin
      if joy_state.rgbButtons[i] <> 0 then
      begin
        Self.Canvas.TextOut(0, 140, 'Joy-Buttons: ' + IntToStr(i));
      end;
    end;
    SetFFB;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  i, j : Integer;
begin
  Memo1.Enabled := True;
//键盘的创建
  DXResult := DInput.CreateDevice(GUID_SysKeyBoard, DInputKeyBoard, nil);
  Memo1.Lines.Clear;
  DXLog.Clear;
  Memo1.Lines.Add('创建键盘');
  DXLog.Add(DXGetErrorString9(DXResult));
  DXLog.Add(DXGetErrorDescription9(DXResult));
  for i := 0 to DXLog.Count - 1 do
    Memo1.Lines.Add(DXlog.Strings[i]);
  if DXResult <> DI_OK then
    Exit;
  j := i;

  DXResult := DInputKeyBoard.SetDataFormat(c_dfDIKeyBoard);
  Memo1.Lines.Add('设置键盘数据格式');
  DXLog.Add(DXGetErrorString9(DXResult));
  DXLog.Add(DXGetErrorDescription9(DXResult));
  for i := j to DXLog.Count - 1 do
    Memo1.Lines.Add(DXlog.Strings[i]);
  if DXResult <> DI_OK then
    Exit;
  j := i;

//如果合作级别是独占模式，你就无法使用ALT+F4关闭程序。必须自己响应这些消息。
  DXResult := DInputKeyBoard.SetCooperativeLevel(Self.Handle, DISCL_fOREGROUND OR DISCL_EXCLUSIVE);
//  DXResult := DInputKeyBoard.SetCooperativeLevel(Self.Handle, DISCL_fOREGROUND OR DISCL_NONEXCLUSIVE or DISCL_NOWINKEY);
  Memo1.Lines.Add('设置键盘合作级别');
  DXLog.Add(DXGetErrorString9(DXResult));
  DXLog.Add(DXGetErrorDescription9(DXResult));
  for i := j to DXLog.Count - 1 do
    Memo1.Lines.Add(DXlog.Strings[i]);
  if DXResult <> DI_OK then
    Exit;
  j := i;

  DXResult := DInputKeyBoard.Acquire;
  Memo1.Lines.Add('获得键盘');
  DXLog.Add(DXGetErrorString9(DXResult));
  DXLog.Add(DXGetErrorDescription9(DXResult));
  for i := j to DXLog.Count - 1 do
    Memo1.Lines.Add(DXlog.Strings[i]);
  if DXResult <> DI_OK then
    Exit;

  bKeyBoard       := True;
  Button1.Enabled := False;
  Memo1.Enabled   := False;
  Self.Caption    := '按Esc键退出';
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  i, j : Integer;
begin
  Memo1.Enabled := True;
//鼠标的创建
  DXResult := DInput.CreateDevice(GUID_SysMouse, DInputMouse, nil);
  Memo1.Lines.Clear;
  DXLog.Clear;
  Memo1.Lines.Add('创建鼠标');
  DXLog.Add(DXGetErrorString9(DXResult));
  DXLog.Add(DXGetErrorDescription9(DXResult));
  for i := 0 to DXLog.Count - 1 do
    Memo1.Lines.Add(DXlog.Strings[i]);
  if DXResult <> DI_OK then
    Exit;
  j := i;

  DXResult := DInputMouse.SetDataFormat(c_dfDIMouse);
  Memo1.Lines.Add('设置鼠标数据格式');
  DXLog.Add(DXGetErrorString9(DXResult));
  DXLog.Add(DXGetErrorDescription9(DXResult));
  for i := j to DXLog.Count - 1 do
    Memo1.Lines.Add(DXlog.Strings[i]);
  if DXResult <> DI_OK then
    Exit;
  j := i;

  DXResult := DInputMouse.SetCooperativeLevel(Self.Handle, DISCL_fOREGROUND OR DISCL_EXCLUSIVE);
  Memo1.Lines.Add('设置鼠标合作级别');
  DXLog.Add(DXGetErrorString9(DXResult));
  DXLog.Add(DXGetErrorDescription9(DXResult));
  for i := j to DXLog.Count - 1 do
    Memo1.Lines.Add(DXlog.Strings[i]);
  if DXResult <> DI_OK then
    Exit;
  j := i;

  DXResult := DInputMouse.Acquire;
  Memo1.Lines.Add('获得鼠标');
  DXLog.Add(DXGetErrorString9(DXResult));
  DXLog.Add(DXGetErrorDescription9(DXResult));
  for i := j to DXLog.Count - 1 do
    Memo1.Lines.Add(DXlog.Strings[i]);
  if DXResult <> DI_OK then
    Exit;

  bMouse          := True;
  Button2.Enabled := False;
  Memo1.Enabled   := False;
  if bKeyBoard then
    Self.Caption    := '按Esc键退出'
  else
    Self.Caption    := '按Alt+F4推出';
end;

procedure TForm1.Button3Click(Sender: TObject);
var
  i         : Integer;
  Axes      : array[0..1] of DWORD;
  Direction : array[0..1] of Longint;
  eff       : DIEFFECT;
  cf        : DICONSTANTFORCE;
begin
  Memo1.Enabled := True;
  Memo1.Lines.Clear;
//回调函数不能是类的成员函数
  DInput.EnumDevices(DI8DEVCLASS_GAMECTRL, EnumJoyCallback, nil, DIEDFL_ATTACHEDONLY or DIEDFL_FORCEFEEDBACK);
  for i := 0 to DXEnumDev.Count - 1 do
    Memo1.Lines.Add(DXEnumDev.Strings[i]);

  if DInputJoy = nil then
  begin
    ShowMessage('无法创建力反馈设备, 继续创建普通设备');
    DInput.EnumDevices(DI8DEVCLASS_GAMECTRL, EnumJoyCallback, nil, DIEDFL_ATTACHEDONLY);
    for i := 0 to DXEnumDev.Count - 1 do
      Memo1.Lines.Add(DXEnumDev.Strings[i]);
    if DInputJoy = nil then
    begin
      ShowMessage('无法创建普通设备');
      Exit;
    end;
  end;

  DXResult := DInputJoy.SetCooperativeLevel(Self.Handle, DISCL_EXCLUSIVE or DISCL_FOREGROUND);
  if DXResult <> DI_OK then
  begin
    ShowMessage('无法设置合作级别');
    Exit;
  end;

  DXResult := DInputJoy.SetDataFormat(c_dfDIJoystick2);
  if DXResult <> DI_OK then
  begin
    ShowMessage('无法设置数据格式');
    Exit;
  end;

  DInputJoy.EnumObjects(EnumAxesCallback, nil, DIDFT_AXIS);
  if NumFFBAxis > 2 then
    NumFFBAxis := 2;

  DInputJoy.EnumObjects(EnumObjCallback, nil, DIDFT_ALL);


  Axes[0]       := DIJOFS_X;
  Axes[1]       := DIJOFS_Y;
  Direction[0]  := 0;
  Direction[1]  := 0;
  cf.lMagnitude := 0;

  ZeroMemory(@eff, SizeOf(eff) );
  eff.dwSize                  := SizeOf(DIEFFECT);
  eff.dwFlags                 := DIEFF_CARTESIAN or DIEFF_OBJECTOFFSETS;
  eff.dwDuration              := INFINITE;
  eff.dwSamplePeriod          := 0;
  eff.dwGain                  := DI_FFNOMINALMAX;
  eff.dwTriggerButton         := DIEB_NOTRIGGER;
  eff.dwTriggerRepeatInterval := 0;
  eff.cAxes                   := NumFFBAxis;
  eff.rgdwAxes                := @Axes;
  eff.rglDirection            := @Direction;
  eff.lpEnvelope              := 0;
  eff.cbTypeSpecificParams    := SizeOf(DICONSTANTFORCE);
  eff.lpvTypeSpecificParams   := @cf;
  eff.dwStartDelay            := 0;

  DXResult := DInputJoy.CreateEffect(GUID_ConstantForce,  @eff, DInputEffect, nil);
  if DXResult <> DI_OK then
  begin
    ShowMessage('无法创建效果');
    Exit;
  end;


  DInputJoy.Acquire;

  bJoy            := True;
  Button3.Enabled := False;
  Memo1.Enabled   := False;
end;

procedure TForm1.FormActivate(Sender: TObject);
var
  i : Integer;
begin
  Application.OnIdle := AppIdle;

  nXForce   := 1;
  nYForce   := 1;
  bKeyBoard := False;
  bMouse    := False;
  bJoy      := False;
  DXLog     := TStringList.Create;
  DXEnumDev := TStringList.Create;
  DXLog.Clear;
  DXEnumDev.Clear;

//DirectInput对象
  DXResult := DirectInput8Create(hInstance, DIRECTINPUT_VERSION, IID_IDirectInput8,
                                 DInput, nil);
  Memo1.Lines.Add('创建DirectInput接口');
  DXLog.Add(DXGetErrorString9(DXResult));
  DXLog.Add(DXGetErrorDescription9(DXResult));
  for i := 0 to DXLog.Count - 1 do
    Memo1.Lines.Add(DXlog.Strings[i]);
  if DXResult <> DI_OK then
    Exit;

  Memo1.Enabled := False;
end;

procedure TForm1.SetFFB;
var
  i         : Integer;
  Direction : array[0..1] of Longint;
  eff       : DIEFFECT;
  cf        : DICONSTANTFORCE;
begin
  Direction[0]  := 0;
  Direction[1]  := 0;
  if NumFFBAxis = 1 then
  begin
    cf.lMagnitude := nXForce;
    Direction[0]  := 0;
  end
  else
  begin
    Direction[0]  := nXForce;
    Direction[1]  := nYForce;
    cf.lMagnitude := Sqr(nXForce * nXForce + nYForce * nYForce);
  end;


  ZeroMemory(@eff, SizeOf(eff) );
  eff.dwSize                  := SizeOf(DIEFFECT);
  eff.dwFlags                 := DIEFF_CARTESIAN or DIEFF_OBJECTOFFSETS;
  eff.cAxes                   := NumFFBAxis;
  eff.rglDirection            := @Direction;
  eff.lpEnvelope              := 0;
  eff.cbTypeSpecificParams    := SizeOf(DICONSTANTFORCE);
  eff.lpvTypeSpecificParams   := @cf;
  eff.dwStartDelay            := 0;

  DInputEffect.SetParameters(eff, DIEP_DIRECTION or DIEP_TYPESPECIFICPARAMS or DIEP_START);
end;

function EnumJoyCallback(var lpddi: DIDeviceInstance; pvRef: Pointer): BOOL;
begin
  Form1.DXEnumDev.Add(lpddi.tszInstanceName + ' - ' + lpddi.tszProductName);
  Form1.DXResult := Form1.DInput.CreateDevice(lpddi.guidInstance, Form1.DInputJoy, nil);
  if Form1.DXResult <> DI_OK then
    ShowMessage('创建游戏控制器失败');
//  Result := DIENUM_CONTINUE;
  Result := DIENUM_STOP;
end;

function EnumObjCallback(var lpddoi: DIDeviceObjectInstance; pvRef : Pointer): BOOL; stdcall;
var
  dirange : DIPROPRANGE;
begin
  if (lpddoi.dwType and DIDFT_AXIS) > 0 then
  begin
    dirange.diph.dwSize       := SizeOf(DIPROPRANGE);
    dirange.diph.dwHeaderSize := SizeOf(DIPROPHEADER);
    dirange.diph.dwHow        := DIPH_BYID;
    dirange.diph.dwObj        := lpddoi.dwType;
    dirange.lMin              := -1000;
    dirange.lMax              := +1000;

    Form1.DXResult := Form1.DInputJoy.SetProperty(DIPROP_RANGE, dirange.diph);
    if Form1.DXResult <> DI_OK then
    begin
      ShowMessage('设置游戏控制器属性失败');
      Result := DIENUM_STOP;
    end;
  end;

  Result := DIENUM_CONTINUE;
end;

function EnumAxesCallback(var lpddoi: DIDeviceObjectInstance; pvRef : Pointer): BOOL; stdcall;
var
  dirange : DIPROPRANGE;
begin
  if (lpddoi.dwFlags and DIDOI_FFACTUATOR) <> 0 then
  begin
    Inc(Form1.NumFFBAxis);
  end;

  Result := DIENUM_CONTINUE;
end;

end.