dxinput.pas

传奇源代码的delphi版本

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);