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 := 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