(******************************************************************************
 *                                                                            *
 *  Придумал и написал Кода Виктор, Март 2002                                 *
 *                                                                            *
 *  Файл:       main.pas                                                      *
 *  Содержание: Пример использования DirectInput для опроса игровых устройств *
 *                                                                            *
 ******************************************************************************)
unit main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, StdCtrls,
  ExtCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    gb1: TGroupBox;
    gb2: TGroupBox;
    gb3: TGroupBox;
    lbInfo: TLabel;
    lb1: TLabel;
    lb2: TLabel;
    lb3: TLabel;
    lb4: TLabel;
    lb5: TLabel;
    lb6: TLabel;
    lb7: TLabel;
    lb8: TLabel;
    lbXAxis: TLabel;
    lbYAxis: TLabel;
    lbZAxis: TLabel;
    lbXRot: TLabel;
    lbYRot: TLabel;
    lbZRot: TLabel;
    lbSlider1: TLabel;
    lbSlider2: TLabel;
    lbIndex: TLabel;
    lbButtons: TLabel;
    btnClose: TButton;
    imView: TImage;
    Bevel1: TBevel;
    procedure btnCloseClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure Idle( Sender: TObject; var Done: Boolean );
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses
  DirectInput8;




//------------------------------------------------------------------------------
// Константы и глобальные переменные
//------------------------------------------------------------------------------
var
  lpDI8:          IDirectInput8       = nil;
  lpDIGameDevice: IDirectInputDevice8 = nil;




//------------------------------------------------------------------------------
// Имя:      EnumJoysticksCallback()
// Описание: Перечисляет установленные в системе игровые контроллеры
//------------------------------------------------------------------------------
function EnumJoysticksCallback( var lpddi: TDIDeviceInstanceA; pvRef: Pointer ):
   Integer; stdcall;
var
  didc: TDIDevCaps;
begin
  Result := DIENUM_CONTINUE;

  // На основе полученного GUID устройства создаём объект для работы с ним
  if FAILED( lpDI8.CreateDevice( lpddi.guidInstance, lpDIGameDevice, nil ) ) then
     Exit;
  lpDIGameDevice._AddRef;

  // Получаем тип устройства (для вывода на метку)
  case GET_DIDEVICE_TYPE( lpddi.dwDevType ) of
    DI8DEVTYPE_JOYSTICK: Form1.lbInfo.Caption := 'Джойстик ';
    DI8DEVTYPE_GAMEPAD:  Form1.lbInfo.Caption := 'Геймпад ';
    DI8DEVTYPE_DRIVING:  Form1.lbInfo.Caption := 'Руль ';
    DI8DEVTYPE_FLIGHT:   Form1.lbInfo.Caption := 'Штурвал ';
  end;

  // Подготавливаем структуру TDIDEVCAPS, она поможет получить сведения о
  // количестве осей и кнопок устройства
  ZeroMemory( @didc, SizeOf( TDIDEVCAPS ) );
  didc.dwSize := SizeOf( TDIDEVCAPS );

  // Получаем информацию методом устройства
  if FAILED( lpDIGameDevice.GetCapabilities( didc ) ) then
     Exit;

  // Выводим собранные сведения
  Form1.lbInfo.Caption := Form1.lbInfo.Caption + lpddi.tszProductName + ' (' +
                          IntToStr( didc.dwAxes ) + ' оси, '+
                          IntToStr( didc.dwButtons ) + ' кнопок).';
  Result := DIENUM_STOP;
end;




//------------------------------------------------------------------------------
// Имя:      EnumAxecCallback()
// Описание: Перечисляет все оси контроллера и устанавливает для них параметры
//------------------------------------------------------------------------------
function EnumAxecCallback( var lpddoi: TDIDeviceObjectInstanceA;
                           pvRef: Pointer ): Integer; stdcall;
// К сожалению, Паскаль не допускает варажения вида if guid1 = guid2..., поэтому
// прибегнем к отдельной функции, сравнивающей поэлементно каждый GUID
function Coincide( g1, g2: TGUID ): Boolean;
begin
  Result := FALSE;

  if ( g1.D1    = g2.D1 )   and
     ( g1.D2    = g2.D2 )   and
     ( g1.D3    = g2.D3 )   and
     ( g1.D4[0] = g2.D4[0]) and
     ( g1.D4[1] = g2.D4[1]) and
     ( g1.D4[2] = g2.D4[2]) and
     ( g1.D4[3] = g2.D4[3]) and
     ( g1.D4[4] = g2.D4[4]) and
     ( g1.D4[5] = g2.D4[5]) and
     ( g1.D4[6] = g2.D4[6]) and
     ( g1.D4[7] = g2.D4[7]) then
  Result := TRUE;
end; // Coincide()

var
  diprgn: TDIPROPRANGE;
begin
  Result := DIENUM_STOP;

  // Подготавливаем структуру TDIPROPRANGE
  // Обязательно указываем размеры структур
  ZeroMemory( @diprgn, SizeOf( TDIPROPRANGE ) );
  diprgn.diph.dwSize       := SizeOf( TDIPROPRANGE );
  diprgn.diph.dwHeaderSize := SizeOf( TDIPROPHEADER );

  diprgn.diph.dwHow := DIPH_BYID;     // Изменяем составную часть устройства
  diprgn.diph.dwObj := lpddoi.dwType; // Тип объекта устройства
  diprgn.lMin       := -1000;         // Минимальное значение области оси
  diprgn.lMax       := +1000;         // Максимальное значение области оси

  // Устанавливаем диапазон координат для перечисленной оси
  if FAILED( lpDIGameDevice.SetProperty( DIPROP_RANGE, diprgn.diph ) ) then
     Exit;

  // Делаем доступными те метки в окне, которые соответствуют найденной оси
  with Form1 do
  begin
    if Coincide( lpddoi.guidType, GUID_XAxis ) then
    begin
      lb1.Enabled := TRUE;
      lbXAxis.Enabled := TRUE;
    end;

    if Coincide( lpddoi.guidType, GUID_YAxis ) then
    begin
      lb2.Enabled := TRUE;
      lbYAxis.Enabled := TRUE;
    end;

    if Coincide( lpddoi.guidType, GUID_ZAxis ) then
    begin
      lb3.Enabled := TRUE;
      lbZAxis.Enabled := TRUE;
    end;

    if Coincide( lpddoi.guidType, GUID_RxAxis ) then
    begin
      lb4.Enabled := TRUE;
      lbXRot.Enabled := TRUE;
    end;

    if Coincide( lpddoi.guidType, GUID_RyAxis ) then
    begin
      lb5.Enabled := TRUE;
      lbYRot.Enabled := TRUE;
    end;

    if Coincide( lpddoi.guidType, GUID_RzAxis ) then
    begin
      lb6.Enabled := TRUE;
      lbZRot.Enabled := TRUE;
    end;

    if Coincide( lpddoi.guidType, GUID_Slider ) then
    begin
      lb7.Enabled := TRUE;
      lbSlider1.Enabled := TRUE;
      lb8.Enabled := TRUE;
      lbSlider2.Enabled := TRUE;
    end;
  end;

  Result := DIENUM_CONTINUE;
end;




//------------------------------------------------------------------------------
// Имя:      InitDirectInput()
// Описание: Производит инициализацию объектов DirectInput в программе
//------------------------------------------------------------------------------
function InitDirectInput( hWnd: HWND ): Boolean;
begin
  Result := FALSE;

  // Создаём объект DirectInput
  if FAILED( DirectInput8Create( GetModuleHandle( 0 ), DIRECTINPUT_VERSION,
                                 IID_IDirectInput8, lpDI8, nil ) ) then
     Exit;
  lpDI8._AddRef();

  // Перечисляем методом созданного объекта установленные игровые устройства
  if FAILED( lpDI8.EnumDevices( DI8DEVCLASS_GAMECTRL, EnumJoysticksCallback, nil,
                                DIEDFL_ATTACHEDONLY ) ) then
     Exit;

  // Убеждаемся, что игровое устройство действительно обнаружено
  if lpDIGameDevice = nil then
     Exit;

  // Установим формат данных для "простого устройства" - предопределённый формат
  // Формат данных определяет, какие элементы управления в устройстве нас инте-
  // ресуют и как о них будет сообщено. Эта строка говорит DInput, что мы будем
  // использовать структуру TDIJOYSTATE в методе GetDeviceState(). Существует
  // более полная структура TDIJOYSTATE2, но т. к. большинство её полей всё
  // равно здесь не используется, обойдемся более простой TDIJOYSTATE.
  if FAILED( lpDIGameDevice.SetDataFormat( @c_dfDIJoystick ) ) then
     Exit;

  // Устанавливаем уровень кооперации, чтобы DInput знал, как это устройство
  // будет взаимодействовать с системой и с другими устройствами DInput.
  if FAILED( lpDIGameDevice.SetCooperativeLevel( hWnd, DISCL_BACKGROUND or
                                                       DISCL_EXCLUSIVE ) ) then
     Exit;

  // Перечисляем оси устройства и устанавливаем области для каждой из них.
  // Примечание: можно было бы и не делать этих действий, но они показывают, как
  // можно перечислить различные объекты (оси, кнопки и т. д.)
  if FAILED( lpDIGameDevice.EnumObjects( EnumAxecCallback, nil, DIDFT_AXIS ) ) then
     Exit;

  // Захватываем игровое устройство
  lpDIGameDevice.Acquire();

  Result := TRUE;
end;




//------------------------------------------------------------------------------
// Имя:      ReleaseDirectInput()
// Описание: Производит удаление объектов DirectInput
//------------------------------------------------------------------------------
procedure ReleaseDirectInput();
begin
  // Удаляем объект для работы с игровым контроллером
  if lpDIGameDevice <> nil then
  begin
    lpDIGameDevice.Unacquire(); // Освобождаем устройство
    lpDIGameDevice._Release();
    lpDIGameDevice := nil;
  end;

  // Удаляем главный объект DirectInput (всегда последним)
  if lpDI8 <> nil then
  begin
    lpDI8._Release();
    lpDI8 := nil;
  end;
end;




//------------------------------------------------------------------------------
// Имя:      UpdateGameDeviceState()
// Описание: Производит опрос контроллера и выводит данные в окно
//------------------------------------------------------------------------------
function UpdateGameDeviceState(): Boolean;
var
  js: TDIJOYSTATE;
  i,
  nXPos,
  nYPos:  Integer;
begin
  Result := FALSE;

  // Опрашиваем устройство ввода
  if FAILED( lpDIGameDevice.Poll() ) then
     lpDIGameDevice.Acquire();

  // Производим опрос состояния джойстика, данные записаны в структуре js
  if FAILED( lpDIGameDevice.GetDeviceState( SizeOf( TDIJOYSTATE ), @js ) ) then
     Exit;

  // Выводим данные в окно
  with Form1 do
  begin
    lbXAxis.Caption := IntToStr( js.lX );
    lbYAxis.Caption := IntToStr( js.lY );
    lbZAxis.Caption := IntToStr( js.lZ );
    lbXRot.Caption  := IntToStr( js.lRx );
    lbYRot.Caption  := IntToStr( js.lRy );
    lbZRot.Caption  := IntToStr( js.lRz );

    lbSlider1.Caption := IntToStr( js.rglSlider[ 0 ] );
    lbSlider2.Caption := IntToStr( js.rglSlider[ 1 ] );

    lbButtons.Caption := '';

    // Теперь выводим список номеров нажатых кнопок
    for i := 0 to 127 do // DirectInput8 теоретически поддерживает 128 кнопок
    begin
      if js.rgbButtons[ i ] = $80 then // Признак нажатой кнопки
      if i <= 9 then lbButtons.Caption := lbButtons.Caption + Format( '0%d ', [ i + 1 ] )
                else lbButtons.Caption := lbButtons.Caption + Format( '%d ', [ i + 1 ] );
    end;

    // Вычисляем координаты курсора в окошке
    nXPos := Round( js.lX / 22 ) + 50;
    nYPos := Round( js.lY / 22 ) + 50;

    // Рисуем курсор
    with imView.Canvas do
    begin
      // Очищаем поверхность рисования
      Brush.Color := clWhite;
      FillRect( Canvas.ClipRect );

      // Рисуем курсор
      MoveTo( nXPos - 4, nYPos );
      LineTo( nXPos + 5, nYPos );

      MoveTo( nXPos, nYPos + 4 );
      LineTo( nXPos, nYPos - 5 );
    end;
  end;

  Result := TRUE;
end;




//------------------------------------------------------------------------------
// Имя:      TForm1.Idle()
// Описание: Вызывает функцию опроса состояния джойстика
//------------------------------------------------------------------------------
procedure TForm1.Idle( Sender: TObject; var Done: Boolean );
begin
  // Если данные от джойстика не получены
  if not UpdateGameDeviceState() then
  begin
    MessageBox( Form1.Handle, 'Потеряно устройство управления!',
                'Ошибка!', MB_ICONHAND);
    Form1.Close();
  end;

  Done := FALSE;
end;




//------------------------------------------------------------------------------
// Имя:      TForm1.FormCreate()
// Описание: Производит инициализацию DirectInput при старте программы
//------------------------------------------------------------------------------
procedure TForm1.FormCreate(Sender: TObject);
begin
  if not InitDirectInput( Form1.Handle ) then
  begin
    MessageBox( Form1.Handle, 'Ошибка при инициализации DirectInput!' + #13 +
                'Возможно, ни одно из игровых устройств к компьютеру не присоединёно.',
                'Ошибка!', MB_ICONHAND);
    ReleaseDirectInput();
    Halt;
  end;

  // Назначаем обработчик Idle-события. Компонент TTimer не позволит раскрыть
  // всех преимуществ использования DirectInput.
  Application.OnIdle := Idle;
end;




//------------------------------------------------------------------------------
// Имя:      TForm1.btnCloseClick()
// Описание: Закрывает программу
//------------------------------------------------------------------------------
procedure TForm1.btnCloseClick(Sender: TObject);
begin
  Form1.Close();
end;




//------------------------------------------------------------------------------
// Имя:      TForm1.FormDestroy()
// Описание: Вызывается при удалении программы из памяти
//------------------------------------------------------------------------------
procedure TForm1.FormDestroy(Sender: TObject);
begin
   ReleaseDirectInput();
end;

end.