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

interface

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

type
  TForm1 = class(TForm)
    gb1: TGroupBox;
    lbX0: TLabel;
    lbY0: TLabel;
    lbX: TLabel;
    lbY: TLabel;
    lb1: TLabel;
    lb2: TLabel;
    lb3: TLabel;
    lb4: TLabel;
    lbBtn1: TLabel;
    lbBtn2: TLabel;
    lbBtn3: TLabel;
    lbBtn4: TLabel;
    imCursor: TImage;
    lbEMail: TLabel;
    procedure FormActivate(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    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;




//------------------------------------------------------------------------------
// Константы и глобальные переменные
//------------------------------------------------------------------------------
const
  CURSOR_SPEED = 2.0;

var
  lpDI8:       IDirectInput8       = nil;
  lpDIMouse:   IDirectInputDevice8 = nil;

  dwMouseXPos: DWORD = 0;
  dwMouseYPos: DWORD = 0;




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

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

  // Создаём объект для работы с мышью
  if FAILED( lpDI8.CreateDevice( GUID_SysMouse, lpDIMouse, nil ) ) then
     Exit;
  lpDIMouse._AddRef();

  // Устанавлаваем предопределённый формат данных
  if FAILED( lpDIMouse.SetDataFormat( @c_dfDIMouse ) ) then
     Exit;

  // Устанавливаем уровень кооперации
  if FAILED( lpDIMouse.SetCooperativeLevel( hWnd, DISCL_FOREGROUND or
                                                  DISCL_EXCLUSIVE ) ) then
     Exit;

  // Захвытываем мышь
  lpDIMouse.Acquire();

  Result := TRUE;
end;




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

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




//------------------------------------------------------------------------------
// Имя:      GetMouseCaps()
// Описание: Получает характеристики мыши (определяет кол-во кнопок)
//------------------------------------------------------------------------------
procedure GetMouseCaps();
var
  lpCaps: TDIDEVCAPS; // Структура для получения данных об элементах мыши
begin
  // Подготавливаем структуру TDIDEVCAPS (для получения характеристик мыши)
  ZeroMemory( @lpCaps, SizeOf( TDIDEVCAPS ) );
  lpCaps.dwSize := SizeOf( TDIDEVCAPS );

  // Получаем характеристики мыши, данные записывааются в структуру lpCaps
  lpDIMouse.GetCapabilities( lpCaps );

  // Приводим GUI в соответствующий вид
  with Form1 do
  begin
    if lpCaps.dwButtons > 0 then
    begin
      lb1.Enabled := TRUE; lbBtn1.Enabled := TRUE;
    end;

    if lpCaps.dwButtons > 1 then
    begin
      lb2.Enabled := TRUE; lbBtn2.Enabled := TRUE;
    end;

    if lpCaps.dwButtons > 2 then
    begin
      lb3.Enabled := TRUE; lbBtn3.Enabled := TRUE;
    end;

    if lpCaps.dwButtons > 3 then
    begin
      lb4.Enabled := TRUE; lbBtn4.Enabled := TRUE;
    end;
  end;
end;




//------------------------------------------------------------------------------
// Имя:      UpdateMouseState()
// Описание: Производит опрос мыши и выводит данные в окно
//------------------------------------------------------------------------------
function UpdateMouseState( var(*по параметру*)x, y: DWORD ): Boolean;
var
  ms: TDIMOUSESTATE;
begin
  Result := FALSE;

  // Получаем данные от мыши
  if lpDImouse.GetDeviceState( SizeOf( TDIMOUSESTATE ), @ms ) = DIERR_INPUTLOST then
  begin
    // Снова захватываем
    lpDIMouse.Acquire();
    // Если всё бесполезно, то выходим
    if FAILED( lpDImouse.GetDeviceState( SizeOf( TDIMOUSESTATE ), @ms ) ) then
       Exit;
  end;

  with Form1 do
  begin
    // Вот так можно сделать движение курсора с переменной скоростью
    if ms.lX < 0 then ms.lX := Round( ms.lX * CURSOR_SPEED ) else
    if ms.lX > 0 then ms.lX := Round( ms.lX * CURSOR_SPEED );

    if ms.lY < 0 then ms.lY := Round( ms.lY * CURSOR_SPEED ) else
    if ms.lY > 0 then ms.lY := Round( ms.lY * CURSOR_SPEED );

    x := ms.lX ;
    y := ms.lY;

    //------

    if ms.rgbButtons[ 0 ] = $080 then lbBtn1.Caption := 'Нажата'
                                 else lbBtn1.Caption := '';
    if ms.rgbButtons[ 1 ] = $080 then lbBtn2.Caption := 'Нажата'
                                 else lbBtn2.Caption := '';
    if ms.rgbButtons[ 2 ] = $080 then lbBtn3.Caption := 'Нажата'
                                 else lbBtn3.Caption := '';
    if ms.rgbButtons[ 3 ] = $080 then lbBtn4.Caption := 'Нажата'
                                 else lbBtn4.Caption := '';
  end;

  Result := TRUE;
end;




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

  // Смещаем позицию курсора
  Inc( dwMouseXPos, dwOffsX );
  Inc( dwMouseYPos, dwOffsY );

  lbX.Caption := Format( '%d', [ dwMouseXPos ] );
  lbY.Caption := Format( '%d', [ dwMouseYPos ] );

  imCursor.Left := 234 + dwMouseXPos; // 234 - координата, если мы хотим, чтобы
  imCursor.Top  := 234 + dwMouseYPos; // курсор был с начала работы в центре окна

  Done := FALSE;
end;




//------------------------------------------------------------------------------
// Имя:      TForm1.FormActivate()
// Описание: Производит инициализацию DirectInput при активизации окна
//------------------------------------------------------------------------------
procedure TForm1.FormActivate(Sender: TObject);
begin
  if not InitDirectInput( Form1.Handle ) then
  begin
    MessageBox( Form1.Handle, 'Ошибка при инициализации DirectInput!',
                'Ошибка!', MB_ICONHAND );
    Form1.Close();
  end;

  // Получаем характеристики мыши (сколько кнопок?). Кстати, я не знаю - как
  // определить, есть ли у мыши колёсико?
  GetMouseCaps();

  // Приводим UI в соответствующий вид
  lbBtn1.Caption := '';
  lbBtn2.Caption := '';
  lbBtn3.Caption := '';
  lbBtn4.Caption := '';
  imCursor.Left := 184; // Курсор центре окна
  imCursor.Top  := 184;

  Application.OnIdle := Idle;
end;




//------------------------------------------------------------------------------
// Имя:      TForm1.FormKeyDown()
// Описание: Обрабатывает клавиатурный ввод
//------------------------------------------------------------------------------
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_ESCAPE then Form1.Close();
end;




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

end.