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;