Пример опроса мыши методами DirectInput

== Пример буферизированного опроса мыши методами DirectInput ==
{******************************************************************************
 * *
 * Придумал и написал Кода Виктор, Март 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;
 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;
// Константы и глобальные переменные
var
 lpDI8: IDirectInput8 = nil;
 lpDIMouse: IDirectInputDevice8 = nil;
 mouseX: LongInt = 0;
 mouseY: LongInt = 0;
// Производит инициализацию объектов 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;
 // Подготавливаем структуру TDIPropDWORD, она поможет установить нам
 // буферизированный опрос мыши
 ZeroMemory(@dipropdw, SizeOf(TDIPropDWORD));
 dipropdw.diph.dwSize := SizeOf(TDIPropDWORD);
 dipropdw.diph.dwHeaderSize := SizeOf(TDIPropHeader);
 dipropdw.diph.dwObj := 0;
 dipropdw.diph.dwHow := DIPH_DEVICE; // Изменяем характеристики всего устройства
 dipropdw.dwData := 16; // Размер буфера для данных (по умолчанию 0)
 // Устанавливаем размер буфера для мыши
 if FAILED(lpDIMouse.SetProperty(DIPROP_BUFFERSIZE, dipropdw.diph)) then
 Exit;
 // Захватываем мышь
 lpDIMouse.Acquire();
 Result := True;
end;
// Производит удаление объектов 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;
// Получает характеристики мыши (определяет количество кнопок)
procedure GetMouseCaps();
var
 lpCaps: TDIDevCaps; // Структура для получения данных об элементах мыши
begin
 // Подготавливаем структуру TDIDevCaps (для получения характеристик мыши)
 ZeroMemory(@lpCaps, SizeOf(TDIDevCaps));
 lpCaps.dwSize := SizeOf(TDIDevCaps);
 // Получаем характеристики мыши, данные записываются в структуру lpCaps
 lpDIMouse.GetCapabilities(lpCaps);
 // Приводим UI в соответствующий вид
 with Form1 do
 begin
 lb1.Enabled := (lpCaps.dwButtons > 0);
 lbBtn1.Enabled := (lpCaps.dwButtons > 0);
 lb2.Enabled := (lpCaps.dwButtons > 1);
 lbBtn2.Enabled := (lpCaps.dwButtons > 1);
 lb3.Enabled := (lpCaps.dwButtons > 2);
 lbBtn3.Enabled := (lpCaps.dwButtons > 2);
 lb4.Enabled := (lpCaps.dwButtons > 3);
 lbBtn4.Enabled := (lpCaps.dwButtons > 3);
 end;
end;
// Производит опрос мыши и выводит данные в окно
function UpdateMouseState(var dwX, dwY: DWORD): Boolean;
var
 od: TDIDeviceObjectData;
 dwElements: DWORD;
begin
 Result := FALSE;
 // Обязательно обнуляем!
 dwX := 0;
 dwY := 0;
 dwElements := 1;
 // Пока количество опрашиваемых элементов мыши (оси, кнопки, колёсики ) <> 0
 while dwElements <> 0 do
 begin
 // Получаем данные от мыши
 if lpDIMouse.GetDeviceData(SizeOf(TDIDeviceObjectData), @od, dwElements, 0) = DIERR_INPUTLOST then
 begin
 // Снова захватываем
 lpDIMouse.Acquire();
 // Если всё бесполезно, то выходим
 if FAILED(lpDIMouse.GetDeviceData(SizeOf(TDIDeviceObjectData), @od, dwElements, 0)) then
 Exit;
 end;
 with Form1 do
 begin
 case od.dwOfs of
 DIMOFS_X:
 dwX := od.dwData;
 DIMOFS_Y:
 dwY := od.dwData;
 DIMOFS_BUTTON0:
 if od.dwData = $080 then
 lbBtn1.Caption := 'Нажата'
 else
 lbBtn1.Caption := ;
 DIMOFS_BUTTON1:
 if od.dwData = $080 then
 lbBtn2.Caption := 'Нажата'
 else
 lbBtn2.Caption := ;
 DIMOFS_BUTTON2:
 if od.dwData = $080 then
 lbBtn3.Caption := 'Нажата'
 else
 lbBtn3.Caption := ;
 DIMOFS_BUTTON3:
 if od.dwData = $080 then
 lbBtn4.Caption := 'Нажата'
 else
 lbBtn4.Caption := ;
 end;
 end;
 end;
 Result := True;
end;
// Вызывает функцию опроса состояния мыши
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(mouseX, dwOffsX);
 Inc(mouseY, dwOffsY);
 lbX.Caption := Format('%d', [mouseX]);
 lbY.Caption := Format('%d', [mouseY]);
 imCursor.Left := 234 + mouseX; // 234 - координата, если мы хотим, чтобы
 imCursor.Top := 234 + mouseY; // курсор был с начала работы в центре окна
 Done := False;
end;
// Производит инициализацию 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 := ;
 Application.OnIdle := Idle;
end;
// Обрабатывает клавиатурный ввод
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
 if Key = VK_ESCAPE then
 Form1.Close();
end;
// Вызывается при удалении программы из памяти
procedure TForm1.FormDestroy(Sender: TObject);
begin
 ReleaseDirectInput();
end;
end.
Форма:
object Form1: TForm1
 Left = 221
 Top = 31
 BorderIcons = []
 BorderStyle = bsSingle
 Caption =
 'DirectInput 8: буферизированный опрос мыши (нажмите Esc для выхо' +
 'да)'
 ClientHeight = 500
 ClientWidth = 500
 Color = clBtnFace
 Font.Charset = DEFAULT_CHARSET
 Font.Color = clWindowText
 Font.Height = -11
 Font.Name = 'MS Sans Serif'
 Font.Style = []
 KeyPreview = True
 OldCreateOrder = False
 Position = poScreenCenter
 OnActivate = FormActivate
 OnDestroy = FormDestroy
 OnKeyDown = FormKeyDown
 PixelsPerInch = 96
 TextHeight = 13
 object imCursor: TImage
 Left = 234
 Top = 234
 Width = 32
 Height = 32
 AutoSize = True
 Picture.Data = {
 055449636F6E0000010001002020000001000800A80800001600000028000000
 2000000040000000010008000000000080040000000000000000000000010000
 0000000000000000800080008000000080800000008000000080800000008000
 C0C0C000C0DCC000F0CAA60080808000FF00FF00FF000000FFFF000000FF0000
 00FFFF000000FF00FFFFFF00F0FBFF00A4A0A000D4F0FF00B1E2FF008ED4FF00
 6BC6FF0048B8FF0025AAFF0000AAFF000092DC00007AB90000629600004A7300
 00325000D4E3FF00B1C7FF008EABFF006B8FFF004873FF002557FF000055FF00
 0049DC00003DB900003196000025730000195000D4D4FF00B1B1FF008E8EFF00
 6B6BFF004848FF002525FF000000FF000000DC000000B9000000960000007300
 00005000E3D4FF00C7B1FF00AB8EFF008F6BFF007348FF005725FF005500FF00
 4900DC003D00B900310096002500730019005000F0D4FF00E2B1FF00D48EFF00
 C66BFF00B848FF00AA25FF00AA00FF009200DC007A00B900620096004A007300
 32005000FFD4FF00FFB1FF00FF8EFF00FF6BFF00FF48FF00FF25FF00FF00FF00
 DC00DC00B900B900960096007300730050005000FFD4F000FFB1E200FF8ED400
 FF6BC600FF48B800FF25AA00FF00AA00DC009200B9007A009600620073004A00
 50003200FFD4E300FFB1C700FF8EAB00FF6B8F00FF487300FF255700FF005500
 DC004900B9003D00960031007300250050001900FFD4D400FFB1B100FF8E8E00
 FF6B6B00FF484800FF252500FF000000DC000000B90000009600000073000000
 50000000FFE3D400FFC7B100FFAB8E00FF8F6B00FF734800FF572500FF550000
 DC490000B93D0000963100007325000050190000FFF0D400FFE2B100FFD48E00
 FFC66B00FFB84800FFAA2500FFAA0000DC920000B97A000096620000734A0000
 50320000FFFFD400FFFFB100FFFF8E00FFFF6B00FFFF4800FFFF2500FFFF0000
 DCDC0000B9B90000969600007373000050500000F0FFD400E2FFB100D4FF8E00
 C6FF6B00B8FF4800AAFF2500AAFF000092DC00007AB90000629600004A730000
 32500000E3FFD400C7FFB100ABFF8E008FFF6B0073FF480057FF250055FF0000
 49DC00003DB90000319600002573000019500000D4FFD400B1FFB1008EFF8E00
 6BFF6B0048FF480025FF250000FF000000DC000000B900000096000000730000
 00500000D4FFE300B1FFC7008EFFAB006BFF8F0048FF730025FF570000FF5500
 00DC490000B93D00009631000073250000501900D4FFF000B1FFE2008EFFD400
 6BFFC60048FFB80025FFAA0000FFAA0000DC920000B97A000096620000734A00
 00503200D4FFFF00B1FFFF008EFFFF006BFFFF0048FFFF0025FFFF0000FFFF00
 00DCDC0000B9B900009696000073730000505000F2F2F200E6E6E600DADADA00
 CECECE00C2C2C200B6B6B600AAAAAA009E9E9E0092929200868686007A7A7A00
 6E6E6E0062626200565656004A4A4A003E3E3E0032323200262626001A1A1A00
 0E0E0E0000000000000000000000000000000000000000000000000000000000
 0000000000000000000000000000000000000000000000000000000000000000
 0000000000000000000000000000000000000000000000000000000000000000
 0000000000000000000000000000000000000000000000000000000000000000
 0000000000000000000000000000000000000000000000000000000000000000
 0000000000000000000000000000000000000000000000000000000000000000
 0000000000000000000000000000000000000000000000000000000000000000
 0000000000000000000000000000000000000000000000000000000000000000
 0000000000000000000000000000000000000000000000000000000000000000
 0000000000000000000000000000000000000000000000000000000000000000
 0000000000000000000000000000000000000000000000000000000000000000
 0000000000000000000000000000000000000000000000000000000000000000
 0000000000000000000000000000000000000000000000000000000000000000
 0000000000000000000000BABA00000000000000000000000000000000000000
 00000000000000000000C5C5C5BA000000000000000000000000000000000000
 00000000000000000000C5ABC5BA000000000000000000000000000000000000
 000000000000000000C5ABC5BA00000000000000000000000000000000000000
 00000000C500000000C5ABC5BA00000000000000000000000000000000000000
 00000000C2C50000C5ABC5BA0000000000000000000000000000000000000000
 00000000C2C3C500C5ABC5BA0000000000000000000000000000000000000000
 00000000C2C3C3C5ABBABA000000000000000000000000000000000000000000
 00000000C2C3C3C4C4C4C5C5BABAD30000000000000000000000000000000000
 00000000C2C3C3C4C4D1D1D1BAD3000000000000000000000000000000000000
 00000000C2C3C3C4C4D1D1BAD300000000000000000000000000000000000000
 00000000C2C3C4C4D1D1D1D30000000000000000000000000000000000000000
 00000000C2C3C4C4D1D1D3000000000000000000000000000000000000000000
 00000000C2C3C4D1D1BA00000000000000000000000000000000000000000000
 00000000C2C4D1D1BA0000000000000000000000000000000000000000000000
 00000000C2C4D1C5000000000000000000000000000000000000000000000000
 00000000C2C5C500000000000000000000000000000000000000000000000000
 00000000C2C50000000000000000000000000000000000000000000000000000
 00000000D0000000000000000000000000000000000000000000000000000000
 00000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
 FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFE7FFFFFFC3FFFFF
 FC3FFFFFF87FFFFF787FFFFF30FFFFFF10FFFFFF01FFFFFF001FFFFF003FFFFF
 007FFFFF00FFFFFF01FFFFFF03FFFFFF07FFFFFF0FFFFFFF1FFFFFFF3FFFFFFF
 7FFFFFFF}
 end
 object gb1: TGroupBox
 Left = 360
 Top = 8
 Width = 129
 Height = 145
 Caption = 'Состояние мыши'
 TabOrder = 0
 object lbX0: TLabel
 Left = 17
 Top = 24
 Width = 10
 Height = 13
 Caption = 'X:'
 end
 object lbY0: TLabel
 Left = 17
 Top = 40
 Width = 10
 Height = 13
 Caption = 'Y:'
 end
 object lb1: TLabel
 Left = 16
 Top = 64
 Width = 46
 Height = 13
 Caption = 'Кнопка1:'
 Enabled = False
 end
 object lb2: TLabel
 Left = 16
 Top = 80
 Width = 46
 Height = 13
 Caption = 'Кнопка2:'
 Enabled = False
 end
 object lb3: TLabel
 Left = 16
 Top = 96
 Width = 46
 Height = 13
 Caption = 'Кнопка3:'
 Enabled = False
 end
 object lbBtn1: TLabel
 Left = 72
 Top = 64
 Width = 30
 Height = 13
 Caption = 'lbBtn1'
 Enabled = False
 end
 object lbBtn2: TLabel
 Left = 72
 Top = 80
 Width = 30
 Height = 13
 Caption = 'lbBtn2'
 Enabled = False
 end
 object lbBtn3: TLabel
 Left = 72
 Top = 96
 Width = 30
 Height = 13
 Caption = 'lbBtn3'
 Enabled = False
 end
 object lb4: TLabel
 Left = 16
 Top = 112
 Width = 46
 Height = 13
 Caption = 'Кнопка4:'
 Enabled = False
 end
 object lbBtn4: TLabel
 Left = 72
 Top = 112
 Width = 30
 Height = 13
 Caption = 'lbBtn4'
 Enabled = False
 end
 object lbX: TLabel
 Left = 72
 Top = 24
 Width = 6
 Height = 13
 Caption = '0'
 end
 object lbY: TLabel
 Left = 72
 Top = 40
 Width = 6
 Height = 13
 Caption = '0'
 end
 end
end
----
== Пример непосредственного опроса мыши методами DirectInput ==
{******************************************************************************
 * *
 * Придумал и написал Кода Виктор, Март 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;
// Производит инициализацию объектов 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;
// Производит удаление объектов 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;
// Получает характеристики мыши (определяет кол-во кнопок)
procedure GetMouseCaps();
var
 lpCaps: TDIDevCaps; // Структура для получения данных об элементах мыши
begin
 // Подготавливаем структуру TDIDevCaps (для получения характеристик мыши)
 ZeroMemory(@lpCaps, SizeOf(TDIDevCaps));
 lpCaps.dwSize := SizeOf(TDIDevCaps);
 // Получаем характеристики мыши, данные записываются в структуру lpCaps
 lpDIMouse.GetCapabilities(lpCaps);
 // Приводим GUI в соответствующий вид
 with Form1 do
 begin
 lb1.Enabled := (lpCaps.dwButtons > 0);
 lbBtn1.Enabled := (lpCaps.dwButtons > 0);
 lb2.Enabled := (lpCaps.dwButtons > 1);
 lbBtn2.Enabled := (lpCaps.dwButtons > 1);
 lb3.Enabled := (lpCaps.dwButtons > 2);
 lbBtn3.Enabled := (lpCaps.dwButtons > 2);
 lb4.Enabled := (lpCaps.dwButtons > 3);
 lbBtn4.Enabled := (lpCaps.dwButtons > 3);
 end;
end;
// Производит опрос мыши и выводит данные в окно
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;
// Вызывает функцию опроса состояния мыши
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;
// Производит инициализацию 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;
// Обрабатывает клавиатурный ввод
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
 Shift: TShiftState);
begin
 if Key = VK_ESCAPE then Form1.Close();
end;
// Вызывается при удалении программы из памяти
procedure TForm1.FormDestroy(Sender: TObject);
begin
 ReleaseDirectInput();
end;
end.
форма:
object Form1: TForm1
 Left = 155
 Top = 34
 BorderIcons = []
 BorderStyle = bsSingle
 Caption =
 'DirectInput 8: непосредственный опрос мыши (нажмите Esc для выхо' +
 'да)'
 ClientHeight = 500
 ClientWidth = 500
 Color = clBtnFace
 Font.Charset = DEFAULT_CHARSET
 Font.Color = clWindowText
 Font.Height = -11
 Font.Name = 'MS Sans Serif'
 Font.Style = []
 KeyPreview = True
 OldCreateOrder = False
 Position = poScreenCenter
 OnActivate = FormActivate
 OnDestroy = FormDestroy
 OnKeyDown = FormKeyDown
 PixelsPerInch = 96
 TextHeight = 13
 object imCursor: TImage
 Left = 234
 Top = 234
 Width = 32
 Height = 32
 AutoSize = True
 Picture.Data = {
 055449636F6E0000010001002020000001000800A80800001600000028000000
 2000000040000000010008000000000080040000000000000000000000010000
 0000000000000000800080008000000080800000008000000080800000008000
 C0C0C000C0DCC000F0CAA60080808000FF00FF00FF000000FFFF000000FF0000
 00FFFF000000FF00FFFFFF00F0FBFF00A4A0A000D4F0FF00B1E2FF008ED4FF00
 6BC6FF0048B8FF0025AAFF0000AAFF000092DC00007AB90000629600004A7300
 00325000D4E3FF00B1C7FF008EABFF006B8FFF004873FF002557FF000055FF00
 0049DC00003DB900003196000025730000195000D4D4FF00B1B1FF008E8EFF00
 6B6BFF004848FF002525FF000000FF000000DC000000B9000000960000007300
 00005000E3D4FF00C7B1FF00AB8EFF008F6BFF007348FF005725FF005500FF00
 4900DC003D00B900310096002500730019005000F0D4FF00E2B1FF00D48EFF00
 C66BFF00B848FF00AA25FF00AA00FF009200DC007A00B900620096004A007300
 32005000FFD4FF00FFB1FF00FF8EFF00FF6BFF00FF48FF00FF25FF00FF00FF00
 DC00DC00B900B900960096007300730050005000FFD4F000FFB1E200FF8ED400
 FF6BC600FF48B800FF25AA00FF00AA00DC009200B9007A009600620073004A00
 50003200FFD4E300FFB1C700FF8EAB00FF6B8F00FF487300FF255700FF005500
 DC004900B9003D00960031007300250050001900FFD4D400FFB1B100FF8E8E00
 FF6B6B00FF484800FF252500FF000000DC000000B90000009600000073000000
 50000000FFE3D400FFC7B100FFAB8E00FF8F6B00FF734800FF572500FF550000
 DC490000B93D0000963100007325000050190000FFF0D400FFE2B100FFD48E00
 FFC66B00FFB84800FFAA2500FFAA0000DC920000B97A000096620000734A0000
 50320000FFFFD400FFFFB100FFFF8E00FFFF6B00FFFF4800FFFF2500FFFF0000
 DCDC0000B9B90000969600007373000050500000F0FFD400E2FFB100D4FF8E00
 C6FF6B00B8FF4800AAFF2500AAFF000092DC00007AB90000629600004A730000
 32500000E3FFD400C7FFB100ABFF8E008FFF6B0073FF480057FF250055FF0000
 49DC00003DB90000319600002573000019500000D4FFD400B1FFB1008EFF8E00
 6BFF6B0048FF480025FF250000FF000000DC000000B900000096000000730000
 00500000D4FFE300B1FFC7008EFFAB006BFF8F0048FF730025FF570000FF5500
 00DC490000B93D00009631000073250000501900D4FFF000B1FFE2008EFFD400
 6BFFC60048FFB80025FFAA0000FFAA0000DC920000B97A000096620000734A00
 00503200D4FFFF00B1FFFF008EFFFF006BFFFF0048FFFF0025FFFF0000FFFF00
 00DCDC0000B9B900009696000073730000505000F2F2F200E6E6E600DADADA00
 CECECE00C2C2C200B6B6B600AAAAAA009E9E9E0092929200868686007A7A7A00
 6E6E6E0062626200565656004A4A4A003E3E3E0032323200262626001A1A1A00
 0E0E0E0000000000000000000000000000000000000000000000000000000000
 0000000000000000000000000000000000000000000000000000000000000000
 0000000000000000000000000000000000000000000000000000000000000000
 0000000000000000000000000000000000000000000000000000000000000000
 0000000000000000000000000000000000000000000000000000000000000000
 0000000000000000000000000000000000000000000000000000000000000000
 0000000000000000000000000000000000000000000000000000000000000000
 0000000000000000000000000000000000000000000000000000000000000000
 0000000000000000000000000000000000000000000000000000000000000000
 0000000000000000000000000000000000000000000000000000000000000000
 0000000000000000000000000000000000000000000000000000000000000000
 0000000000000000000000000000000000000000000000000000000000000000
 0000000000000000000000000000000000000000000000000000000000000000
 0000000000000000000000BABA00000000000000000000000000000000000000
 00000000000000000000C5C5C5BA000000000000000000000000000000000000
 00000000000000000000C5ABC5BA000000000000000000000000000000000000
 000000000000000000C5ABC5BA00000000000000000000000000000000000000
 00000000C500000000C5ABC5BA00000000000000000000000000000000000000
 00000000C2C50000C5ABC5BA0000000000000000000000000000000000000000
 00000000C2C3C500C5ABC5BA0000000000000000000000000000000000000000
 00000000C2C3C3C5ABBABA000000000000000000000000000000000000000000
 00000000C2C3C3C4C4C4C5C5BABAD30000000000000000000000000000000000
 00000000C2C3C3C4C4D1D1D1BAD3000000000000000000000000000000000000
 00000000C2C3C3C4C4D1D1BAD300000000000000000000000000000000000000
 00000000C2C3C4C4D1D1D1D30000000000000000000000000000000000000000
 00000000C2C3C4C4D1D1D3000000000000000000000000000000000000000000
 00000000C2C3C4D1D1BA00000000000000000000000000000000000000000000
 00000000C2C4D1D1BA0000000000000000000000000000000000000000000000
 00000000C2C4D1C5000000000000000000000000000000000000000000000000
 00000000C2C5C500000000000000000000000000000000000000000000000000
 00000000C2C50000000000000000000000000000000000000000000000000000
 00000000D0000000000000000000000000000000000000000000000000000000
 00000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
 FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFE7FFFFFFC3FFFFF
 FC3FFFFFF87FFFFF787FFFFF30FFFFFF10FFFFFF01FFFFFF001FFFFF003FFFFF
 007FFFFF00FFFFFF01FFFFFF03FFFFFF07FFFFFF0FFFFFFF1FFFFFFF3FFFFFFF
 7FFFFFFF}
 end
 object lbEMail: TLabel
 Left = 8
 Top = 480
 Width = 195
 Height = 13
 Caption = 'Кода Виктор, e-mail kodavic@rambler.ru'
 Font.Charset = DEFAULT_CHARSET
 Font.Color = clBlue
 Font.Height = -11
 Font.Name = 'MS Sans Serif'
 Font.Style = []
 ParentFont = False
 end
 object gb1: TGroupBox
 Left = 360
 Top = 8
 Width = 129
 Height = 145
 Caption = 'Состояние мыши'
 TabOrder = 0
 object lbX0: TLabel
 Left = 17
 Top = 24
 Width = 10
 Height = 13
 Caption = 'X:'
 end
 object lbY0: TLabel
 Left = 17
 Top = 40
 Width = 10
 Height = 13
 Caption = 'Y:'
 end
 object lb1: TLabel
 Left = 16
 Top = 64
 Width = 46
 Height = 13
 Caption = 'Кнопка1:'
 Enabled = False
 end
 object lb2: TLabel
 Left = 16
 Top = 80
 Width = 46
 Height = 13
 Caption = 'Кнопка2:'
 Enabled = False
 end
 object lb3: TLabel
 Left = 16
 Top = 96
 Width = 46
 Height = 13
 Caption = 'Кнопка3:'
 Enabled = False
 end
 object lbBtn1: TLabel
 Left = 72
 Top = 64
 Width = 30
 Height = 13
 Caption = 'lbBtn1'
 Enabled = False
 end
 object lbBtn2: TLabel
 Left = 72
 Top = 80
 Width = 30
 Height = 13
 Caption = 'lbBtn2'
 Enabled = False
 end
 object lbBtn3: TLabel
 Left = 72
 Top = 96
 Width = 30
 Height = 13
 Caption = 'lbBtn3'
 Enabled = False
 end
 object lb4: TLabel
 Left = 16
 Top = 112
 Width = 46
 Height = 13
 Caption = 'Кнопка4:'
 Enabled = False
 end
 object lbBtn4: TLabel
 Left = 72
 Top = 112
 Width = 30
 Height = 13
 Caption = 'lbBtn4'
 Enabled = False
 end
 object lbX: TLabel
 Left = 72
 Top = 24
 Width = 6
 Height = 13
 Caption = '0'
 end
 object lbY: TLabel
 Left = 72
 Top = 40
 Width = 6
 Height = 13
 Caption = '0'
 end
 end
end
 по материалам fido7.ru.delphi.*
Source: Взято с сайта Анатолия Подгорецкого http://podgoretsky.com 
ID: 03915
Category:Графика
Category:DirectX