Ручная анимация прокрутки списка

[ra.eremeev]

Добрый день!

 

Подскажите, пожалуйста, как можно кодом (или с использованием компонентов TAnimation...) организовать программную прокрутку Listbox к заданному итему?

ScrollToItem дает мгновенный переход. Необходима именно плавная прокрутка списка приложением.

С анимацией не сталкивался ранее  Пол-дня "убил" и не смог сам разобраться

[mmover]

Вот, накидал класс который может помочь.

unit UAnimHelper;

interface
uses
  System.Classes,
  System.SysUtils,
  FMX.Types;

type
  TAnimateStep = reference to procedure(Value : Single);

  TAnimateHelper = class
  private
  type
    TAniInst = class(TFmxObject)
    private
      FValue : Single;
      FStepProc : TAnimateStep;
      FStopProc : TProc;
      procedure SetValue(Value : Single);
      procedure DoAniFinished(Sender: TObject);
    public
      constructor Create(AStepProc : TAnimateStep;
                         AStopProc : TProc);
    published
      property Value : Single read FValue write SetValue;
    end;
  public
    class procedure DoAnimate(Root : IRoot; // без указания формы анимация работать не будет
                              Duration, FromValue, ToValue : Single;
                              AType: TAnimationType;
                              AInterpolation: TInterpolationType;
                              StepProc : TAnimateStep;
                              StopProc : TProc = nil);
  end;

implementation

uses FMX.Ani;

constructor TAnimateHelper.TAniInst.Create(AStepProc : TAnimateStep;
                        AStopProc : TProc);
begin
 inherited Create(nil);
 FStepProc := AStepProc;
 FStopProc := AStopProc;
end;

procedure TAnimateHelper.TAniInst.SetValue(Value : Single);
begin
 if Assigned(FStepProc) then
   FStepProc(Value);
end;

procedure TAnimateHelper.TAniInst.DoAniFinished(Sender: TObject);
begin
 if Assigned(FStopProc) then
   FStopProc();

  TThread.ForceQueue(nil, procedure
  begin
    TAnimation(Sender).TagObject.DisposeOf;
  end);
end;

class procedure TAnimateHelper.DoAnimate(Root : IRoot;
                          Duration, FromValue, ToValue : Single;
                          AType: TAnimationType;
                          AInterpolation: TInterpolationType;
                          StepProc : TAnimateStep;
                          StopProc : TProc = nil);
var
 AniInst : TAniInst;
 Animation: TFloatAnimation;
begin
 AniInst := TAniInst.Create(StepProc,StopProc);
 AniInst.FValue := FromValue;

 Animation := TFloatAnimation.Create(nil);
 Animation.TagObject := AniInst;
 Animation.Parent := AniInst;
 Animation.SetRoot(Root);
 Animation.AnimationType := AType;
 Animation.Interpolation := AInterpolation;
 Animation.OnFinish := AniInst.DoAniFinished;
 Animation.Duration := Duration;
 Animation.PropertyName := 'Value';
 Animation.StartFromCurrent := True;
 Animation.StopValue := ToValue;
 Animation.Start;
end;

end.

 

Пример использования :

procedure TForm1.Button3Click(Sender: TObject);
begin
 TAnimateHelper.DoAnimate(Self, 1.2, ListBox1.ViewportPosition.Y , 400,
                          TAnimationType.&In,
                          TInterpolationType.Circular,
                          procedure(Value : Single)
                          begin
                            ListBox1.ViewportPosition := PointF(0,Value);
                          end);
end;

 

 

[RoschinSpb]

Можно попробовать TListBox.AniCalculations.MouseWheel

См. также Платформонезависимый скроллинг в Fire Monkey

 

[ra.eremeev]

2 часа назад, RoschinSpb сказал:

Можно попробовать TListBox.AniCalculations.MouseWheel

См. также Платформонезависимый скроллинг в Fire Monkey

 

Большое спасибо!

Указанный Вами способ отлично работает!