WebSVN – spacemission – Diff – /VCL_DELPHIX_D6/DXInput.pas


unit DXInput;
 
interface
 
{$INCLUDE DelphiXcfg.inc}
 
uses
  Windows, Messages, SysUtils, Classes, Controls, Forms, MMSystem,
  DXClass, {$IFDEF VER17UP} Types, {$ENDIF}
{$IfDef StandardDX}
  {$IfDef DX9}
  DirectInput;
  {$Else}
    {$IfDef DX81}
  DirectInput8;
    {$Else}
  DirectInput;
    {$EndIf}
  {$EndIf}
{$Else}
  DirectX;
{$EndIf}
 
type
 
  {  EDXInputError  }
 
  EDXInputError = class(Exception);
 
  {  EForceFeedbackEffectError  }
 
  EForceFeedbackEffectError = class(Exception);
 
 
  {  TForceFeedbackEffect  }
 
  TForceFeedbackEffectType = (etNone, etConstantForce, etPeriodic, etCondition);
 
  TForceFeedbackEffect = class;
  TForceFeedbackEffects = class;
 
  TForceFeedbackEffectObject = class
  private
    FAxes: array[0..1] of DWORD;
    FAxesCount: Integer;
    Feff: TDIEffect;
    FDirections: array[0..1] of DWORD;
    FEnvelope: TDIEnvelope;
    FConstantForce: TDIConstantForce;
    FCondition: TDICondition;
    FPeriodic: TDIPeriodic;
    FEffect: IDirectInputEffect;
    procedure Clear;
    procedure Init(Effect: TForceFeedbackEffect);
    procedure Release;
  public
    destructor Destroy; override;
  end;
 
  TForceFeedbackEffect = class(TPersistent)
  private
    FRoot: TForceFeedbackEffects;                
    FParent: TForceFeedbackEffect;
    FList: TList;
    FAttackLevel: Integer;
    FAttackTime: Integer;
    FCondition: TPoint;
    FConstant: TPoint;
    FEffectType: TForceFeedbackEffectType;
    FFadeLevel: Integer;
    FFadeTime: Integer;
    FName: string;
    FPeriod: Integer;
    FPlaying: Boolean;
    FPower: Integer;
    FTime: Integer;
    FStartDelayTime: Integer;
    FObject: TForceFeedbackEffectObject;
    FObject2: TForceFeedbackEffectObject;
    FFindEffectFlag: Boolean;
    FFindEffectGUID: TGUID;
    procedure Acquire;
    procedure Finalize;
    procedure Initialize;
    procedure ChangeEffect;
    procedure MakeEff;
    procedure CreateEffect;
    function GetCount: Integer;
    function GetEffect(Index: Integer): TForceFeedbackEffect;
    function GetIndex: Integer;
    function GetPlaying: Boolean;
    procedure SetAttackLevel(Value: Integer);
    procedure SetAttackTime(Value: Integer);
    procedure SetCondition(Value: TPoint);
    procedure SetConstant(Value: TPoint);
    procedure SetEffectType(Value: TForceFeedbackEffectType);
    procedure SetFadeLevel(Value: Integer);
    procedure SetFadeTime(Value: Integer);
    procedure SetIndex(Value: Integer);
    procedure SetPeriod(Value: Integer);
    procedure SetParent(Value: TForceFeedbackEffect);
    procedure SetPower(Value: Integer);
    procedure SetTime(Value: Integer);
    procedure SetStartDelayTime(Value: Integer);
    function HasInterface: Boolean;
  protected
    function GetOwner: TPersistent; override;
    property StartDelayTime: Integer read FStartDelayTime write SetStartDelayTime;
  public
    constructor Create(AParent: TForceFeedbackEffect);
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    procedure Clear;
    function Find(const Name: string): TForceFeedbackEffect;
    function IndexOf(const Name: string): Integer;
    procedure LoadFromFile(const FileName: string);
    procedure LoadFromStream(Stream: TStream);
    procedure SaveToFile(const FileName: string);
    procedure SaveToStream(Stream: TStream);
    procedure Start;
    procedure Stop;
    procedure Unload(Recurse: Boolean);
    property Count: Integer read GetCount;
    property Effects[Index: Integer]: TForceFeedbackEffect read GetEffect; default;
    property Index: Integer read GetIndex write SetIndex;
    property Playing: Boolean read GetPlaying;
    property Parent: TForceFeedbackEffect read FParent write SetParent;
    property Name: string read FName write FName;
    property EffectType: TForceFeedbackEffectType read FEffectType write SetEffectType;
    property AttackLevel: Integer read FAttackLevel write SetAttackLevel;
    property AttackTime: Integer read FAttackTime write SetAttackTime;
    property Condition: TPoint read FCondition write SetCondition;
    property Constant: TPoint read FConstant write SetConstant;
    property FadeLevel: Integer read FFadeLevel write SetFadeLevel;
    property FadeTime: Integer read FFadeTime write SetFadeTime;
    property Period: Integer read FPeriod write SetPeriod;
    property Power: Integer read FPower write SetPower;
    property Time: Integer read FTime write SetTime;
  end;
 
  {  TForceFeedbackEffects  }
 
  TCustomInput = class;
 
  TForceFeedbackEffects = class(TForceFeedbackEffect)
  private
    FComponent: TComponent;
    FInput: TCustomInput;
  protected
    procedure DefineProperties(Filer: TFiler); override;
  public
    constructor Create(Input: TCustomInput);
    destructor Destroy; override;
    property Input: TCustomInput read FInput;
  end;
 
  {  TCustomInput  }
 
  TDXInputState = (isUp, isDown, isLeft, isRight, isButton1, isButton2, isButton3,
    isButton4, isButton5, isButton6, isButton7, isButton8, isButton9, isButton10, isButton11,
    isButton12, isButton13, isButton14, isButton15, isButton16, isButton17, isButton18,
    isButton19, isButton20, isButton21, isButton22, isButton23, isButton24, isButton25,
    isButton26, isButton27, isButton28, isButton29, isButton30, isButton31, isButton32);
 
  TDXInputStates = set of TDXInputState;
 
  TCustomDXInput = class;
 
  TCustomInput = class(TPersistent)
  private          
    FBindInputStates: Boolean;
    FButtonCount: Integer;
    FDataFormat: TDIDataFormat;
    FDataFormatObjects: array[0..255] of TDIObjectDataFormat;
    FDataFormatGUIDs: array[0..255] of TGUID;
    FDevice: IDirectInputDevice;
    FDevice2: IDirectInputDevice2;
    FDXInput: TCustomDXInput;
    FEffects: TForceFeedbackEffects;
    FEnabled: Boolean;
    FForceFeedback: Boolean;
    FForceFeedbackDevice: Boolean;
    FInitialized: Boolean;
    FStates: TDXInputStates;
    procedure Acquire;
    procedure Finalize; virtual;
    procedure Initialize; virtual;
    function GetButton(Index: Integer): Boolean;
    function GetCooperativeLevel: Integer; virtual;
    function GetDeviceState(dwSize: Integer; var Data): Boolean;
    function SetDataFormat: Boolean;
    procedure SetEffects(Value: TForceFeedbackEffects);
    procedure SetEnabled(Value: Boolean);
    procedure SetForceFeedback(Value: Boolean);
    procedure SetWindowHandle(Value: Integer);
  public
    constructor Create(DXInput: TCustomDXInput); virtual;
    destructor Destroy; override;
    procedure Update; virtual; abstract;
    property ButtonCount: Integer read FButtonCount;
    property Buttons[Index: Integer]: Boolean read GetButton;
    property States: TDXInputStates read FStates;
  published
    property BindInputStates: Boolean read FBindInputStates write FBindInputStates;
    property Effects: TForceFeedbackEffects read FEffects write SetEffects;
    property Enabled: Boolean read FEnabled write SetEnabled;
    property ForceFeedback: Boolean read FForceFeedback write SetForceFeedback;
  end;
 
  {  TKeyboard  }
 
  PKeyAssign = ^TKeyAssign;
  TKeyAssign = array[0..2] of Integer;
 
  TKeyAssignList = array[TDXInputState] of TKeyAssign;
 
  TKeyboard = class(TCustomInput)
  private
    FKeyStates: TKeyboardState;
    procedure Finalize; override;
    procedure Initialize; override;
    function GetKey(Key: Integer): Boolean;
    procedure ReadAssigns(Stream: TStream);
    procedure WriteAssigns(Stream: TStream);
  protected
    procedure DefineProperties(Filer: TFiler); override;
  public
    KeyAssigns: TKeyAssignList;
    constructor Create(DXInput: TCustomDXInput); override;
    procedure Update; override;
    property Keys[Key: Integer]: Boolean read GetKey;
  end;
 
  {  TMouse  }
 
  TMouse = class(TCustomInput)
  private  
    Fdims: TDIMouseState;
    procedure Finalize; override;
    procedure Initialize; override;
    function GetX: Integer;
    function GetY: Integer;
    function GetZ: Integer;
  public
    constructor Create(DXInput: TCustomDXInput); override;
    procedure Update; override;
    property X: Integer read GetX;
    property Y: Integer read GetY;
    property Z: Integer read GetZ;
  end;
 
  {  TJoystick  }
 
  TJoystick = class(TCustomInput)
  private
    Fdijs: TDIJoyState2;
    FAutoCenter: Boolean;
    FDeviceGUID: TGUID;
    FEnumFlag: Boolean;
    FEnumIndex: Integer;
    FID: Integer;
    FID2: Integer;
    FJoyCaps: TJoyCaps;
    FDeadZone: array[0..SizeOf(TDIJoyState2)-1] of Integer;
    FRange: array[0..SizeOf(TDIJoyState2)-1] of Integer;
    procedure Finalize; override;
    procedure Initialize; override;
    function GetCooperativeLevel: Integer; override;
    function GetDeadZone(Obj: Integer): Integer;
    function GetRange(Obj: Integer): Integer;
    function GetX: Integer;
    function GetY: Integer;
    function GetZ: Integer;
    procedure SetDeadZone(Obj: Integer; Value: Integer);
    procedure SetRange(Obj: Integer; Value: Integer);
    procedure SetAutoCenter(Value: Boolean);
    procedure SetID(Value: Integer);
  public
    constructor Create(DXInput: TCustomDXInput); override;
    procedure Update; override;
    property DeadZone[Obj: Integer]: Integer read GetDeadZone write SetDeadZone;
    property Range[Obj: Integer]: Integer read GetRange write SetRange;
    property Joystate: TDIJoyState2 read Fdijs;
    property X: Integer read GetX;
    property Y: Integer read GetY;
    property Z: Integer read GetZ;
  published
    property AutoCenter: Boolean read FAutoCenter write SetAutoCenter;
    property DeadZoneX: Integer index DIJOFS_X read GetDeadZone write SetDeadZone;
    property DeadZoneY: Integer index DIJOFS_Y read GetDeadZone write SetDeadZone;
    property DeadZoneZ: Integer index DIJOFS_Z read GetDeadZone write SetDeadZone;
    property ID: Integer read FID write SetID;
    property RangeX: Integer index DIJOFS_X read GetRange write SetRange;
    property RangeY: Integer index DIJOFS_Y read GetRange write SetRange;
    property RangeZ: Integer index DIJOFS_Z read GetRange write SetRange;
  end;
 
  {  TCustomDXInput  }
 
  TCustomDXInput = class(TComponent)
  private
    FActiveOnly: Boolean;
    FDevice: TList;
    FDInput: IDirectInput;
    FForm: TCustomForm;
    FJoystick: TJoystick;
    FKeyboard: TKeyboard;
    FMouse: TMouse;
    FOldStates: TDXInputStates;
    FStates: TDXInputStates;
    FSubClass: TControlSubClass;
    FUseDirectInput: Boolean;
    procedure Finalize;
    procedure Initialize;
    procedure FormWndProc(var Message: TMessage; DefWindowProc: TWndMethod);
    procedure SetActiveOnly(Value: Boolean);
    procedure SetJoystick(Value: TJoystick);
    procedure SetKeyboard(Value: TKeyboard);
    procedure SetMouse(Value: TMouse);
    procedure SetWindowHandle;
    procedure SetUseDirectInput(Value: Boolean);
  protected
    procedure Loaded; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Update;
    property ActiveOnly: Boolean read FActiveOnly write SetActiveOnly;
    property Joystick: TJoystick read FJoystick write SetJoystick;
    property Keyboard: TKeyboard read FKeyboard write SetKeyboard;
    property Mouse: TMouse read FMouse write SetMouse;
    property States: TDXInputStates read FStates write FStates;
    property UseDirectInput: Boolean read FUseDirectInput write SetUseDirectInput;
  end;
 
  {  TDXInput  }
 
  TDXInput = class(TCustomDXInput)
  published
    property ActiveOnly;
    property Joystick;
    property Keyboard;
    property Mouse;
    property UseDirectInput;
  end;
 
function DefKeyAssign: TKeyAssignList;
function DefKeyAssign2_1: TKeyAssignList;
function DefKeyAssign2_2: TKeyAssignList;
 
implementation
 
uses DXConsts;
 
procedure AssignKey(var KeyAssignList: TKeyAssignList; State: TDXInputState;
  const Keys: array of Integer);
var
  i, i2: Integer;
  KeyAssign: PKeyAssign;
begin
  KeyAssign := @KeyAssignList[State];
  FillChar(KeyAssign^, SizeOf(TKeyAssign), 0);
 
  i2 := 0;
  for i:=LOW(Keys) to HIGH(Keys) do
  begin
    if i2<3 then
      KeyAssign^[i2] := Keys[i]
    else
      Exit;
    Inc(i2);
  end;
end;
 
function DefKeyAssign: TKeyAssignList;
begin
  FillChar(Result, SizeOf(Result), 0);
 
  AssignKey(Result, isUp,      [Ord('K'), VK_UP, VK_NUMPAD8]);
  AssignKey(Result, isDown,    [Ord('J'), VK_DOWN, VK_NUMPAD2]);
  AssignKey(Result, isLeft,    [Ord('H'), VK_LEFT, VK_NUMPAD4]);
  AssignKey(Result, isRight,   [Ord('L'), VK_RIGHT, VK_NUMPAD6]);
  AssignKey(Result, isButton1, [Ord('Z'), VK_SPACE]);
  AssignKey(Result, isButton2, [Ord('X'), VK_RETURN]);
  AssignKey(Result, isButton9, [VK_F2]);
end;
 
function DefKeyAssign2_1: TKeyAssignList;
begin
  FillChar(Result, SizeOf(Result), 0);
 
  AssignKey(Result, isUp,      [Ord('K'), VK_UP, VK_NUMPAD8]);
  AssignKey(Result, isDown,    [Ord('J'), VK_DOWN, VK_NUMPAD2]);
  AssignKey(Result, isLeft,    [Ord('H'), VK_LEFT, VK_NUMPAD4]);
  AssignKey(Result, isRight,   [Ord('L'), VK_RIGHT, VK_NUMPAD6]);
  AssignKey(Result, isButton1, [VK_SPACE , VK_NUMPAD0]);
  AssignKey(Result, isButton2, [VK_RETURN, VK_NUMPAD5]);
  AssignKey(Result, isButton9, [VK_F2]);
end;
 
function DefKeyAssign2_2: TKeyAssignList;
begin
  FillChar(Result, SizeOf(Result), 0);
 
  AssignKey(Result, isUp,      [Ord('E')]);
  AssignKey(Result, isDown,    [Ord('C')]);
  AssignKey(Result, isLeft,    [Ord('S')]);
  AssignKey(Result, isRight,   [Ord('F')]);
  AssignKey(Result, isButton1, [Ord('Z')]);
  AssignKey(Result, isButton2, [Ord('X')]);
  AssignKey(Result, isButton9, [VK_F2]);
end;
 
{  TForceFeedbackEffectObject  }
 
destructor TForceFeedbackEffectObject.Destroy;
begin
  Release;                      
  inherited Destroy;
end;
 
function ConvertTime(i: Integer): DWORD;
begin
  if i=-1 then Result := INFINITE else Result := i*1000;
end;
 
procedure TForceFeedbackEffectObject.Clear;
begin
  FillChar(Feff, SizeOf(Feff), 0);
end;
 
procedure TForceFeedbackEffectObject.Init(Effect: TForceFeedbackEffect);
begin
  with FEnvelope do
  begin
    dwSize := SizeOf(FEnvelope);
 
    dwAttackLevel := Effect.FAttackLevel;
    if Effect.FTime<0 then
      dwAttackTime := Effect.FAttackTime*1000
    else
      dwAttackTime := Min(Effect.FAttackTime, Effect.FTime)*1000;
                                             
    if Effect.FTime<0 then
    begin
      dwFadeLevel := 0;
      dwFadeTime := 0;
    end else
    begin
      dwFadeLevel := Effect.FFadeLevel;
      dwFadeTime := Min(Effect.FFadeTime, Effect.FTime)*1000;
    end;
  end;
 
  FillChar(Feff, SizeOf(Feff), 0);
  with Feff do
  begin
    dwSize := SizeOf(Feff);
    dwFlags := DIEFF_CARTESIAN or DIEFF_OBJECTOFFSETS;
    dwDuration := ConvertTime(Effect.FTime);
    dwSamplePeriod := 0;
    dwGain := Effect.FPower;
    dwTriggerButton := DIEB_NOTRIGGER;
    dwTriggerRepeatInterval := 0;
    cAxes := FAxesCount;
    rgdwAxes := @FAxes;
    rglDirection := @FDirections;
    lpEnvelope := @FEnvelope;
    //dwStartDelay := Effect.FStartDelayTime;
  end;
end;
 
procedure TForceFeedbackEffectObject.Release;
begin
  FEffect := nil;
end;
 
{  TForceFeedbackEffect  }
 
constructor TForceFeedbackEffect.Create(AParent: TForceFeedbackEffect);
begin
  inherited Create;
  FParent := AParent;
  FList := TList.Create;
 
  if FParent<>nil then
  begin
    FParent.FList.Add(Self);
    FRoot := FParent.FRoot;
  end else
  begin
    FName := 'Effects';
    FRoot := Self as TForceFeedbackEffects;
  end;
 
  FObject := TForceFeedbackEffectObject.Create;
  FObject2 := TForceFeedbackEffectObject.Create;
 
  AttackTime := 0;
  Constant := Point(0, 0);
  EffectType := etNone;
  FadeTime := 0;
  Period := 50;
  Power := 10000;
  Time := 1000;
end;
 
destructor TForceFeedbackEffect.Destroy;
begin
  Clear;
  FObject.Free;
  FObject2.Free;
  FList.Free;
  if FParent<>nil then
    FParent.FList.Remove(Self);
  inherited Destroy;
end;
 
function TForceFeedbackEffect.GetOwner: TPersistent;
begin
  Result := Parent;
end;
 
procedure TForceFeedbackEffect.Assign(Source: TPersistent);
var
  i: Integer;
begin
  if Source is TForceFeedbackEffect then
  begin
    if Source<>Self then
    begin
      Clear;
 
      EffectType := etNone;
 
      Name := TForceFeedbackEffect(Source).Name;
 
      AttackLevel := TForceFeedbackEffect(Source).AttackLevel;
      AttackTime := TForceFeedbackEffect(Source).AttackTime;
      Constant := TForceFeedbackEffect(Source).Constant;
      Condition := TForceFeedbackEffect(Source).Condition;
      EffectType := TForceFeedbackEffect(Source).EffectType;
      FadeLevel := TForceFeedbackEffect(Source).FadeLevel;
      FadeTime := TForceFeedbackEffect(Source).FadeTime;
      Period := TForceFeedbackEffect(Source).Period;
      Power := TForceFeedbackEffect(Source).Power;
      Time := TForceFeedbackEffect(Source).Time;
      StartDelayTime := TForceFeedbackEffect(Source).StartDelayTime;
 
      EffectType := TForceFeedbackEffect(Source).EffectType;
 
      for i:=0 to TForceFeedbackEffect(Source).Count-1 do
        TForceFeedbackEffect.Create(Self).Assign(TForceFeedbackEffect(Source)[i]);
    end;
  end else
    inherited Assign(Source);
end;
 
procedure TForceFeedbackEffect.Acquire;
var
  i: Integer;
begin
  if Playing and (Time=-1) then
    Start;
 
  for i:=0 to Count-1 do
    Effects[i].Initialize;
end;
 
procedure TForceFeedbackEffect.Clear;
begin
  while Count>0 do
    Effects[Count-1].Free;
end;
 
procedure TForceFeedbackEffect.Initialize;
var
  i: Integer;
begin
  CreateEffect;
  for i:=0 to Count-1 do
    Effects[i].Initialize;
end;
 
procedure TForceFeedbackEffect.Finalize;
var
  i: Integer;
begin
  try
    Stop;
    FObject.Release;
    FObject2.Release;
  finally
    for i:=0 to Count-1 do
      Effects[i].Finalize;
  end;
end;
 
function TForceFeedbackEffect.Find(const Name: string): TForceFeedbackEffect;
var
  i, p: Integer;
  Effect: TForceFeedbackEffect;
  AName: string;
begin
  AName := Name;
  Effect := Self;
 
  p := AnsiPos('.', AName);
  while p<>0 do
  begin
    i := Effect.IndexOf(AName);
    if i<>-1 then
    begin
      Result := Effect[i];
      Exit;
    end else
    begin
      i := Effect.IndexOf(Copy(Name, 1, p-1));
      if i=-1 then
        raise EForceFeedbackEffectError.CreateFmt(SEffectNotFound, [Name]);
      Effect := Effect[i];
      AName := Copy(Name, p+1, MaxInt);
      p := AnsiPos('.', AName);
    end;
  end;
 
  i := Effect.IndexOf(Name);
  if i=-1 then
    raise EForceFeedbackEffectError.CreateFmt(SEffectNotFound, [Name]);
  Result := Effect[i];
end;
 
function TForceFeedbackEffect.IndexOf(const Name: string): Integer;
var
  i: Integer;
begin
  Result := -1;
  for i:=0 to Count-1 do
    if Effects[i].Name=Name then
    begin
      Result := i;
      Break;
    end;
end;
 
function TForceFeedbackEffect.HasInterface: Boolean;
begin
  Result := (FEffectType<>etNone) and ((FObject.FEffect<>nil) or (FObject2.FEffect<>nil));
end;
 
procedure TForceFeedbackEffect.MakeEff;
var
  Constant2: TPoint;
begin
  FObject.Clear;
  FObject2.Clear;
 
  with Constant2 do
  begin
    X := -FConstant.X;
    Y := -FConstant.Y;
  end;
 
  case FEffectType of
    etConstantForce:  { etConstantForce }
        begin
          with FObject do
          begin
            FDirections[0] := Constant2.X;
            FDirections[1] := Constant2.Y;
 
            FAxesCount := 2;
            FAxes[0] := DIJOFS_X;
            FAxes[1] := DIJOFS_Y;
 
            with Constant2 do
              FConstantForce.lMagnitude := Trunc(Sqrt(X*X+Y*Y));
 
            Init(Self);
            with Feff do
            begin
              cbTypeSpecificParams := SizeOf(FConstantForce);
              lpvTypeSpecificParams := @FConstantForce;
            end;
          end;
        end;
    etPeriodic:       { etPeriodic }
        begin
          with FObject do
          begin
            FDirections[0] := Constant2.X;
            FDirections[1] := Constant2.Y;
 
            FAxesCount := 2;
            FAxes[0] := DIJOFS_X;
            FAxes[1] := DIJOFS_Y;
 
            with FPeriodic do
            begin
              with Constant2 do
                dwMagnitude := Trunc(Sqrt(X*X+Y*Y));
              lOffset := 0;
              dwPhase := 0;
              dwPeriod := ConvertTime(FPeriod);
            end;
 
            Init(Self);
            with Feff do
            begin
              cbTypeSpecificParams := SizeOf(FPeriodic);
              lpvTypeSpecificParams := @FPeriodic;
            end;
          end;
        end;
    etCondition:      { etCondition }
        begin
          with FObject do
          begin
            FillChar(FDirections, SizeOf(FDirections), 0);
 
            FAxesCount := 1;
            FAxes[0] := DIJOFS_X;
                   
            with FCondition do
            begin
              lOffset := -Constant2.X;
              lPositiveCoefficient := Self.FCondition.X;
              lNegativeCoefficient := -Self.FCondition.X;
              dwPositiveSaturation := 0;
              dwNegativeSaturation := 0;
              lDeadBand := 0;
            end;
 
            Init(Self);
            with Feff do
            begin
              cbTypeSpecificParams := SizeOf(FCondition);
              lpvTypeSpecificParams := @FCondition;
            end;
          end;
 
          with FObject2 do
          begin
            FillChar(FDirections, SizeOf(FDirections), 0);
 
            FAxesCount := 1;
            FAxes[0] := DIJOFS_Y;
 
            with FCondition do
            begin
              lOffset := -Constant2.Y;
              lPositiveCoefficient := Self.FCondition.Y;
              lNegativeCoefficient := -Self.FCondition.Y;
              dwPositiveSaturation := 0;
              dwNegativeSaturation := 0;
              lDeadBand := 0;
            end;
 
            Init(Self);
            with Feff do
            begin
              cbTypeSpecificParams := SizeOf(FCondition);
              lpvTypeSpecificParams := @FCondition;
            end;
          end;
        end;
  end;
end;
 
procedure TForceFeedbackEffect.CreateEffect;
                                           
  function FindEffectCallBack(const pdei: TDIEffectInfoA;
    pvRef: Pointer): HRESULT; stdcall;
  begin
    with TForceFeedbackEffect(pvRef) do
    begin
      FFindEffectFlag := True;
      FFindEffectGUID := pdei.guid;
    end;
 
    Result := Integer(DIENUM_STOP);
  end;
 
  procedure CreateIEffectGuid(const GUID: TGUID;
    EffectObject: TForceFeedbackEffectObject);
  begin
    if EffectObject.Feff.dwSize=0 then Exit;
 
    if FRoot.FInput.FDevice2<>nil then
      FRoot.FInput.FDevice2.CreateEffect(GUID, @EffectObject.Feff, EffectObject.FEffect, nil);
  end;
 
  procedure CreateIEffect(dwFlags: DWORD;
    EffectObject: TForceFeedbackEffectObject);
  begin
    if EffectObject.Feff.dwSize=0 then Exit;
 
    if FRoot.FInput.FDevice2<>nil then
    begin
      FFindEffectFlag := False;
      FRoot.FInput.FDevice2.EnumEffects(@FindEffectCallBack,
        Self, dwFlags);
      if FFindEffectFlag then
        CreateIEffectGuid(FFindEffectGUID, EffectObject);
    end;
  end;
 
begin
  FObject.Release;
  FObject2.Release;
 
  if (FRoot.FInput=nil) or (FRoot.FInput.FDevice2=nil) or
    (not FRoot.FInput.FForceFeedbackDevice) or
    (not FRoot.FInput.FForceFeedback) then Exit;
 
  if FEffectType=etNone then Exit;
 
  MakeEff;
  case FEffectType of
    etConstantForce:
        begin
          CreateIEffectGUID(GUID_ConstantForce, FObject);
        end;
    etPeriodic:
        begin
          CreateIEffect(DIEFT_PERIODIC, FObject);
        end;
    etCondition:
        begin
          CreateIEffect(DIEFT_CONDITION, FObject);
          CreateIEffect(DIEFT_CONDITION, FObject2);
        end;
  end;
 
  if Playing and (Time=-1) then
    Start;
end;
 
procedure TForceFeedbackEffect.ChangeEffect;
var
  dwFlags: DWORD;
begin
  if HasInterface then
  begin
    MakeEff;
 
    dwFlags := DIEP_DIRECTION or DIEP_DURATION or DIEP_ENVELOPE or
      DIEP_GAIN or DIEP_SAMPLEPERIOD or DIEP_TRIGGERBUTTON or
      DIEP_TRIGGERREPEATINTERVAL or DIEP_TYPESPECIFICPARAMS;
 
    if Playing then
      dwFlags := dwFlags or DIEP_START;
 
    if FObject.FEffect<>nil then FObject.FEffect.SetParameters(FObject.Feff, dwFlags);
    if FObject2.FEffect<>nil then FObject2.FEffect.SetParameters(FObject2.Feff, dwFlags);
  end;
end;
 
function TForceFeedbackEffect.GetPlaying: Boolean;
var
  dwFlags: DWORD;
begin
  Result := False;
 
  if not FPlaying then Exit;
 
  if FPlaying and (FTime=-1) then
  begin
    Result := True;
    Exit;
  end;
 
  if FObject.FEffect<>nil then
  begin
    dwFlags := 0;
    FObject.FEffect.GetEffectStatus(dwFlags);
    if dwFlags and DIEGES_PLAYING<>0 then
    begin
      Result := True;
      Exit;
    end;
  end;
 
  if FObject2.FEffect<>nil then
  begin
    dwFlags := 0;
    FObject2.FEffect.GetEffectStatus(dwFlags);
    if dwFlags and DIEGES_PLAYING<>0 then
    begin
      Result := True;
      Exit;
    end;
  end;
 
  if not Result then
    FPlaying := False;
end;
 
function TForceFeedbackEffect.GetCount: Integer;
begin
  Result := FList.Count;
end;
 
function TForceFeedbackEffect.GetEffect(Index: Integer): TForceFeedbackEffect;
begin
  Result :=FList[Index];
end;
 
function TForceFeedbackEffect.GetIndex: Integer;
begin
  if FParent<>nil then
    Result := FParent.FList.IndexOf(Self)
  else
    Result := 0;
end;
 
procedure TForceFeedbackEffect.SetIndex(Value: Integer);
begin
  if FParent<>nil then
  begin
    FParent.FList.Remove(Self);
    FParent.FList.Insert(Value, Self);
  end;
end;
 
procedure TForceFeedbackEffect.SetParent(Value: TForceFeedbackEffect);
begin
  if Parent<>Value then
  begin
    if (Value=nil) or (FRoot<>Value.FRoot) then
      raise EForceFeedbackEffectError.CreateFmt(SCannotChanged, ['Parent']);
 
    FParent.FList.Remove(Self);
    FParent := Value;
    FParent.FList.Add(Self);
  end;
end;
 
procedure TForceFeedbackEffect.SetAttackLevel(Value: Integer);
begin
  if Value<0 then Value := 0;
  if Value>10000 then Value := 10000;
 
  if FAttackLevel<>Value then
  begin
    FAttackLevel := Value;
    ChangeEffect;
  end;
end;
 
procedure TForceFeedbackEffect.SetAttackTime(Value: Integer);
begin
  if Value<0 then Value := 0;
 
  if FAttackTime<>Value then
  begin
    FAttackTime := Value;
    ChangeEffect;
  end;
end;
 
procedure TForceFeedbackEffect.SetCondition(Value: TPoint);
begin
  with Value do
  begin
    if X<-10000 then X := -10000;
    if X>+10000 then X := +10000;
 
    if Y<-10000 then Y := -10000;
    if Y>+10000 then Y := +10000;
  end;
 
  if not CompareMem(@FCondition, @Value, SizeOf(FCondition)) then
  begin
    FCondition := Value;
 
    if HasInterface then
      ChangeEffect;
  end;
end;
 
procedure TForceFeedbackEffect.SetConstant(Value: TPoint);
begin
  with Value do
  begin
    if X<-10000 then X := -10000;
    if X>+10000 then X := +10000;
 
    if Y<-10000 then Y := -10000;
    if Y>+10000 then Y := +10000;
  end;
 
  if not CompareMem(@FConstant, @Value, SizeOf(FConstant)) then
  begin
    FConstant := Value;
 
    if HasInterface then
      ChangeEffect;
  end;
end;
 
procedure TForceFeedbackEffect.SetEffectType(Value: TForceFeedbackEffectType);
begin
  if FEffectType<>Value then
  begin
    FEffectType := Value;
    Stop;
    CreateEffect;
  end;
end;
 
procedure TForceFeedbackEffect.SetFadeLevel(Value: Integer);
begin
  if Value<0 then Value := 0;
  if Value>10000 then Value := 10000;
 
  if FFadeLevel<>Value then
  begin
    FFadeLevel := Value;
    ChangeEffect;
  end;
end;
 
procedure TForceFeedbackEffect.SetFadeTime(Value: Integer);
begin
  if Value<0 then Value := 0;
 
  if FFadeTime<>Value then
  begin
    FFadeTime := Value;
    ChangeEffect;
  end;
end;
 
procedure TForceFeedbackEffect.SetPeriod(Value: Integer);
begin
  if Value<0 then Value := 0;
 
  if FPeriod<>Value then
  begin
    FPeriod := Value;
    ChangeEffect;
  end;
end;
 
procedure TForceFeedbackEffect.SetPower(Value: Integer);
begin
  if Value<0 then Value := 0;
  if Value>10000 then Value := 10000;
 
  if FPower<>Value then
  begin
    FPower := Value;
    ChangeEffect;
  end;
end;
 
procedure TForceFeedbackEffect.SetTime(Value: Integer);
begin
  if (Value<>-1) and (Value<0) then Value := 0;
 
  if FTime<>Value then
  begin
    FTime := Value;
    Stop;
    ChangeEffect;
  end;
end;
 
procedure TForceFeedbackEffect.SetStartDelayTime(Value: Integer);
begin
  if Value<0 then Value := 0;
 
  if FStartDelayTime<>Value then
  begin
    FStartDelayTime := Value;
    Stop;
    ChangeEffect;
  end;
end;
 
procedure TForceFeedbackEffect.Start;
 
  procedure StartEffect(Effect: IDirectInputEffect);
  var
    hr: HRESULT;
  begin
    if Effect<>nil then
    begin
      hr := Effect.Start(1, 0);
      if (hr=DIERR_INPUTLOST) or (hr=DIERR_NOTACQUIRED) then
      begin
        FRoot.FInput.Acquire;
        Effect.Start(1, 0);
      end;
    end;
  end;
 
var
  i: Integer;
begin
  for i:=0 to Count-1 do
    Effects[i].Start;
 
  if not HasInterface then
  begin
    CreateEffect;
    if not HasInterface then Exit;
  end;
 
  StartEffect(FObject.FEffect);
  StartEffect(FObject2.FEffect);
 
  FPlaying := True;
end;
 
procedure TForceFeedbackEffect.Stop;
var
  i: Integer;
begin
  if Playing then
  begin
    FPlaying := False;
    if FObject.FEffect<>nil then FObject.FEffect.Stop;
    if FObject2.FEffect<>nil then FObject2.FEffect.Stop;
  end;
 
  for i:=0 to Count-1 do
    Effects[i].Stop;
end;
 
procedure TForceFeedbackEffect.Unload(Recurse: Boolean);
var
  i: Integer;
begin
  if Playing then
  begin
    if FObject.FEffect<>nil then FObject.FEffect.Stop;
    if FObject2.FEffect<>nil then FObject2.FEffect.Stop;
  end;
 
  if FObject.FEffect<>nil then FObject.FEffect.Unload;
  if FObject2.FEffect<>nil then FObject2.FEffect.Unload;
 
  if Recurse then
  begin
    for i:=0 to Count-1 do
      Effects[i].Unload(True);
  end;
end;
 
type
  TForceFeedbackEffectItem = class(TCollectionItem)
  private
    FName: string;
    FEffectType: TForceFeedbackEffectType;
    FAttackLevel: Integer;
    FAttackTime: Integer;
    FConditionX: Integer;
    FConditionY: Integer;
    FConstantX: Integer;
    FConstantY: Integer;
    FFadeLevel: Integer;
    FFadeTime: Integer;
    FPeriod: Integer;
    FPower: Integer;
    FTime: Integer;
    FStartDelayTime: Integer;
    FEffects: TCollection;
    function GetStoredEffects: Boolean;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    procedure AssignTo(Dest: TPersistent); override;
  published
    property Name: string read FName write FName;
    property EffectType: TForceFeedbackEffectType read FEffectType write FEffectType;
    property AttackLevel: Integer read FAttackLevel write FAttackLevel default 0;
    property AttackTime: Integer read FAttackTime write FAttackTime default 0;
    property ConditionX: Integer read FConditionX write FConditionX default 0;
    property ConditionY: Integer read FConditionY write FConditionY default 0;
    property ConstantX: Integer read FConstantX write FConstantX default 0;
    property ConstantY: Integer read FConstantY write FConstantY default 0;
    property FadeLevel: Integer read FFadeLevel write FFadeLevel default 0;
    property FadeTime: Integer read FFadeTime write FFadeTime default 0;
    property Period: Integer read FPeriod write FPeriod;
    property Power: Integer read FPower write FPower;
    property Time: Integer read FTime write FTime;
    property StartDelayTime: Integer read FStartDelayTime write FStartDelayTime;
    property Effects: TCollection read FEffects write FEffects stored GetStoredEffects;
  end;
 
  TForceFeedbackEffectComponent = class(TComponent)
  private
    FEffects: TCollection;
  published
    property Effects: TCollection read FEffects write FEffects;
  end;
 
constructor TForceFeedbackEffectItem.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FEffects := TCollection.Create(TForceFeedbackEffectItem);
end;
 
destructor TForceFeedbackEffectItem.Destroy;
begin
  FEffects.Free;
  inherited Destroy;
end;
 
procedure TForceFeedbackEffectItem.Assign(Source: TPersistent);
var
  Effect: TForceFeedbackEffect;
  i: Integer;
begin
  Effect := Source as TForceFeedbackEffect;
 
  FName := Effect.Name;
  FEffectType := Effect.EffectType;
  FAttackLevel := Effect.AttackLevel;
  FAttackTime := Effect.AttackTime;
  FConditionX := Effect.Condition.X;
  FConditionY := Effect.Condition.Y;
  FConstantX := Effect.Constant.X;
  FConstantY := Effect.Constant.Y;
  FFadeLevel := Effect.FadeLevel;
  FFadeTime := Effect.FadeTime;
  FPeriod := Effect.Period;
  FPower := Effect.Power;
  FTime := Effect.Time;
  FStartDelayTime := Effect.StartDelayTime;
 
  for i:=0 to Effect.Count-1 do
    TForceFeedbackEffectItem.Create(FEffects).Assign(Effect[i]);
end;
 
procedure TForceFeedbackEffectItem.AssignTo(Dest: TPersistent);
var
  Effect: TForceFeedbackEffect;
  i: Integer;
begin
  Effect := Dest as TForceFeedbackEffect;
 
  Effect.EffectType := etNone;
 
  Effect.Name := FName;
  Effect.AttackLevel := FAttackLevel;
  Effect.AttackTime := FAttackTime;
  Effect.Condition := Point(FConditionX, FConditionY);
  Effect.Constant := Point(FConstantX, FConstantY);
  Effect.FadeLevel := FFadeLevel;
  Effect.FadeTime := FFadeTime;
  Effect.Period := FPeriod;
  Effect.Power := FPower;
  Effect.Time := FTime;
  Effect.StartDelayTime := FStartDelayTime;
 
  Effect.EffectType := FEffectType;
 
  for i:=0 to FEffects.Count-1 do
    TForceFeedbackEffectItem(FEffects.Items[i]).AssignTo(TForceFeedbackEffect.Create(Effect));
end;
 
function TForceFeedbackEffectItem.GetStoredEffects: Boolean;
begin
  Result := FEffects.Count>0;
end;
 
procedure TForceFeedbackEffect.LoadFromFile(const FileName: string);
var
  Stream: TFileStream;
begin
  Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
  try
    LoadFromStream(Stream);
  finally
    Stream.Free;
  end;
end;
 
procedure TForceFeedbackEffect.LoadFromStream(Stream: TStream);
var
  Component: TForceFeedbackEffectComponent;
begin
  Clear;
 
  Component := TForceFeedbackEffectComponent(FRoot.FComponent);
  try
    Component.FEffects := TCollection.Create(TForceFeedbackEffectItem);
    Stream.ReadComponentRes(Component);
    TForceFeedbackEffectItem(Component.FEffects.Items[0]).AssignTo(Self);
  finally
    Component.FEffects.Free;
    Component.FEffects := nil;
  end;
end;
 
procedure TForceFeedbackEffect.SaveToFile(const FileName: string);
var
  Stream: TFileStream;
begin
  Stream := TFileStream.Create(FileName, fmCreate);
  try
    SaveToStream(Stream);
  finally
    Stream.Free;
  end;
end;
 
procedure TForceFeedbackEffect.SaveToStream(Stream: TStream);
var
  Component: TForceFeedbackEffectComponent;
begin
  Component := TForceFeedbackEffectComponent(FRoot.FComponent);
  try
    Component.FEffects := TCollection.Create(TForceFeedbackEffectItem);
    TForceFeedbackEffectItem.Create(Component.FEffects).Assign(Self);
    Stream.WriteComponentRes('DelphiXForceFeedbackEffect', Component);
  finally
    Component.FEffects.Free;
    Component.FEffects := nil;
  end;
end;
 
{  TForceFeedbackEffects  }
 
constructor TForceFeedbackEffects.Create(Input: TCustomInput);
begin
  inherited Create(nil);
  FInput := Input;
  FComponent := TForceFeedbackEffectComponent.Create(nil);
end;
 
destructor TForceFeedbackEffects.Destroy;
begin
  FComponent.Free;
  inherited Destroy;
end;
 
procedure TForceFeedbackEffects.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
  Filer.DefineBinaryProperty('Effects', LoadFromStream, SaveToStream, True);
end;
 
{  TCustomInput  }
 
constructor TCustomInput.Create(DXInput: TCustomDXInput);
begin
  inherited Create;
  FDXInput := DXInput;
  FDXInput.FDevice.Add(Self);
  FEffects := TForceFeedbackEffects.Create(Self);
  FEnabled := True;
  FBindInputStates := True;
end;
 
destructor TCustomInput.Destroy;
begin
  Finalize;
  FEffects.Free;
  FDXInput.FDevice.Remove(Self);
  inherited Destroy;
end;
 
procedure TCustomInput.Acquire;
begin
  if FDXInput.FActiveOnly and (GetForegroundWindow<>FDXInput.FForm.Handle) then
    Exit;
 
  if FDevice<>nil then
    FDevice.Acquire;
 
  FEffects.Acquire;
end;
 
procedure TCustomInput.Finalize;
begin
  if FDevice<>nil then FDevice.Unacquire;
  FInitialized := False;
  FButtonCount := 0;
  FEffects.Finalize;
  FDevice := nil;
  FDevice2 := nil;
  FForceFeedbackDevice := False;
  FStates := [];
end;
 
procedure TCustomInput.Initialize;
begin
  FInitialized := True;
  FEffects.Initialize;
end;
 
function TCustomInput.GetButton(Index: Integer): Boolean;
begin
  if Index in [0..31] then
    Result := TDXInputState(Integer(isButton1)+Index) in FStates
  else
    Result := False;
end;
 
function TCustomInput.GetCooperativeLevel: Integer;
const
  Levels: array[Boolean] of Integer = (DISCL_NONEXCLUSIVE, DISCL_EXCLUSIVE);
  Levels2: array[Boolean] of Integer = (DISCL_BACKGROUND, DISCL_FOREGROUND);
begin
  Result := Levels[FForceFeedbackDevice and FForceFeedback] or Levels2[FDXInput.ActiveOnly];
end;
 
function TCustomInput.GetDeviceState(dwSize: Integer; var Data): Boolean;
var
  hr: HRESULT;
begin
  FillChar(Data, dwSize, 0);
 
  if FDevice<>nil then
  begin
    hr := FDevice.GetDeviceState(dwSize, @Data);
    if (hr=DIERR_INPUTLOST) or (hr=DIERR_NOTACQUIRED) then
    begin
      FDevice.Acquire;
      hr := FDevice.GetDeviceState(dwSize, @Data);
    end;
    Result := hr=DI_OK;
  end else
    Result := False;
end;
 
function TCustomInput.SetDataFormat: Boolean;
 
  function DIEnumDeviceObjectsProc(const peff: TDIDeviceObjectInstanceA;
    pvRef: Pointer): HRESULT; stdcall;
  begin
    Result := Integer(DIENUM_CONTINUE);
 
    if CompareMem(@peff.guidType, @GUID_Unknown, SizeOf(TGUID)) then Exit;
 
    with TCustomInput(pvRef) do
    begin
      if peff.dwOfs<FDataFormat.dwDataSize then
      begin
        FDataFormatGUIDs[FDataFormat.dwNumObjs] := peff.guidType;
 
        with FDataFormatObjects[FDataFormat.dwNumObjs] do
        begin
          pguid := @FDataFormatGUIDs[FDataFormat.dwNumObjs];
          dwOfs := peff.dwOfs;
          dwType := peff.dwType;
          dwFlags := 0;
        end;
        Inc(FDataFormat.dwNumObjs);
      end;
    end;
  end;
 
begin
  Result := False;
  if FDevice<>nil then
  begin
    with FDataFormat do
    begin
      dwSize := SizeOf(FDataFormat);
      dwObjSize := SizeOf(TDIObjectDataFormat);
      dwNumObjs := 0;
      rgodf := @FDataFormatObjects;
    end;
 
    FDevice.EnumObjects(@DIEnumDeviceObjectsProc, Self, DIDFT_ALL);
    if FDevice.SetDataFormat(FDataFormat)<>DI_OK then Exit;
  end;
  Result := True;
end;
 
procedure TCustomInput.SetEffects(Value: TForceFeedbackEffects);
begin
  FEffects.Assign(Value);
end;
 
procedure TCustomInput.SetEnabled(Value: Boolean);
begin
  if FEnabled<>Value then
  begin
    FEnabled := Value;
    if FDXInput.ComponentState*[csLoading, csReading]=[] then
      Initialize;
  end;
end;
 
procedure TCustomInput.SetForceFeedback(Value: Boolean);
begin
  if FForceFeedback<>Value then
  begin
    FForceFeedback := Value;
    if FDXInput.ComponentState*[csLoading, csReading]=[] then
      Initialize;
  end;
end;
 
procedure TCustomInput.SetWindowHandle(Value: Integer);
begin
  if FDevice<>nil then
    FDevice.SetCooperativeLevel(Value, GetCooperativeLevel);
end;
 
{  TKeyboard  }
 
constructor TKeyboard.Create(DXInput: TCustomDXInput);
begin
  inherited Create(DXInput);
  KeyAssigns := DefKeyAssign;
end;
 
procedure TKeyboard.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
  Filer.DefineBinaryProperty('Aissgns', ReadAssigns, WriteAssigns, False);
  Filer.DefineBinaryProperty('Assigns', ReadAssigns, WriteAssigns, True);
end;
 
function TKeyboard.GetKey(Key: Integer): Boolean;
begin
  if Key in [1..255] then
    Result := FKeyStates[Key] and $80<>0
  else
    Result := False;
end;
 
procedure TKeyboard.Finalize;
begin
  FillChar(FKeyStates, SizeOf(FKeyStates), 0);
  inherited Finalize;
end;
 
procedure TKeyboard.Initialize;
begin
  Finalize;
 
  if (not FEnabled) or (csDesigning in FDXInput.ComponentState) then Exit;
 
  if FDXInput.FDInput<>nil then
  begin
    if FDXInput.FDInput.CreateDevice(GUID_SysKeyboard, FDevice, nil)<>DI_OK then Exit;
    FDevice.SetDataFormat(c_dfDIKeyboard);
  end;
 
  FButtonCount := 32;
 
  inherited Initialize;
end;
 
procedure TKeyboard.Update;
 
  function DIKEYtoVK(Key: Byte): Integer;
  begin
    Result := 0;
    case Key of
      DIK_ESCAPE       : Result := VK_ESCAPE;
      DIK_1            : Result := Ord('1');
      DIK_2            : Result := Ord('2');
      DIK_3            : Result := Ord('3');
      DIK_4            : Result := Ord('4');
      DIK_5            : Result := Ord('5');
      DIK_6            : Result := Ord('6');
      DIK_7            : Result := Ord('7');
      DIK_8            : Result := Ord('8');
      DIK_9            : Result := Ord('9');
      DIK_0            : Result := Ord('0');
      DIK_EQUALS       : Result := Ord('=');
      DIK_BACK         : Result := VK_BACK;
      DIK_TAB          : Result := VK_TAB;
      DIK_Q            : Result := Ord('Q');
      DIK_W            : Result := Ord('W');
      DIK_E            : Result := Ord('E');
      DIK_R            : Result := Ord('R');
      DIK_T            : Result := Ord('T');
      DIK_Y            : Result := Ord('Y');
      DIK_U            : Result := Ord('U');
      DIK_I            : Result := Ord('I');
      DIK_O            : Result := Ord('O');
      DIK_P            : Result := Ord('P');
      DIK_LBRACKET     : Result := Ord('[');
      DIK_RBRACKET     : Result := Ord(']');
      DIK_RETURN       : Result := VK_RETURN;
      DIK_LCONTROL     : Result := VK_CONTROL;
      DIK_A            : Result := Ord('A');
      DIK_S            : Result := Ord('S');
      DIK_D            : Result := Ord('D');
      DIK_F            : Result := Ord('F');
      DIK_G            : Result := Ord('G');
      DIK_H            : Result := Ord('H');
      DIK_J            : Result := Ord('J');
      DIK_K            : Result := Ord('K');
      DIK_L            : Result := Ord('L');
      DIK_SEMICOLON    : Result := Ord(';');
      DIK_APOSTROPHE   : Result := Ord('''');
      DIK_LSHIFT       : Result := VK_SHIFT;
      DIK_BACKSLASH    : Result := Ord('\');
      DIK_Z            : Result := Ord('Z');
      DIK_X            : Result := Ord('X');
      DIK_C            : Result := Ord('C');
      DIK_V            : Result := Ord('V');
      DIK_B            : Result := Ord('B');
      DIK_N            : Result := Ord('N');
      DIK_M            : Result := Ord('M');
      DIK_COMMA        : Result := Ord(',');
      DIK_PERIOD       : Result := Ord('.');
      DIK_SLASH        : Result := Ord('/');
      DIK_RSHIFT       : Result := VK_SHIFT;
      DIK_MULTIPLY     : Result := Ord('*');
      DIK_LMENU        : Result := VK_MENU;
      DIK_SPACE        : Result := VK_SPACE;
      DIK_CAPITAL      : Result := VK_CAPITAL;
      DIK_F1           : Result := VK_F1;
      DIK_F2           : Result := VK_F2;
      DIK_F3           : Result := VK_F3;
      DIK_F4           : Result := VK_F4;
      DIK_F5           : Result := VK_F5;
      DIK_F6           : Result := VK_F6;
      DIK_F7           : Result := VK_F7;
      DIK_F8           : Result := VK_F8;
      DIK_F9           : Result := VK_F9;
      DIK_F10          : Result := VK_F10;
      DIK_NUMLOCK      : Result := VK_NUMLOCK;
      DIK_SCROLL       : Result := VK_SCROLL;
      DIK_NUMPAD7      : Result := VK_NUMPAD7;
      DIK_NUMPAD8      : Result := VK_NUMPAD8;
      DIK_NUMPAD9      : Result := VK_NUMPAD9;
      DIK_SUBTRACT     : Result := VK_SUBTRACT;
      DIK_NUMPAD4      : Result := VK_NUMPAD4;
      DIK_NUMPAD5      : Result := VK_NUMPAD5;
      DIK_NUMPAD6      : Result := VK_NUMPAD6;
      DIK_ADD          : Result := VK_ADD;
      DIK_NUMPAD1      : Result := VK_NUMPAD1;
      DIK_NUMPAD2      : Result := VK_NUMPAD2;
      DIK_NUMPAD3      : Result := VK_NUMPAD3;
      DIK_NUMPAD0      : Result := VK_NUMPAD0;
      DIK_DECIMAL      : Result := VK_DECIMAL;
      DIK_F11          : Result := VK_F11;
      DIK_F12          : Result := VK_F12;
      DIK_NUMPADENTER  : Result := VK_RETURN;
      DIK_RCONTROL     : Result := VK_CONTROL;
      DIK_DIVIDE       : Result := VK_DIVIDE;
      DIK_RMENU        : Result := VK_MENU;
      DIK_HOME         : Result := VK_HOME;
      DIK_UP           : Result := VK_UP;
      DIK_PRIOR        : Result := VK_PRIOR;
      DIK_LEFT         : Result := VK_LEFT;
      DIK_RIGHT        : Result := VK_RIGHT;
      DIK_END          : Result := VK_END;
      DIK_DOWN         : Result := VK_DOWN;
      DIK_NEXT         : Result := VK_NEXT;
      DIK_INSERT       : Result := VK_INSERT;
      DIK_DELETE       : Result := VK_DELETE;
      DIK_LWIN         : Result := VK_LWIN;
      DIK_RWIN         : Result := VK_RWIN;
      DIK_APPS         : Result := VK_APPS;
    end;
  end;
{$IFDEF StandardDX}
type
  TDIKeyboardState = array[0..255] of Byte;
{$ENDIF}
var
  j: Integer;
  i: TDXInputState;
  dikb: TDIKeyboardState;
begin
  FillChar(FKeyStates, SizeOf(FKeyStates), 0);
  FStates := [];
 
  if (not FInitialized) or FDXInput.FActiveOnly and (GetForegroundWindow<>FDXInput.FForm.Handle) then
    Exit;
 
  if FDevice<>nil then
  begin
    FillChar(dikb, SizeOf(dikb), 0);
 
    if GetDeviceState(SizeOf(dikb), dikb) then
    begin
      {  The DirectInput key code is converted into the Windows virtual key code.  }
      for j:=Low(dikb) to High(dikb) do
        if dikb[j] and $80<>0 then
          FKeyStates[Byte(DIKEYtoVK(j))] := $80;
    end;
  end else
  begin          
    GetKeyboardState(FKeyStates);
  end;
 
  for i:=LOW(TDXInputState) to HIGH(TDXInputState) do
  begin
    for j:=0 to 2 do
      if Keys[KeyAssigns[i, j]] then
      begin
        FStates := FStates + [i];
        Break;
      end;
  end;
end;
 
procedure TKeyboard.ReadAssigns(Stream: TStream);
begin
  Stream.ReadBuffer(KeyAssigns, SizeOf(KeyAssigns));
end;
 
procedure TKeyboard.WriteAssigns(Stream: TStream);
begin
  Stream.WriteBuffer(KeyAssigns, SizeOf(KeyAssigns));
end;
 
{  TMouse  }
 
constructor TMouse.Create(DXInput: TCustomDXInput);
begin
  inherited Create(DXInput);
  BindInputStates := False;
  Enabled := False;
end;              
 
function TMouse.GetX: Integer;
begin
  Result := Fdims.lX;
end;
 
function TMouse.GetY: Integer;
begin
  Result := Fdims.lY;
end;
 
function TMouse.GetZ: Integer;
begin
  Result := Fdims.lZ;
end;
 
procedure TMouse.Finalize;
begin
  FillChar(Fdims, SizeOf(Fdims), 0);
  inherited Finalize;
end;
 
procedure TMouse.Initialize;
begin
  Finalize;
 
  if (not FEnabled) or (csDesigning in FDXInput.ComponentState) then Exit;
 
  if FDXInput.FDInput<>nil then
  begin
    if FDXInput.FDInput.CreateDevice(GUID_SysMouse, FDevice, nil)<>DI_OK then Exit;
    FDevice.SetDataFormat(c_dfDIMouse);
  end else
    raise EDXInputError.Create(SNecessaryDirectInputUseMouse);
 
  FButtonCount := 3;
 
  inherited Initialize;
end;
 
procedure TMouse.Update;
begin
  FillChar(Fdims, SizeOf(Fdims), 0);
  FStates := [];
 
  if (not FInitialized) or FDXInput.FActiveOnly and (GetForegroundWindow<>FDXInput.FForm.Handle) then
    Exit;
 
  if FDevice<>nil then
  begin
    FillChar(Fdims, SizeOf(Fdims), 0);
    GetDeviceState(SizeOf(Fdims), Fdims);
  end;
 
  if Fdims.lX<0 then FStates := FStates + [isLeft];
  if Fdims.lX>0 then FStates := FStates + [isRight];
  if Fdims.lY<0 then FStates := FStates + [isUp];
  if Fdims.lY>0 then FStates := FStates + [isDown];
 
  if Fdims.rgbButtons[0] and $80<>0 then FStates := FStates + [isButton1];
  if Fdims.rgbButtons[1] and $80<>0 then FStates := FStates + [isButton2];
  if Fdims.rgbButtons[2] and $80<>0 then FStates := FStates + [isButton3];
end;
 
{  TJoystick  }
 
function SetDWORDProperty(pdev: IDirectInputDevice; guidProperty: PGUID;
  dwObject, dwHow, dwValue: DWORD): HResult;
var
  dipdw: TDIPropDWORD;
begin
  dipdw.diph.dwSize       := SizeOf(dipdw);
  dipdw.diph.dwHeaderSize := SizeOf(dipdw.diph);
  dipdw.diph.dwObj        := dwObject;
  dipdw.diph.dwHow        := dwHow;
  dipdw.dwData            := dwValue;
 
  Result := pdev.SetProperty(guidProperty, dipdw.diph);
end;
 
function SetRangeProperty(pdev: IDirectInputDevice; guidProperty: PGUID;
  dwObject, dwHow, Value: DWORD): HResult;
var
  diprg: TDIPropRange;
begin
  diprg.diph.dwSize       := SizeOf(diprg);
  diprg.diph.dwHeaderSize := SizeOf(diprg.diph);
  diprg.diph.dwObj        := dwObject;
  diprg.diph.dwHow        := dwHow;
  diprg.lMin              := -Value;
  diprg.lMax              := +Value;
 
  Result := pdev.SetProperty(guidProperty, diprg.diph);
end;
 
constructor TJoystick.Create(DXInput: TCustomDXInput);
begin
  inherited Create(DXInput);
  FAutoCenter := True;
 
  FID := 0;
 
  DeadZoneX := 50;
  DeadZoneY := 50;
  DeadZoneZ := 50;
 
  RangeX := 1000;
  RangeY := 1000;
  RangeZ := 1000;
end;
 
function TJoystick.GetX: Integer;
begin
  Result := Fdijs.lX;
end;
 
function TJoystick.GetY: Integer;
begin
  Result := Fdijs.lY;
end;
 
function TJoystick.GetZ: Integer;
begin
  Result := Fdijs.lZ;
end;
 
procedure TJoystick.Finalize;
begin
  FID2 := -1;
  FillChar(Fdijs, SizeOf(Fdijs), 0);
  FillChar(FJoyCaps, SizeOf(FJoyCaps), 0);
  inherited Finalize;
end;
 
function TJoystick.GetCooperativeLevel: Integer;
begin
  if not FAutoCenter then
    Result := DISCL_EXCLUSIVE or DISCL_FOREGROUND
  else
    Result := inherited GetCooperativeLevel;
end;
                                                       
function TJoystick_EnumJoysticksCallback(const lpddi: TDIDeviceInstanceA;
  pvRef: Pointer): HRESULT; stdcall;
begin
  Result := Integer(DIENUM_CONTINUE);
 
  with TJoystick(pvRef) do
  begin
    if FEnumIndex=FID then
    begin
      FDeviceGUID := lpddi.guidInstance;
      FEnumFlag := True;
      Result := Integer(DIENUM_STOP);
      Exit;
    end;
    Inc(FEnumIndex);
  end;
end;
 
procedure TJoystick.Initialize;
var
  i, j: Integer;
  devcaps: TDIDevCaps;
begin        
  Finalize;
 
  if (not FEnabled) or (FID<0) or (csDesigning in FDXInput.ComponentState) then Exit;
 
  try
    try
      if FDXInput.FDInput<>nil then
      begin
        {  Device search.  }
        FEnumFlag := False;
        FEnumIndex := 0;
 
        FDXInput.FDInput.EnumDevices({DIDEVTYPE_JOYSTICK}4, @TJoystick_EnumJoysticksCallback,
          Self, DIEDFL_ATTACHEDONLY);
 
        if not FEnumFlag then Exit;
 
        {  Device making.  }
        if FDXInput.FDInput.CreateDevice(FDeviceGUID, FDevice, nil)<>DI_OK then Exit;
 
        devcaps.dwSize := SizeOf(devcaps);
        if FDevice.GetCapabilities(devcaps)=DI_OK then
        begin
          FButtonCount := devcaps.dwButtons;
          if devcaps.dwFlags and DIDC_FORCEFEEDBACK<>0 then
            FForceFeedbackDevice := True;
        end;
 
        //if FDXInput.FDInput.CreateDevice(GUID_Joystick, FDevice, nil)<>DI_OK then Exit;   get out by Paul van Dinther
 
        {  Device data format (TDIDataFormat) making.  }
 
        with FDataFormat do
        begin
          dwFlags := DIDF_ABSAXIS;
          dwDataSize := SizeOf(Fdijs);
        end;            
 
        if not SetDataFormat then
        begin
          FDevice := nil;
          Exit;
        end;
         
        AutoCenter := FAutoCenter;
 
        for i:=Low(FDeadZone) to High(FDeadZone) do
          SetDeadZone(i, FDeadZone[i]);
 
        for i:=Low(FRange) to High(FRange) do
          SetRange(i, FRange[i]);
 
        FDevice2 := FDevice as IDirectInputDevice2;
      end;
    except
      Finalize;
      raise;
    end;
  finally
    if FDevice=nil then
    begin
      {  Because DirectInput cannot be used,  the GetJoyPosEx function is used.  }
      FID2 := -1;
 
      j := 0;
      for i:=0 to 255 do
      begin
        FillChar(FJoyCaps, SizeOf(FJoyCaps), 0);
        if joyGetDevCaps(i, @FJoyCaps, SizeOf(FJoyCaps))=JOYERR_NOERROR then
        begin
          if FID=j then
          begin
            FID2 := i;
            Break;
          end;
          Inc(j);
        end;
      end;
 
      if FID2<>-1 then
      begin
        if joyGetDevCaps(FID2, @FJoyCaps, SizeOf(FJoyCaps))=JOYERR_NOERROR then
        begin
          FButtonCount := FJoyCaps.wNumButtons;
        end else
        begin
          FID2 := -1;
        end;
      end;
    end;
  end;
 
  inherited Initialize;
end;
 
procedure TJoystick.SetAutoCenter(Value: Boolean);
begin
  FAutoCenter := Value;
 
  if FDevice<>nil then
    SetDWORDProperty(FDevice, DIPROP_AUTOCENTER, 0, DIPH_DEVICE, Ord(Value));
end;
 
procedure TJoystick.SetID(Value: Integer);
begin
  if Value<>FID then
  begin
    FID := Value;
    Initialize;
  end;
end;
 
function TJoystick.GetDeadZone(Obj: Integer): Integer;
begin
  Result := 0;
  if (Obj>=Low(FDeadZone)) and (Obj<High(FDeadZone)) then
    Result := FDeadZone[Obj];
end;
 
function TJoystick.GetRange(Obj: Integer): Integer;
begin
  Result := 0;
  if (Obj>=Low(FRange)) and (Obj<High(FRange)) then
    Result := FRange[Obj];
end;
 
procedure TJoystick.SetDeadZone(Obj: Integer; Value: Integer);
begin
  if (Obj<Low(FDeadZone)) or (Obj>=High(FDeadZone)) then Exit;
 
  if Value<0 then Value := 0;
  if Value>100 then Value := 100;
 
  if Obj=Integer(@PDIJoyState2(nil).rgdwPOV[0]) then
  begin
    FDeadZone[Obj] := -1;
    Exit;
  end;
 
  FDeadZone[Obj] := Value;
 
  if FDevice<>nil then
  begin
    if SetDWORDProperty(FDevice, DIPROP_DEADZONE, Obj, DIPH_BYOFFSET, Value*100)<>DI_OK then
      FDeadZone[Obj] := -1;
  end;
end;
 
procedure TJoystick.SetRange(Obj: Integer; Value: Integer);
begin
  if (Obj<Low(FRange)) or (Obj>=High(FRange)) then Exit;
 
  if Value<0 then Value := 0;
 
  if Obj=Integer(@PDIJoyState2(nil).rgdwPOV[0]) then
  begin
    FRange[Obj] := -1;
    Exit;
  end;
 
  FRange[Obj] := Value;
 
  if FDevice<>nil then
  begin
    if SetRangeProperty(FDevice, DIPROP_RANGE, Obj, DIPH_BYOFFSET, Value)<>DI_OK then
      FRange[Obj] := -1;
  end;
end;
 
procedure TJoystick.Update;
 
  function ConvertValue(Value, wXmax, wXmin, DeadZone, Range: Integer): Integer;
  var
    c, w: Integer;
  begin
    Result := 0;
 
    c := (wXmax - wXmin) div 2;
    Value := Value-c;
 
    w := c*DeadZone div 100;
    c := c - w;
 
    if c=0 then Exit;
 
    if Abs(Value)>w then
    begin
      if Value>0 then
        Result := MulDiv(Value-w, Range, c)
      else
        Result := MulDiv(Value+w, Range, c);
    end;
  end;
 
var
  i: Integer;
  JoyInfo: TJoyInfoEx;
begin
  FillChar(Fdijs, SizeOf(Fdijs), 0);
  FStates := [];
 
  if (not FInitialized) or FDXInput.FActiveOnly and (GetForegroundWindow<>FDXInput.FForm.Handle) then
    Exit;
 
  if FDevice<>nil then
  begin
    FDevice2.Poll;
    GetDeviceState(SizeOf(Fdijs), Fdijs);
  end else
  begin
    if FID2<>-1 then
    begin
      JoyInfo.dwSize := SizeOf(JoyInfo);
      JoyInfo.dwFlags := JOY_RETURNX or JOY_RETURNY or JOY_RETURNZ or JOY_RETURNPOV or
        JOY_RETURNBUTTONS or JOY_RETURNCENTERED;
 
      joyGetPosEx(FID2, @JoyInfo);
 
      with FJoyCaps do
        Fdijs.lX := ConvertValue(JoyInfo.wXpos, wXmax, wXmin, FDeadZone[DIJOFS_X], FRange[DIJOFS_X]);
 
      with FJoyCaps do
        Fdijs.lY := ConvertValue(JoyInfo.wYpos, wYmax, wYmin, FDeadZone[DIJOFS_Y], FRange[DIJOFS_Y]);
 
      with FJoyCaps do
        Fdijs.lZ := ConvertValue(JoyInfo.wZpos, wZmax, wZmin, FDeadZone[DIJOFS_Z], FRange[DIJOFS_Z]);
 
      Fdijs.rgdwPOV[0] := JoyInfo.dwPOV;
 
      for i:=0 to FJoyCaps.wNumButtons-1 do
        if JoyInfo.wButtons and (1 shl i)<>0 then
          Fdijs.rgbButtons[i] := $80;
    end;
  end;
 
  for i:=0 to 31 do
    if Fdijs.rgbButtons[i] and $80<>0 then
      FStates := FStates + [TDXInputState(Ord(isButton1)+i)];
 
  if Fdijs.lX<0 then FStates := FStates + [isLeft];
  if Fdijs.lX>0 then FStates := FStates + [isRight];
  if Fdijs.lY<0 then FStates := FStates + [isUp];
  if Fdijs.lY>0 then FStates := FStates + [isDown];
end;
 
{  TCustomDXInput  }
 
var
  FDirectInput: IDirectInput;
  FDirectInputCount: Integer;
 
procedure InitDirectInput(out DI: IDirectInput);
type
  TDirectInputCreate = function(hinst: THandle; dwVersion: DWORD;
    out ppDI: {$IFDEF UNICODE}IDirectInputW{$ELSE}IDirectInputA{$ENDIF}; punkOuter: IUnknown): HRESULT; stdcall;
begin
  if FDirectInput=nil then
  begin
    try
      TDirectInputCreate(DXLoadLibrary('DInput.dll', 'DirectInputCreateA'))
        (HInstance, DIRECTINPUT_VERSION, FDirectInput, nil);
    except
      FDirectInput := nil;
    end;
  end;
 
  DI := FDirectInput;
  if FDirectInput<>nil then
    Inc(FDirectInputCount);
end;
 
procedure FinDirectInput(var DI: IDirectInput);
begin
  if DI<>nil then
  begin
    DI := nil;
    Dec(FDirectInputCount);
    if FDirectInputCount<=0 then
    begin
      FDirectInputCount := 0;
      FDirectInput := nil;
    end;
  end;
end;
 
constructor TCustomDXInput.Create(AOwner: TComponent);
var
  Component: TComponent;
begin
  inherited Create(AOwner);
 
  FDevice := TList.Create;
 
  FActiveOnly := True;
  FJoystick := TJoystick.Create(Self);
  FKeyboard := TKeyboard.Create(Self);
  FMouse := TMouse.Create(Self);
  FUseDirectInput := True;
 
  Component := Owner;
  while (Component<>nil) and (not (Component is TCustomForm)) do
    Component := Component.Owner;
  if Component=nil then
    raise EDXInputError.CreateFmt(SNoForm, ['Owner']);
  FForm := TCustomForm(Component);
 
  FSubClass := TControlSubClass.Create(FForm, FormWndProc);
end;
 
destructor TCustomDXInput.Destroy;
begin
  Finalize;
  FJoystick.Free;
  FKeyboard.Free;
  FMouse.Free;
  FSubClass.Free;
  while FDevice.Count>0 do
    TCustomInput(FDevice[FDevice.Count-1]).Free;
  FDevice.Free;
  inherited Destroy;
end;
 
procedure TCustomDXInput.FormWndProc(var Message: TMessage; DefWindowProc: TWndMethod);
 
  procedure AcquireDevice;
  var
    i: Integer;
  begin
    for i:=0 to FDevice.Count-1 do
      TCustomInput(FDevice[i]).Acquire;
  end;
 
begin
  case Message.Msg of
    WM_CREATE:
        begin
          {  Window handle of Form changed.  }
          DefWindowProc(Message);
          SetWindowHandle;
          Exit;
        end;
    WM_ACTIVATEAPP:
        begin
          DefWindowProc(Message);
          if TWMActivateApp(Message).Active then
            AcquireDevice;
          Exit;
        end;
    WM_ACTIVATE:
        begin
          DefWindowProc(Message);
          if TWMActivate(Message).Active<>WA_INACTIVE then
            AcquireDevice;
          Exit;
        end;
  end;
  DefWindowProc(Message);
end;
 
procedure TCustomDXInput.Finalize;
var
  i: Integer;
begin
  for i:=0 to FDevice.Count-1 do
    TCustomInput(FDevice[i]).Finalize;
  FinDirectInput(FDInput);
end;
 
procedure TCustomDXInput.Loaded;
begin
  Initialize;
end;
 
procedure TCustomDXInput.Initialize;
var
  i: Integer;
begin
  Finalize;
  if not (csDesigning in ComponentState) then
  begin
    if FUseDirectInput then InitDirectInput(FDInput);
 
    for i:=0 to FDevice.Count-1 do
      TCustomInput(FDevice[i]).Initialize;
 
    SetWindowHandle;
 
    Update;
  end;
end;
 
procedure TCustomDXInput.SetActiveOnly(Value: Boolean);
begin
  if Value<>FActiveOnly then
  begin
    FActiveOnly := Value;
    if [csLoading, csReading]*ComponentState=[] then SetWindowHandle;
  end;
end;
 
procedure TCustomDXInput.SetJoystick(Value: TJoystick);
begin
  FJoystick.Assign(Value);
end;
 
procedure TCustomDXInput.SetKeyboard(Value: TKeyboard);
begin
  FKeyboard.Assign(Value);
end;
 
procedure TCustomDXInput.SetMouse(Value: TMouse);
begin
  FMouse.Assign(Value);
end;
 
procedure TCustomDXInput.SetUseDirectInput(Value: Boolean);
begin
  if FUseDirectInput<>Value then
  begin
    FUseDirectInput := Value;
    Initialize;
  end;
end;
 
procedure TCustomDXInput.SetWindowHandle;
var
  i: Integer;
begin
  for i:=0 to FDevice.Count-1 do
    TCustomInput(FDevice[i]).SetWindowHandle(FForm.Handle);
end;
 
procedure TCustomDXInput.Update;
var
  j: Integer;
  i: TDXInputState;
  s: TDXInputStates;
begin
  s := [];
 
  for j:=0 to FDevice.Count-1 do
  begin
    TCustomInput(FDevice[j]).Update;
    if TCustomInput(FDevice[j]).FBindInputStates then
      s := s + TCustomInput(FDevice[j]).States;
  end;
 
  for i:=Low(TDXInputState) to High(TDXInputState) do
  begin
    if (i in s) and (not (i in FOldStates)) then
      FStates := FStates + [i];
    if (not (i in s)) and (i in FOldStates) then
      FStates := FStates - [i];
  end;
 
  FOldStates := s;
end;
 
end.
 

Rev 1	Rev 4
1	unit DXInput;	1	unit DXInput;
2		2
3	interface	3	interface
4		4
5	{$INCLUDE DelphiXcfg.inc}	5	{$INCLUDE DelphiXcfg.inc}
6		6
7	uses	7	uses
8	Windows, Messages, SysUtils, Classes, Controls, Forms, MMSystem,	8	Windows, Messages, SysUtils, Classes, Controls, Forms, MMSystem,
-		9	DXClass, {$IFDEF VER17UP} Types, {$ENDIF}
-		10	{$IfDef StandardDX}
-		11	{$IfDef DX9}
-		12	DirectInput;
-		13	{$Else}
-		14	{$IfDef DX81}
9	DirectX, DXClass;	15	DirectInput8;
-		16	{$Else}
-		17	DirectInput;
-		18	{$EndIf}
-		19	{$EndIf}
-		20	{$Else}
-		21	DirectX;
-		22	{$EndIf}
10		23
11	type	24	type
12		25
13	{ EDXInputError }	26	{ EDXInputError }
14		27
15	EDXInputError = class(Exception);	28	EDXInputError = class(Exception);
16		29
17	{ EForceFeedbackEffectError }	30	{ EForceFeedbackEffectError }
18		31
19	EForceFeedbackEffectError = class(Exception);	32	EForceFeedbackEffectError = class(Exception);
20		33
21		34
22	{ TForceFeedbackEffect }	35	{ TForceFeedbackEffect }
23		36
24	TForceFeedbackEffectType = (etNone, etConstantForce, etPeriodic, etCondition);	37	TForceFeedbackEffectType = (etNone, etConstantForce, etPeriodic, etCondition);
25		38
26	TForceFeedbackEffect = class;	39	TForceFeedbackEffect = class;
27	TForceFeedbackEffects = class;	40	TForceFeedbackEffects = class;
28		41
29	TForceFeedbackEffectObject = class	42	TForceFeedbackEffectObject = class
30	private	43	private
31	FAxes: array[0..1] of DWORD;	44	FAxes: array[0..1] of DWORD;
32	FAxesCount: Integer;	45	FAxesCount: Integer;
33	Feff: TDIEffect;	46	Feff: TDIEffect;
34	FDirections: array[0..1] of DWORD;	47	FDirections: array[0..1] of DWORD;
35	FEnvelope: TDIEnvelope;	48	FEnvelope: TDIEnvelope;
36	FConstantForce: TDIConstantForce;	49	FConstantForce: TDIConstantForce;
37	FCondition: TDICondition;	50	FCondition: TDICondition;
38	FPeriodic: TDIPeriodic;	51	FPeriodic: TDIPeriodic;
39	FEffect: IDirectInputEffect;	52	FEffect: IDirectInputEffect;
40	procedure Clear;	53	procedure Clear;
41	procedure Init(Effect: TForceFeedbackEffect);	54	procedure Init(Effect: TForceFeedbackEffect);
42	procedure Release;	55	procedure Release;
43	public	56	public
44	destructor Destroy; override;	57	destructor Destroy; override;
45	end;	58	end;
46		59
47	TForceFeedbackEffect = class(TPersistent)	60	TForceFeedbackEffect = class(TPersistent)
48	private	61	private
49	FRoot: TForceFeedbackEffects;	62	FRoot: TForceFeedbackEffects;
50	FParent: TForceFeedbackEffect;	63	FParent: TForceFeedbackEffect;
51	FList: TList;	64	FList: TList;
52	FAttackLevel: Integer;	65	FAttackLevel: Integer;
53	FAttackTime: Integer;	66	FAttackTime: Integer;
54	FCondition: TPoint;	67	FCondition: TPoint;
55	FConstant: TPoint;	68	FConstant: TPoint;
56	FEffectType: TForceFeedbackEffectType;	69	FEffectType: TForceFeedbackEffectType;
57	FFadeLevel: Integer;	70	FFadeLevel: Integer;
58	FFadeTime: Integer;	71	FFadeTime: Integer;
59	FName: string;	72	FName: string;
60	FPeriod: Integer;	73	FPeriod: Integer;
61	FPlaying: Boolean;	74	FPlaying: Boolean;
62	FPower: Integer;	75	FPower: Integer;
63	FTime: Integer;	76	FTime: Integer;
64	FStartDelayTime: Integer;	77	FStartDelayTime: Integer;
65	FObject: TForceFeedbackEffectObject;	78	FObject: TForceFeedbackEffectObject;
66	FObject2: TForceFeedbackEffectObject;	79	FObject2: TForceFeedbackEffectObject;
67	FFindEffectFlag: Boolean;	80	FFindEffectFlag: Boolean;
68	FFindEffectGUID: TGUID;	81	FFindEffectGUID: TGUID;
69	procedure Acquire;	82	procedure Acquire;
70	procedure Finalize;	83	procedure Finalize;
71	procedure Initialize;	84	procedure Initialize;
72	procedure ChangeEffect;	85	procedure ChangeEffect;
73	procedure MakeEff;	86	procedure MakeEff;
74	procedure CreateEffect;	87	procedure CreateEffect;
75	function GetCount: Integer;	88	function GetCount: Integer;
76	function GetEffect(Index: Integer): TForceFeedbackEffect;	89	function GetEffect(Index: Integer): TForceFeedbackEffect;
77	function GetIndex: Integer;	90	function GetIndex: Integer;
78	function GetPlaying: Boolean;	91	function GetPlaying: Boolean;
79	procedure SetAttackLevel(Value: Integer);	92	procedure SetAttackLevel(Value: Integer);
80	procedure SetAttackTime(Value: Integer);	93	procedure SetAttackTime(Value: Integer);
81	procedure SetCondition(Value: TPoint);	94	procedure SetCondition(Value: TPoint);
82	procedure SetConstant(Value: TPoint);	95	procedure SetConstant(Value: TPoint);
83	procedure SetEffectType(Value: TForceFeedbackEffectType);	96	procedure SetEffectType(Value: TForceFeedbackEffectType);
84	procedure SetFadeLevel(Value: Integer);	97	procedure SetFadeLevel(Value: Integer);
85	procedure SetFadeTime(Value: Integer);	98	procedure SetFadeTime(Value: Integer);
86	procedure SetIndex(Value: Integer);	99	procedure SetIndex(Value: Integer);
87	procedure SetPeriod(Value: Integer);	100	procedure SetPeriod(Value: Integer);
88	procedure SetParent(Value: TForceFeedbackEffect);	101	procedure SetParent(Value: TForceFeedbackEffect);
89	procedure SetPower(Value: Integer);	102	procedure SetPower(Value: Integer);
90	procedure SetTime(Value: Integer);	103	procedure SetTime(Value: Integer);
91	procedure SetStartDelayTime(Value: Integer);	104	procedure SetStartDelayTime(Value: Integer);
92	function HasInterface: Boolean;	105	function HasInterface: Boolean;
93	protected	106	protected
94	function GetOwner: TPersistent; override;	107	function GetOwner: TPersistent; override;
95	property StartDelayTime: Integer read FStartDelayTime write SetStartDelayTime;	108	property StartDelayTime: Integer read FStartDelayTime write SetStartDelayTime;
96	public	109	public
97	constructor Create(AParent: TForceFeedbackEffect);	110	constructor Create(AParent: TForceFeedbackEffect);
98	destructor Destroy; override;	111	destructor Destroy; override;
99	procedure Assign(Source: TPersistent); override;	112	procedure Assign(Source: TPersistent); override;
100	procedure Clear;	113	procedure Clear;
101	function Find(const Name: string): TForceFeedbackEffect;	114	function Find(const Name: string): TForceFeedbackEffect;
102	function IndexOf(const Name: string): Integer;	115	function IndexOf(const Name: string): Integer;
103	procedure LoadFromFile(const FileName: string);	116	procedure LoadFromFile(const FileName: string);
104	procedure LoadFromStream(Stream: TStream);	117	procedure LoadFromStream(Stream: TStream);
105	procedure SaveToFile(const FileName: string);	118	procedure SaveToFile(const FileName: string);
106	procedure SaveToStream(Stream: TStream);	119	procedure SaveToStream(Stream: TStream);
107	procedure Start;	120	procedure Start;
108	procedure Stop;	121	procedure Stop;
109	procedure Unload(Recurse: Boolean);	122	procedure Unload(Recurse: Boolean);
110	property Count: Integer read GetCount;	123	property Count: Integer read GetCount;
111	property Effects[Index: Integer]: TForceFeedbackEffect read GetEffect; default;	124	property Effects[Index: Integer]: TForceFeedbackEffect read GetEffect; default;
112	property Index: Integer read GetIndex write SetIndex;	125	property Index: Integer read GetIndex write SetIndex;
113	property Playing: Boolean read GetPlaying;	126	property Playing: Boolean read GetPlaying;
114	property Parent: TForceFeedbackEffect read FParent write SetParent;	127	property Parent: TForceFeedbackEffect read FParent write SetParent;
115	property Name: string read FName write FName;	128	property Name: string read FName write FName;
116	property EffectType: TForceFeedbackEffectType read FEffectType write SetEffectType;	129	property EffectType: TForceFeedbackEffectType read FEffectType write SetEffectType;
117	property AttackLevel: Integer read FAttackLevel write SetAttackLevel;	130	property AttackLevel: Integer read FAttackLevel write SetAttackLevel;
118	property AttackTime: Integer read FAttackTime write SetAttackTime;	131	property AttackTime: Integer read FAttackTime write SetAttackTime;
119	property Condition: TPoint read FCondition write SetCondition;	132	property Condition: TPoint read FCondition write SetCondition;
120	property Constant: TPoint read FConstant write SetConstant;	133	property Constant: TPoint read FConstant write SetConstant;
121	property FadeLevel: Integer read FFadeLevel write SetFadeLevel;	134	property FadeLevel: Integer read FFadeLevel write SetFadeLevel;
122	property FadeTime: Integer read FFadeTime write SetFadeTime;	135	property FadeTime: Integer read FFadeTime write SetFadeTime;
123	property Period: Integer read FPeriod write SetPeriod;	136	property Period: Integer read FPeriod write SetPeriod;
124	property Power: Integer read FPower write SetPower;	137	property Power: Integer read FPower write SetPower;
125	property Time: Integer read FTime write SetTime;	138	property Time: Integer read FTime write SetTime;
126	end;	139	end;
127		140
128	{ TForceFeedbackEffects }	141	{ TForceFeedbackEffects }
129		142
130	TCustomInput = class;	143	TCustomInput = class;
131		144
132	TForceFeedbackEffects = class(TForceFeedbackEffect)	145	TForceFeedbackEffects = class(TForceFeedbackEffect)
133	private	146	private
134	FComponent: TComponent;	147	FComponent: TComponent;
135	FInput: TCustomInput;	148	FInput: TCustomInput;
136	protected	149	protected
137	procedure DefineProperties(Filer: TFiler); override;	150	procedure DefineProperties(Filer: TFiler); override;
138	public	151	public
139	constructor Create(Input: TCustomInput);	152	constructor Create(Input: TCustomInput);
140	destructor Destroy; override;	153	destructor Destroy; override;
141	property Input: TCustomInput read FInput;	154	property Input: TCustomInput read FInput;
142	end;	155	end;
143		156
144	{ TCustomInput }	157	{ TCustomInput }
145		158
146	TDXInputState = (isUp, isDown, isLeft, isRight, isButton1, isButton2, isButton3,	159	TDXInputState = (isUp, isDown, isLeft, isRight, isButton1, isButton2, isButton3,
147	isButton4, isButton5, isButton6, isButton7, isButton8, isButton9, isButton10, isButton11,	160	isButton4, isButton5, isButton6, isButton7, isButton8, isButton9, isButton10, isButton11,
148	isButton12, isButton13, isButton14, isButton15, isButton16, isButton17, isButton18,	161	isButton12, isButton13, isButton14, isButton15, isButton16, isButton17, isButton18,
149	isButton19, isButton20, isButton21, isButton22, isButton23, isButton24, isButton25,	162	isButton19, isButton20, isButton21, isButton22, isButton23, isButton24, isButton25,
150	isButton26, isButton27, isButton28, isButton29, isButton30, isButton31, isButton32);	163	isButton26, isButton27, isButton28, isButton29, isButton30, isButton31, isButton32);
151		164
152	TDXInputStates = set of TDXInputState;	165	TDXInputStates = set of TDXInputState;
153		166
154	TCustomDXInput = class;	167	TCustomDXInput = class;
155		168
156	TCustomInput = class(TPersistent)	169	TCustomInput = class(TPersistent)
157	private	170	private
158	FBindInputStates: Boolean;	171	FBindInputStates: Boolean;
159	FButtonCount: Integer;	172	FButtonCount: Integer;
160	FDataFormat: TDIDataFormat;	173	FDataFormat: TDIDataFormat;
161	FDataFormatObjects: array[0..255] of TDIObjectDataFormat;	174	FDataFormatObjects: array[0..255] of TDIObjectDataFormat;
162	FDataFormatGUIDs: array[0..255] of TGUID;	175	FDataFormatGUIDs: array[0..255] of TGUID;
163	FDevice: IDirectInputDevice;	176	FDevice: IDirectInputDevice;
164	FDevice2: IDirectInputDevice2;	177	FDevice2: IDirectInputDevice2;
165	FDXInput: TCustomDXInput;	178	FDXInput: TCustomDXInput;
166	FEffects: TForceFeedbackEffects;	179	FEffects: TForceFeedbackEffects;
167	FEnabled: Boolean;	180	FEnabled: Boolean;
168	FForceFeedback: Boolean;	181	FForceFeedback: Boolean;
169	FForceFeedbackDevice: Boolean;	182	FForceFeedbackDevice: Boolean;
170	FInitialized: Boolean;	183	FInitialized: Boolean;
171	FStates: TDXInputStates;	184	FStates: TDXInputStates;
172	procedure Acquire;	185	procedure Acquire;
173	procedure Finalize; virtual;	186	procedure Finalize; virtual;
174	procedure Initialize; virtual;	187	procedure Initialize; virtual;
175	function GetButton(Index: Integer): Boolean;	188	function GetButton(Index: Integer): Boolean;
176	function GetCooperativeLevel: Integer; virtual;	189	function GetCooperativeLevel: Integer; virtual;
177	function GetDeviceState(dwSize: Integer; var Data): Boolean;	190	function GetDeviceState(dwSize: Integer; var Data): Boolean;
178	function SetDataFormat: Boolean;	191	function SetDataFormat: Boolean;
179	procedure SetEffects(Value: TForceFeedbackEffects);	192	procedure SetEffects(Value: TForceFeedbackEffects);
180	procedure SetEnabled(Value: Boolean);	193	procedure SetEnabled(Value: Boolean);
181	procedure SetForceFeedback(Value: Boolean);	194	procedure SetForceFeedback(Value: Boolean);
182	procedure SetWindowHandle(Value: Integer);	195	procedure SetWindowHandle(Value: Integer);
183	public	196	public
184	constructor Create(DXInput: TCustomDXInput); virtual;	197	constructor Create(DXInput: TCustomDXInput); virtual;
185	destructor Destroy; override;	198	destructor Destroy; override;
186	procedure Update; virtual; abstract;	199	procedure Update; virtual; abstract;
187	property ButtonCount: Integer read FButtonCount;	200	property ButtonCount: Integer read FButtonCount;
188	property Buttons[Index: Integer]: Boolean read GetButton;	201	property Buttons[Index: Integer]: Boolean read GetButton;
189	property States: TDXInputStates read FStates;	202	property States: TDXInputStates read FStates;
190	published	203	published
191	property BindInputStates: Boolean read FBindInputStates write FBindInputStates;	204	property BindInputStates: Boolean read FBindInputStates write FBindInputStates;
192	property Effects: TForceFeedbackEffects read FEffects write SetEffects;	205	property Effects: TForceFeedbackEffects read FEffects write SetEffects;
193	property Enabled: Boolean read FEnabled write SetEnabled;	206	property Enabled: Boolean read FEnabled write SetEnabled;
194	property ForceFeedback: Boolean read FForceFeedback write SetForceFeedback;	207	property ForceFeedback: Boolean read FForceFeedback write SetForceFeedback;
195	end;	208	end;
196		209
197	{ TKeyboard }	210	{ TKeyboard }
198		211
199	PKeyAssign = ^TKeyAssign;	212	PKeyAssign = ^TKeyAssign;
200	TKeyAssign = array[0..2] of Integer;	213	TKeyAssign = array[0..2] of Integer;
201		214
202	TKeyAssignList = array[TDXInputState] of TKeyAssign;	215	TKeyAssignList = array[TDXInputState] of TKeyAssign;
203		216
204	TKeyboard = class(TCustomInput)	217	TKeyboard = class(TCustomInput)
205	private	218	private
206	FKeyStates: TKeyboardState;	219	FKeyStates: TKeyboardState;
207	procedure Finalize; override;	220	procedure Finalize; override;
208	procedure Initialize; override;	221	procedure Initialize; override;
209	function GetKey(Key: Integer): Boolean;	222	function GetKey(Key: Integer): Boolean;
210	procedure ReadAssigns(Stream: TStream);	223	procedure ReadAssigns(Stream: TStream);
211	procedure WriteAssigns(Stream: TStream);	224	procedure WriteAssigns(Stream: TStream);
212	protected	225	protected
213	procedure DefineProperties(Filer: TFiler); override;	226	procedure DefineProperties(Filer: TFiler); override;
214	public	227	public
215	KeyAssigns: TKeyAssignList;	228	KeyAssigns: TKeyAssignList;
216	constructor Create(DXInput: TCustomDXInput); override;	229	constructor Create(DXInput: TCustomDXInput); override;
217	procedure Update; override;	230	procedure Update; override;
218	property Keys[Key: Integer]: Boolean read GetKey;	231	property Keys[Key: Integer]: Boolean read GetKey;
219	end;	232	end;
220		233
221	{ TMouse }	234	{ TMouse }
222		235
223	TMouse = class(TCustomInput)	236	TMouse = class(TCustomInput)
224	private	237	private
225	Fdims: TDIMouseState;	238	Fdims: TDIMouseState;
226	procedure Finalize; override;	239	procedure Finalize; override;
227	procedure Initialize; override;	240	procedure Initialize; override;
228	function GetX: Integer;	241	function GetX: Integer;
229	function GetY: Integer;	242	function GetY: Integer;
230	function GetZ: Integer;	243	function GetZ: Integer;
231	public	244	public
232	constructor Create(DXInput: TCustomDXInput); override;	245	constructor Create(DXInput: TCustomDXInput); override;
233	procedure Update; override;	246	procedure Update; override;
234	property X: Integer read GetX;	247	property X: Integer read GetX;
235	property Y: Integer read GetY;	248	property Y: Integer read GetY;
236	property Z: Integer read GetZ;	249	property Z: Integer read GetZ;
237	end;	250	end;
238		251
239	{ TJoystick }	252	{ TJoystick }
240		253
241	TJoystick = class(TCustomInput)	254	TJoystick = class(TCustomInput)
242	private	255	private
243	Fdijs: TDIJoyState2;	256	Fdijs: TDIJoyState2;
244	FAutoCenter: Boolean;	257	FAutoCenter: Boolean;
245	FDeviceGUID: TGUID;	258	FDeviceGUID: TGUID;
246	FEnumFlag: Boolean;	259	FEnumFlag: Boolean;
247	FEnumIndex: Integer;	260	FEnumIndex: Integer;
248	FID: Integer;	261	FID: Integer;
249	FID2: Integer;	262	FID2: Integer;
250	FJoyCaps: TJoyCaps;	263	FJoyCaps: TJoyCaps;
251	FDeadZone: array[0..SizeOf(TDIJoyState2)-1] of Integer;	264	FDeadZone: array[0..SizeOf(TDIJoyState2)-1] of Integer;
252	FRange: array[0..SizeOf(TDIJoyState2)-1] of Integer;	265	FRange: array[0..SizeOf(TDIJoyState2)-1] of Integer;
253	procedure Finalize; override;	266	procedure Finalize; override;
254	procedure Initialize; override;	267	procedure Initialize; override;
255	function GetCooperativeLevel: Integer; override;	268	function GetCooperativeLevel: Integer; override;
256	function GetDeadZone(Obj: Integer): Integer;	269	function GetDeadZone(Obj: Integer): Integer;
257	function GetRange(Obj: Integer): Integer;	270	function GetRange(Obj: Integer): Integer;
258	function GetX: Integer;	271	function GetX: Integer;
259	function GetY: Integer;	272	function GetY: Integer;
260	function GetZ: Integer;	273	function GetZ: Integer;
261	procedure SetDeadZone(Obj: Integer; Value: Integer);	274	procedure SetDeadZone(Obj: Integer; Value: Integer);
262	procedure SetRange(Obj: Integer; Value: Integer);	275	procedure SetRange(Obj: Integer; Value: Integer);
263	procedure SetAutoCenter(Value: Boolean);	276	procedure SetAutoCenter(Value: Boolean);
264	procedure SetID(Value: Integer);	277	procedure SetID(Value: Integer);
265	public	278	public
266	constructor Create(DXInput: TCustomDXInput); override;	279	constructor Create(DXInput: TCustomDXInput); override;
267	procedure Update; override;	280	procedure Update; override;
268	property DeadZone[Obj: Integer]: Integer read GetDeadZone write SetDeadZone;	281	property DeadZone[Obj: Integer]: Integer read GetDeadZone write SetDeadZone;
269	property Range[Obj: Integer]: Integer read GetRange write SetRange;	282	property Range[Obj: Integer]: Integer read GetRange write SetRange;
270	property Joystate: TDIJoyState2 read Fdijs;	283	property Joystate: TDIJoyState2 read Fdijs;
271	property X: Integer read GetX;	284	property X: Integer read GetX;
272	property Y: Integer read GetY;	285	property Y: Integer read GetY;
273	property Z: Integer read GetZ;	286	property Z: Integer read GetZ;
274	published	287	published
275	property AutoCenter: Boolean read FAutoCenter write SetAutoCenter;	288	property AutoCenter: Boolean read FAutoCenter write SetAutoCenter;
276	property DeadZoneX: Integer index DIJOFS_X read GetDeadZone write SetDeadZone;	289	property DeadZoneX: Integer index DIJOFS_X read GetDeadZone write SetDeadZone;
277	property DeadZoneY: Integer index DIJOFS_Y read GetDeadZone write SetDeadZone;	290	property DeadZoneY: Integer index DIJOFS_Y read GetDeadZone write SetDeadZone;
278	property DeadZoneZ: Integer index DIJOFS_Z read GetDeadZone write SetDeadZone;	291	property DeadZoneZ: Integer index DIJOFS_Z read GetDeadZone write SetDeadZone;
279	property ID: Integer read FID write SetID;	292	property ID: Integer read FID write SetID;
280	property RangeX: Integer index DIJOFS_X read GetRange write SetRange;	293	property RangeX: Integer index DIJOFS_X read GetRange write SetRange;
281	property RangeY: Integer index DIJOFS_Y read GetRange write SetRange;	294	property RangeY: Integer index DIJOFS_Y read GetRange write SetRange;
282	property RangeZ: Integer index DIJOFS_Z read GetRange write SetRange;	295	property RangeZ: Integer index DIJOFS_Z read GetRange write SetRange;
283	end;	296	end;
284		297
285	{ TCustomDXInput }	298	{ TCustomDXInput }
286		299
287	TCustomDXInput = class(TComponent)	300	TCustomDXInput = class(TComponent)
288	private	301	private
289	FActiveOnly: Boolean;	302	FActiveOnly: Boolean;
290	FDevice: TList;	303	FDevice: TList;
291	FDInput: IDirectInput;	304	FDInput: IDirectInput;
292	FForm: TCustomForm;	305	FForm: TCustomForm;
293	FJoystick: TJoystick;	306	FJoystick: TJoystick;
294	FKeyboard: TKeyboard;	307	FKeyboard: TKeyboard;
295	FMouse: TMouse;	308	FMouse: TMouse;
296	FOldStates: TDXInputStates;	309	FOldStates: TDXInputStates;
297	FStates: TDXInputStates;	310	FStates: TDXInputStates;
298	FSubClass: TControlSubClass;	311	FSubClass: TControlSubClass;
299	FUseDirectInput: Boolean;	312	FUseDirectInput: Boolean;
300	procedure Finalize;	313	procedure Finalize;
301	procedure Initialize;	314	procedure Initialize;
302	procedure FormWndProc(var Message: TMessage; DefWindowProc: TWndMethod);	315	procedure FormWndProc(var Message: TMessage; DefWindowProc: TWndMethod);
303	procedure SetActiveOnly(Value: Boolean);	316	procedure SetActiveOnly(Value: Boolean);
304	procedure SetJoystick(Value: TJoystick);	317	procedure SetJoystick(Value: TJoystick);
305	procedure SetKeyboard(Value: TKeyboard);	318	procedure SetKeyboard(Value: TKeyboard);
306	procedure SetMouse(Value: TMouse);	319	procedure SetMouse(Value: TMouse);
307	procedure SetWindowHandle;	320	procedure SetWindowHandle;
308	procedure SetUseDirectInput(Value: Boolean);	321	procedure SetUseDirectInput(Value: Boolean);
309	protected	322	protected
310	procedure Loaded; override;	323	procedure Loaded; override;
311	public	324	public
312	constructor Create(AOwner: TComponent); override;	325	constructor Create(AOwner: TComponent); override;
313	destructor Destroy; override;	326	destructor Destroy; override;
314	procedure Update;	327	procedure Update;
315	property ActiveOnly: Boolean read FActiveOnly write SetActiveOnly;	328	property ActiveOnly: Boolean read FActiveOnly write SetActiveOnly;
316	property Joystick: TJoystick read FJoystick write SetJoystick;	329	property Joystick: TJoystick read FJoystick write SetJoystick;
317	property Keyboard: TKeyboard read FKeyboard write SetKeyboard;	330	property Keyboard: TKeyboard read FKeyboard write SetKeyboard;
318	property Mouse: TMouse read FMouse write SetMouse;	331	property Mouse: TMouse read FMouse write SetMouse;
319	property States: TDXInputStates read FStates write FStates;	332	property States: TDXInputStates read FStates write FStates;
320	property UseDirectInput: Boolean read FUseDirectInput write SetUseDirectInput;	333	property UseDirectInput: Boolean read FUseDirectInput write SetUseDirectInput;
321	end;	334	end;
322		335
323	{ TDXInput }	336	{ TDXInput }
324		337
325	TDXInput = class(TCustomDXInput)	338	TDXInput = class(TCustomDXInput)
326	published	339	published
327	property ActiveOnly;	340	property ActiveOnly;
328	property Joystick;	341	property Joystick;
329	property Keyboard;	342	property Keyboard;
330	property Mouse;	343	property Mouse;
331	property UseDirectInput;	344	property UseDirectInput;
332	end;	345	end;
333		346
334	function DefKeyAssign: TKeyAssignList;	347	function DefKeyAssign: TKeyAssignList;
335	function DefKeyAssign2_1: TKeyAssignList;	348	function DefKeyAssign2_1: TKeyAssignList;
336	function DefKeyAssign2_2: TKeyAssignList;	349	function DefKeyAssign2_2: TKeyAssignList;
337		350
338	implementation	351	implementation
339		352
340	uses DXConsts;	353	uses DXConsts;
341		354
342	procedure AssignKey(var KeyAssignList: TKeyAssignList; State: TDXInputState;	355	procedure AssignKey(var KeyAssignList: TKeyAssignList; State: TDXInputState;
343	const Keys: array of Integer);	356	const Keys: array of Integer);
344	var	357	var
345	i, i2: Integer;	358	i, i2: Integer;
346	KeyAssign: PKeyAssign;	359	KeyAssign: PKeyAssign;
347	begin	360	begin
348	KeyAssign := @KeyAssignList[State];	361	KeyAssign := @KeyAssignList[State];
349	FillChar(KeyAssign^, SizeOf(TKeyAssign), 0);	362	FillChar(KeyAssign^, SizeOf(TKeyAssign), 0);
350		363
351	i2 := 0;	364	i2 := 0;
352	for i:=LOW(Keys) to HIGH(Keys) do	365	for i:=LOW(Keys) to HIGH(Keys) do
353	begin	366	begin
354	if i2<3 then	367	if i2<3 then
355	KeyAssign^[i2] := Keys[i]	368	KeyAssign^[i2] := Keys[i]
356	else	369	else
357	Exit;	370	Exit;
358	Inc(i2);	371	Inc(i2);
359	end;	372	end;
360	end;	373	end;
361		374
362	function DefKeyAssign: TKeyAssignList;	375	function DefKeyAssign: TKeyAssignList;
363	begin	376	begin
364	FillChar(Result, SizeOf(Result), 0);	377	FillChar(Result, SizeOf(Result), 0);
365		378
366	AssignKey(Result, isUp, [Ord('K'), VK_UP, VK_NUMPAD8]);	379	AssignKey(Result, isUp, [Ord('K'), VK_UP, VK_NUMPAD8]);
367	AssignKey(Result, isDown, [Ord('J'), VK_DOWN, VK_NUMPAD2]);	380	AssignKey(Result, isDown, [Ord('J'), VK_DOWN, VK_NUMPAD2]);
368	AssignKey(Result, isLeft, [Ord('H'), VK_LEFT, VK_NUMPAD4]);	381	AssignKey(Result, isLeft, [Ord('H'), VK_LEFT, VK_NUMPAD4]);
369	AssignKey(Result, isRight, [Ord('L'), VK_RIGHT, VK_NUMPAD6]);	382	AssignKey(Result, isRight, [Ord('L'), VK_RIGHT, VK_NUMPAD6]);
370	AssignKey(Result, isButton1, [Ord('Z'), VK_SPACE]);	383	AssignKey(Result, isButton1, [Ord('Z'), VK_SPACE]);
371	AssignKey(Result, isButton2, [Ord('X'), VK_RETURN]);	384	AssignKey(Result, isButton2, [Ord('X'), VK_RETURN]);
372	AssignKey(Result, isButton9, [VK_F2]);	385	AssignKey(Result, isButton9, [VK_F2]);
373	end;	386	end;
374		387
375	function DefKeyAssign2_1: TKeyAssignList;	388	function DefKeyAssign2_1: TKeyAssignList;
376	begin	389	begin
377	FillChar(Result, SizeOf(Result), 0);	390	FillChar(Result, SizeOf(Result), 0);
378		391
379	AssignKey(Result, isUp, [Ord('K'), VK_UP, VK_NUMPAD8]);	392	AssignKey(Result, isUp, [Ord('K'), VK_UP, VK_NUMPAD8]);
380	AssignKey(Result, isDown, [Ord('J'), VK_DOWN, VK_NUMPAD2]);	393	AssignKey(Result, isDown, [Ord('J'), VK_DOWN, VK_NUMPAD2]);
381	AssignKey(Result, isLeft, [Ord('H'), VK_LEFT, VK_NUMPAD4]);	394	AssignKey(Result, isLeft, [Ord('H'), VK_LEFT, VK_NUMPAD4]);
382	AssignKey(Result, isRight, [Ord('L'), VK_RIGHT, VK_NUMPAD6]);	395	AssignKey(Result, isRight, [Ord('L'), VK_RIGHT, VK_NUMPAD6]);
383	AssignKey(Result, isButton1, [VK_SPACE , VK_NUMPAD0]);	396	AssignKey(Result, isButton1, [VK_SPACE , VK_NUMPAD0]);
384	AssignKey(Result, isButton2, [VK_RETURN, VK_NUMPAD5]);	397	AssignKey(Result, isButton2, [VK_RETURN, VK_NUMPAD5]);
385	AssignKey(Result, isButton9, [VK_F2]);	398	AssignKey(Result, isButton9, [VK_F2]);
386	end;	399	end;
387		400
388	function DefKeyAssign2_2: TKeyAssignList;	401	function DefKeyAssign2_2: TKeyAssignList;
389	begin	402	begin
390	FillChar(Result, SizeOf(Result), 0);	403	FillChar(Result, SizeOf(Result), 0);
391		404
392	AssignKey(Result, isUp, [Ord('E')]);	405	AssignKey(Result, isUp, [Ord('E')]);
393	AssignKey(Result, isDown, [Ord('C')]);	406	AssignKey(Result, isDown, [Ord('C')]);
394	AssignKey(Result, isLeft, [Ord('S')]);	407	AssignKey(Result, isLeft, [Ord('S')]);
395	AssignKey(Result, isRight, [Ord('F')]);	408	AssignKey(Result, isRight, [Ord('F')]);
396	AssignKey(Result, isButton1, [Ord('Z')]);	409	AssignKey(Result, isButton1, [Ord('Z')]);
397	AssignKey(Result, isButton2, [Ord('X')]);	410	AssignKey(Result, isButton2, [Ord('X')]);
398	AssignKey(Result, isButton9, [VK_F2]);	411	AssignKey(Result, isButton9, [VK_F2]);
399	end;	412	end;
400		413
401	{ TForceFeedbackEffectObject }	414	{ TForceFeedbackEffectObject }
402		415
403	destructor TForceFeedbackEffectObject.Destroy;	416	destructor TForceFeedbackEffectObject.Destroy;
404	begin	417	begin
405	Release;	418	Release;
406	inherited Destroy;	419	inherited Destroy;
407	end;	420	end;
408		421
409	function ConvertTime(i: Integer): DWORD;	422	function ConvertTime(i: Integer): DWORD;
410	begin	423	begin
411	if i=-1 then Result := INFINITE else Result := i*1000;	424	if i=-1 then Result := INFINITE else Result := i*1000;
412	end;	425	end;
413		426
414	procedure TForceFeedbackEffectObject.Clear;	427	procedure TForceFeedbackEffectObject.Clear;
415	begin	428	begin
416	FillChar(Feff, SizeOf(Feff), 0);	429	FillChar(Feff, SizeOf(Feff), 0);
417	end;	430	end;
418		431
419	procedure TForceFeedbackEffectObject.Init(Effect: TForceFeedbackEffect);	432	procedure TForceFeedbackEffectObject.Init(Effect: TForceFeedbackEffect);
420	begin	433	begin
421	with FEnvelope do	434	with FEnvelope do
422	begin	435	begin
423	dwSize := SizeOf(FEnvelope);	436	dwSize := SizeOf(FEnvelope);
424		437
425	dwAttackLevel := Effect.FAttackLevel;	438	dwAttackLevel := Effect.FAttackLevel;
426	if Effect.FTime<0 then	439	if Effect.FTime<0 then
427	dwAttackTime := Effect.FAttackTime*1000	440	dwAttackTime := Effect.FAttackTime*1000
428	else	441	else
429	dwAttackTime := Min(Effect.FAttackTime, Effect.FTime)*1000;	442	dwAttackTime := Min(Effect.FAttackTime, Effect.FTime)*1000;
430		443
431	if Effect.FTime<0 then	444	if Effect.FTime<0 then
432	begin	445	begin
433	dwFadeLevel := 0;	446	dwFadeLevel := 0;
434	dwFadeTime := 0;	447	dwFadeTime := 0;
435	end else	448	end else
436	begin	449	begin
437	dwFadeLevel := Effect.FFadeLevel;	450	dwFadeLevel := Effect.FFadeLevel;
438	dwFadeTime := Min(Effect.FFadeTime, Effect.FTime)*1000;	451	dwFadeTime := Min(Effect.FFadeTime, Effect.FTime)*1000;
439	end;	452	end;
440	end;	453	end;
441		454
442	FillChar(Feff, SizeOf(Feff), 0);	455	FillChar(Feff, SizeOf(Feff), 0);
443	with Feff do	456	with Feff do
444	begin	457	begin
445	dwSize := SizeOf(Feff);	458	dwSize := SizeOf(Feff);
446	dwFlags := DIEFF_CARTESIAN or DIEFF_OBJECTOFFSETS;	459	dwFlags := DIEFF_CARTESIAN or DIEFF_OBJECTOFFSETS;
447	dwDuration := ConvertTime(Effect.FTime);	460	dwDuration := ConvertTime(Effect.FTime);
448	dwSamplePeriod := 0;	461	dwSamplePeriod := 0;
449	dwGain := Effect.FPower;	462	dwGain := Effect.FPower;
450	dwTriggerButton := DIEB_NOTRIGGER;	463	dwTriggerButton := DIEB_NOTRIGGER;
451	dwTriggerRepeatInterval := 0;	464	dwTriggerRepeatInterval := 0;
452	cAxes := FAxesCount;	465	cAxes := FAxesCount;
453	rgdwAxes := @FAxes;	466	rgdwAxes := @FAxes;
454	rglDirection := @FDirections;	467	rglDirection := @FDirections;
455	lpEnvelope := @FEnvelope;	468	lpEnvelope := @FEnvelope;
456	//dwStartDelay := Effect.FStartDelayTime;	469	//dwStartDelay := Effect.FStartDelayTime;
457	end;	470	end;
458	end;	471	end;
459		472
460	procedure TForceFeedbackEffectObject.Release;	473	procedure TForceFeedbackEffectObject.Release;
461	begin	474	begin
462	FEffect := nil;	475	FEffect := nil;
463	end;	476	end;
464		477
465	{ TForceFeedbackEffect }	478	{ TForceFeedbackEffect }
466		479
467	constructor TForceFeedbackEffect.Create(AParent: TForceFeedbackEffect);	480	constructor TForceFeedbackEffect.Create(AParent: TForceFeedbackEffect);
468	begin	481	begin
469	inherited Create;	482	inherited Create;
470	FParent := AParent;	483	FParent := AParent;
471	FList := TList.Create;	484	FList := TList.Create;
472		485
473	if FParent<>nil then	486	if FParent<>nil then
474	begin	487	begin
475	FParent.FList.Add(Self);	488	FParent.FList.Add(Self);
476	FRoot := FParent.FRoot;	489	FRoot := FParent.FRoot;
477	end else	490	end else
478	begin	491	begin
479	FName := 'Effects';	492	FName := 'Effects';
480	FRoot := Self as TForceFeedbackEffects;	493	FRoot := Self as TForceFeedbackEffects;
481	end;	494	end;
482		495
483	FObject := TForceFeedbackEffectObject.Create;	496	FObject := TForceFeedbackEffectObject.Create;
484	FObject2 := TForceFeedbackEffectObject.Create;	497	FObject2 := TForceFeedbackEffectObject.Create;
485		498
486	AttackTime := 0;	499	AttackTime := 0;
487	Constant := Point(0, 0);	500	Constant := Point(0, 0);

Subversion Repositories spacemission

spacemission/VCL_DELPHIX_D6/DXInput.pas – Rev 1 → 4