Laboratoř ČeskýchHer.cz - PasteBin

Vložit nový kód

TDX8Application = class(TObject)
    ...
    function InitDirectInput: Boolean;
    ...
    property DirectInput8: IDirectInput8 read FDirectInput8;
    ...
  end;
 
  TDirectInput8Keyboard = class(TObject)
  private
    FApplication : TDX8Application;
    FKeyboard : IDIRECTINPUTDEVICE8;
    FKeyState : array [0..255] of Byte;
    FOldKeyState : array [0..255] of Byte;
    FTimeKeyState : array [0..255] of Byte;
    FDoTimeKeys : boolean;
  protected
    function GetKeyDown(index: byte): boolean;
    function GetOldKeyDown(index: byte): boolean;
    function GetTimeKey(index: byte): byte;
    procedure SetTimeKey(index, value: byte);
  public
    constructor Create(App: TDX8Application); virtual;
    destructor Destroy; override;
    procedure UpDate;
    property Keys[index: byte] : Boolean read GetKeyDown;
    property OldKeys[index: byte]: boolean read GetOldKeyDown;
    property TimeKeys[index: byte]: byte read GetTimeKey write SetTimeKey;
    property DoTimeKeys : boolean read FDoTimeKeys write FDoTimeKeys; 
  end;
 
{ TDX8Application }
 
function TDX8Application.InitDirectInput: Boolean;
begin
  Result := False;
  if Failed(DirectInput8Create(GetModuleHandle(nil), DIRECTINPUT_VERSION,IID_IDirectInput8,FDirectInput8,nil)) then
      begin
        {$ifdef sg3d_engine_debug}Writeln(logfile,'End initializing DirectInpu...Error');{$endif}
        exit;
      end
    else
      begin
        {$ifdef sg3d_engine_debug}Writeln(logfile,'End initializing DirectInpu...OK');{$endif}
      end;
  Result := True;
end;
 
{TDirectInput8Keyboard}
 
constructor TDirectInput8Keyboard.Create(App: TDX8Application);
begin
 {$ifdef sg3d_engine_debug}App.Writeln(App.logfile,'Creating Keyboard');{$endif}
 FApplication := App;
 if App.DirectInput8 <> nil then
 begin 
  if (FAILED(App.DirectInput8.CreateDevice(GUID_SysKeyboard, FKeyboard, nil))) then
    begin
    {$ifdef sg3d_engine_debug}
      FApplication.Writeln(FApplication.logfile,'Keyboard: Error CreateDevice');
    {$endif}
    App.Terminate;
    end;
  if (FAILED(FKeyboard.SetDataFormat(@c_dfDIKeyboard))) then
    begin
    {$ifdef sg3d_engine_debug}
      FApplication.Writeln(FApplication.logfile,'Keyboard: Error SetDataFormat');
    {$endif}
    App.Terminate;
    end;
  if (FAILED(FKeyboard.SetCooperativeLevel(App.WindowHandle, DISCL_BACKGROUND or
                                             DISCL_NONEXCLUSIVE))) then
    begin
    {$ifdef sg3d_engine_debug}
      FApplication.Writeln(FApplication.logfile,'Keyboard: Error SetCooperativeLevel');
    {$endif}
    App.Terminate;
    end;
  if (FAILED(FKeyboard.Acquire)) then
    begin
    {$ifdef sg3d_engine_debug}
      App.Writeln(FApplication.logfile,'Keyboard: Error Acquire');
    {$endif}
    App.Terminate;
    end;
 end;
 {$ifdef sg3d_engine_debug}App.Writeln(FApplication.logfile,'Creating Keyboard...OK');{$endif}
 FDoTimeKeys := False;
end;
 
destructor TDirectInput8Keyboard.Destroy;
begin
  if FKeyboard <> nil then begin
  FKeyboard.Unacquire();
//  FKeyboard._Release();
  FKeyboard := nil;        end;
  inherited Destroy;
end;
 
procedure TDirectInput8Keyboard.UpDate;
var i : integer;
begin
  fillChar(FOldKeyState,sizeof(FOldKeyState),0);
  Move(FKeyState,FOldKeyState,sizeof(FKeyState));
  if (FAILED(FKeyboard.GetDeviceState(sizeof(FKeyState), @FKeyState))) then
    exit;
  if FDoTimeKeys then
  for i := 0 to 255 do
    if Keys[i] then Inc(FTimeKeyState[i])  else FTimeKeyState[i] := 0;
 
end;
 
function TDirectInput8Keyboard.GetKeyDown(index: byte): boolean;
begin
 Result := (FKeyState[index] and $80 = $80);
end;
function TDirectInput8Keyboard.GetOldKeyDown(index: byte): boolean;
begin
 Result := (FOldKeyState[index] and $80 = $80);
end;
function TDirectInput8Keyboard.GetTimeKey(index: byte): byte;
begin
 Result := FTimeKeyState[index];
end;
procedure TDirectInput8Keyboard.SetTimeKey(index, value: byte);
begin
 FTimeKeyState[index] := value;
end;