{******************************************************************************}
{* Иллюстрация к книге "DirectX. Графика в проектах Delphi".                  *}
{* Издательство BHV. www.bhv.ru                                               *}
{* Краснов М.В. softgl@chat.ru                                                *}
{******************************************************************************}
unit Unit1;

interface

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

type
  TfrmDX = class(TForm)
    ApplicationEvents1: TApplicationEvents;
    Memo1: TMemo;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ApplicationEvents1Idle(Sender: TObject; var Done: Boolean);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    function OnCreateDevice : HRESULT;
    function ReadBufferedData : HRESULT;
    function ReadImmediateData : HRESULT;
  public
    { Public declarations }
  end;

const
  SAMPLE_BUFFER_SIZE = 8;

var
  frmDX: TfrmDX;
  DInput : IDIRECTINPUT8 = nil;
  DIKeyboard : IDIRECTINPUTDEVICE8 = nil;

implementation

{$R *.DFM}

function TfrmDX.OnCreateDevice : HRESULT;
var
  hRet : HRESULT;
  dipdw : TDIPROPDWORD;
begin
  hRet := DirectInput8Create (hInstance, DIRECTINPUT_VERSION,
                                         IID_IDirectInput8, DInput, nil);
  if Failed (hRet) then begin
     Result := hRet;
     Exit
  end;

  hRet := DInput.CreateDevice (GUID_SysKeyboard, DIKeyboard, nil);
  if Failed (hRet) then begin
     Result := hRet;
     Exit
  end;

  hRet := DIKeyboard.SetDataFormat(c_dfDIKeyboard);
  if Failed (hRet) then begin
     Result := hRet;
     Exit
  end;

  hRet := DIKeyboard.SetCooperativeLevel(Handle, DISCL_NONEXCLUSIVE or DISCL_BACKGROUND);
  if Failed (hRet) then begin
     Result := hRet;
     Exit
  end;

  ZeroMemory (@dipdw, SizeOf (dipdw));
  with dipdw do begin
       diph.dwSize       := SizeOf(TDIPROPDWORD);
       diph.dwHeaderSize := SizeOf(TDIPROPHEADER);
       diph.dwObj        := 0;
       diph.dwHow        := DIPH_DEVICE;
       dwData            := SAMPLE_BUFFER_SIZE;
  end;

  hRet := DIKeyboard.SetProperty(DIPROP_BUFFERSIZE, dipdw.diph);
  if Failed (hRet) then begin
     Result := hRet;
     Exit
  end;

  Result := DIKeyboard.Acquire;
end;

procedure TfrmDX.FormCreate(Sender: TObject);
var
  hRet : HRESULT;
begin
  hRet := OnCreateDevice;
  if Failed (hRet) then MessageDlg(DIErrorString(Error), mtError, [mbAbort], 0);
end;

procedure TfrmDX.FormDestroy(Sender: TObject);
begin
  if Assigned (DIKeyboard) then DIKeyboard.Unacquire;
  if Assigned (DIKeyboard) then DIKeyboard := nil;
  if Assigned (DInput) then DInput := nil;
end;

function TfrmDX.ReadBufferedData : HRESULT;
var
  didod : Array [0..SAMPLE_BUFFER_SIZE - 1] of TDIDEVICEOBJECTDATA;
  dwElements : DWORD;
  i : DWORD;
  hRet : HRESULT;
  s : String;
begin
  if DIKeyboard = nil then begin
     Result := DI_OK;
     Exit
  end;

  hRet := DIKeyboard.GetDeviceData (SizeOf(TDIDEVICEOBJECTDATA),
                                    @didod, dwElements, 0);
  if Failed (hRet) then begin
     hRet := DIKeyboard.Acquire;
        while hRet = DIERR_INPUTLOST do
            hRet := DIKeyboard.Acquire;
  end;

  if dwElements <> 0 then
     for i := 0 to dwElements - 1 do begin
      if didod[i].dwData and $80 <> 0
         then s := 'D'
         else s := 'U';
      Memo1.Lines.Add (Format ('0x%02x%s', [didod[i].dwOfs, s]));
      if didod[i].dwOfs = DIK_ESCAPE then Close;
  end;

  Result := DI_OK;
end;

procedure TfrmDX.ApplicationEvents1Idle(Sender: TObject;
  var Done: Boolean);
begin
  Button1.SetFocus;
  if Failed (ReadBufferedData) then Close;
//  if Failed (ReadImmediateData) then Close;
  Done := False;
end;

procedure TfrmDX.Button1Click(Sender: TObject);
begin
  Memo1.Clear
end;

function TfrmDX.ReadImmediateData : HRESULT;
var
  hRet : HRESULT;
  diks : Array [0..255] of BYTE;
  i : Integer;
  sMulti : String;
begin
  if DIKeyboard = nil then begin
     Result := DI_OK;
     Exit
  end;

  ZeroMemory(@diks, SizeOf(diks));
  hRet := DIKeyboard.GetDeviceState(SizeOf(diks), @diks);
  if Failed (hRet) then begin
     hRet := DIKeyboard.Acquire;
        while hRet = DIERR_INPUTLOST do
            hRet := DIKeyboard.Acquire;
  end;

  sMulti := '';
  for i := 0 to 255 do
      if diks[i] and $80 <> 0
         then sMulti := sMulti + ' ' + Format ('0x%02x', [i]);

  Memo1.Lines.Add (sMulti);

  Result := DI_OK;
end;

end.
